Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Object Pascal: кроссплатформенные технологии > Работа со списками


Автор: Ripper 12.11.2006, 15:54
Есть такая задача:
 В файл занести сведения о заработной плате сотрудников некоторой организации в формате: номер отдела, должность, ставка, фамилия, имя, отчество. Создать в памяти кольцевой список из сотрудников организации. Список упорядочить по фамилиям. Обеспечить исправление сведений о сотрудниках, в том числе и изменение числа сотрудников.

Я только недавно познакомился со списками поэтому тяжеловато щас они идут. Но я не совсем понимаю само задание. 
Я создал два типа, один из них TSotrudnik со всеми полями, другой TNode, у которого поле Data: TSotrudnik и соответственно указатель на след. элемент. 
Но что нужно, сначала завести данные в файл, потом считать данные из файла в список и его отсортировать? Если да то неподскажете как это сделать. Я еле еле разобрался как вообще сделать несколько элементов списка. И темболее сортировка в них же 1)Невыгодна? 2)Мы и не делали её никогда.
Ладно еслиб в массиве по алфавиту)
А вот что у меня получилось: (работаю я в дельфи в консоли)
Код

program laba6;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows;

const
 DataFile = 'Data.dat';

type
 ss=string[30];
 PNode = ^TNode;

 TSotrudnik = record
  ID:integer;
  Otdel:integer;
  Dolznost:ss;
  Stavka:integer;
  F,I,O:ss;
 end;

 TNode = record
  Data :TSotrudnik;
  Next :PNode;
 end;

 TColor = (Red,Green,Blue);

procedure SetColor(C:TColor);
var
 h:THandle;
begin
 h := GetStdHandle(STD_OUTPUT_HANDLE);
  case C of
   Red:   SetConsoleTextAttribute(h,FOREGROUND_RED or FOREGROUND_INTENSITY);
   Blue:  SetConsoleTextAttribute(h,FOREGROUND_BLUE or FOREGROUND_INTENSITY);
   Green: SetConsoleTextAttribute(h,FOREGROUND_GREEN or FOREGROUND_INTENSITY);
  end;
end;

procedure ShowMenu;
begin
 WriteLn;
 Writeln(' ', chr(16), ' [1] Add record');
 WriteLn(' ', chr(16), ' [2] Show records');
 WriteLn(' ', chr(16), ' [3] Clear File');
 WriteLn(' ', chr(16), ' [0] Exit');
end;

procedure AddSotrudnik();
var
 s:TSotrudnik;
 f:file of TSotrudnik;
 i,Otd,st:integer;
 dol,fam,name,ot:ss;
begin
 Write('Enter name: ');          ReadLn(name);
 Write('Enter second name: ');   Readln(fam);
 Write('Enter Ot4estvo: ');      ReadLn(ot);
 Write('Enter number otdela: '); ReadLn(Otd);
 Write('Enter dolznost: ');      ReadLn(dol);
 Write('Enter stavka: ');        ReadLn(st);

 AssignFile(f,DataFile);
 Reset(f);
 i:=FileSize(f);
 Seek(f,i);
 s.Otdel:=Otd;
 s.Dolznost:=dol;
 s.Stavka:=st;
 s.F:=fam;
 s.I:=name;
 s.O:=ot;
 Write(f,s);
 CloseFile(f);
end;

procedure ClearFile();
var
 f:file of TSotrudnik;
begin
 AssignFile(f,DataFile);
 Rewrite(f);
 CloseFile(f);
end;

procedure ShowFile();
var
 f:file of TSotrudnik;
 s:TSotrudnik;
 fs:Integer;
begin
 AssignFile(f,DataFile);
 Reset(f);
 fs:=FileSize(f);
 if fs=0 then
  begin
   SetColor(Red);
   Writeln('File is empty!');
   Exit;
  end;
 while not(EOF(f)) do
  begin
   read(f,s);
   WriteLn ('---------------------------------');
   WriteLn (' ', chr(26), ' Familiya: ', s.F);
   WriteLn (' ', chr(26), ' Imya: ', s.I);
   WriteLn (' ', chr(26), ' Ot4estvo: ', s.O);
   WriteLn (' ', chr(26), ' Nomer otdela: ', s.Otdel);
   WriteLn (' ', chr(26), ' Dolznost: ', s.Dolznost);
   WriteLn (' ', chr(26), ' Stavka: ', s.stavka);
  end;
end;
var
 f:file of TSotrudnik;
 a:byte;

begin
 SetColor(Green);
 AssignFile(f, DataFile);
 {$I-}
 if (not(FileExists(DataFile))) then
  begin
   Rewrite(f);
   CloseFile(f);
  end;

 Reset(f);
  if IOResult<>0 then
   begin
    SetColor(Red);
    WriteLn('Cant Open file!');
    readln;
    Exit;
   end;
 {$I+}

 while(true) do
 begin
  SetColor(Green);
  ShowMenu();
  readln(a);
  case a of
    1: AddSotrudnik;
    2: ShowFile;
    3: ClearFile;
    0: Exit;
  end;
 end;

end.


Завтра сдавать smile Конечно не критично, но хотел бы понять хотя бы задание, не представляю себе сортировку списка да и ещё кольцевого. Спасибо заранее

Автор: TaNK 12.11.2006, 16:21
могу тебе предложить что старое мое....работа со списком....но без работы с файлами..там есть и удаление и еще кое то..думаю тебе пригодиться....но эо написано на паскале!
Код

program spisok_05;
type
    list=^elem;
               elem=record
               info : integer;
               next : list;
         end;

    Spisok=object
                 L : list;
                 procedure Init;
                 procedure Insert(x : integer; p : list);
                 procedure Delete_(p : list);
                 function Locate(x : integer):list;
                 function Retrive(p : list):integer;
                 function First:list;
                 function End_:list;
                 procedure Print;
end;

Procedure Spisok.Init;
begin
     new(L);
     L^.info:=0;
     L^.next:=nil;
end;

Procedure Spisok.Insert;
var
     temp : list;

begin
     temp:=p^.next;
     new(p^.next);
     p^.next^.info:=x;
     p^.next^.next:=temp;
end;

Procedure Spisok.Delete_;
begin
     p^.next:=p^.next^.next;
end;

Function Spisok.Locate;
var
     p,q : list;
begin
      p:=L;
      q:=nil;
      while p^.next<>nil do
      begin
           if p^.next^.info=x then q:=p;
           p:=p^.next;
      end;
      Locate:=q;
end;

Function Spisok.End_;
var
     q : list;
begin
     q:=L;
     while q^.next<>nil do q:=q^.next;
     End_:=q;
end;

Function Spisok.First;
begin
     First:=L^.next;
end;


Function Spisok.Retrive;
var
     q : list;
begin
     q:=L;
     Retrive:=0;
     while q<>nil do
     begin
          if q=p then Retrive:=q^.info;
          q:=q^.next;
     end;
end;

Procedure Spisok.Print;
var
     p : list;
begin
     p:=L^.next;
     while p<>nil do
     begin
          write(p^.info,' ');
          p:=p^.next;
     end;
end;

type
    O_Spisok=object(Spisok)
                           procedure Vvod;
                           procedure Vyvod;
                           function Vhozhdenie(x : integer):integer;
                           procedure Zamena;
                           procedure Obedenenie;
             end;

Procedure O_Spisok.Vvod;
var
     n,i,x : integer;
       p : list;
begin
     write('Vvedite kolichestvo elementov spiska : ');
     readln(n);
     Init;
     writeln('Vvedite elementy spiska : ');
     p:=L;
     for i:=1 to n do
     begin
          readln(x);
          Insert(x,p);
          p:=p^.next;
     end;
     writeln;
end;

Procedure O_Spisok.Vyvod;
begin
     write('Vyvod : ');
     Print;
     writeln;
end;

Function O_Spisok.Vhozhdenie;
var
     f : integer;
     p : list;
begin
     f:=0;
     p:=L^.next;
     while p<>nil do
     begin
          if p^.info=x then f:=f+1;
          p:=p^.next;
     end;
     Vhozhdenie:=f;
end;

Procedure O_Spisok.Zamena;
var
     a,b,c : integer;
     p : list;
begin
     writeln('Vvedite elementy spiska mezhdu kototymi nuzhno zamenit element : ');
     readln(a,b);
     writeln('Vvedite znachenie na kotoroe nuzhno zamenit :');
     readln(c);
     p:=L^.next;
     while p<>nil do
        if (p^.info=a)and(p^.next^.next^.info=b) then
        begin
             p^.next^.info:=c;
             p:=p^.next^.next;
        end
                                                 else p:=p^.next;
end;

Procedure O_Spisok.Obedenenie;
var
     p,q,k : list;

procedure Sort(L : list);
var
     p,q : list;
      x : integer;
begin
     q:=L^.next;

     while q<>nil do
     begin
          p:=L^.next;
          while p<>nil do
          begin
               if p^.info>p^.next^.info then
               begin
                     x:=p^.info;
                     p^.info:=p^.next^.info;
                     p^.next^.info:=x;
               end;
               p:=p^.next;
          end;
          q:=q^.next;
     end;
end;

begin
     writeln;


     writeln('  Vvod 1-go spiska ');
     Vvod;


     p:=L^.next;
     writeln;
     writeln('  Vvod 2-go spiska ');
     Vvod;



     q:=L^.next;
     while q<>nil do
     begin
          if q^.next=nil then k:=q;
          q:=q^.next;
     end;

     k^.next:=p;
     Sort(L);
     writeln;
     writeln('  Obedenenniy otsortirovaniy spisok ');
     Vyvod;
end;

Var
     S : O_Spisok;
     c : integer;

begin
     S.Vvod;

     write('Vvedite element kotoroy nuzhno proverit na chislo vhozhdeniy v spisok : ');
     readln(c);
     writeln;
     writeln('Chislo ',c,' vhodit v spisok ',S.Vhozhdenie(c),' raz');
     writeln;

     S.Zamena;
     S.Vyvod;

     S.Obedenenie;
     readln;
end.

у меня там еще кое что есть п окольцевому кажется..если надо напиши!

Автор: volvo877 12.11.2006, 16:29
Цитата
что нужно, сначала завести данные в файл, потом считать данные из файла в список и его отсортировать?
Можно и так, но можно создать в памяти список, и записывать его в файл только после упорядочивания... Во всяком случае, с приведенным заданием это конфликтовать не будет...

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

Код
function insert_sort(l: plist): plist;

  function insert(a: plist; l: plist): plist;
  begin
    a^.next := nil;
    if l = nil then insert := a
    else
      if a^.data.F < l^.data.F then begin { <--- Сортируем по фамилиям }
        a^.next := l; insert := a;
      end
      else begin
        l^.next := insert(a, l^.next);
        insert := l;
      end;
  end;

begin
  if l = nil then insert_sort := nil
  else insert_sort := insert(l, insert_sort(l^.next));
end;


Вызывать вот так:
Код
head := insert_sort(head); { <--- head - указатель на начало списка }

Автор: TaNK 12.11.2006, 19:10
кольцевой
Код

program kolco_06;
Type
    list=^elem;
               elem=record
                          info : integer;
                          next,prev : list;
end;

     DSpisok=object
                   L : list;
                   K : list;
                   procedure Init;
                   function Empty:boolean;
                   function Locate(x : integer):list;
                   procedure Insert_(x : integer; p : list);
                   procedure Delete_(p : list);
                   procedure Zamena(x : integer; p : list);
                   procedure PrintPr;
                   procedure PrintOb;
                   function End_:list;
             end;

Procedure DSpisok.Init;
begin
     new(L);
     L^.next:=nil;
     L^.prev:=nil;
     K:=L;
end;

Function DSpisok.Empty;
begin
     if L=K then Empty:=true
            else Empty:=false;
end;

Function DSpisok.Locate;
var
     q,p : list;

begin
     p:=L;
     q:=nil;
     while p^.next<>nil do
     begin
          if p^.next^.info=x then q:=p;
          p:=p^.next;
     end;
     Locate:=q;
end;

Procedure DSpisok.Insert_;
var
     rus : list;

begin
     rus:=p^.next;
     new(p^.next);
     p^.next^.info:=x;
     p^.next^.next:=rus;
     p^.next^.prev:=p;
     rus^.prev:=p^.next;

     K:=End_;
end;


Procedure DSpisok.Delete_;

begin
     if p^.next<>K then
                        p^.next:=p^.next^.next
                   else
begin                   p^.next:=p^.next^.next;
K:=p;
end;
   end;

Procedure DSpisok.Zamena;
begin
     p^.info:=x;
end;

Function DSpisok.End_;
var
     q : list;
begin
     q:=L;
     while q^.next<>nil do
                           q:=q^.next;
     End_:=q;
end;

Procedure DSpisok.PrintPr;
var
     p : list;
begin
     p:=L^.next;
     while p<>nil do
     begin
          write(p^.info,' ');
          p:=p^.next;
     end;
     writeln;
end;

Procedure DSpisok.PrintOb;
var
     p : list;
begin
     p:=K;
     while p<>L do
     begin
          write(p^.info,' ');
          p:=p^.prev;
     end;
     writeln;
end;

Type
    KolSpisok=object(DSpisok)


                           procedure PrintPrK;
                           procedure PrintObK;
                           procedure InitK;
                           function LocateK(x : integer): list;
    end;

Procedure KolSpisok.InitK;
begin
     K:=End_;
     K^.next:=L;
     L^.prev:=K;
end;

Function KolSpisok.LocateK;
var
     q,p : list;

begin
     p:=L;
     q:=nil;
     while p<>K do
     begin
          if p^.next^.info=x then q:=p;
          p:=p^.next;
     end;
     LocateK:=q;
end;

Procedure KolSpisok.PrintPrK;
var
     p : list;
begin
     p:=L^.next;
     while p<>K^.next do
     begin
          write(p^.info,' ');
          p:=p^.next;
     end;
     writeln;
end;

Procedure KolSpisok.PrintObK;
var
     p : list;
begin
     p:=K;
     while p<>L do
     begin
          write(p^.info,' ');
          p:=p^.prev;
     end;
     writeln;
end;


Var
     DOSia : DSpisok;
     KOSia : KolSpisok;
      x : integer;

begin
     {Dvunapravlenniy Spisok }
     DOSia.Init;
     writeln('Vvedite Spisok : ');
     readln(x);
     while x<>0 do
     begin
          DOSia.Insert_(x,DOSia.End_);
          readln(x);
     end;
     writeln;

     if DOSia.Empty then writeln(' Spisok pust ')
                 else
                  begin
                       writeln('Pechat v pryamom poryadke : ');
                       write(' Spisok : ');
                       DOSia.PrintPr;
                       writeln;

                       writeln('Pechat v obratnom poryadke : ');
                       write(' Spisok : ');
                       DOSia.PrintOb;

                  end;
     writeln;

     writeln('Udalenlie poslednego elementa spiska : ');
     if DOSia.Empty then writeln(' Spisok pust ')
                 else
                  begin
                       DOSia.Delete_(DOSia.Locate(DOSia.K^.info));
                       write(' Spisok : ');
                       DOSia.PrintPr;
                  end;
     writeln;

     writeln('Zamena znacheniya poslednego elementa na 55 : ');
     if DOSia.Empty then writeln(' Spisok pust ')
                 else
                  begin
                       DOSia.Zamena(55,DOSia.End_);
                       write(' Spisok : ');
                       DOSia.PrintPr;
                  end;
     writeln;

     {Kolcevoi Spisok}

     KOSia.Init;
     writeln('Vvedite elementi kolcevogo Spisoka : ');
     readln(x);

     while x<>0 do
     begin
          KOSia.Insert_(x,KOSia.End_);
          readln(x);
     end;
     KOSia.InitK;
     writeln;

     if KOSia.Empty then writeln(' Kolcevoi Spisok pust ')
                 else
                  begin
                       writeln('Pechat kolcevogo spiska v pryamom poryadke : ');
                       write(' Kolcevoi Spisok : ');
                       KOSia.PrintPrK;
                       writeln;

                       writeln('Pechat kolcevogo spiska v obratnom poryadke : ');
                       write(' Kolcevoi Spisok : ');
                       KOSia.PrintObK;
                       writeln;
                  end;
     writeln;

     writeln('Udalenlie poslednego elementa spiska : ');
     if KOSia.Empty then writeln(' Kolcevoi Spisok pust ')
                 else
                  begin
                       KOSia.Delete_(KOSia.LocateK(KOSia.K^.info));
                       write(' Kolcevoi Spisok : ');
                       KOSia.PrintPrK;
                  end;
     writeln;

     writeln('Zamena znacheniya v spiske na 111 : ');
     if KOSia.Empty then writeln(' Kolcevoi Spisok pust ')
                 else
                  begin
                       KOSia.Zamena(111,KOSia.K);
                       write(' Kolcevoi Spisok : ');
                       KOSia.PrintPrK;
                  end;
     writeln;

     readln;
end.

Автор: Ripper 24.11.2006, 13:34
Никак я не пойму эти списки. Вот сделал несколько процедур:
Код

procedure Create_Ring(var pFirst:PNode);
var
 pTemp:PNode;
 s:TSotrudnik;
 f:file of TSotrudnik;
begin
 AssignFile(f,DataFile);
 reset(f);
 read(f,s);
 New(pFirst);
 pFirst^.Data:=s;
 pFirst^.pNext:=nil;
 pTemp:=pFirst;

 while (not EOF(f)) do
  begin
   read(f,s);
   New(pTemp^.pNext);
   pTemp:=pTemp^.pNext;
   pTemp^.Data:=s;
  end;
  pTemp^.pNext:=pFirst;
end;

procedure ShowSotrudnik(s:TSotrudnik);
begin
   WriteLn ('---------------------------------');
   WriteLn (' ', chr(26), ' Familiya: ', s.F);
   WriteLn (' ', chr(26), ' Imya: ', s.I);
   WriteLn (' ', chr(26), ' Ot4estvo: ', s.O);
   WriteLn (' ', chr(26), ' Nomer otdela: ', s.Otdel);
   WriteLn (' ', chr(26), ' Dolznost: ', s.Dolznost);
   WriteLn (' ', chr(26), ' Stavka: ', s.stavka);
end;

procedure Show_Ring(pFirst:PNode);
var pTemp:PNode;
begin
 SetColor(Red);
 ShowSotrudnik(pFirst^.Data);
 pTemp:=pFirst^.pNext;
while (pTemp<>pFirst) do
 begin
  ShowSotrudnik(pTemp^.Data);                 
  pTemp:=pTemp^.pNext;
 end;
end;


Вроде работает нормально, но я без понятия вообще ...брр smile  
Непойму я как сделать сортировку, вставку и удаление. Вернее я на сортировке застрял. Ф-ию приведенную для связанного списка обычного тоже нефига не понял smile 
Может кто нибудь даст процедуру для моего случая и пояснит как это все работает %( И заодно, нормально ли я создал кольцо.. 

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)