Рефераты → Информатика, программирование → Гр → Градиентный метод первого порядка

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

Содержание

Введение


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


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


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


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


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


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


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


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


Вывод


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


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


Введение

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


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


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

,
x
2

, ...,
xn

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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


Согласно принятой терминологии факторы x1
, x2
, ..., xn
— это измеряемые и регулируемые входные переменные объекта (независимые переменные); помехи f1
, f2
, ..., fs
— это не контролируемые, случайным образом изменяющиеся переменные объекта; выходные переменные y1
, y2
, ..., ym
— это контролируемые переменные, которые определяются факторами и связаны с целью исследования. Часто в планируемом эксперименте у называют параметром оптимизации (технологический или экономический показатель процесса).


Факторы x
1

,
x
2

, ...,
xn

иногда называют основными, поскольку они определяют условия эксперимента. Помехи f
1

,
f
2

, ...,
fs

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


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

,
x
2

, ...,
xn

),
связывающую параметр оптимизации с факторами, которые варьируются при проведении опытов.


Пространство с координатами x
1

,
x
2

, ...,
xn

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


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


Y
=
f
(
x
1

,
x
2

, ...,
xn

, Я1
, Я2
, ... , Я
n

). (1)


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

,
b
1

, ...,
bi

, ...,
bn

,
являющиеся оценками коэффициентов Я0
, Я1
, ..., Я
i

, ..., Я
n

.


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


(2)


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


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


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


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


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

i

до значения x
’’

i

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


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


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


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


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


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


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


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


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



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


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


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


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


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


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


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


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


(1)


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


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


, (2)


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


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


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


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


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


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


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


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


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


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


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


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

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


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


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


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


, (3)


то его градиент в точке (x1
, x2
,…, xn
) определяется вектором:


. (4)


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


(5)


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


, (6)


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


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


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



то



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


. (7)


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


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


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


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


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


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


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


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


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

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


grad y(X)= ,


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


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


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


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


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


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


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


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


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


(8)


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


, .(9)


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


(10)


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



Рис.1


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


. (11)


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


. (12)


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


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


, , (13)


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


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


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


(14)


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


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


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


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


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


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

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


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


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


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


примет вид


grad (X)= b1
+ b2
+ … + bn


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


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


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


max (bi
) = a


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


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


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


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


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


hi
= (*)


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


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


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


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

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


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


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


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


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



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


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


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


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


Xj-факторы;


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


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


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


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


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


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


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


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



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


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


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


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


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


bj
- несмешанные оценки;


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


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


tj
- критерий Стьюдента;


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


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




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


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


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


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


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


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


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


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


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


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


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


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


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


Uj
= (Хj
- Хj
0
) / , j = 1,2,…..k;


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


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


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


Таблица 1.1








































Номер опыта Значения факторов в натуральном масштабе выход
X1
X2
… Xn
Y
1 X11
X 12
… X 1 n
Y1
2 X 21
X2 2
… X 2 n
Y2
…. … … … … ...
N X N1
X N2
… XNn
YN

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


Таблица 1.2














































Номер опыта фиктивный столбец Значения факторов в безразмерной системе координат Выход
U0
U1
U2
… Un
У
1 +1 +1 +1 … +1 У1
2 +1 -1 +1 … +1 У2
... … … … … …. …
N +1 -1 -1 … -1 УN

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


Таблица 1.3




































































Номер


опыта


 Значения факторов Выход
В натуральном масштабе В безразмернойсистеме координат
X1
X2
… Xn
U 0
U1
U2
… Un
Y
1 X11
X12
… X1n
+1 +1 +1 … +1 Y1
2 X21
X22
… X2
n
+1 -1 +1 … +1 Y2
… … … … … … … … … … …
N XN1
X N2
… XNn
+1 -1 -1 … -1 YN

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


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


;


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


;


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


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


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


s2
y
= s2
b
0
+ s2
b
1
U1
2
+ … + s2
bn
Un
2


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


s2
y
= s2
bi


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



,


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


s2
y
= s2
bi
.


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


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


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



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




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



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



.


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


Y= Р0
+ Р1
U1
+ Р2
U2
+ … + Рn
Un
+ … +


+…+P13
U1
U3
+ P23
U2
U3
+…+ P123
U1
U2
U3
…


Таблица 1.4



































































Номер опыта U0
U1
U2
… Un
…


… У
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

P12
, P23
- эффекты двойного взаимодействия, а P123
- эффекты тройного взаимодействия. Эффекты взаимодействия определяют аналогично линейным эффектам:


.


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


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


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


,


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


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


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


Y = и Y = Р0
+ Р1
U1
+ Р2
U2
+ … + Рn
Un
+ … +


+ … +


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


sbj
= s2
воспр


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


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


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


F= s2
ост
/ s2
воспр
; s2
ост
,


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


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



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


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


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


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





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


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


, , .


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


, .


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


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


.


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


Необходимо


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


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


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


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


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

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


,


, ;
.


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


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


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


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


, , .


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


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


, .


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


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


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


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

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


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


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


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


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


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

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


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


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



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


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


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




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


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


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


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


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


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


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


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

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


.


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


.


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





Вывод

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


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

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


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


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


4. А.В. Бондаренко, Г.А. Статюха. Планирование эксперимента в химической технологии. “Вища школа”. Киев 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 : PPro

cTask;


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;


TSubMerger = 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 ShowSubMerging(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;


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;


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;


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;


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;


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;


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;


end;


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


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;


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;


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;


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;


end;


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;


// --- SubMerger --- //


constructor TSubMerger.Create;


begin


Points := TList.Create;


AllProcTasks := TList.Create;


Procs:=TList.Create;


Links:=TList.Create


end;


procedure TSubMerger.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 TSubMerger.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;


end;


procedure TSubMerger.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 TSubMerger.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;


end;


function TSubMerger.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;


end;


procedure TSubMerger.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;


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;


end;


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;


end;


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);


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);


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


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


end;


PPC:=PPC.Next;


end;


end;


procedure TSubMerger.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;


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;


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;


end;


end;


end;


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;


end;


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;


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;


end;


end;


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;


end;


зrocedure TSubMerger.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;


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;


end;


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 TSubMerger.ShowSubMerging(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;


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;


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;


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;


end;


end;


procedure TSubMerger.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;


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;


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;


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;


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;


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;


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;


end;


end;


procedure TSubMerger.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;


end;


procedure TSubMerger.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;


end;


function TSubMerger.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 TSubMerger.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 TSubMerger.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 TSubMerger.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;


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;


end;


DeselectTask;


end;


function TSubMerger.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;


end;


end;


function TSubMerger.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 TSubMerger.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;


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;


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:=-


1


else


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


else Result:=0


end;


procedure TSubMerger.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 TSubMerger.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;


end;


procedure TSubMerger.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.
Сохранить в соц. сетях:
Обсуждение:
comments powered by Disqus

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

Слов:10885
Символов:136357
Размер:266.32 Кб.