Градиентный метод первого порядка

Содержание

Содержание 1

Введение 2

Градиентные методы оптимизации 16

Градиентный метод первого порядка 19

Алгоритм градиентного метода 24

Математическое описание системы и значения переменных 26

Построение математической модели 37

Алгоритм реализации решения задачи построения динамической модели 38

Апробирование машинной программы 39

Результаты работы программы 42

Вывод 43

Список литературы 44

Листинг программы 45

unit MainUnit; 45

Введение

На современном этапе научно-технического прогресса необыкновенно возрастает роль средств, позволяющих рационально использовать ресурсы, выделенные для решения народнохозяйственных задач. Кибернетика предлагает такие средства, как исследование операций, теория систем, математическое моделирование, теория эксперимента, вычислительная техника и др.

Часть этих методов предназначена для увеличения эффективности научного эксперимента на всех стадиях разработки, исследования, проектирования и эксплуатации производств. Единство теории и практики эксперимента совместно с вычислительной техникой образуют комплекс автоматизированного эксперимента, предназначенный для повышения производительности научного труда.

Объекты, на которых проводятся эксперименты, отличаются прежде всего протекающими в них процессами. Объект, на котором осуществляется планируемый эксперимент, характеризуется обязательным условием — все входные переменные, или факторы, x_>1>, x_>2>, ..., x_>n> должны быть управляемыми. Этого требует сама постановка условий построения динамической модели, предполагающих активное вмешательство в ход эксперимента. Такой объект технологии называют объектом исследования.

Необходимыми и достаточными условием для определения любой отрасли знаний как науки является наличие: предмета исследования, метода исследования и средства для реализации этого метода. Для кибернетики как науки предметом исследования являются системы любой природы и их управляемость, методом исследования - математическое моделирование, стратегией исследования - системный анализ, а средством исследования - вычислительные машины.

Кибернетика включает в себя такие понятия, как системы, информация, хранение и переработка информации, управление системами и оптимизация систем. При этом кибернетика широко пользуется методом математического моделирования и стремится к получению конкретных результатов, позволяющих анализировать и синтезировать изучаемые системы, прогнозировать их оптимальное поведение и выявлять каналы и алгоритмы управления.

Методы кибернетики не только позволяют создавать оптимально функционирующий процесс или систему, но указывают пути выбора и использования оптимального режима, а также оптимального управления процессом или системой.

Понятие «системы» дает возможность осуществить математическую формализацию изучаемых объектов, обеспечивающую глубокое проникновение в их сущность и получение широких обобщений и количественных закономерностей.

Всякая система состоит из взаимосвязанных и взаимодействующих между собой и с внешней средой частей и в определенном смысле представляет собой замкнутое целое (иначе ее нельзя было бы назвать системой).

Система - это достаточно сложный объект, который можно расчленить (провести декомпозицию) на составляющие элементы, или подсистемы. Эти элементы информационно связаны друг с другом и с окружающей средой объекта. Совокупность связей образует структуру системы. Система имеет алгоритм функционирования, направленный на достижение определенной цели.

Системный анализ - это стратегия изучения сложных систем. В качестве метода исследования в нем используется математическое моделирование, а основным принципом является декомпозиция сложной системы на более простые подсистемы. В этом случае математическая модель системы строиться по блочному принципу: общая модель подразделяется на блоки, которым можно дать сравнительно простые математические описания. Необходимо иметь в виду, что все подсистемы взаимодействуют между собой, составляя общую единую математическую модель.

В основе стратегии системного анализа лежат следующие общие положения:

1. Четкая формулировка цели исследования;

2. Постановка задачи по реализации этой цели и определение критерия эффективности решения задачи;

3. Разработка развернутого плана исследования с указанием основных этапов и направлений решения задач;

4. Пропорционально - продвижение по всему комплексу взаимосвязанных этапов и возможных направлений;

5. Организация последовательных приближений и повторных циклов исследований на отдельных этапах;

6. Принцип нисходящей иерархии анализа и восходящей иерархии синтеза в решении составных частных задач и т.п.

Системный анализ организует наши знания об объекте таким образом, чтобы помочь выбрать нужную стратегию либо предсказать результаты одной или нескольких стратегий, представляющихся целесообразными темами, кто должен принимать решения. С позиции системного анализа решаются задачи моделирования, оптимизации, управления и оптимального проектирования систем.

Особый вклад системного анализа в решение различных проблем заключается в том, что он позволяет выявить факторы и взаимосвязи, которые в последствии могут оказаться весьма существенными, дает возможность видоизменить методику наблюдений и построить эксперимент так, чтобы эти факторы были включены в рассмотрение, и освещает слабые места гипотез и допущений. Как научный подход системный анализ с его акцентом на последовательное рассмотрение явлений в соответствии с разными уровнями иерархии и на проверку гипотез с помощью строгих выборочных процедур создает мощные инструменты познания физического мира и объединяет эти инструменты в систему гибкого, но строгого исследования сложных явлений.

Математическое моделирование осуществляется в три взаимосвязанные стадии:

1. Формализация изучаемого процесса - построение математической модели (составление математического описания);

2. Программирование решения задачи (алгоритмизация), обеспечивающего нахождение численных значений определяемых параметров;

3. Установление соответствия (адекватности) модели изучаемому процессу.

Построение математической модели:

В каждом конкретном случае математическую модель создают, исходя из целевой направленности процесса и задач исследования, с учетом требуемой точности решения и достоверности используемых исходных данных. При анализе полученных результатов возможно повторное обращение к модели с целью внесения коррективов после выполнения части расчетов.

Построение любой математической модели начинают с формализованного описания объекта моделирования. При этом аналитический аспект моделирования состоит в выражении смыслового описания объекта на языке математики в виде некоторой системы уравнений и функциональных соотношений между отдельными параметрами модели. Основным приемом построения математического описания изучаемого объекта является блочный принцип. Согласно этому принципу, после того как определен набор элементарных процессов, каждый из них исследуется по блокам в условиях, максимально приближенных к условиям эксплуатации объекта моделирования.

В результате каждому элементарному технологическому оператору ставиться в соответствие функциональный элементарный оператор с параметрами, достаточно близкими к истинным значениям.

Следующий этап моделирования состоит в агрегировании функциональных элементарных операторов в общий функциональный результирующий оператор, который и представляет математическую модель объекта. Важным фактором агрегирования является правильная взаимная координация отдельных операторов, которая не всегда возможна вследствие трудностей учета естественных причинно-следственных связей между отдельными элементарными процессами.

При выборе модели необходимо учитывать следующее:

- модель должна наиболее точно отражать характер потоков вещества и энергии при достаточно простом математическом описании;

- параметры модели могут быть определены экспериментальным или другим путем;

- в случае гетерогенных систем модели выбираются для каждой фазы в отдельности, причем для обеих фаз они могут быть одинаковыми или различными.

При построении математического описания используют уравнения таких видов:

- алгебраические уравнения;

- обыкновенные дифференциальные уравнения;

- дифференциальные уравнения в частных производных.

Алгоритмизация математических моделей:

После составления математического описания и выбора соответствующих начальных и граничных условий необходимо провести второй этап моделирования - довести задачу до логического конца, т. е. выбрать метод решения и составить программу (алгоритм).

В простейших случаях, когда возможно аналитическое решение системы уравнений математического описания, необходимость в специальной разработке моделирующего алгоритма, естественно, отпадает, так как вся информация может быть получена из соответствующих аналитических решений. Когда математическое описание представляет собой сложную систему конечных и дифференциальных уравнений, от возможности построения достаточно эффективного моделирующего алгоритма может существенно зависеть практическая применимость математической модели. В особенности это важно при использовании модели для решения задач, в которых она входит в качестве составной части более общего алгоритма, например, алгоритма оптимизации. Как правило, в таких случаях для реализации математической модели приходиться применять средства вычислительной техники; фактически без них нельзя ставить и решать сколько-нибудь сложные задачи математического моделирования и тем более задачи оптимизации, при решении которых расчеты по уравнениям математического описания обычно многократно повторяются.

Широко развитые в настоящее время методы численного анализа позволяют решать широкий круг задач математического моделирования.

Выбор численного метода:

При выборе метода для решения уравнений математического описания обычно ставиться задача обеспечения максимального быстродействия при минимуме занимаемой программой памяти. Естественно, при этом должна обеспечиваться заданная точность решения. Прежде чем выбрать тот или иной численный метод, необходимо проанализировать ограничения, связанные с его использованием, например, подвергнуть функцию или систему уравнений аналитическому исследованию, в результате которого выявиться возможность использования данного метода. При этом весьма часто исходная функция или система уравнений должна быть соответствующим образом преобразована с тем, чтобы можно было эффективно применить численный метод. Преобразованием или введением новых функциональных зависимостей часто удается значительно упростить задачу.

При выборе метода существенным моментом является размерность задачи. Некоторые методы эффективны при решении небольших задач, однако, с увеличением числа переменных объем вычислений настолько возрастает, что от них приходиться отказаться. Задачи такого класса обычно встречаются при решении систем уравнений, поиске оптимальных значений параметров многомерных функций. При соответствующем выборе метода можно уменьшить время, затрачиваемое на решение задачи и объем занимаемой машиной памяти.

Составление алгоритма решения:

Желательно составить четкое описание последовательности вычислительных и логических действий, обеспечивающих решение, т.е. составить алгоритм решения задачи. Основными требованиями к форме и содержанию записи алгоритма являются его наглядность, компактность и выразительность. В практике математического обеспечения вычислительных машин широкое распространение получил графический способ описания алгоритмов. Этот способ основан на представлении отдельных элементов алгоритма графическими символами, а всего алгоритма - в виде блок схемы. При этом набор графических символов не является произвольным, он регламентирован технической документацией по математическому обеспечению ЭВМ и соответствующими ГОСТами.

Методы оптимизации:

Оптимизация заключается в нахождении оптимума рассматриваемой функции или оптимальных условий проведения данного процесса. Для оценки оптимума необходимо прежде всего выбрать критерий оптимизации. В зависимости от конкретных условий в качестве критерия оптимизации можно взять технологический критерий, например максимальный съем продукции с единицы объема аппарата, экономический критерий - минимальную стоимость продукта при заданной производительности.

На основе выбранного критерия оптимизации составляется так называемая целевая функция, или функция выгоды, представляющая собой зависимость критерия оптимизации от параметров, влияющих на его значение. Задача оптимизации сводиться к нахождению экстремума (максимума или минимума) целевой функции.

Следует иметь в виду, что проблема оптимизации возникает в тех случаях, когда необходимо решать компромиссную задачу преимущественного улучшения двух или более количественных характеристик, различным образом влияющих на переменные процесса при условии их взаимной балансировки. Например, эффективность процесса балансируют с производительностью, качество - с количеством, запас единиц продукции - с их реализацией, производительность - с затратами.

Для автоматически управляемых процессов или систем различают две стадии оптимизации: статическую и динамическую.

Проблема создания и реализации оптимального стационарного режима процесса решает статическая оптимизация, создания и реализации системы оптимального управления процессом - динамическая оптимизация.

В зависимости от характера рассматриваемых математических моделей применяются различные математические методы оптимизации. Многие из них сводятся к нахождению минимума или максимума целевой функции. Линии, вдоль которых целевая функция сохраняет постоянное значение при изменении входящих в нее параметров, называются контурными или линиями уровня.

При выборе метода оптимизации необходимо учитывать возможные вычислительные трудности, обусловленные объемом вычислений, сложностью самого метода, размерностью самой задачи и т.п.

Целесообразно по возможности проводить предварительную оценку положения оптимума какой-либо конкретной задачи. Для этого необходимо рассмотреть исходные и основные соотношения между переменными. Для сокращения размерности задач часто используется прием выделения наиболее существенных переменных

Согласно принятой терминологии факторы x_>1>, x_>2>, ..., x_>n> — это измеряемые и регулируемые входные переменные объекта (независимые переменные); помехи f_>1>, f_>2>, ..., f_>s> — это не контролируемые, случайным образом изменяющиеся переменные объекта; выходные переменные y_>1>, y_>2>, ..., y_>m> — это контролируемые переменные, которые определяются факторами и связаны с целью исследования. Часто в планируемом эксперименте у называют параметром оптимизации (технологический или экономический показатель процесса).

Факторы x_>1>, x_>2>, ..., x_>n> иногда называют основными, поскольку они определяют условия эксперимента. Помехи f_>1>, f_>2>, ..., f_>s> — как правило недоступны для измерения. Они проявляются лишь в том, что изменяют влияние факторов на выходные переменные. Объект исследования может иметь несколько выходных переменных. Опыт показывает, что в большинстве случаев удается ограничиться одним параметром оптимизации, и тогда вектор Y превращается в скаляр y.

Количество факторов и характер их взаимосвязей с выходной переменной определяют сложность объекта исследования. При наличии качественной статистической информации о факторах и зависящей от них выходной переменной можно построить математическую модель объекта исследования и функцию отклика y = f(x_>1>, x_>2>, ..., x_>n>), связывающую параметр оптимизации с факторами, которые варьируются при проведении опытов.

Пространство с координатами x_>1>, x_>2>, ..., x_>n> принято называть факторным, а графическое изображение функции отклика в факторном пространстве — поверхностью отклика.

При описании объектов, находящихся в стационарном состоянии, математическая модель чаще всего представляется полиномом:

Y = f(x_>1>, x_>2>, ..., x_>n>, Я_>1>, Я_>2>, ... , Я_>n>). (1)

Поскольку в реальном процессе всегда существуют неуправляемые и неконтролируемые переменные, величина у носит случайный характер. Поэтому при обработке экспериментальных данных получаются так называемые выборочные коэффициенты регрессии b_>0>, b_>1>, ..., b_>i>, ..., b_>n>, являющиеся оценками коэффициентов Я_>0>, Я_>1>, ..., Я_>i>, ..., Я_>n>.

Тогда математическая модель в форме уравнения регрессии в общем случае будет иметь вид:

(2)

Если анализируются нестационарные, т. е. изменяющиеся во времени состояния объекта, что характерно для динамического процесса, приходится рассматривать не случайные величины, как ранее, а случайные процессы. Случайный процесс можно рассматривать как систему, состоящую из бесконечного множества случайных величин. При моделировании таких объектов использовать модель в виде (2) уже недопустимо — необходимо переходить к специальным интегрально-дифференциальным моделям и методам. В нашем случае – это градиентный метод первого порядка.

Составлению плана эксперимента всегда должны предшествовать сбор априорной информации для составления характеристики объекта исследования, опыты по наладке экспериментальной установки и при необходимости — опыты для установления области определения наиболее существенных факторов и выходной переменной.

Теорией и практикой эксперимента выработаны определенные требования (условия), которым должны удовлетворять независимые и зависимые переменные. Поэтому на стадии подготовки к проведению эксперимента весьма полезны приведенные ниже рекомендации.

1. При выборе выходной переменной необходимо учитывать, что она должна иметь количественную характеристику, т. е. должна измеряться; должна однозначно оценивать (измерять) работоспособность объекта исследования; быть статистически эффективной, т. е. иметь возможно меньшую дисперсию при проведении опытов (это позволяет четко различать опыты); отражать как можно более широкий спектр исследуемого явления, т. е. обладать универсальностью (практически это требование обеспечить трудно, тогда рекомендуют пользоваться так называемой обобщенной переменной); иметь достаточно четкий физический смысл.

2. При выборе факторов нужно выполнять следующие требования: фактор должен быть регулируемым, т. е. определенным регулирующим устройством фактор должен изменяться от значения x^’_>i> до значения x^’’_>i>; точность изменения и управления фактором должна быть известна и достаточно высока (хотя бы на порядок выше точности измерения выходной переменной), очевидно, что низкая точность измерения фактора уменьшает возможности воспроизведения эксперимента; связь между факторами должна быть как можно меньшей (в пределе должна отсутствовать), это свойство называют однозначностью факторов, что соответствует независимости одного фактора от другого.

Ряд требований предъявляется одновременно к факторам и выходной переменной: факторы и выходная переменная должны иметь области определения, заданными технологическими или принципиальными ограничениями; области определения факторов должны быть таковы, чтобы при их предельных значениях значение выходной переменной оставалось в своих границах; между факторами и выходной переменной должно существовать однозначное соответствие (причинно-следственная связь).

Успех современного экспериментирования в значительной степени обязан теории эксперимента, которая призвана дать экспериментатору ответы на следующие вопросы:

Как нужно организовать эксперимент, чтобы наилучшим образом решить поставленную задачу (в смысле затрат времени, средств или точности результатов).

Как следует обрабатывать результаты эксперимента, чтобы получить максимальное количество информации об исследуемом объекте.

Какие обоснованные выводы можно сделать об исследуемом объекте по результатам эксперимента.

Основой теории эксперимента является статистическое представление об эксперименте (рассматриваются случайные величины или случайные функции). Это представление отвечает действительности: как правило, итоги эксперимента связаны с некоторой неопределенностью, получающейся в результате влияния неконтролируемых факторов, случайного характера процесса на микроуровне, изменений условий эксперимента, ошибок измерения и др.

Теория эксперимента указывает исследователю точную логическую схему и способы поиска решения задач на разных этапах исследования. Можно представить весь процесс исследования циклами, повторяющимися после решения каждой из последовательных задач исследования, причем объем знаний об объекте непрерывно увеличивается.

Цель настоящей работы состоит в построении динамической модели заданного эксперимента, широко используемой при решении задач лабораторных и промышленных исследований. В работе рассмотрены основные методы и алгоритмы, относящиеся к идентификации динамических систем градиентным методом первого порядка.

Моделирование и программирование динамических систем

Метод динамического программирования применяется для многостадийных процессов, характеризуемых последовательностью решений и тем, что состояние системы зависит только от предыдущего шага, т. е. не зависит от ранее сделанных шагов.

В таких случаях используется принцип оптимальности, который формулируется в следующем виде: оптимальная стратегия обладает таким свойством, что, каково бы ни было начальное состояние и начальное решение, последующие решения должны приниматься, исходя из оптимальной стратегии относительно состояния, получаемого в результате первого решения.

Основная идея динамического программирования и заключается в том, что если какой-либо поток изменяется на каждой стадии процесса, то, если на последней стадии режим работы (независимо от режима работы на всех стадиях) не будет оптимальным по отношению к поступающему на нее потоку, не будет оптимальным и режим всего многостадийного процесса в целом.

Применение метода динамического программирования состоит в определении такого режима работы стадии, который максимизирует доход на этой и всех последующих стадиях для любых возможных состояний поступающего на нее потока. Обычно рассмотрение начинается с последней стадии процесса. Оптимальный режим всего процесса определяется постадийно.

Таким образом, метод динамического программирования предполагает разбиение анализируемого процесса во времени или пространстве на стадии или ступени. В качестве стадии можно принять единицу времени (минута или час), единичный элемент оборудования (тарелка в ректификационной колонне или реактор в цепочке реакторов).

В любом случае стадия или ступень – это математическая абстракция, применяемая для представления непрерывной переменной в дискретном виде. Состояние системы характеризуется совокупностью переменных, описывающих систему на любой стадии процесса.

Каждая стадия характеризуется входными xⁱ^-1 и выходными xⁱ параметрами, а также параметрами управления uⁱ. При помощи управляющих воздействий оптимизируется результирующая оценка эффективности многостадийного процесса, определяемая как аддитивная функция результатов, получаемых на каждой стадии ui(x_>1>ⁱ^-1, uⁱ):

(1)

Значение критерия оптимальности R_>N> зависит от совокупности u_>N> управляющих воздействий на всех стадиях. Совокупность управлений называется стратегией управления многостадийным процессом.

Основным уравнением динамического программирования является функциональное уравнение вида:

, (2)

где - оптимизируемая функция N-стадийного процесса, максимальное значение критерия R_>N>.

Максимизация первого слагаемого r_>1>(x⁰,u¹), представляющего собой частный критерий, характеризующий первую стадию, проводится только по управлению u¹.

Член есть значение оптимизируемой функции на последующих N-1 стадиях и максимизируется выбором управлений на всех стадиях, uⁱ (I = 1,…,N), поскольку значение x¹ зависит от управления u¹.

Выражение (2) представляет собой рекуррентное соотношение, характеризующее последовательность функций последняя из которых отвечает искомому решению оптимальной задачи. Стратегия решения выражается системой выбранных значений u_>i> – членов уравнения (2), где i = 1, 2, ..., N; система дает решение функционального уравнения. Оптимальная стратегия выражается системой функций u_>i>, которые максимизируют правую часть уравнения (2), а именно: для i = 1, 2, ..., N.

Часто важно знать сам характер оптимальной стратегии, нежели значение оптимизируемой функции. В ходе определения функции f_>N>(x) получают одновременно последовательность решений u_>i> или стратегию также в виде функции номера стадии i.

Решение рекуррентных уравнений обычно выполняется численными методами. Часто используется следующая последовательность расчета с применением вычислительной машины: сначала находят f_>1>(x), затем по найденному значению функции f_>1>(x) по уравнению ( 1 ) определяют функцию f_>2>(x); далее последовательно определяют f_>3>(x) из f_>2>(x) и т.д.

При решении задач оптимизации и моделировании динамической системы методом динамического программирования необходимо обратить внимание на следующие основные положения:

А) оптимизируемый процесс должен быть дискретно-распределенным во времени или пространстве (многостадийный процесс);

Б) отдельные стадии процесса должны обладать относительной независимостью, т.е. вектор выходных параметров любой стадии должен зависеть только от вектора входных параметров на эту стадию и управления на ней;

В) критерий оптимальности всего процесса должен быть сформулирован как аддитивная функция критериев оптимальности каждой стадии.

Если выполняются эти условия, необходимо правильно сформулировать задачу оптимизации. При формулировке задачи оптимизации и моделирования должны быть выявлены: 1) параметры, характеризующие состояние каждой стадии; 2) управляющие параметры на каждой стадии; 3) ограничения, которые накладываются на параметры состояния процесса и управляющие параметры. Кроме того, должно быть составлено математическое описание для каждой стадии и определен критерий оптимальности.

Градиентные методы оптимизации

Градиентные методы оптимизации относятся к численным методам поискового типа. Они универсальны, хорошо приспособлены для работы с современными цифровыми вычислительными машинами и в большинстве случаев весьма эффективны при поиске экстремального значения нелинейных функций с ограничениями и без них, а также тогда, когда аналитический вид функции вообще неизвестен. Вследствие этого градиентные, или поисковые, методы широко применяются на практике.

Сущность указанных методов заключается в определении значений независимых переменных, дающих наибольшие изменения целевой функции. Обычно для этого двигаются вдоль градиента, ортогонального к контурной поверхности в данной точке.

Различные поисковые методы в основном отличаются один от другого способом определения направления движения к оптимуму, размером шага и продолжительностью поиска вдоль найденного направления, критериями окончания поиска, простотой алгоритмизации и применимостью для различных ЭВМ. Техника поиска экстремума основана на расчетах, которые позволяют определить направление наиболее быстрого изменения оптимизируемого критерия.

Если критерий задан уравнением

, (3)

то его градиент в точке (x_>1>, x_>2>,…, x_>n>) определяется вектором:

. (4)

Частная производная пропорциональна косинусу угла, образуемого вектором градиента с i-й осью координат. При этом

(5)

Наряду с определением направления градиентного вектора основным вопросом, решаемым при использовании градиентных методов, является выбор шага движения по градиенту. Величина шага в направлении gradF в значительной степени зависит от вида поверхности. Если шаг слишком мал, потребуются продолжительные расчеты; если слишком велик, можно проскочить оптимум. Размер шага должен удовлетворять условию, при котором все шаги от базисной точки лежат в том же самом направлении, что и градиент в базисной точке. Размеры шага по каждой переменной x_>i> вычисляются из значений частных производных в базовой (начальной) точке:

, (6)

где К – константа, определяющая размеры шага и одинаковая для всех i-х направлений. Только в базовой точке градиент строго ортогонален к поверхности. Если же шаги слишком велики в каждом i-м направлении, вектор из базисной точки не будет ортогонален к поверхности в новой точке.

Если выбор шага был удовлетворительным, производная в следующей точке существенно близка к производной в базисной точке.

Для линейных функций градиентное направление не зависит от положения на поверхности, для которой оно вычисляется. Если поверхность имеет вид

то

и компонента градиента в i-м направлении равна

. (7)

Для нелинейной функции направление градиентного вектора зависит от точки на поверхности, в которой он вычисляется.

Несмотря на существующие различия между градиентными методами, последовательность операций при поиске оптимума в большинстве случаев одинакова и сводится к следующему:

а) выбирается базисная точка;

б) определяется направление движения от базисной точки;

в) находится размер шага;

г) определяется следующая точка поиска;

д) значение целевой функции в данной точке сравнивается с ее значением в предыдущей точке;

е) вновь определяется направление движения и процедура повторяется до достижения оптимального значения.

Градиентный метод первого порядка

При оптимизации методом градиента оптимум исследуемого объекта ищут в направлении наиболее быстрого возрастания (убывания) выходной переменной, т.е. в направлении градиента. Но прежде чем сделать шаг в направлении градиента, необходимо его рассчитать. Градиент можно рассчитать либо по имеющейся модели

grad y(X)= ,

моделирование динамический градиентный полиномиальный

где - частная производная по i-му фактору;

i, j, k – единичные векторы в направлении координатных осей факторного пространства, либо по результатам n пробных движений в направлении координатных осей.

Если математическая модель статистического процесса имеет вид линейного полинома, коэффициенты регрессии b_>i> которого являются частными производными разложения функции y = f(X) в ряд Тейлора по степеням x_>i>, то оптимум ищут в направлении градиента с некоторым шагом h_>i>:

пкфв н(Ч)= и_>1>р_>1>+и_>2>р_>2>+…+и_>т>р_>т>

Направление корректируют после каждого шага.

Метод градиента вместе с его многочисленными модификациями является распространенным и эффективным методом поиска оптимума исследуемых объектов. Рассмотрим одну из модификаций метода градиента – метод крутого восхождения.

Метод крутого восхождения, или иначе метод Бокса-Уилсона, объединяет в себе достоинства трех методов - метода Гаусса-Зейделя, метода градиентов и метода полного (или дробного) факторного экспериментов, как средства получения линейной математической модели. Задача метода крутого восхождения заключается в том, чтобы шаговое движение осуществлять в направлении наискорейшего возрастания (или убывания) выходной переменной, то есть по grad y(X). В отличии от метода градиентов, направление корректируется не после каждого следующего шага, а при достижении в некоторой точке на данном направлении частного экстремума целевой функции, как это делается в методе Гаусса-Зейделя. В точке частного экстремума ставится новый факторный эксперимент, определяется математическая модель и вновь осуществляется крутое восхождение. В процессе движения к оптимуму указанным методом регулярно проводиться статистический анализ промежуточных результатов поиска. Поиск прекращается, когда квадратичные эффекты в уравнении регрессии становятся значимыми. Это означает, что достигнута область оптимума.

Опишем принцип использования градиентных методов на примере функции двух переменных

(8)

при наличии двух дополнительных условий:

, .(9)

Этот принцип (без изменения) можно применить при любом числе переменных, а также дополнительных условий. Рассмотрим плоскость x_>1>, x_>2> (Рис. 1). Согласно формуле (8) каждой точке соответствует некоторое значение F. На Рис.1 линии F = const, принадлежащие этой плоскости, представлены замкнутыми кривыми, окружающими точку M^*, в которой F минимально. Пусть в начальный момент значения x_>1> и x_>2> соответствуют точке M_>0>. Цикл расчета начинается с серии пробных шагов. Сначала величине x_>1> дается небольшое приращение ; в это время значение x_>2> неизменно. Затем определяется полученное при этом приращение величины F, которое можно считать пропорциональным значению частной производной

(10)

(если величина всегда одна и та же).

Рис.1

Далее дается приращение величине x_>2>. В это время x_>1> = const. Получаемое при этом приращение величины F является мерой другой частной производной:

. (11)

Определение частных производных ( 10 ) и ( 11 ) означает, что найден вектор с координатами и , который называется градиентом величины F и обозначается так:

. (12)

Известно, что направление этого вектора совпадает с направлением наиболее крутого возрастания величины F. Противоположное ему направление – это «наискорейший спуск», другими словами, наиболее крутое убывание величины F.

После нахождения составляющих градиента пробные движения прекращаются и осуществляются рабочие шаги в направлении, противоположном направлению градиента, причем величина шага тем больше, чем больше абсолютная величина вектора grad F. Эти условия осуществляются, если величины рабочих шагов и пропорциональны полученным ранее значениям частных производных:

, , (13)

где α – положительная константа.

После каждого рабочего шага оценивается приращение величины F. Если оно оказывается отрицательным, то движение происходит в правильном направлении и нужно двигаться в том же направлении M_>0>M_>1> дальше. Если же в точке M_>1> результат измерения показывает, что , то рабочие движения прекращаются и начинается новая серия пробных движений. При этом определяется градиент gradF в новой точке M_>1>, затем рабочее движение продолжается по новому найденному направлению наискорейшего спуска, т. е. по линии M_>1>M_>2>, и т.д. Этот метод называется методом наискорейшего спуска/крутого восхождения.

Когда система находится вблизи минимума, показателем чего является малое значение величины

(14)

происходит переключение на более «осторожный» метод поиска, так называемый метод градиента. От метода наискорейшего спуска он отличается тем, что после определения градиента gradF делается лишь один рабочий шаг, а затем в новой точке опять начинается серия пробных движений. Такой метод поиска обеспечивает более точное установление минимума по сравнению с методом наискорейшего спуска, между тем как последний позволяет быстрее приблизиться к минимуму. Если в процессе поиска точка М доходит до границы допустимой области и хотя бы одна из величин М_>1>, М_>2> меняет знак, метод меняется и точка М начинает двигаться вдоль границы области.

Эффективность метода крутого восхождения зависит от выбора масштаба переменных и вида поверхности отклика. Поверхность со сферическими контурами обеспечивает быстрое стягивание к оптимуму.

К недостаткам метода крутого восхождения следует отнести:

1. Ограниченность экстраполяции. Двигаясь вдоль градиента, мы основываемся на экстраполяции частных производных целевой функции по соответствующим переменным. Однако форма поверхности отклика может изменяться и необходимо изменять направление поиска. Другими словами, движение на плоскости не может быть продолжительным.

2. Трудность поиска глобального оптимума. Метод применим для отыскания только локальных оптимумов.

Алгоритм градиентного метода

Представим последовательность расчета: расчет составляющих градиента.

Практически расчет составляющих градиента реализуется вычислением произведений коэффициентов регрессии на соответствующие интервалы варьирования значимых факторов.

Тогда уравнение

пкфв н(Ч) = и_>1>р_>1>+ и_>2>р_>2>+ … + и_>т>р_>т>

примет вид

grad (X)= b_>1>_>> + b_>2>_>> + … + b_>n>

т.е. в качестве шагов крутого восхождения выбираются интервалы варьирования факторов.

Выбор базового фактора:

Фактор, для которого произведение коэффициента регрессии на интервал варьирования максимально, принимается базовым:

max (b_>i>) = a

Выбор шага крутого восхождения:

Для базового (или другого) фактора выбирают шаг крутого восхождения h_>a>. Обычно его выбирают по совету технологов или по имеющейся априорной информации.

Пересчет составляющих градиента:

Здесь используется условие: умножение составляющих градиента на любое положительное число дает точки, также лежащие на градиенте.

Составляющие градиента пересчитывают по выбранному шагу крутого восхождения базового фактора:

h_>i>= (*)

Коэффициенты b_>i> в выражении (*) берутся со своими знаками, шаги h_>i>_>>округляют.

Принятие решений после крутого восхождения:

После того, как экспериментальная проверка определила некоторую оптимальную точку, крутое восхождение считается завершенным. Здесь, как и ранее, необходимо принимать решения, которые зависят, прежде всего, от эффективности крутого восхождения. Большое влияние на результаты принятия решений оказывает информация об адекватности или неадекватности линейной модели и о положении области оптимума. Конечно, сведения о положении области оптимума носят весьма неопределенный характер и зависят от конкретной задачи, где переменная состояния – например, прочность материала на разрыв. Однако можно безошибочно оценить положение оптимума, если переменная состояния - выход целевого продукта в процентах.

Математическое описание системы и значения переменных

В нашем случае имеем:

При построении математической модели определённого в условии технологического процесса одновременно решается задача оптимизации поверхности отклика , то есть определяются значения факторов, при которых , что означает, что . Известно, что одним из наиболее эффективных методов решеня задачи является градиентный метод. Согласно ему в данном случае (исходя из условий задачи) из каждой точки направление движения осуществляется в сторону, противоположную самому градиенту. Отсюда в каждой точке необходимо провести расчет градиента следующего вида:

, где i и k – единичные орты

Как правило, определить всю математическую модель процесса достаточно сложно, поэтому здесь нужно воспользоваться следующей процедурой:

В окрестности начальной точки

производится полный факторный эксперимент или дробный факторный эксперимент. Мы будем использовать полный факторный эксперимент.

Следует охарактеризовать общие положения проведения полного факторного эксперимента:

Применение полного факторного эксперимента позволяет найти оптимальное расположение точек в факторном пространстве и осуществить линейное преобразование координат, благодаря чему обеспечивается возможность преодолеть недостатки классического регрессионного анализа, в частности корреляцию между коэффициентами уравнения регрессии.

Некоторые обозначения для дальнейшего понимания изложения материала:

Xj-факторы;

Рj- регрессионные коэффициенты системы;

Y- выходная переменная (функция отклика);

М [f]- математическое ожидание помехи;

D [f] – дисперсия помехи;

l – число уровней ;

k – количество факторов;

Уровень факторов – граница исследования области по данному параметру;

Точка с координатами (Х_>0>(1),Х_>0>(2),…) - центр плана, или основной уровень;

- единица варьирования, или интервал варьирования;

S – дисперсия;

вектор В - вектор коэффициентов регрессии;

N - число опытов в матрице планирования;

Р - коэффициент взаимодействия;

b_>j>_>>- несмешанные оценки;

- генеральные коэффициенты;

S2_>воспр> - дисперсия воспроизводимости;

t_>j> - критерий Стьюдента;

F – критерий Фишера.

Выбор плана исследования эксперимента определяется постановкой задачи исследования и особенностями объекта. Пусть имеем математическую модель системы:

_>>

Также нам известны характер помехи и статистические параметры: М[f] = 0 и D[f] = 0,8. Необходимо отметить, что под помехами понимают ряд факторов, искажающих результаты опыта. Если существуют определённые априорные сведения об источнике помех, то можно построить оптимальные планы исследования, учитывающие их влияние, и повысить таким образом точность анализа результата.

В данной задаче требуется провести полный факторный эксперимент.

Полный факторный эксперимент, или метод планирования эксперимента позволяет свести к минимуму число необходимых опытов и одновременно получить оптимальные значения искомых функций. При планировании эксперимента, условия опыта представляют собой фиксированное число значений для каждого фактора. Полный факторный эксперимент фактически представляет собой применение классических метода наименьших квадратов и регрессионного анализа, проводимых по определённому плану.

Процесс исследования обычно разбивается на отдельные этапы. Информация, полученная после каждого этапа, определяет дальнейшую стратегию эксперимента. Таким образом возникает возможность оптимального управления экспериментом. Планирование эксперимента позволяет одновременно варьировать все факторы и получать количественные оценки основных эффектов и эффектов взаимодействия.

Интересующие исследователя эффекты определяются со значительно меньшей ошибкой, чем та, которая характерна для других методов исследования.

В конечном счете, применение методов планирования эксперимента значительно повышает эффективность эксперимента.

Так как при планировании по схеме полного факторного эксперимента реализуются все возможные комбинации факторов на всех выбранных для исследования уровнях, то необходимое число опытов N при полном факторном эксперименте определяется по формуле: N=l^k.

Если эксперименты проводятся только на двух уровнях при двух значениях факторов и при этом в процессе эксперимента осуществляются все возможные комбинации из k факторов, то такой план носит название полный факторный эксперимент типа 2^k.

Описание алгоритма моделирования сводится к следующему:

1. Определяется для любого фактора:

Х_>0>_>j> = (Х_>>_>j> _>max>_>>+ Х_>>_>j> _>min> ) / 2,

= (Х_>jmax>_>>- Х_>jmin>) / 2, j = 1,2,…..k ;

2. От основной системы координат (Х_>1>, Х_>2>, …Х_>n>_>>) переходим к безразмерной системе координат (U_>1>, U_>2>, …U_>n>_>>) c помощью формулы перехода:

U_>j>_>>= (Х_>>_>j> - Х_>>_>j>⁰ ) / , j = 1,2,…..k;

В безразмерной системе координат верхний уровень равен +1, а нижний равен –1, координаты центра плана равны нулю и совпадают с началом координат.

3. План эксперимента:

В матрицу планирования (Табл. 1.1) записываются все возможные значения граничных величин в натуральном масштабе.

Таблица 1.1

Номер опыта	Значения факторов в натуральном масштабе	выход
	X_>1>	X_>2>	…	X_>n>	Y
1	X_>11>	X _>12>	…	X _{>1 n}>	Y_>1>
2	X _>21>	X_>2 2>	…	X _{>2 n}>	Y_>2>
….	…	…	…	…	...
N	X _>N1>	X _>N2>	…	X_>Nn>	Y_>N>

Введём фиктивный столбец U_>0> в матрицу и запишем матрицу в безразмерной форме (Табл.1.2):

Таблица 1.2

Номер опыта	фиктивный столбец	Значения факторов в безразмерной системе координат	Выход
U_>0>	U_>1>	U_>2>	…	U_>n>	У
1	+1	+1	+1	…	+1	У_>1>
2	+1	-1	+1	…	+1	У_>2>
...	…	…	…	…	….	…
N	+1	-1	-1	…	-1	У_>N>

5. Приведём полную матрицу планирования (Табл. 1.3.):

Таблица 1.3

Номер опыта	Значения факторов	Выход
В натуральном масштабе	В безразмерной системе координат
X_>1>	X_>2>	…	X_>n>	U _>0>	U_>1>	U_>2>	…	U_>n>	Y
1	X_>11>	X_>12>	…	X_>1n>	+1	+1	+1	…	+1	Y_>1>
2	X_>21>	X_>22>	…	X_>2>_>n>	+1	-1	+1	…	+1	Y_>2>
…	…	…	…	…	…	…	…	…	…	…
N	X_>N1>	X _>N2>	…	X_>Nn>	+1	-1	-1	…	-1	Y_>N>

Предложенный план эксперимента обладает следующими свойствами:

Свойство симметричности.

;

Свойство нормировки.

;

Свойство ортогональности.

, ( l_>>j , l,i = 1…k );

Следует отметить, что ортогональные планы полный факторный эксперимент ( для линейных моделей ) обладают также рототабельностью. Последнее предполагает равенство и минимальность дисперсий предсказанных значений выходной переменной для всех точек факторного пространства. По закону накопления ошибок для дисперсии предсказанных уравнением регрессии значений выходной переменной можно записать:

s²_>y>= s²_>b>_>0>+ s²_>b>_>1>U_>1>²+ … + s²_>bn>U_>n>²

Дисперсии коэффициентов регрессии равны между собою, поэтому

s²_>y>_>>= s²_>bi>

С учетом того, что

_>>,

Где - радиус сферы имеем

s²_>y>_>>= s²_>bi>.

Отсюда ясно, что дисперсия предсказанного значения выходной переменной зависит только от радиуса сферы. Это свойство рототабельности эквивалентно независимости дисперсии выходной переменной от вращения координат в центре плана и оправдано при поиске оптимума градиентными методами. Интуитивно понятно, что исследователю удобно иметь дело с такой информацией, содержащейся в уравнении регрессии, которая равномерно «размазана» по сфере радиусом . Действительно такое положение можно признать разумным, ибо с помощью уравнения регрессии будут предприниматься попытки предсказать положение ещё неизвестных участков факторного пространства. Равноценность этих участков в смысле ошибки предсказания, по-видимому, является необходимой.

Свойство ортогональности существенно облегчает процесс вычисления коэффициентов, так как корреляционная матрица (U^ТU)^-1 становится диагональной, и коэффициенты будут равны 1/N;

6. С учетом свойства ортогональности можно вычислить вектор В коэффициентов регрессии:

Следовательно, любой коэффициент уравнения регрессии bj определяется скалярным произведением столбца Y на соответствующий столбец Uj, деленным на число опытов N в матрице планирования:

_>>

Вычислим коэффициенты регрессии линейного уравнения :

Если в рассмотрение ввести более полное уравнение регрессии с коэффициентами взаимодействия Р, то используя процедуру метода наименьших квадратов , получим:

_>>.

Пользуясь планом, представленным в табл. 1.2, можно перечислить коэффициенты регрессии и записать в табл.1.4:

Y = Р_>0> + Р_>1>U_>1> + Р_>2>U_>2> + … + Р_>n>U_>n>_>>+ … +

+…+_>>P_>13>U_>1>U_>3> + P_>23>U_>2>U_>3> + … + P_>123>U_>1>U_>2>U_>3>…

Таблица 1.4

Номер опыта	U_>0>	U_>1>	U_>2>	…	U_>n>	…	_>>	_>>	_>>	…	У
1	+1	+1	+1	…	+1	_>…>	-1	+1	+1	_>…>	У_>1>
2	+1	-1	+1	…	+1	_>…>	-1	-1	+1	_>…>	У_>2>
…	…	…	…	…	…	…	…	…	…	…	…
N	+1	-1	-1	…	-1	_>…>	-1	+1	+1	_>…>	У_>N>

P_>12>, P_>23>- эффекты двойного взаимодействия, а P_>123> - эффекты тройного взаимодействия. Эффекты взаимодействия определяют аналогично линейным эффектам:

7. Проверка однородности дисперсии и значимости коэффициентов регрессии.

Если дополнительно поставить параллельные опыты, можно определить s²_>воспр>- дисперсию воспроизводимости, проверить значимость коэффициентов регрессии, а при наличии степеней свободы – адекватность уравнения.

В связи с тем, что корреляционная матрица (U*U)^-1 для спланированного эксперимента есть матрица диагональная

коэффициенты уравнения регрессии некоррелированы между собой. Значимость коэффициентов уравнения регрессии можно проверять для каждого коэффициента в отдельности, пользуясь критерием Стьюдента : . Исключение из уравнения регрессии незначимого коэффициента не скажется на значениях остальных коэффициентов. При этом выборочные коэффициенты b_>j> оказываются так называемыми несмешанными оценками для соответствующих генеральных коэффициентов β_>j>:

b_>j>_>> β_>j>, т. е. величины коэффициентов уравнения регрессии характеризуют вклад каждого фактора в величину y.

Диагональные элементы корреляционной матрицы равны между собой, поэтому все коэффициенты уравнений

Y = и Y = Р_>0> + Р_>1>U_>1> + Р_>2>U_>2> + … + Р_>n>U_>n>_>>+ … +

+ … +

oпределяются с одинаковой точностью:

s_>bj>= s²_>воспр>

8. Проверка адекватности уравнения

Проверка адекватности уравнения проводится по критерию Фишера:

Рассчитывается значение

F= s²_>ост>/ s²_>воспр> ; s²_>ост> _>,>

где m - число значимых коэффициентов в уравнении регрессии.

После проведения полного факторного эксперимента определены коэффициенты регрессии

Тогда частные производные будут пропорциональны .

Делая, с учетом последнего выражения, шаг в сторону, противоположную среднему, определяем новую точку и опять проводим эксперимент.

Повторяем первые три шага, пока не приблизимся к точке экстремума. При приближении к точке экстремума алгоритм начинает работать плохо при близости к нулю частных производных, то есть линейная модель становится неадекватной и требует введения квадратичных членов.

По условию дано:

, T = 20, U(t) = 15 – 0.1t, .

Уравнение выхода системы:

, , .

Значение параметров системы:

, .

Характер помехи и ее статистические параметры:

Нормальное распределение

Здесь - вектор состояния системы; - вектор наблюдения; - вектор помехи; А, В, С – матрицы коэффициентов (параметров) системы; [0, T] – интервал определения системы.

Необходимо

- составить в соответствии с математическим ожиданием системы ее имитационную модель для формирования реализации вектора и состояния системы на интервале определения;

- составить алгоритм и программу решения задачи построения динамической модели в соответствии с заданным типом модели методом идентификации и точностью решения задачи;

- отладить программу;

- провести расчеты и анализ полученных результатов.

Построение математической модели

Учитывая характер помехи можно составить следующую имитационную модель системы для формирования реализации вектора и состояния системы на интервале определения:

, ; .

Здесь - вектор состояния системы; - вектор состояния модели; - матрицы коэффициентов модели.

, T = 20, U(t) = 15 – 0.1t, .

Здесь [0, T] – интервал определения системы.

Уравнение выхода системы:

, , .

Здесь - вектор наблюдения; - вектор помехи; С – матрица коэффициентов (параметров) системы.

Значение параметров системы:

, .

Здесь А, В – матрицы коэффициентов (параметров) системы.

Характер помехи и ее статистические параметры:

Помеха имеет нормальное распределение с математическим ожиданием, равным .

Алгоритм реализации решения задачи построения динамической модели

Идея построения требуемой динамической системы состоит в следующем: для заданного значения параметра t с его интервала определения градиентным методом первого порядка находим соответствующее значение параметра x, который изменяется динамически. Поэтому необходимо в каждый момент t_>i> найти оптимальное соответствующее значение фактора х и функции отклика у, которые наиболее близко описывали бы исходную систему. Помеха имеет нормальное распределение, поэтому включаем ее в функцию отклика таким образом, как показано в выше предложенных формулах.

Для поиска решения необходимо рассчитать оптимальный шаг .

Это делается по выше указанной формуле ( 6 ) – поиск шага варьирования. Именно так и реализуем в программном решении данной задачи.

Для поиска оптимального решения используем матрицы коэффициентов модели , с помощью которых определяем соответствующее значение функции отклика. Все выше сказанное реализовано в предлагаемой программе, в которой реализовано решение задачи построения динамической модели в соответствии с заданным типом модели методом идентификации и точностью решения задачи. Программа отлажена на упрощенных тестовых примерах с использованием информации, полученной от имитационной тестовой модели.

Проведен анализ полученных результатов, что также отражено в предложенной программе.

Апробирование машинной программы

Как было отмечено ранее, в данной программе кроме ручного ввода исходных значений факторов Х (т. е. задание так называемой «нулевой точки») существует задание количества факторов и количества опытов, как по умолчанию, так и непосредственно пользователем.

Программа исследований программного эксперимента:

Решает задачу оптимизации поверхности отклика. В начале работы требуется задать значения функции отклика Y, для которых и будет найдены соответствующие значения факторов X, при которых функция отклика принимает максимальное значение.

Задаем количество факторов и экспериментов

Получаем значения факторов в натуральном масштабе, заполняем матрицу планирования.

Производим кодирование в безразмерной системе координат, для каждого фактора определяются нулевые уровни и интервалы варьирования. Они будут использованы для определения градиента в данной точке.

Получаем значения коэффициентов регрессии.

Считаем выборочные дисперсии, и если они однородны, выводим значение дисперсии воспроизводимости

Проверяем на значимость коэффициенты регрессии.

В данном случае все коэффициенты значимы.

6. Получаем информацию о том, описывает ли уравнение эксперимент адекватно.

7. Делаем шаг в сторону, противоположную градиенту и находим новую точку (набор факторов).

8. Для нового набора переходим к шагу 2. Выполняем указанные действия до тех пор, пока не приблизимся к точке экстремума, на что указывает убыль последующих значений функции отклика.

Результаты работы программы

Матрица значений функции отклика системы:

Матрица помех:

Найденные значения факторов, про которых функция отклика принимает максимальное значение:

Вывод

В данном курсовом проекте рассматривался градиентный метод первого порядка, в качестве ядра которого использовался полный факторный эксперимент первого порядка, что предполагает такое проведение исследований, которое позволяет некоторым оптимальным образом получить информацию об объекте, оформить её в виде полиномиальной линейной модели и провести её статистический анализ. Так же в работе был составлен алгоритм моделирования , на основе которого была написана программа для проведения исследований градиентным методом.

Список литературы

Ю.П. Зайченко. Исследование операций. “Вища школа”. Киев 1988.

А.Г. Бондарь, Г.А. Статюха, Т. В. Землянкин , И.А. Потяженко. Планирование эксперимента при оптимизации процессов химической технологии. “Вища школа”. Киев 1980.

В.В. Кафаров. Методы кибернетики в химии и химической технологии. Москва. «Химия». 1985.

А.В. Бондаренко, Г.А. Статюха. Планирование эксперимента в химической технологии. “Вища школа”. Киев 1976.

5. А. Кофман, Р. Крюон “Массовое обслуживание. Теория и приложения”.

6. Е.С. Венцель “Исследование операций”.

Листинг программы

unit MainUnit;

interface

uses Windows,Classes,Graphics,SysUtils,StdCtrls,Math,Grids, ListControl,

Forms;

type

SelType = (stNONE,stPOINT,stCON); // Тип текущего элемента

PPoint = ^TPoint;

TPoint = record

UIN : integer;

Value : integer;

X,Y : integer;

end;

PConnection = ^TConnection;

TConnection = record

toPoint : PPoint;

fromPoint : PPoint;

Value : integer;

end;

CurElement = record

ceType : SelType;

element : pointer;

end;

TGraph = class

private

WasChanged : boolean;

ChangedAfter : boolean;

PointRadius : integer;

MaxUIN : integer;

Points : TList;

Connections : TList;

Selected,Current : CurElement;

function CheckCicle(FP,TP:PPoint):boolean;

function MouseOverPoint(X,Y:integer):PPoint;

function MouseOverConnection(X,Y:integer):PConnection;

procedure

DrawConnections(C:TCanvas;minW,minH,maxW,maxH:integer);

procedure DrawPoints(C:TCanvas;minW,minH,maxW,maxH:integer);

procedure Clear;

public

constructor Create;

destructor Destroy;override;

function MouseOver(X,Y:integer):CurElement;

function DeleteSelected:boolean;

procedure DrawGraph(C:TCanvas;minW,minH,maxW,maxH:integer);

procedure AddPoint(X,Y:integer;Value:integer);

function AddConnection(fromPoint,toPoint:PPoint;Value:integer):boolean;

procedure ChangeCur(dX,dY:integer);

procedure

ChangeCurAndDrawContur(X,Y,GridDelta:integer;C:TCanvas;DrawFirst,D

rawSecond:boolean);

procedure GetDeltaOfCurrent(X,Y:integer;var dX,dY:integer);

procedure SaveToFile(filename:string);

procedure OpenFromFile(filename:string);

procedure SelectCurrent;

procedure DeselectCurrent;

procedure MoveOnTop;

function IsChanged:boolean;

function WasChangedAfter:boolean;

function GetPoints:TList;

function GetConnections:TList;

function GetPointByID(ID:integer):PPoint;

procedure ZoomOn(coef:extended);

procedure ZoomOff(coef:extended);

procedure ChangeValue(Elem:CurElement;Value:integer);

function GetConsCount:integer;

function GetPointsCount:integer;

end;

PProcCon = ^TProcCon;

PProcPoint = ^TProcPoint;

TProcCon = record

Value : integer;

toPoint : PProcPoint;

Next : PProcCon;

end;

TProcPoint = record

UIN : integer;

Value : integer;

Merged : boolean;

UBorder,DBorder : integer;

UCon,DCon : integer;

UFixed,DFixed : boolean;

Prev,Next : PProcCon;

end;

PWay = ^TWay;

TWay = record

Numbers : string;

Length : integer;

Weight : integer;

Current : PProcPoint;

end;

PLinkTask = ^TLinkTask;

PProcTask = ^TProcTask;

PHolder = ^THolder;

THolder = record

Task : PProcTask;

Link : PLinkTask;

Next : PHolder;

end;

TProcTask = record

UIN : integer;

ProcNum : integer;

StartTime : integer;

Length : integer;

Prev : PHolder;

MayBeBefore : boolean;

MayBeAfter : boolean;

Ready : integer;

end;

TLinkTask = record

fromUIN : integer;

toUIN : integer;

fromProc : integer;

toProc : integer;

fromTask : PProcTask;

toTask : PProcTask;

StartTime : integer;

Length : integer;

PrevLink : PLinkTask;

PrevTask : PProcTask;

end;

PPossibleMove = ^TPossibleMove;

TPossibleMove = record

UIN : integer;

processor : integer;

afterUIN : integer;

ProcCount,Time:integer;

CurrentState : boolean;

end;

Tsub>Merger = class

private

Selected : PProcTask;

MinProcNum:integer;

MaxProcNum:integer;

Points : TList;

Procs : TList;

Links : TList;

AllProcTasks : Tlist;

function GetProcPointByUIN(UIN:integer):PProcPoint;

function GetProcTaskByUIN(UIN:integer):PProcTask;

procedure Clear;

procedure ClearProcs(FreeElements:boolean);

procedure ClearLinks(FreeElements:boolean);

procedure FormLinkTasksAndSetTimes(NumOfProcs:integer);

// -- Optimization -- //

procedure ClearPossibleMoves(var List:TList);

function GetPossibleMoves(UIN:integer):TList;

function GetTime:integer;

function GetProcCount:integer;

procedure SaveBackUp(var List:Tlist);

procedure RestoreBackUp(var

List:Tlist;NOP:integer;ClearCurrent:boolean);

public

constructor Create;

procedure Init(GPoints,GConnections:TList);

procedure DoBazovoe;

procedure SelectTask(UIN:integer);

procedure DeselectTask;

procedure MoveSelectedAfter(ProcNum,UIN:integer);

procedure Showsub>Merging(SG:TStringGrid);

function IncNumOfProc:boolean;

function DecNumOfProc:boolean;

function OptimizeOneStep(L1,L2:TLabel):boolean;

procedure OptimizeAuto(Form:TForm;L1,L2:TLabel);

end;

// --- --- --- //

function MinInt(I1,I2:integer):integer;

function MaxInt(I1,I2:integer):integer;

procedure MinMaxInt(I1,I2:integer;Var Min,Max:integer);

implementation

// -- Native functions -- //

function MinInt(I1,I2:integer):integer;

begin

if I1<I2 then Result:=I1 else Result:=I2

end;

function MaxInt(I1,I2:integer):integer;

begin

if I1>I2 then Result:=I1 else Result:=I2

end;

procedure MinMaxInt(I1,I2:integer;Var Min,Max:integer);

begin

if I1<I2 then

begin

Min:=I1;

Max:=I2

end

else

begin

Min:=I2;

Max:=I1

end

end;

// -- Objects -- //

function TGraph.GetConsCount:integer;

begin

Result:=Connections.Count

end;

function TGraph.GetPointsCount:integer;

begin

Result:=Points.Count

end;

procedure TGraph.ZoomOn(coef:extended);

var PP:PPoint;

i:integer;

begin

for i:=0 to Points.Count-1 do

begin

PP:=Points[i];

PP.X:=round(PP.X*coef);

PP.Y:=round(PP.Y*coef);

end;

procedure TGraph.ZoomOff(coef:extended);

var PP:PPoint;

i:integer;

begin

for i:=0 to Points.Count-1 do

begin

PP:=Points[i];

PP.X:=round(PP.X/coef);

PP.Y:=round(PP.Y/coef);

end;

constructor TGraph.Create;

begin

inherited Create;

MaxUIN:=0;

Points:=TList.Create;

Connections:=TList.Create;

Current.ceType := stNONE;

Current.element := nil;

Selected.ceType := stNONE;

Selected.element := nil;

PointRadius := 15;

WasChanged := false;

ChangedAfter := false;

end;

destructor TGraph.Destroy;

begin

Clear;

Points.Destroy;

Connections.Destroy;

inherited Destroy

end;

procedure TGraph.Clear;

begin

while Points.Count<>0 do

begin

dispose(PPoint(Points.first));

Points.delete(0);

end;

while Connections.Count<>0 do

begin

dispose(PConnection(Connections.first));

Connections.delete(0);

end;

MaxUIN:=0;

Current.ceType := stNONE;

Current.element := nil;

Selected.ceType := stNONE;

Selected.element := nil;

end;

function TGraph.DeleteSelected:boolean;

var i:integer;

PP:PPoint;

PC:PConnection;

begin

if Selected.ceType = stNONE

then Result:=false

else

begin

WasChanged:=true;

ChangedAfter:=true;

Result:=true;

if Selected.ceType = stCON then

begin

PC:=Selected.element;

for i:=0 to Connections.Count-1 do

begin

if Connections[i] = PC then

begin

Connections.delete(i);

break

end;

dispose(PC);

end

else

begin

PP:=Selected.element;

for i:=0 to Points.Count-1 do

begin

if Points[i] = PP then

begin

Points.delete(i);

break

end;

i:=0;

while i<Connections.Count do

begin

PC:=Connections[i];

if(PC.toPoint=PP)or(PC.fromPoint=PP)then

begin

Connections.delete(i);

dispose(PC)

end

else

i:=i+1

end;

dispose(PP)

end;

Selected.ceType:=stNONE;

Selected.element:=nil

end;

procedure TGraph.MoveOnTop;

var PP:PPoint;

num:integer;

begin

if Current.ceType = stPoint then

begin

WasChanged:=true;

// ChangedAfter:=true;

PP:=Current.element;

num:=0;

while num<Points.count do

begin

if Points[num]=PP then break;

num:=num+1

end;

Points.delete(num);

Points.add(PP)

end;

procedure TGraph.SelectCurrent;

begin

Selected:=Current

end;

procedure TGraph.DeselectCurrent;

begin

Selected.ceType:=stNONE;

Selected.element:=nil

end;

function TGraph.MouseOverPoint(X,Y:integer):PPoint;

var PP:PPoint;

d,i:integer;

begin

Result:=nil;

for i:=Points.Count-1 downto 0 do

begin

PP:=Points[i];

d := round(sqrt((X-PP.X)*(X-PP.X)+(Y-PP.Y)*(Y-PP.Y)));

if d<=15 then

begin

Result:=Points[i];

break

end;

function TGraph.MouseOverConnection(X,Y:integer):PConnection;

var PC:PConnection;

i:integer;

TX,TY,FX,FY,d:integer;

begin

Result:=nil;

for i:=Connections.Count-1 downto 0 do

begin

PC:=Connections[i];

if MinInt(PC.fromPoint.X,PC.toPoint.X) = PC.fromPoint.X then

begin

FX:=PC.fromPoint.X;

FY:=PC.fromPoint.Y;

TX:=PC.toPoint.X;

TY:=PC.toPoint.Y

end

else

begin

FX:=PC.toPoint.X;

FY:=PC.toPoint.Y;

TX:=PC.fromPoint.X;

TY:=PC.fromPoint.Y

end;

if (X>=FX-5)and(X<=TX+5)then

begin

d := (TY-FY)*X + (FX-TX)*Y + TX*FY - FX*TY;

d := abs(round(d/sqrt((TY-FY)*(TY-FY)+(FX-TX)*(FX-TX))));

if d<=5 then

begin

Result:=Connections[i];

break

end

end;

function TGraph.MouseOver(X,Y:integer):CurElement;

begin

current.element:=MouseOverPoint(X,Y);

if current.element<>nil then current.ceType:=stPOINT

else

begin

current.element:=MouseOverConnection(X,Y);

if current.element<>nil then current.ceType:=stCON

else current.ceType:=stNONE

end;

Result:=current;

end;

procedure TGraph.GetDeltaOfCurrent(X,Y:integer;var dX,dY:integer);

var PP:PPoint;

begin

PP:=current.element;

if PP<>nil then

begin

dX:=X - PP.X;

dY:=Y - PP.Y

end

else

begin

dX:=0;

dY:=0

end;

procedure TGraph.ChangeCur(dX,dY:integer);

var PP:PPoint;

begin

WasChanged:=true;

// ChangedAfter:=true;

PP:=current.element;

if PP<>nil then

begin

PP.X:=PP.X+dx;

PP.Y:=PP.Y+dy

end

end;

procedure

TGraph.ChangeCurAndDrawContur(X,Y,GridDelta:integer;C:TCanvas;Dra

wFirst,DrawSecond:boolean);

var PP:PPoint;

begin

WasChanged:=true;

// ChangedAfter:=true;

if current.ceType<>stNONE then

begin

PP:=current.element;

C.Brush.Style:=bsClear;

C.Pen.Mode := pmNotXor;

C.Pen.Color:=clBlack;

C.Pen.Width:=1;

if DrawFirst then C.Ellipse(PP.X-PointRadius,PP.Y-

PointRadius,PP.X+PointRadius,PP.Y+PointRadius);

if GridDelta>1 then

begin

PP.X:=round(X/GridDelta)*GridDelta;

PP.Y:=round(Y/GridDelta)*GridDelta

end

else

begin

PP.X:=X;

PP.Y:=Y

end;

if DrawSecond then C.Ellipse(PP.X-PointRadius,PP.Y-

PointRadius,PP.X+PointRadius,PP.Y+PointRadius);

C.Pen.Mode := pmCopy;

C.Brush.Style:=bsSolid;

end;

procedure getArrowCoord(Fx,Fy,Tx,Ty:integer;R,Alpha:Integer;var

Ar1X,Ar1Y,Ar2X,Ar2Y:integer);

var CosV,SinV,D,CosAd2:extended;

a,b,c,Descr:extended;

y1,y2,x1,x2:extended;

RCosAd2,RSinAd2:integer;

begin

D := sqrt((FX-TX)*(FX-TX)+(FY-TY)*(FY-TY));

if D<>0 then CosV := (FX-TX) / D else CosV:=0;

if CosV = 0 then

begin

RCosAd2 := round(R*Cos(Pi*Alpha/360));

RSinAd2 := round(R*Sin(Pi*Alpha/360));

Ar1X := TX + RSinAd2;

Ar2X := TX - RSinAd2;

if TY>FY then Ar1Y := TY - RCosAd2

else Ar1Y := TY + RCosAd2;

Ar2Y := Ar1Y;

end

else

begin

SinV := (FY-TY) / D;

CosAd2 := Cos(Pi*Alpha/360);

a:=1;

b:=-2*CosAd2*SinV;

c:=CosAd2*CosAd2-CosV*CosV;

Descr := b*b - 4*a*c;

y1 := (-b - sqrt(Descr))/(2*a);

y2 := (-b + sqrt(Descr))/(2*a);

x1 := (cosAd2 - sinV*y1) / cosV;

x2 := (cosAd2 - sinV*y2) / cosV;

Ar1X:=round(x1*R)+Tx;

Ar2X:=round(x2*R)+Tx;

Ar1Y:=round(y1*R)+Ty;

Ar2Y:=round(y2*R)+Ty;

end

end;

procedure

TGraph.DrawConnections(C:TCanvas;minW,minH,maxW,maxH:integer);

var i:integer;

PC:PConnection;

Ar1X,Ar1Y,Ar2X,Ar2Y:integer;

Poly:array[0..2]of Windows.TPoint;

D:extended;

FX,FY,TX,TY:integer;

s:string;

W,H,X,Y:integer;

begin

C.Pen.Color := clBlue;

for i:=0 to Connections.Count-1 do

begin

C.Brush.Color := clBlue;

PC:=Connections[i];

if Selected.element = PC then C.Pen.Width:=2

else C.Pen.Width:=1;

C.moveto(PC.fromPoint.X,PC.fromPoint.Y);

C.lineto(PC.toPoint.X,PC.toPoint.Y);

FX:=PC.fromPoint.X;

FY:=PC.fromPoint.Y;

TX:=PC.toPoint.X;

TY:=PC.toPoint.Y;

D := sqrt((FX-TX)*(FX-TX)+(FY-TY)*(FY-TY));

if D<>0 then

begin

TX := round( TX - PointRadius*(TX-FX)/D );

TY := round( TY - PointRadius*(TY-FY)/D );

end;

getArrowCoord(FX,FY,TX,TY,10,45,Ar1X,Ar1Y,Ar2X,Ar2Y);

getArrowCoord(PC.fromPoint.X,PC.fromPoint.Y,PC.toPoint.X,PC.toPoint.

Y,Poin tRadius,10,45,Ar1X,Ar1Y,Ar2X,Ar2Y);

Poly[0].x := TX;

Poly[0].y := TY;

Poly[1].x := Ar1X;

Poly[1].y := Ar1Y;

Poly[2].x := Ar2X;

Poly[2].y := Ar2Y;

C.Polygon(Poly);

s:=inttostr(PC.Value);

H:=C.TextHeight('A');

W:=C.TextWidth(s);

X:=round((FX+TX-W)/2)-3;

Y:=round((FY+TY-H)/2)-1;

C.Brush.Color := clWhite;

C.Rectangle(X,Y,X+W+7,Y+H+2);

C.Brush.style:=bsClear;

C.TextOut(X+3,Y+1,s);

C.Brush.style:=bsSolid;

{ C.moveto(Ar1X,Ar1Y);

C.lineto(PC.toPoint.X,PC.toPoint.Y);

C.moveto(Ar2X,Ar2Y);

C.lineto(PC.toPoint.X,PC.toPoint.Y);

}

end

end;

procedure

TGraph.DrawPoints(C:TCanvas;minW,minH,maxW,maxH:integer);

var i:integer;

PP:PPoint;

H,W:integer;

X1,X2,Y1,Y2:integer;

s:string;

begin

C.Brush.Style := bsSolid;

C.Brush.Color := clWhite;

C.Pen.Color := clBlack;

for i:=0 to Points.Count-1 do

begin

PP:=Points[i];

if Selected.element = PP then C.Pen.Width:=2

else C.Pen.Width:=1;

// C.Ellipse(PP.X-PointRadius,PP.Y-

PointRadius,PP.X+PointRadius,PP.Y+PointRadius+10);

X1:=PP.X-PointRadius;

Y1:=PP.Y-PointRadius;

X2:=PP.X+PointRadius;

Y2:=PP.Y+PointRadius;

if(X1<maxW)and(Y2<=maxH)and(X2>minW)and(Y2>minH)then

C.Ellipse(X1,Y1,X2,Y2);

s:=inttostr(PP.Value);

H:=C.TextHeight('A');

W:=C.TextWidth(s);

C.TextOut(round(PP.X-W/2),round(PP.Y-H/2),s)

end;

C.Brush.Style := bsClear;

C.Font.Color:=clBlack;

C.Font.Style:=[fsBold];

for i:=0 to Points.Count-1 do

begin

PP:=Points[i];

s:=inttostr(PP.UIN);

H:=C.TextHeight('A');

W:=C.TextWidth(s);

C.TextOut(round(PP.X+PointRadius-W/2),PP.Y-PointRadius-H-1,s)

end;

C.Font.Style:=[];

C.Brush.Style := bsSolid;

end;

procedure

TGraph.DrawGraph(C:TCanvas;minW,minH,maxW,maxH:integer);

begin

DrawConnections(C,minW,minH,maxW,maxH);

DrawPoints(C,minW,minH,maxW,maxH);

end;

procedure TGraph.AddPoint(X,Y:integer;Value:integer);

var PP:PPoint;

begin

WasChanged:=true;

ChangedAfter:=true;

MaxUIN:=MaxUIN+1;

new(PP);

PP.UIN:=MaxUIN;

PP.X:=X;

PP.Y:=Y;

PP.Value:=Value;

Points.Add(PP);

end;

function TGraph.CheckCicle(FP,TP:PPoint):boolean;

var List : TList;

PC:PConnection;

CurP:PPoint;

i:integer;

begin

Result:=true;

List:= TList.create;

List.add(TP);

while List.Count<>0 do

begin

CurP:=List.first;

List.delete(0);

if CurP = FP then

begin

Result:=false;

break

end;

for i:=0 to Connections.Count-1 do

begin

PC:=Connections[i];

if PC.fromPoint = CurP then List.Add(PC.toPoint)

end

end;

List.clear;

List.Destroy

end;

function

TGraph.AddConnection(fromPoint,toPoint:PPoint;Value:integer):boolean;

var PC:PConnection;

begin

if(fromPoint<>toPoint) and CheckCicle(fromPoint,toPoint) then

begin

WasChanged:=true;

ChangedAfter:=true;

new(PC);

PC.fromPoint:=fromPoint;

PC.toPoint:=toPoint;

PC.Value:=Value;

Connections.Add(PC);

Result:=true

end

else

Result:=false

end;

procedure TGraph.SaveToFile(filename:string);

var f:file;

PP:PPoint;

PC:PConnection;

i:integer;

begin

assign(f,filename);

rewrite(f,1);

BlockWrite(f,Points.Count,SizeOf(integer));

BlockWrite(f,Connections.Count,SizeOf(integer));

for i:=0 to Points.Count-1 do

begin

PP:=Points[i];

BlockWrite(f,PP,SizeOf(PP));

BlockWrite(f,PP^,SizeOf(PP^));

end;

for i:=0 to Connections.Count-1 do

begin

PC:=Connections[i];

// BlockWrite(f,PC,SizeOf(PC));

BlockWrite(f,PC^,SizeOf(PC^));

end;

close(f);

end;

procedure TGraph.OpenFromFile(filename:string);

type

PAddr = ^TAddr;

TAddr = record

Old,New:pointer;

end;

var f:file;

Addresses:TList;

PA:PAddr;

PP:PPoint;

PC:PConnection;

p:pointer;

i,NOP,NOC:integer;

procedure SetNewAddr(iOld,iNew:pointer);

var PA:PAddr;

begin

new(PA);

PA.Old:=iOld;

Pa.New:=iNew;

Addresses.add(PA)

end;

function GetNewAddr(Old:pointer):pointer;

var i:integer;

begin

Result:=nil;

for i:=0 to Addresses.Count-1 do

if PAddr(Addresses[i]).Old = Old then

begin

Result:=PAddr(Addresses[i]).New;

Break

end;

begin

MaxUIN:=0;

Clear;

WasChanged:=false;

ChangedAfter:=false;

Addresses:=TList.Create;

assign(f,filename);

reset(f,1);

BlockRead(f,NOP,SizeOf(integer));

BlockRead(f,NOC,SizeOf(integer));

for i:=0 to NOP-1 do

begin

new(PP);

BlockRead(f,p,SizeOf(p));

BlockRead(f,PP^,SizeOf(PP^));

Points.Add(PP);

SetNewAddr(p,PP);

If MaxUIN < PP.UIN then MaxUIN:=PP.UIN

end;

for i:=0 to NOC-1 do

begin

new(PC);

BlockRead(f,PC^,SizeOf(PC^));

PC.toPoint:=GetNewAddr(PC.toPoint);

PC.fromPoint:=GetNewAddr(PC.fromPoint);

Connections.Add(PC);

end;

close(f);

while Addresses.Count<>0 do

begin

PA:=Addresses.first;

Addresses.Delete(0);

dispose(PA);

end;

Addresses.Destroy

end;

function TGraph.IsChanged:boolean;

begin

Result:=WasChanged

end;

function TGraph.WasChangedAfter:boolean;

begin

Result:=ChangedAfter;

ChangedAfter:=false;

end;

function TGraph.GetPointByID(ID:integer):PPoint;

var PP:PPoint;

i:integer;

begin

Result:=nil;

for i:=0 to Points.Count-1 do

begin

PP:=Points[i];

if PP.UIN=ID then

begin

Result:=PP;

break

end;

function TGraph.GetPoints:TList;

begin

Result:=Points

end;

function TGraph.GetConnections:TList;

begin

Result:=Connections

end;

procedure TGraph.ChangeValue(Elem:CurElement;Value:integer);

begin

if Elem.element<>nil then

begin

case Elem.ceType of

stPOINT:PPoint(Elem.element).Value:=Value;

stCON :PConnection(Elem.element).Value:=Value;

end;

WasChanged:=true;

ChangedAfter:=true

end

end;

// --- sub>Merger --- //

constructor Tsub>Merger.Create;

begin

Points := TList.Create;

AllProcTasks := TList.Create;

Procs:=TList.Create;

Links:=TList.Create

end;

procedure Tsub>Merger.ClearProcs(FreeElements:boolean);

var PPT:PProcTask;

PH:PHolder;

tmpPoint:pointer;

List:TList;

begin

Selected:=nil;

while Procs.Count<>0 do

begin

List:=Procs.first;

Procs.delete(0);

while List.Count<>0 do

begin

PPT:=List.first;

List.delete(0);

PH:=PPT.Prev;

while PH<>nil do

begin

tmpPoint:=PH.Next;

dispose(PH);

PH:=tmpPoint

end;

PPT.Prev:=nil;

PPT.MayBeAfter:=false;

PPT.MayBeBefore:=false;

if FreeElements then dispose(PPT);

end;

List.destroy;

end;

if FreeElements then AllProcTasks.clear;

end;

procedure Tsub>Merger.ClearLinks(FreeElements:boolean);

var PLT:PLinkTask;

List:TList;

begin

while Links.Count<>0 do

begin

List:=Links.first;

Links.delete(0);

while List.Count<>0 do

begin

PLT:=List.first;

List.delete(0);

PLT.PrevLink:=nil;

PLT.PrevTask:=nil;

if FreeElements then dispose(PLT);

end;

List.destroy;

end;

procedure Tsub>Merger.Clear;

var PPP:PProcPoint;

PPC:PProcCon;

begin

while Points.Count<>0 do

begin

PPP:=Points.first;

Points.delete(0);

while PPP.Prev<>nil do

begin

PPC:=PPP.Prev.Next;

dispose(PPP.Prev);

PPP.Prev:=PPC

end;

while PPP.Next<>nil do

begin

PPC:=PPP.Next.Next;

dispose(PPP.Next);

PPP.Next:=PPC

end;

dispose(PPP)

end;

ClearLinks(true);

ClearProcs(true);

AllProcTasks.Clear;

{

while FProcTasks.Count<>0 do

begin

PPT:=FProcTasks.first;

FProcTasks.delete(0);

dispose(PPT)

end;

while FLinkTasks.Count<>0 do

begin

PLT:=FLinkTasks.first;

FLinkTasks.delete(0);

dispose(PLT)

end;

}

end;

function Tsub>Merger.GetProcPointByUIN(UIN:integer):PProcPoint;

var i:integer;

begin

Result:=nil;

for i:=0 to Points.Count-1 do

if PProcPoint(Points[i]).UIN = UIN then

begin

Result:=Points[i];

break

end;

function Tsub>Merger.GetProcTaskByUIN(UIN:integer):PProcTask;

var i:integer;

begin

Result:=nil;

for i:=0 to AllProcTasks.Count-1 do

if PProcTask(AllProcTasks[i]).UIN = UIN then

begin

Result:=AllProcTasks[i];

break

end;

procedure Tsub>Merger.Init(GPoints,GConnections:TList);

var i:integer;

PP:PPoint;

PC:PConnection;

PPP:PProcPoint;

PPC:PProcCon;

begin

Clear;

for i:=0 to GPoints.Count-1 do

begin

PP:=GPoints[i];

new(PPP);

PPP.UIN := PP.Uin;

PPP.Value := PP.Value;

PPP.UBorder:=0;

PPP.DBorder:=$8FFFFFFF;

PPP.UFixed:=false;

PPP.DFixed:=false;

PPP.UCon:=0;

PPP.DCon:=0;

PPP.Prev:=nil;

PPP.Next:=nil;

Points.Add(PPP);

end;

for i:=0 to GConnections.Count-1 do

begin

PC:=GConnections[i];

PPP := GetProcPointByUIN(PC.fromPoint.UIN);

new(PPC);

PPC.Value := PC.Value;

PPC.toPoint := GetProcPointByUIN(PC.toPoint.UIN);

PPC.Next := PPP.Next;

PPP.Next := PPC;

PPP := GetProcPointByUIN(PC.toPoint.UIN);

new(PPC);

PPC.Value := PC.Value;

PPC.toPoint := GetProcPointByUIN(PC.fromPoint.UIN);

PPC.Next := PPP.Prev;

PPP.Prev := PPC;

end;

procedure SetUBorderToPPP(PPP:PProcPoint;Value:integer);

var PPC:PProcCon;

Fix:boolean;

begin

if PPP.UBorder < Value then PPP.UBorder := Value;

PPC:=PPP.Prev;

Fix:=true;

while PPC<>nil do

begin

if not PPC.toPoint.DFixed then

begin

Fix:=false;

Break

end;

PPC:=PPC.Next

end;

PPP.UFixed:=Fix

end;

procedure SetDBorderToPPP(PPP:PProcPoint;Value:integer);

var PPC:PProcCon;

Fix:boolean;

begin

if PPP.DBorder > Value then PPP.DBorder := Value;

PPC:=PPP.Next;

Fix:=true;

while PPC<>nil do

begin

if not PPC.toPoint.UFixed then

begin

Fix:=false;

Break

end;

PPC:=PPC.Next

end;

PPP.DFixed:=Fix

end;

procedure SetUBorderDown(PPP:PProcPoint;Value:integer);

var PPC:PProcCon;

workPPP:PProcPoint;

List:TList;

begin

List:=TList.create;

if PPP.UBorder < Value then

begin

PPP.UBorder := Value;

List.Add(PPP);

while List.Count<>0 do

begin

workPPP:=List[0];

List.delete(0);

PPC:=workPPP.Next;

while PPC<>nil do

begin

if PPC.toPoint.UBorder < workPPP.UBorder+1 then

begin

PPC.toPoint.UBorder:=workPPP.UBorder+1;

List.Add(PPC.toPoint)

end;

PPC:=PPC.Next

end;

List.Destroy;

end;

procedure SetDBorderUp(PPP:PProcPoint;Value:integer);

var PPC:PProcCon;

workPPP:PProcPoint;

List:TList;

begin

List:=TList.create;

if PPP.DBorder > Value then

begin

PPP.DBorder := Value;

List.Add(PPP);

while List.Count<>0 do

begin

workPPP:=List[0];

List.delete(0);

PPC:=workPPP.Prev;

while PPC<>nil do

begin

if PPC.toPoint.DBorder > workPPP.DBorder-1 then

begin

PPC.toPoint.DBorder:=workPPP.DBorder-1;

List.Add(PPC.toPoint)

end;

PPC:=PPC.Next

end;

List.Destroy;

end;

procedure SetProcToPPP(PPP:PProcPoint;Value:integer);

var PPC:PProcCon;

begin

PPP.UBorder:=Value;

PPP.DBorder:=Value;

PPP.UFixed:=true;

PPP.DFixed:=true;

PPP.Merged:=true;

PPC:=PPP.Prev;

while PPC<>nil do

begin

if not PPC.toPoint.Merged then

begin

//if PPC.toPoint.DBorder>PPP.UBorder-1 then

SetDBorderToPPP(PPC.toPoint,PPP.UBorder-1);

PPC.toPoint.DCon:=PPC.toPoint.DCon+PPC.Value;

end;

PPC:=PPC.Next;

end;

PPC:=PPP.Next;

while PPC<>nil do

begin

if not PPC.toPoint.Merged then

begin

//if PPC.toPoint.UBorder<PPP.DBorder+1 then

SetUBorderToPPP(PPC.toPoint,PPP.DBorder+1);

PPC.toPoint.UCon:=PPC.toPoint.UCon+PPC.Value;

end;

PPC:=PPC.Next;

end;

procedure Tsub>Merger.DoBazovoe;

var i,j,p:integer;

PPP:PProcPoint;

PPC:PProcCon;

PW,newPW:PWay;

WorkList : TList;

WaysList : TList;

MaxWayLength : integer;

s : string;

//-->>

Pretender:PProcPoint;

NoChange:boolean;

PretenderCon : integer;

//-->>

PPT:PProcTask;

begin

ClearLinks(true);

ClearProcs(true);

AllProcTasks.Clear;

WaysList := TList.Create;

WorkList := TList.Create;

for i:=0 to Points.Count-1 do

begin

PPP:=Points[i];

PPP.UBorder:=0;

PPP.DBorder:=$7FFFFFFF;

PPP.UCon:=0;

PPP.DCon:=0;

PPP.UFixed:=false;

PPP.DFixed:=false;

PPP.Merged:=false;

WorkList.Add(PPP)

end;

for i:=0 to Points.Count-1 do

begin

PPP:=Points[i];

PPC:=PPP.Next;

while PPC<>nil do

begin

for j:=0 to WorkList.Count-1 do

if PPC.toPoint = WorkList[j] then

begin

WorkList.delete(j);

break

end;

PPC:=PPC.Next

end;

for i:=0 to WorkList.Count-1 do

begin

PPP:=WorkList[i];

new(PW);

PW.Length:=1;

PW.Numbers:=inttostr(PPP.UIN)+',';

PW.Weight:=PPP.Value;

PW.Current:=PPP;

WorkList[i]:=PW

end;

while WorkList.Count<>0 do

begin

PW:=WorkList.first;

WorkList.delete(0);

if PW.Current.Next=nil then WaysList.Add(PW)

else

begin

PPC:=PW.Current.Next;

while PPC<>nil do

begin

new(newPW);

newPW.Length:=PW.Length+1;

newPW.Weight:=PW.Weight+PPC.Value+PPC.toPoint.Value;

newPW.Numbers:=PW.Numbers+inttostr(PPC.toPoint.UIN)+',';

newPW.Current:=PPC.toPoint;

WorkList.Add(newPW);

PPC:=PPC.Next

end;

dispose(PW)

end;

MaxWayLength := 0;

for i:=0 to WaysList.Count-1 do

begin

PW:=WaysList[i];

if PW.Length > MaxWayLength then MaxWayLength:=PW.Length

end;

for i:=0 to Points.Count-1 do

begin

PPP:=Points[i];

if PPP.Prev = nil then SetUBorderDown(PPP,1);

if PPP.Next = nil then SetDBorderUp(PPP,MaxWayLength);

end;

for i:=0 to Points.Count-1 do

begin

PPP:=Points[i];

if PPP.UBorder = PPP.DBorder then SetProcToPPP(PPP,PPP.UBorder);

end;

Pretender:=nil;

PretenderCon:=0;

repeat

NoChange:=true;

for i:=0 to Points.Count-1 do

begin

PPP:=Points[i];

if not PPP.merged then

begin

if PPP.UFixed and PPP.DFixed then

begin

if PPP.UCon > PPP.DCon then SetProcToPPP(PPP,PPP.UBorder)

else SetProcToPPP(PPP,PPP.DBorder);

Pretender:=nil;

NoChange:=false;

break

end

else

begin

if PPP.UFixed then

begin

if(Pretender = nil)or(PretenderCon < PPP.UCon) then

begin

Pretender:=PPP;

PretenderCon := PPP.UCon

end;

end

else

if PPP.DFixed then

begin

if(Pretender = nil)or(PretenderCon < PPP.DCon) then

begin

Pretender:=PPP;

PretenderCon := PPP.DCon

end;

if Pretender<>nil then

begin

if Pretender.UFixed then SetProcToPPP(Pretender,Pretender.UBorder)

else SetProcToPPP(Pretender,Pretender.DBorder);

Pretender:=nil;

PretenderCon:=0;

NoChange:=false;

end;

until NoChange;

for i:=0 to Points.Count-1 do

begin

PPP:=Points[i];

new(PPT);

PPT.ProcNum:=PPP.UBorder;

PPT.ProcNum:=PPP.DBorder;

PPT.Ready:=0;

PPT.UIN:=PPP.UIN;

PPT.StartTime:=0;

PPT.Length:=PPP.Value;

PPT.Prev:=nil;

PPT.MayBeAfter:=false;

PPT.MayBeBefore:=false;

PPC:=PPP.Prev;

while PPC<>nil do

begin

PPT.Ready:=PPT.Ready+1;

PPC:=PPC.next

end;

j:=0;

while j<=AllProcTasks.Count-1 do

begin

if PProcTask(AllProcTasks[j]).Ready > PPT.Ready then break;

j:=j+1;

end;

AllProcTasks.Add(PPT);

end;

FormLinkTasksAndSetTimes(MaxWayLength);

end;

procedure SetProcTimes(List:TList);

var i,j:integer;

PPT:PProcTask;

PH:PHolder;

Time,dTime:integer;

begin

Time:=1;

for i:=0 to List.Count-1 do

begin

PPT:=List[i];

PPT.StartTime:=Time;

Time:=Time+PPT.Length;

end;

for i:=0 to List.Count-1 do

begin

PPT:=List[i];

Time:=PPT.StartTime;

PH:=PPT.Prev;

while PH<>nil do

begin

if PH.Task<>nil then

begin

if Time < PH.Task.StartTime+PH.Task.Length then

Time:= PH.Task.StartTime+PH.Task.Length

end

else

begin

if Time < PH.Link.StartTime+PH.Link.Length then

Time:= PH.Link.StartTime+PH.Link.Length

end;

PH:=PH.Next

end;

if Time > PPT.StartTime then

begin

dTime:=Time-PPT.StartTime;

PPT.StartTime:=Time;

for j:=i+1 to List.Count-1 do

PProcTask(List[j]).StartTime:=PProcTask(List[j]).StartTime+dTime

end;

procedure SetProcStartTimes(List:TList);

var i:integer;

PPT:PProcTask;

Time:integer;

begin

Time:=1;

for i:=0 to List.Count-1 do

begin

PPT:=List[i];

PPT.StartTime:=Time;

Time:=Time+PPT.Length;

end;

function PLT_TimeCompare(I1,I2:Pointer):integer;

var D1,D2:integer;

Item1,Item2:PLinkTask;

begin

Item1:=I1;

Item2:=I2;

if Item1.StartTime<Item2.StartTime then Result:=-1

else

if Item1.StartTime>Item2.StartTime then Result:=1

else

begin

if Item1.toProc = Item2.toProc then

begin

if Item1.toTask.StartTime<Item2.toTask.StartTime then Result:=-1

else

if Item1.toTask.StartTime>Item2.toTask.StartTime then Result:=1

else Result:=0

end

else

begin

D1:=Item1.toProc - Item1.fromProc;

D2:=Item2.toProc - Item2.fromProc;

if D1>D2 then Result:=1

else

if D1<D2 then Result:=-1

else

begin

if Item1.toProc<Item2.toProc then Result:=-1

else

if Item1.toProc>Item2.toProc then Result:=1

else

Result:=0

end;

procedure SetLinkTimes(List:TList);

var i:integer;

PLT:PLinkTask;

Time:integer;

begin

for i:=0 to List.Count-1 do

begin

PLT:=List[i];

if PLT.PrevTask<>nil then

Time:= PLT.PrevTask.StartTime+PLT.PrevTask.Length

else

Time:= PLT.PrevLink.StartTime+PLT.PrevLink.Length;

PLT.StartTime:=Time;

end;

List.Sort(PLT_TimeCompare);

Time:=1;

for i:=0 to List.Count-1 do

begin

PLT:=List[i];

if Time>PLT.StartTime then PLT.StartTime:=Time;

Time:=PLT.StartTime+PLT.Length;

end;

зrocedure Tsub>Merger.FormLinkTasksAndSetTimes(NumOfProcs:integer);

var i,j,k:integer;

PPT,toPPT:PProcTask;

PLT:PLinkTask;

PPP:PProcPoint;

PPC:PProcCon;

PH:PHolder;

tmpPoint : pointer;

List:TList;

begin

ClearLinks(true);

ClearProcs(false);

if NumOfProcs<>0 then

begin

List:=TList.Create;;

Procs.Add(list);

for i:=1 to NumOfProcs-1 do

begin

List:=TList.Create;;

Procs.Add(list);

List:=TList.Create;

Links.Add(List)

end;

for i:=0 to AllProcTasks.Count-1 do

begin

PPT:=AllProcTasks[i];

List:=Procs[PPT.ProcNum-1];

List.Add(PPT);

end;

// Формированик Линков

for i:=1 to Procs.Count-1 do

begin

List:=Procs[i];

for j:=0 to List.Count-1 do

begin

PPT:=List[j];

PPP:=GetProcPointByUIN(PPT.UIN);

PPC:=PPP.Prev;

while PPC<>nil do

begin

toPPT:=GetProcTaskByUIN(PPC.toPoint.UIN);

if toPPT.ProcNum = PPT.ProcNum then

begin

new(PH);

PH.Task:=toPPT;

PH.Link:=nil;

PH.Next:=PPT.Prev;

PPT.Prev:=PH;

end

else

begin

new(PLT);

PLT.length:=PPC.Value;

PLT.fromUIN:=toPPT.UIN;

PLT.fromProc:=toPPT.ProcNum;

PLT.toUIN:=PPT.UIN;

PLT.toProc:=PPT.ProcNum;

PLT.fromTask:=toPPT;

PLT.toTask:=PPT;

PLT.StartTime:=0;

PLT.PrevTask:=toPPT;

PLT.PrevLink:=nil;

Tlist(Links[toPPT.ProcNum-1]).Add(PLT);

tmpPoint:=PLT;

for k:=toPPT.ProcNum to PPT.ProcNum-2 do

begin

new(PLT);

PLT.length:=PPC.Value;

PLT.fromUIN:=toPPT.UIN;

PLT.fromProc:=toPPT.ProcNum;

PLT.toUIN:=PPT.UIN;

PLT.toProc:=PPT.ProcNum;

PLT.fromTask:=toPPT;

PLT.toTask:=PPT;

PLT.StartTime:=0;

PLT.PrevTask:=nil;

PLT.PrevLink:=tmpPoint;

Tlist(Links[k]).Add(PLT);

tmpPoint:=PLT

end;

new(PH);

PH.Task:=nil;

PH.Link:=tmpPoint;

PH.Next:=PPT.Prev;

PPT.Prev:=PH;

end;

PPC:=PPC.next

end;

for i:=0 to Procs.Count-1 do

SetProcStartTimes(Procs[i]);

for i:=0 to Procs.Count+Links.Count-1 do

if i mod 2 = 0 then SetProcTimes(Procs[i div 2])

else SetLinkTimes(Links[i div 2])

end;

procedure Tsub>Merger.Showsub>Merging(SG:TStringGrid);

var i,j,k:integer;

NumOfRows:integer;

List:TList;

PPT:PProcTask;

PLT:PLinkTask;

begin

NumOfRows:=1;

for i:=0 to Procs.Count-1 do

begin

List:=Procs[i];

if List.Count<>0 then

begin

PPT:=List.last;

if NumOfRows<PPT.StartTime+PPT.Length then

NumOfRows:=PPT.StartTime+PPT.Length;

end;

for i:=0 to Links.Count-1 do

begin

List:=Links[i];

if List.Count<>0 then

begin

PLT:=List.last;

if NumOfRows<PLT.StartTime+PLT.Length then

NumOfRows:=PLT.StartTime+PLT.Length;

end;

// Чистим сетку //

SG.RowCount:=NumOfRows;

if Procs.Count<>0 then SG.ColCount:=2*Procs.Count

else SG.ColCount:=0;

for i:=1 to SG.RowCount-1 do

for j:=1 to SG.ColCount-1 do SG.Cells[j,i]:='';

for i:=1 to SG.RowCount-1 do

SG.Cells[0,i]:=inttostr(i);

for i:=1 to SG.ColCount-1 do

if i mod 2 = 1 then SG.Cells[i,0]:=inttostr((i div 2)+1)

else SG.Cells[i,0]:='->';

if Selected<>nil then

for i:=MinProcNum-1 to MaxProcNum-1 do

begin

List:=Procs[i];

if List.Count<>0 then

begin

if(PProcTask(List.first).MayBeBefore)or(Selected=List.first)then

SG.Cells[2*i+1,0]:='m'+SG.Cells[2*i+1,0]

end

else

SG.Cells[2*i+1,0]:='m'+SG.Cells[2*i+1,0]

end;

SG.Cells[0,0]:='';

if SG.ColCount<>1 then

begin

SG.FixedCols:=1;

SG.FixedRows:=1;

end;

// Вывод

for i:=0 to Procs.Count-1 do

begin

List:=Procs[i];

for j:=0 to List.Count-1 do

begin

PPT:=List[j];

for k:=PPT.StartTime to PPT.StartTime+PPT.Length-1 do

begin

SG.Cells[2*i+1,k]:=inttostr(PPT.UIN);

if Selected = PPT then SG.Cells[2*i+1,k]:='s'+SG.Cells[2*i+1,k]

else

if PPT.MayBeAfter then SG.Cells[2*i+1,k]:='m'+SG.Cells[2*i+1,k]

end

end;

for i:=0 to Links.Count-1 do

begin

List:=Links[i];

for j:=0 to List.Count-1 do

begin

PLT:=List[j];

for k:=PLT.StartTime to PLT.StartTime+PLT.Length-1 do

SG.Cells[2*i+2,k]:=inttostr(PLT.fromUIN)+':'+inttostr(PLT.toUIN);

end;

procedure Tsub>Merger.SelectTask(UIN:integer);

var i,j:integer;

PPP,tmpPPP:PProcPoint;

PPC,prevPPC:PProcCon;

PPT:PProcTask;

PH:PHolder;

List:TList;

newStartIndex,StartIndex,EndIndex:integer;

Reset:boolean;

begin

Selected:=GetProcTaskByUIN(UIN);

for i:=0 to AllProcTasks.Count-1 do

begin

PPT:=AllProcTasks[i];

PPT.MayBeAfter:= PPT.UIN<>UIN;

PPT.MayBeBefore:=PPT.MayBeAfter

end;

List:=TList.Create;

MinProcNum:=1;

MaxProcNum:=Procs.Count;

PPP:=GetProcPointByUIN(UIN);

PPC:=PPP.Prev;

while PPC<>nil do

begin

PPT:=GetProcTaskByUIN(PPC.toPoint.UIN);

if PPT.ProcNum > MinProcNum then MinProcNum:=PPT.ProcNum;

PPC:=PPC.Next

end;

PPC:=PPP.Next;

while PPC<>nil do

begin

PPT:=GetProcTaskByUIN(PPC.toPoint.UIN);

if PPT.ProcNum < MaxProcNum then MaxProcNum:=PPT.ProcNum;

PPC:=PPC.Next

end;

PPC:=PPP.Next;

while PPC<>nil do

begin

List.Add(PPC.toPoint);

PPC:=PPC.Next

end;

while List.Count<>0 do

begin

tmpPPP:=List.first;

GetProcTaskByUIN(tmpPPP.UIN).MayBeAfter:=false;

List.Delete(0);

PPC:=tmpPPP.Next;

while PPC<>nil do

begin

List.Add(PPC.toPoint);

PPC:=PPC.next

end;

PPC:=PPP.Prev;

while PPC<>nil do

begin

List.Add(PPC.toPoint);

PPC:=PPC.Next

end;

while List.Count<>0 do

begin

tmpPPP:=List.first;

GetProcTaskByUIN(tmpPPP.UIN).MayBeBefore:=false;

List.Delete(0);

PPC:=tmpPPP.Prev;

while PPC<>nil do

begin

List.Add(PPC.toPoint);

PPC:=PPC.next

end;

{ PPC:=PPP.Prev;

while PPC<>nil do

begin

PPT:=GetProcTaskByUIN(PPC.toPoint.UIN);

PPT.MayBeAfter:= not (PPT.ProcNum < MinProcNum);

prevPPC:=PPC.toPoint.Prev;

while prevPPC<>nil do

begin

List.Add(prevPPC.toPoint);

prevPPC:=prevPPC.Next

end;

PPC:=PPC.Next

end;

while List.Count<>0 do

begin

tmpPPP:=List.First;

List.delete(0);

PPT:=GetProcTaskByUIN(tmpPPP.UIN);

PPT.MayBeAfter:=false;

PPC:=tmpPPP.Prev;

while PPC<>nil do

begin

List.Add(PPC.toPoint);

PPC:=PPC.Next

end;

//<<<

PPC:=PPP.Next;

while PPC<>nil do

begin

PPT:=GetProcTaskByUIN(PPC.toPoint.UIN);

PPT.MayBeBefore:= not (PPT.ProcNum > MaxProcNum);

prevPPC:=PPC.toPoint.Next;

while prevPPC<>nil do

begin

List.Add(prevPPC.toPoint);

prevPPC:=prevPPC.Next

end;

PPC:=PPC.Next

end;

while List.Count<>0 do

begin

tmpPPP:=List.First;

List.delete(0);

PPT:=GetProcTaskByUIN(tmpPPP.UIN);

PPT.MayBeBefore:=false;

PPC:=tmpPPP.Next;

while PPC<>nil do

begin

List.Add(PPC.toPoint);

PPC:=PPC.Next

end;

}

List.Destroy;

for i:=1 to MinProcNum-1 do

begin

List:=Procs[i-1];

for j:=0 to List.Count-1 do

begin

PPT:= PProcTask(List[j]);

PPT.MayBeAfter:=false;

PPT.MayBeBefore:=false

end;

for i:=MaxProcNum+1 to Procs.Count do

begin

List:=Procs[i-1];

for j:=0 to List.Count-1 do

begin

PPT:= PProcTask(List[j]);

PPT.MayBeAfter:=false;

PPT.MayBeBefore:=false

end;

for i:=MinProcNum to MaxProcNum do

begin

List:=Procs[i-1];

Reset:=false;

for j:=0 to List.Count-1 do

if Selected<>List[j] then

begin

if Reset then

begin

PPT:=PProcTask(List[j]);

PPT.MayBeAfter:=false;

end

else Reset:=not PProcTask(List[j]).MayBeAfter

end;

Reset:=false;

for j:=List.Count-1 downto 0 do

if Selected<>List[j] then

begin

if Reset then

begin

PPT:=PProcTask(List[j]);

PPT.MayBeAfter:=false;

PPT.MayBeBefore:=false;

end

else Reset:=not PProcTask(List[j]).MayBeBefore

end;

procedure Tsub>Merger.DeselectTask;

var i:integer;

PPT:PProcTask;

begin

Selected:=nil;

for i:=0 to AllProcTasks.Count-1 do

begin

PPT:=AllProcTasks[i];

PPT.MayBeAfter:= false;

PPT.MayBeBefore:=false;

end;

procedure Tsub>Merger.MoveSelectedAfter(ProcNum,UIN:integer);

var i:integer;

PPT:PProcTask;

begin

if Selected<>nil then

begin

if UIN<>-1 then

begin

PPT:=GetProcTaskByUIN(UIN);

if PPT.MayBeAfter then

begin

Selected.ProcNum:=PPT.ProcNum;

AllProcTasks.delete(AllProcTasks.IndexOf(Selected));

AllProcTasks.insert(AllProcTasks.IndexOf(PPT)+1,Selected);

FormLinkTasksAndSetTimes(Procs.Count);

end;

end

else

begin

Selected.ProcNum:=ProcNum;

AllProcTasks.delete(AllProcTasks.IndexOf(Selected));

i:=0;

while i<AllProcTasks.Count do

begin

if PProcTask(AllProcTasks[i]).ProcNum=ProcNum then break;

i:=i+1

end;

AllProcTasks.insert(i,Selected);

end;

FormLinkTasksAndSetTimes(Procs.Count);

end;

function Tsub>Merger.IncNumOfProc:boolean;

var List:TList;

begin

if Procs.Count<>0 then

begin

List:=TList.Create;

Procs.Add(List);

List:=TList.Create;

Links.Add(List);

List:=nil;

Result:=true

end

else Result:=false

end;

function Tsub>Merger.DecNumOfProc:boolean;

var i,FoundNum:integer;

PPT:PProcTask;

begin

FoundNum:=0;

while FoundNum<Procs.Count do

begin

if TList(Procs[FoundNum]).Count=0 then break;

FoundNum:=FoundNum+1

end;

if FoundNum<Procs.Count then

begin

Procs.Delete(FoundNum);

for i:=0 to AllProcTasks.Count-1 do

begin

PPT:=AllProcTasks[i];

if PPT.ProcNum>FoundNum then PPT.ProcNum:=PPT.ProcNum-1;

end;

FormLinkTasksAndSetTimes(Procs.Count);

Result:=true

end

else Result:=false;

end;

procedure Tsub>Merger.ClearPossibleMoves(var List:TList);

var PMT:PPossibleMove;

begin

while List.Count<>0 do

begin

PMT:=List.first;

List.delete(0);

dispose(PMT)

end;

List.Destroy

end;

function Tsub>Merger.GetPossibleMoves(UIN:integer):TList;

var i:integer;

PMT:PPossibleMove;

PPT:PProcTask;

List:TList;

begin

Result:=TList.Create;

SelectTask(UIN);

for i:=MinProcNum-1 to MaxProcNum-1 do

begin

List:=Procs[i];

if(List.Count=0)or((List.Count<>0)and(PProcTask(List.first).MayBeBefore)

or(Selected=List.first))then

begin

new(PMT);

PMT.UIN:=UIN;

PMT.processor:=i+1;

PMT.afterUIN:=-1;

PMT.Time:=$7FFFFFFF;

PMT.ProcCount:=$7FFFFFFF;

PMT.CurrentState:=false;

Result.Add(PMT);

end;

for i:=0 to AllProcTasks.Count-1 do

begin

PPT:=AllProcTasks[i];

if PPT.MayBeAfter then

begin

new(PMT);

PMT.UIN:=UIN;

PMT.processor:=PPT.ProcNum;

PMT.afterUIN:=PPT.UIN;

PMT.Time:=$7FFFFFFF;

PMT.ProcCount:=$7FFFFFFF;

PMT.CurrentState:=false;

Result.Add(PMT);

end;

DeselectTask;

end;

function Tsub>Merger.GetTime:integer;

var i:integer;

PPT:PProcTask;

List:TList;

begin

Result:=0;

for i:=0 to Procs.Count-1 do

begin

List:=Procs[i];

if List.Count<>0 then

begin

PPT:=List.Last;

if Result < PPT.StartTime+PPT.Length-1 then Result :=

PPT.StartTime+PPT.Length-1

end;

function Tsub>Merger.GetProcCount:integer;

var i:integer;

begin

Result:=0;

for i:=0 to Procs.Count-1 do

if TList(Procs[i]).Count<>0 then Result:=Result+1

end;

function Tsub>Merger.OptimizeOneStep(L1,L2:TLabel):boolean;

var i,j:integer;

List,AllMoves:TList;

PPM,bestPPM,workPPM:PPossibleMove;

PPT:PProcTask;

BackUpList:TList;

BackUpNOP:integer;

BestFit:integer;

CurProcCount,CurTime:integer;

MinTime:integer;

Unique:boolean;

PH:PHolder;

CurUIN,MinProcessor:integer;

begin

DeselectTask;

AllMoves:=TList.create;

for i:=0 to AllProcTasks.Count-1 do

begin

PPT:=AllProcTasks[i];

List:=GetPossibleMoves(PPT.UIN);

for j:=0 to List.Count-1 do AllMoves.add(List[j]);

List.clear;

List.Destroy;

end;

CurProcCount:=GetProcCount;

CurTime:=GetTime;

BackUpNOP:=Procs.Count;

SaveBackUp(BackUpList);

for i:=0 to AllMoves.Count-1 do

begin

PPM:=AllMoves[i];

Selected:=GetProcTaskByUIN(PPM.UIN);

Unique:=true;

if Selected.ProcNum = PPM.processor then

begin

List:=Procs[Selected.ProcNum-1];

PPT:=nil;

for j:=0 to List.Count-1 do

begin

if PProcTask(List[j]).UIN = PPM.UIN then break;

PPT:=List[j];

end;

if((PPT<>nil)and(PPT.UIN=PPM.afterUIN))or

((PPT=nil)and(PPM.afterUIN=-1))then Unique:=false;

end;

PPM.CurrentState := not Unique;

if Unique then

begin

if PPM.afterUIN<>-1 then

(GetProcTaskByUIN(PPM.afterUIN)).MayBeAfter:=true;

MoveSelectedAfter(PPM.processor,PPM.afterUIN);

while GetProcCount<>Procs.Count do DecNumOfProc;

PPM.Time:=GetTime;

PPM.ProcCount:=Procs.Count;

RestoreBackUp(BackUpList,BackUpNOP,false);

end

else

begin

PPM.Time:=CurTime;

PPM.ProcCount:=CurProcCount;

end;

Selected:= nil;

RestoreBackUp(BackUpList,BackUpNOP,true); //??

MinTime:=$7FFFFFFF;

for i:=0 to AllMoves.Count-1 do

if MinTime>PPossibleMove(AllMoves[i]).Time then

MinTime:=PPossibleMove(AllMoves[i]).Time;

//-->>

{ Memo.Lines.Clear;

for i:=0 to AllMoves.Count-1 do

begin

PPM:=AllMoves[i];

Memo.Lines.Add(inttostr(PPM.UIN)+' <>

'+inttostr(PPM.processor)+':'+inttostr(PPM.afterUIN)+' Time=

'+inttostr(PPM.Time)+' PC='+inttostr(PPM.ProcCount));

if PPM.CurrentState then Memo.Lines.Add('Was current state!')

end;}

//<<--

// выделяем минимальные времена

i:=0;

while i<>AllMoves.Count do

begin

PPM:=AllMoves[i];

if PPM.Time > MinTime then

begin

AllMoves.delete(i);

dispose(PPM);

end

else i:=i+1

end;

MinProcessor:=$7FFFFFFF;

for i:=0 to AllMoves.Count-1 do

if MinProcessor>PPossibleMove(AllMoves[i]).ProcCount then

MinProcessor:=PPossibleMove(AllMoves[i]).ProcCount;

i:=0;

while i<>AllMoves.Count do

begin

PPM:=AllMoves[i];

if PPM.ProcCount > MinProcessor then

begin

AllMoves.delete(i);

dispose(PPM);

end

else i:=i+1

end;

i:=0;

CurUIN:=0;

MinProcessor:=0;

while i<>AllMoves.Count do

begin

PPM:=AllMoves[i];

if PPM.UIN<>CurUIN then

begin

CurUIN:=PPM.UIN;

MinProcessor:=PPM.processor;

j:=i+1;

while j<>AllMoves.Count do

begin

workPPM:=AllMoves[j];

if workPPM.UIN<>CurUIN then break;

if workPPM.processor<MinProcessor then

MinProcessor:=workPPM.processor;

j:=j+1;

end;

if (PPM.CurrentState)or(PPM.processor>MinProcessor)

then

begin

AllMoves.delete(i);

dispose(PPM);

end

else i:=i+1

end;

i:=0;

if MinTime = CurTime then

while i<AllMoves.Count do

begin

PPM:=AllMoves[i];

PPT:=GetProcTaskByUIN(PPM.UIN);

if PPM.processor = PPT.ProcNum then

begin

AllMoves.delete(i);

dispose(PPM);

end

else i:=i+1

end;

BestFit:=AllMoves.Count-1;

for i:=0 to AllMoves.Count-2 do

begin

PPM:=AllMoves[i];

bestPPM:=AllMoves[BestFit];

if(PPM.Time<bestPPM.Time)or

((PPM.Time=bestPPM.Time)and(PPM.ProcCount<bestPPM.ProcCount))

then BestFit:=i

end;

if BestFit<>-1 then

begin

bestPPM:=AllMoves[BestFit];

Selected:=GetProcTaskByUIN(bestPPM.UIN);

if bestPPM.afterUIN<>-1 then

(GetProcTaskByUIN(bestPPM.afterUIN)).MayBeAfter:=true;

MoveSelectedAfter(bestPPM.processor,bestPPM.afterUIN);

while GetProcCount<>Procs.Count do DecNumOfProc;

if L1<>nil then L1.Caption:=inttostr(bestPPM.Time);

if L2<>nil then L2.Caption:=inttostr(bestPPM.ProcCount);

Result:=true

end

else Result:=false;

//-->>

{ Memo.Lines.Add('');

Memo.Lines.Add('--- Min ---');

Memo.Lines.Add('');

for i:=0 to AllMoves.Count-1 do

begin

PPM:=AllMoves[i];

Memo.Lines.Add(inttostr(PPM.UIN)+' <>

'+inttostr(PPM.processor)+':'+inttostr(PPM.afterUIN)+' Time=

'+inttostr(PPM.Time)+' PC='+inttostr(PPM.ProcCount));

if PPM.CurrentState then Memo.Lines.Add('Was current state!')

end;}

//<<--

ClearPossibleMoves(AllMoves);

DeselectTask;

end;

function ComparePPT(Item1, Item2: Pointer): Integer;

begin

if PProcTask(Item1).StartTime<PProcTask(Item2).StartTime then Result:=-

else

if PProcTask(Item1).StartTime>PProcTask(Item2).StartTime then Result:=1

else Result:=0

end;

procedure Tsub>Merger.OptimizeAuto(Form:TForm;L1,L2:TLabel);

var i,j,k:integer;

List,UINList:TList;

PPT,nextPPT:PProcTask;

Time:integer;

MatchError:boolean;

NewProc:TList;

NOP:integer;

NoChange:boolean;

StartFrom,NewStartFrom:integer;

BackList:TList;

BackTime:integer;

begin

while OptimizeOneStep(L1,L2) do Form.Update;

Time:=GetTime;

UINList:=TList.Create;

NewStartFrom:=0;

repeat

StartFrom:=NewStartFrom;

NoChange:=true;

for i:=0 to Procs.Count-2 do

begin

NewStartFrom:=i+1;

List:=Procs[i];

for j:=0 to List.Count-1 do UINList.Add(List[j]);

List:=Procs[i+1];

for j:=0 to List.Count-1 do UINList.Add(List[j]);

UINList.Sort(ComparePPT);

MatchError:=false;

PPT:=UINList.first;

for j:=1 to UINList.Count-1 do

begin

nextPPT:=UINList[j];

if (PPT.StartTime = nextPPT.StartTime) or

(PPT.StartTime+PPT.Length>nextPPT.StartTime) then

begin

MatchError:=true;

break

end;

PPT:=nextPPT;

end;

if not MatchError then

begin

SaveBackUp(BackList);

BackTime:=GetTime;

NOP:=Procs.Count-1;

ClearLinks(true);

ClearProcs(false);

for j:=0 to UINList.Count-1 do

begin

PPT:=UINList[j];

PPT.ProcNum:=i+1;

AllProcTasks.delete(AllProcTasks.indexOf(PPT));

end;

for j:=0 to AllProcTasks.Count-1 do

begin

PPT:=AllProcTasks[j];

if PPT.ProcNum>i+1 then PPT.ProcNum:=PPT.ProcNum-1

end;

for j:=0 to UINList.Count-1 do AllProcTasks.add(UINList[j]);

FormLinkTasksAndSetTimes(NOP);

if BackTime>=GetTime then

begin

NoChange:=false;

NewStartFrom:=0;

while BackList.Count<>0 do

begin

PPT:=BackList.first;

BackList.delete(0);

dispose(PPT)

end;

end

else RestoreBackUp(BackList,NOP+1,true);

break;

end;

UINList.Clear;

end;

UINList.Clear;

until NoChange;

UINList.Destroy;

end;

procedure Tsub>Merger.SaveBackUp(var List:Tlist);

var backPPT,PPT:PProcTask;

i:integer;

begin

List:=TList.Create;

for i:=0 to AllProcTasks.Count-1 do

begin

PPT:=AllProcTasks[i];

new(backPPT);

backPPT^:=PPT^;

backPPT.Prev:=nil;

List.add(backPPT);

end;

procedure Tsub>Merger.RestoreBackUp(var

List:Tlist;NOP:integer;ClearCurrent:boolean);

var backPPT,PPT:PProcTask;

i:integer;

begin

Selected:=nil;

ClearLinks(true);

ClearProcs(true);

for i:=0 to List.Count-1 do

begin

backPPT:=List[i];

new(PPT);

PPT^:=backPPT^;

AllProcTasks.add(PPT);

if ClearCurrent then dispose(backPPT);

end;

if ClearCurrent then List.Destroy;

FormLinkTasksAndSetTimes(NOP);

end;

end.