Задача на сортировку динамического списка., (по мере добавления) Опции

[Jabbson]

Прошу посмотреть код на предмет логичности.
Задача:
Scheduling policy по методу "shortest job first".

1. Создание списка: {ПРОЦЕСС}-{ВРЕМЯ ВЫПОЛНЕНИЯ} и его сортировка по времени от меньшего к большему.
2. Вывод списка.

p.s.> так же реализованы функции "выполнить" задачу и создать список рандомных процессов, чтобы не забивать список вручную.

Код:

program STF;

uses crt,sysutils;

type

TData = record
  NAME: string;
 TIM_S: string;
  TIME: longint;
 end;

LINK = ^LIST;

LIST = record
 REC:  TData;
 NEXT: LINK;
 end;

var
i,H,M,S:        integer;   {счетчик, время в секундах }
HH,MM,SS:       string[2]; {время текстом}
TimS:           string[8];
sp, spN:        LINK; {указатель на элемент и начало списка}
z:              LIST; {запись}
menu:           byte;

{-------------------}
procedure Add(var L,Nach:link; R:list); {добавление записи в порядке}
var p:link;

begin
  new(p);
  p^:=R;

{если список пуст}
  if L=nil then begin
    L:=p;
    Nach:=p;
    exit;
  end

  else begin
{вставка в начало}
    if R.rec.time<L^.rec.time then begin
        p^.next:=L;
        L:=p; Nach:=p;
        exit;
      end

      else
{вставка в середину}
      while L^.next<>nil do begin
        if ((R.rec.time>=L^.rec.time) and (R.rec.time<L^.next^.rec.time)) then begin
          p^.next:=L^.next;
          L^.next:=p;
          L:=Nach;
          exit;
        end;{if}

        L:=L^.next;
      end;{while}
{вставка в конец}
    L^.next:=p;
  end; {else}
L:=Nach; {идем в начало списка}
end;

procedure EXECUTE(var L:link); {"выполнение" процесса}
begin
  L:=L^.next;
  writeln('TOP PRIORITY PROCESS HAS BEEN EXECUTED...');
  readln;
end;

procedure PRINT(L:link); {печать списка процессов}
begin

if L<>nil then begin
  clrscr;
  while L<>nil do begin
    writeln('NAME: [',L^.rec.name:9,']  TIME: ',L^.rec.tim_s);
    L:=L^.next;
  end;

readln;
end
else begin
  writeln('SORRY, THERE IS NOTHING TO PRINT.');
  readln;
end;
end;

{-------------------}


BEGIN {основной блок}

repeat
clrscr;

writeln('1 - ADD PROCESS');
writeln('2 - EXECUTE TOP PRIORITY PROCESS');
writeln('3 - PRINT PROCESS LIST');
writeln('4 - LOAD THE SAMPLE LIST');writeln;
writeln('0 - EXIT');writeln;

write('MENU = ');readln(menu);writeln;

case menu of
1:begin
    clrscr;
    write('NEW PROCESS NAME [e.g. calc]: ');readln(z.rec.name);
    write('NEW PROCESS TIME  [xx:xx:xx]: ');readln(z.rec.tim_S);writeln;
    tims:=z.rec.tim_s;

    HH:=tims[1]+tims[2];H:=strtoint(HH);
    MM:=tims[4]+tims[5];M:=strtoint(MM);
    SS:=tims[7]+tims[8];S:=strtoint(SS);

    z.rec.time:=H*3600+M*60+S;
    z.next:=nil;

    ADD(sp,spN,z);
  end;
2:begin EXECUTE(sp); end;
3:begin PRINT(sp);   end;
4:begin
    sp:=nil;
    spN:=nil;

    for i:=1 to 20 do begin
      z.rec.name:='Process'+inttostr(i);
      H:=random(24);if H <10 then HH:='0'+inttostr(H) else HH:=inttostr(H);
      M:=random(60);if M <10 then MM:='0'+inttostr(M) else MM:=inttostr(M);
      S:=random(60);if S <10 then SS:='0'+inttostr(S) else SS:=inttostr(S);

      z.rec.time:=H*3600+M*60+S;
      z.rec.tim_s:=HH+':'+MM+':'+SS;
      z.next:=nil;
      Add(sp,spN,z);
    end;
    writeln('LIST HAS BEEN LOADED...');
    readln;
  end;

end;{case}
until menu=0;{repeat}

END.{BEGIN}

Прилагаю исходник и исполняемый файл:  SJF.rar ( 46.43 килобайт ) Кол-во скачиваний: 379


Сообщение отредактировано: Jabbson - 27.05.2010 19:38

[volvo]

Я бы переписал добавление:

procedure Add(var nach: link; R: list);
var p, L: link;
begin
  new(p);
  p^ := R;

  if nach = nil then nach := p
  else
    if R.rec.time < nach^.rec.time then begin
      p^.next := nach; nach := p;
    end
    else begin
      L := nach;
      while (L^.next <> nil) and (R.rec.time > L^.next^.rec.time) do
        L := L^.next;

      p^.next := L^.next;
      L^.next := p;
    end;
end;

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

P.S. Кстати, компилятором каким пользуешься? SysUtils наводит на сомнения, что это Турбо-Паскаль... FPC? Тогда почему не используешь другие его возможности, например вывод через Format, так же намного удобнее будет...

P.P.S. От утечек памяти избавься. Ты в Execute продвигаешь указатель на начало списка на следующий элемент. А удалять первый кто будет?

[Jabbson]

Спасибо за Ваш ответ, очень ждал.

Да, Вы абсолютно правы, так процедура выглядит гораздо чище, спасибо.

Компиляторами пользуюсь разными, и BP7 и FPC и PascalABC.NET, но последний отпугивает невозможностью использования модуля crt при отладке, так что по большей части, все же, первыми двумя. Но, к своему стыду, замечу, что использую FPC только за возможность писать на русском прямо в среде. Ткните, пожалуйста, где почитать про то, что же я упускаю делая так.

SysUtils использовал для IntToStr / StrToInt.

А подтирать так? Честно говоря, никогда этого не делал, но надо привыкать, полагаю.

procedure EXECUTE(var L:link);
var tmp:link;

begin
  tmp:=L;
  L:=L^.next;
  writeln('TOP PRIORITY PROCESS HAS BEEN EXECUTED...');
  readln;
  dispose(tmp);
end;

Сообщение отредактировано: Jabbson - 27.05.2010 21:46