Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 11.10.2011, 11:49   #1
dukales
Пользователь
 
Регистрация: 26.06.2011
Сообщений: 58
Радость Задача о трёх станках[исправить код]

Доброго времени суток, помогите пожалуйста исправить код, уже часа 3 «копаю», - никак не могу найти ошибку.

Цитата:
Задача о трех станках. Даны N деталей, каждая из которых должна быть обработана на станке A, затем на станке B, затем на станке C. Каждый станок может в данный момент времени обрабатывать только одну деталь. Если нужный станок занят, то другие детали могут ожидать его освобождения. Для каждой детали известны длительности ее обработки на каждом станке: TAi, TBi, TCi. Требуется найти такой порядок запуска деталей на обработку (т.е. найти такую перестановку номеров деталей), при котором длительность обработки всего комплекта деталей минимальна.
Код:
program lab6;
{$APPTYPE CONSOLE}

uses
  SysUtils, Windows;

var
  fin,fout :text;
  Mt :array [1..10, 1..3] of integer;
  X  :array [1..10] of integer;
  Xm :array [1..10] of integer;
  N, min1, min2, i, j :integer;
  time :real;

{возвращает системное время как вещественное число секунд}
function GetSeconds :Real;
var
  SystemTime :TSystemTime;     //некое время(неверное)
begin
  GetLocalTime(SystemTime);    //получаем системное время
  GetSeconds := (systemtime.whour * 3600.0) + (systemtime.wMinute * 60.0) +
                  + systemtime.wSecond + (systemtime.wMilliseconds / 1000);
end; {GetSeconds}

{возвращает максимум из двух целых чисел }
function max2(a, b :integer) :integer;
begin
  if (a > b) then
     begin
       max2 := a;
     end
       else
     begin
       max2 := b;
     end;{if a>b}
end;

{возвращает максимум из трёх целых чисел }
function max3(a, b, c :integer) :integer;
begin
  max3 := max2(a, max2(b, c));
end; {max3}

{процедура подсчёта длительности обработки всего комплекта деталей }
procedure calc(var time :integer);
var
  i :integer;
begin
  time := 0;
  time := Mt[X[1], 1];
  time := time + max2(Mt[X[1], 2], Mt[X[2], 1]);
  i := 1;
  while i < (n - 1) do
        begin
          time := time + max3(Mt[X[i], 3], Mt[X[i + 1], 2], Mt[X[i + 2], 1]);
          inc(i);
        end; {while i<(n-1)}
  time := time + max2(Mt[X[N - 1], 3], Mt[X[N], 2]);
  time := time + Mt[X[N], 3];
end; {calc}

{процедура перебора.K-количество уже найденных номеров деталей в последовательности }
procedure perebor(k :integer);
var
  ip,j :integer;
  ok :boolean;
begin
  if k = N then
     begin
       calc(ip);
       if ip < min1 then
           begin
             min1 := ip;
             for j := 1 to N do
                 begin
                   Xm[j] := X[j];
                 end; {for j:=1 to N}
           end; {if ip<min1}
     end
       else
     begin {k < n}
        inc(k);
        X[k] := 1;
        while X[k] <= N do
             begin
                ok := true;
                ip := 1;
                while ip < k do
                      begin
                        if X[k] = X[ip] then
                           begin
                             ok := false;
                           end; {if x[k]=x[ip]}
                        inc(ip);
                      end;{while ip < k}
                if (ok) then
                   begin
                     perebor(k);
                   end; {if ok}
                inc(X[k]);
             end; {while x[k] <= N}
      end; {if k=N}
end; {perebor}

{функция возвращает факториал от n}
function fact(n :integer) :longint;
var i :integer;
    s :longint;
begin
  s := 1;
  i := 1;
  while i <= n do
        begin
          s := s * i;
          inc(i);
        end; {while i <= n}
  fact := s;
end; {fact}


{ Эвристический алгоритм }
Procedure evristika(N1 :integer; var time1 :integer);
var
  i,j,k :integer;
  min :integer;
  ok:boolean;
begin
{поиск первой наилучшей детали}
  min := 32000;
  for i := 1 to N1 do
      begin
        if Mt[i, 1] < min then
           begin
             min := Mt[i, 1];
             X[1] := i;
           end; {if mt[i,1] < min}
      end; {if for i:=1 to n1}
  time1 := min;

Входящий файл in.txt в приложении...
Вложения
Тип файла: txt in.txt (11.7 Кб, 162 просмотров)
dukales вне форума Ответить с цитированием
Старый 11.10.2011, 11:49   #2
dukales
Пользователь
 
Регистрация: 26.06.2011
Сообщений: 58
По умолчанию

Код:
{поиск второй лучшей детали }
  min := 32000;
  for i := 1 to N1 do
      begin
        if i <> X[1] then
            begin
              if max2(Mt[X[1], 2], Mt[i, 1]) < min then
                 begin
                   min := max2(Mt[X[1], 2], Mt[i, 1]);
                   X[2] := i;
                 end; {if max2(mt...}
            end; {if i<>x[1]}
      end; {for i :=1 to n1}
  time1 := time1 + min;

 {поиск остальных деталей }
  i := 1;
  while i <= (N1 - 2) do
        begin
          min := 32000;
          for j := 1 to N1 do
              begin
                ok := true;
                for k := 1 to (i + 1) do
                    begin
                      if j = X[k] then
                         begin
                           ok := false;
                         end; {if k:=1 to (i +1)}
                    end; {for k:=1 to (i+1)}
                if ok then
                   begin
                    if max3(Mt[X[i], 3], Mt[X[i + 1], 2], Mt[X[j], 1]) < min then
                       begin
                         X[i + 2] := j;
                         min := max3(Mt[X[i], 3], Mt[X[i + 1], 2], Mt[X[j], 1]);
                       end; {if max3}
                   end; {if ok then}
               end; {for j:=1 to n1}
          time1 := time1 + min;
          inc(i);
        end; {while i<= (n1-2)}
  time1 := time1 + max2(Mt[X[N - 1], 3], Mt[X[N], 2]);
  time1 := time1 + Mt[X[N], 3];
end; {evrestika}



Begin
  {открытие и считывание данных с входного файла }
  assign(fin, 'in.txt');
  assign(fout, 'out.txt');
  rewrite(fout);
  for i := 1 to 5 do
      begin
        N := 0;
        min1 := 32000;
        min2 := 32000;
        reset(fin);
        while (not(eof(fin)) and (N < i + 4))do
              begin
                inc(N);
                readln(fin, Mt[N, 1], Mt[N, 2], Mt[N, 3]);
              end; {while (not(eof(fin...}
        Time := GetSeconds;
        perebor(0);
        {sывод таблицы результатов }
        write('N: ', N : 2, '.Time: ', (GetSeconds - Time) : 5 : 2, 'cek. MIN1: ', min1:3, ' KoJI-BO ', fact(N) : 7);
        Time := Getseconds;
        evristika(N, min2);
        writeln(' Time2: ',(GetSeconds-Time):5:2,'cek. Min2: ',min2:3);
        write(fout, 'N: ', N:2, '.Time: ', (GetSeconds - Time) : 5 : 2, 'cek.  MINIMUM: ', min1 : 3, ' KoJI-BO ', fact(N) : 7);
        writeln(fout, ' Time2: ', (GetSeconds - Time) : 5 : 2,'cek. Min2: ', min2 : 3);
      end; {for i:=1 to 5}
  for i := 1 to 5 do
      begin
        N :=  0;
        min2  :=  32000;
        reset(fin);
        while (not(eof(fin)) and (N < i * 200))do
              begin
                 inc(N);
                 readln(fin, Mt[N, 1], Mt[N, 2], Mt[N, 3]);
              end; {while (not(fin))...}
        Time := Getseconds;
        evristika(N, min2);
        writeln('N: ', N : 3, ' Time2: ', (GetSeconds - Time):5:2,'cek. Min2: ', min2 : 3);
        writeln(fout,' Time2: ',(GetSeconds-Time):5:2,'cek. Min2: ',min2:3);
      end; {for i:=1 to 5}
  readln;
 {закрытие файлов}
  close(fin);
  close(fout);
End.
dukales вне форума Ответить с цитированием
Старый 11.10.2011, 11:54   #3
dukales
Пользователь
 
Регистрация: 26.06.2011
Сообщений: 58
По умолчанию

Должен быть, примерно, такой результат:

А получается:
dukales вне форума Ответить с цитированием
Старый 11.10.2011, 23:27   #4
dukales
Пользователь
 
Регистрация: 26.06.2011
Сообщений: 58
По умолчанию

Вопрос ещё актуальный, никак не удалось исправить. Помогите пожалуйста...
dukales вне форума Ответить с цитированием
Старый 13.10.2011, 01:29   #5
dukales
Пользователь
 
Регистрация: 26.06.2011
Сообщений: 58
По умолчанию

Форумчане, ну помогите пожалуйста исправить ошибку...
dukales вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
исправить код seed92 Помощь студентам 0 21.02.2011 16:02
Исправить код DirtyBASS Помощь студентам 2 22.09.2009 10:20
Исправить код IndividBezLica Помощь студентам 0 02.06.2009 09:41
Помогите исправить код student_63 Помощь студентам 5 13.12.2007 18:20
Задача на объекты. Исправить код. AVer Помощь студентам 1 21.01.2007 14:55