[Pascal] Сортировка слов

[ddj]

Код: Выделить всё

program Project2;
const
  MAX = 25;
type
  TArray = array [1..MAX] of string;

procedure Delemited(var Arr : TArray; str : string; var last : integer);
var
  i : integer;
  sub : string;
begin
  if str = '' then
    exit;
  str := str + ' ';
  for I := 1 to length(str) do
    if ((str[i] in ['A'..'Z']) or (str[i] in ['a'..'z']) or (str[i] in ['1'..'9'])) then
      sub := sub + str[i]
    else
      if sub <> '' then
        if last > MAX then
          exit
        else
          begin
            arr[last] := sub;
            inc(last);
            sub := '';
          end;
end;

procedure ReadFile(var s : string);
var
  fname, tmp : string;
  result : integer;
  txt : text;
begin
  repeat
    writeln ('Enter file name:');
    writeln('Files: dom.txt,news.txt');
    Write('>> ');
    readln(fname);
    assign(Txt, fname);
    {$I-}
    reset(Txt);
    {$I+}
    Result := IOResult;
    if result <> 0 then
      writeln('ERROR!');
  until result = 0;
  writeln('text:');
  while not eof(Txt) do
    begin
      Readln(Txt, tmp);
      writeln(tmp);
      tmp := tmp + ' ';
      s := s + tmp;
    end;
  Close(Txt);
end;


procedure Swap(var Arr : TArray; pos1, pos2 : integer);
var
  tmp : string;
begin
  tmp := arr[pos1];
  arr[pos1] := arr[pos2];
  arr[pos2] := tmp;
end;


var
  s : string;
  cel, k : integer;
  a : TArray;
  twosort : boolean;
  i, j : integer;

begin
  cel := 1;
  twosort := true;
  ReadFile(s);
  Delemited(a, s, cel);
  writeLn('S kokogo slova sortiruem?');
  readln(k);

  if k > cel then
    begin
      k := cel;
      twosort := false;
    end;

  for i := 1 to k - 1 do
    for j:=1 to k - i do
      if ord(a[j][1]) > ord(a[j+1][1]) then
        swap(a, j, j + 1);

  writeln('V porjadke vozrastanij');

  for i := 1 to k do
    writeln(a[i]);

  if twosort then
    begin
      for i := k to cel - 1 do
        for j := k + 1 to cel - i do
          if ord(a[j][1]) < ord(a[j+1][1]) then
            swap(a, j, j + 1);

      writeln('V porjadke ubyvanija');

      for i := k + 1 to cel - 1 do
        writeln(a[i]);
    end;
  readln;
end.

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

[ddj]

вот как бы начало: (но я ниуверен что там написано всё хорошо)

Код: Выделить всё

program d2;

const
  MAX = 25;
  type  node = ^elem;
        elem     = record
        duom     : integer;
        kitas    : node;      //    kitas - second - sledushij
  end;

type
  TArray = array [1..MAX] of string;
  
  var  pr,pab    : node;      // pr - nachalo, pab - konec
       n,elementas : integer;
       
       //------------------------------------------------------------------------
procedure Duomenys(var pr, pab:node; var n : integer);     //dannye
  var  d      : integer;
       failas : string;
       ff   : text;
       mas    : node;

begin
  writeln('Enter file name');
  readln(failas);
  {$I-}
  assign(ff, failas); reset(ff);
  if IOResult<>0 then
    begin
      writeln('error!!!');
    end
  else
    begin
      {$I+}
      pr  := nil;
      pab  := nil;
      n := 0;
      while not eof(ff) do
        begin
          while not eoln(ff) do
            begin
              read(ff,d);
              if (IOResult=0) then
                begin
                  new(mas);
                  mas^.duom := d;
                  mas^.kitas := nil;
                  if pr = nil then
                    pr := mas
                  else
                    pab^.kitas:=mas;     // kitas - second
                    pab:=mas;
                    n := n+1;
                    writeln('mas[',n,']= ',d);
                end;
            end;
           readln(ff);
        end;
      close(ff);
      writeln();
      {$I+}
    end;
end;
//------------------------------------------------------------------------

function MasNusk(mas:node; n:integer):integer;  // schityvaim masiv
  var i:integer;
begin
  for i:=1 to n-1 do
    mas:=mas^.kitas;
  MasNusk:=mas^.duom;
end;
//------------------------------------------------------------------------
procedure MasIrasas(var pr:node; x, n:integer);   //zapisyvaim masiv
  var  i    : integer;
       mas  : node;
begin
  mas:=pr;
  for i:=1 to n-1 do
    mas:=mas^.kitas;
  mas^.duom:=x;
end;

procedure sort(var pr:node; a,b:integer);
.
.
.
.
.
end;

procedure Rezultats(var mas : node; var n : integer);
  var i : integer;
begin
  writeln('Masyv otsortirovan');
  for i:= 1 to n do
    begin
      write(MasNusk(pr, i),'  ');
    end;
end;

procedure delete(var pr, pab:node);
  var mas : node;
begin
  while pr <> nil do
    begin
      mas := pr;
      if pab <> pr then
        begin
          while mas^.kitas <> pab do
            mas := mas^.kitas;
          pab := mas;
          dispose (mas^.kitas);
        end
      else
        begin
          dispose(mas);
          pr := nil;
          pab := nil;
        end;
    end;
end;
BEGIN
  Duomenys(pr, pab, n);
  if n>0 then
    begin
      write('s kokogo slova sortiruem ?' );
      readln(elementas); writeln;
      if (elementas>0) and (elementas <= n) then
        begin

          sort(pr, elementas, n);
          Rezultats(pr, n);
          delete(pr, pab);
        end  ;
        end;
        END.

ICQ Number: 219-788-380