Forum programistyczne
Lipiec 01, 2022, 16:15:42 *
Witamy, Gość. Zaloguj się lub zarejestruj.

Zaloguj się podając nazwę użytkownika, hasło i długość sesji
Aktualności: Forum programistyczne wystartowało. Potrzebujesz pomocy przy pisaniu programu, masz problem programistyczny?

Zapraszamy do rejestracji!!!
 
   Strona główna   Pomoc Szukaj Zaloguj się Rejestracja  

Strony: [1]
  Drukuj  
Autor Wątek: [Pascal] Dopisywanie danych do listy dwukierunkowej  (Przeczytany 5248 razy)
orzechw
Nowy użytkownik
*
Wiadomości: 1


Zobacz profil
« : Październik 08, 2011, 13:09:05 »

Witam, mam problem z dopisywaniem danych do listy dwukierunkowej, otóż po wpisaniu kolejnych liczb program powinien je wpisać do listy w kolejności rosnącej, natomiast przy wyświetlaniu wypisuje jedynie jedną, ostatnią liczbę. Jest mi ktoś w stanie podpowiedzieć dlaczego tak się dzieje?

Kod:
Type wsk=^elem;
     elem=record
      liczba,mnoznik:longint;
      pop,nast:wsk;
     end;

Type nodeList=^e;
     e=record
      first,last,tmp:wsk;
     end;

Var lista:nodeList;
    liczbaa:longint;

Procedure createList(var lista:nodelist);
 Begin
  lista^.first:=nil;
  lista^.last:=nil;
  lista^.tmp:=nil;
 End;

Procedure push(var lista:nodelist; dod:wsk; const ile:shortint);
 Var nowy:wsk;
     liczba:longint;
 Begin
  new(nowy);
  nowy^.liczba:=dod^.liczba;
  nowy^.mnoznik:=dod^.mnoznik;
  IF lista^.tmp=nil Then lista^.first:=nowy
                         Else
   Begin
    IF lista^.tmp^.nast<>nil Then
     Begin
      While lista^.tmp^.nast<>nil do
       Begin
       IF lista^.tmp^.liczba=nowy^.liczba Then
        Begin
         inc(lista^.tmp^.mnoznik,ile);
         IF lista^.tmp^.mnoznik=0 Then
          Begin
           lista^.tmp^.pop^.nast:=lista^.tmp^.nast;
           lista^.tmp^.nast^.pop:=lista^.tmp^.pop;
           dispose(lista^.tmp);
           Break;
          End;
        End;
       IF lista^.tmp^.liczba>nowy^.liczba Then
        Begin
         lista^.tmp^.pop^.nast:=nowy;
         nowy^.nast:=lista^.tmp;
         nowy^.pop:=lista^.tmp^.pop;
         lista^.tmp^.pop:=nowy;
        End;
       IF lista^.tmp^.liczba<nowy^.liczba Then
        Begin
         lista^.tmp^.nast:=nowy;
         nowy^.pop:=lista^.tmp;
        End;
       lista^.tmp:=lista^.tmp^.nast;
       End;
     End
      Else
     Begin
      IF lista^.tmp^.liczba>nowy^.liczba Then
       Begin
        lista^.tmp^.pop:=nowy;
        nowy^.nast:=lista^.tmp;
       End;
      IF lista^.tmp^.liczba<nowy^.liczba Then
       Begin
        lista^.tmp^.nast:=nowy;
        nowy^.pop:=lista^.tmp;
       End;
      IF lista^.tmp^.liczba=nowy^.liczba Then
       Begin
        inc(lista^.tmp^.mnoznik,ile);
        IF lista^.tmp^.mnoznik=0 Then
         Begin
          lista^.tmp^.pop^.nast:=lista^.tmp^.nast;
          lista^.tmp^.nast^.pop:=lista^.tmp^.pop;
         End;
       End;
     End;
   End;
 End;

Procedure readlist(var liste:wsk);
 Var tmpa:wsk;
 Begin
  tmpa:=liste;
  While tmpa<>nil do
   Begin
    WriteLn(' => ',tmpa^.liczba);
    tmpa:=tmpa^.nast;
   End;
 End;

Var i:byte;
    x:wsk;
    y:longint;

Begin
 New(lista);
 CreateList(lista);
 new(x);
 For i:=0 to 3 do
  Begin
   ReadLn(y);
   x^.liczba:=y;
   push(lista,x,1);
  End;
 readlist(lista^.first);
 Readln;
End.
Zapisane
Strony: [1]
  Drukuj  
 
Skocz do:  



https://dania-polska.pl www.ciekawetargi.pl druk cyfrowy na bawełnie
Działa na MySQL Działa na PHP Powered by SMF 1.1.20 | SMF © 2006-2007, Simple Machines Prawidłowy XHTML 1.0! Prawidłowy CSS!