Wyświetlanie listy jednokierunkowej

0

Kod mi się odpala, lecz jeśli dodaje do kolejki pierwszy element to gdy wyświetlam nie wiem dlatego mam dwie pozycje. Czego może to być wina?
Jan; Kowalski; wiek:18; pesel:12345678963 ; ; wiek:0; pesel:

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;
type
  lista = ^tlista;
    tlista = record
    imie: string[20];
    nazwisko: string[30];
    wiek: byte;
    pesel: string;
    wsk: lista;
end;
var
  pocz, kon: lista;
  menu: integer;

procedure dodaj(var a:lista; var b:lista);
var
  nowy:lista;
begin
  new(nowy);
  write('Podaj imie: ');
  readln(nowy^.imie);
  write('Podaj nazwisko: ');
  readln(nowy^.nazwisko);
  write('Podaj wiek: ');
  readln(nowy^.wiek);
  write('Podaj pesel: ');
  readln(nowy^.pesel);
   if (a = nil) then begin
    new(a);
    a:=nowy;
    a^.wsk:=nil;
  end;
  if (b = nil) then begin
    new(nowy);
    b:=nowy;
    a^.wsk:=b;
    b^.wsk:=nil;
  end;
  if (b <> nil) then begin
    b^.wsk:=nowy;
    new(b);
    b:=nowy;
    b^.wsk:=nil;
  end;
end;
procedure usun(var a:lista);
var
  del:lista;
begin
  if (a = nil) then
    writeln('Nie ma danych w kolejce!') else
    begin
      del:=a;
      a:=a^.wsk;
      dispose(del);
    end;
end;
procedure wyswietl(a:lista);
begin
  if (a = nil) then writeln('Nie ma danych w kolejce!');
  while(a <> nil) do begin
    write(a^.imie,'; ',a^.nazwisko,'; wiek:',a^.wiek,'; pesel:',a^.pesel);
    writeln;
    a:=a^.wsk;
  end;
end;

begin
  pocz:=nil;
  kon:=nil;
  repeat
    writeln('           MENU       ');
    writeln('-------------------------');
    writeln('1. Dodaj element na koniec kolejki.');
    writeln('2. Usun element kolejki.');
    writeln('3. Wyprowadz zawartosc kolejki na ekran.');
    writeln('9. Koniec');
    readln(menu);
    writeln('-------------------------');
    case (menu) of
    1: dodaj(pocz, kon);
    2: usun(pocz);
    3: wyswietl(pocz);
  end;
  until(menu=9);
end.
0

Wina jest tego, że nie rozumiesz wskaźników, a ich używasz...

0

Teraz już lepiej?

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;
type
  lista = ^tlista;
    tlista = record
    imie: string[20];
    nazwisko: string[30];
    wiek: byte;
    pesel: string;
    wsk: lista;
end;
var
  pocz, kon: lista;
  menu: integer;

procedure dodaj(var a:lista; var b:lista);
var
  nowy:lista;
begin
  new(nowy);
  write('Podaj imie: ');
  readln(nowy^.imie);
  write('Podaj nazwisko: ');
  readln(nowy^.nazwisko);
  write('Podaj wiek: ');
  readln(nowy^.wiek);
  write('Podaj pesel: ');
  readln(nowy^.pesel);
   if (a = nil) then begin
    a:=nowy;
    a^.wsk:=nil;
  end;
  if (b = nil) then begin
    b:=nowy;
    a^.wsk:=b;
    b^.wsk:=nil;
  end;
  if (b <> nil) then begin
    b^.wsk:=nowy;
    //new(b);
    b:=nowy;
    b^.wsk:=nil;
  end;
end;
procedure usun(var a:lista);
var
  del:lista;
begin
  if (a = nil) then
    writeln('Nie ma danych w kolejce!') else
    begin
      del:=a;
      a:=a^.wsk;
      dispose(del);
    end;
end;
procedure wyswietl(a:lista);
begin
  if (a = nil) then writeln('Nie ma danych w kolejce!');
  while(a <> nil) do begin
    write(a^.imie,'; ',a^.nazwisko,'; wiek:',a^.wiek,'; pesel:',a^.pesel);
    writeln;
    a:=a^.wsk;
  end;
end;

procedure wyswietl_wiek(a: lista);
var
  wiek: integer;
begin
  write('Podaj wiek: ');
  readln(wiek);
  while (a <> nil) do begin
    if (wiek = a^.wiek) then
      write(a^.imie,'; ',a^.nazwisko,'; wiek:',a^.wiek,'; pesel:',a^.pesel);
    writeln;
    a:=a^.wsk;
  end;
end;

begin
  pocz:=nil;
  kon:=nil;
  repeat
    writeln('           MENU       ');
    writeln('-------------------------');
    writeln('1. Dodaj element na koniec kolejki.');
    writeln('2. Usun element kolejki.');
    writeln('3. Wyprowadz zawartosc kolejki na ekran.');
    writeln('4. Wyprowadz elementy na ekran zgodnie z podanym wiekiem');
    writeln('9. Koniec');
    readln(menu);
    writeln('-------------------------');
    case (menu) of
    1: dodaj(pocz, kon);
    2: usun(pocz);
    3: wyswietl(pocz);
    4: wyswietl_wiek(pocz);
  end;
  until(menu=9);
end. 
0

Wygląda lepiej, a jak działa?

0

Teraz dobrze mi wypisuje, wiec chyba szybko ok


begin
  new(nowy);
  write('Podaj imie: ');
  readln(nowy^.imie);
  write('Podaj nazwisko: ');
  readln(nowy^.nazwisko);
  write('Podaj wiek: ');
  readln(nowy^.wiek);
  write('Podaj pesel: ');
  readln(nowy^.pesel);
   if (a = nil) then begin
    a:=nowy;
    a^.wsk:=nil;
  end;
  if (b = nil) then begin
    b:=nowy;
    a^.wsk:=b;
    b^.wsk:=nil;
  end;
  if (b <> nil) then begin
    b^.wsk:=nowy;
    //new(b);   << czyli to też jest zbędne ?
    b:=nowy;
    b^.wsk:=nil;
  end;
end;
0

Ogólnie nie wiem do czego Tobie ten koniec, ale new(b) tez jest zbędne. Brakuje też czyszczenia pamięci na koniec.

1

@kaczus - koniec potrzebny jest po to, aby móc od razu wstawić na koniec listy, bez zbędnego iterowania po wszystkich elementach, czyli uniknięcia złożoności O(n) :]

@morodis - sformatuj ten kod porządnie; Używaj wielkich liter, korzystaj ze stylu PascalCase zamiast znaku _, pozbądź się polskich słow z kodu na rzecz tylko i wyłącznie angielskich identyfikatorów; Do tego wsadź wskaźniki na głowę i ogon listy do rekurdu i na nim operuj - jego przekazuj w parametrach:

type
  PListNode = ^TListNode;
  TListNode = record
    { tu pola z danymi węzła }
  end;

type
  TList = record
    Head: PListNode;
    Tail: PListNode;
  end;

Kolejna rzecz - dlaczego procedury służące do usuwania węzłów listy czy jej wyświetlania, pobierają jakieś dane od użytkownika? Wywal to, każda procedura czy funkcja ma spełniać tylko jedno zadanie - dodanie węzła, jego usunięcie, wyświetlenie listy, pobranie danych od użytkownika itd.; Procedur przybędzie, jednak dzięki temu kod będzie bardziej przejrzysty i łatwiej będzie go ogarnąć.

0

Mam pytanie jeszcze odnośnie procedury, która usunie mi wszystkie elementy kolejny. Wszystko działa dobrze jeśli usuwam więcej niż jeden element, lecz jeśli mam tylko jeden i chce usunąć to od razu mnie wywala z konsoli.


procedure Wyczysc(var a:lista; var b:lista);
var
  usun: lista;
begin
if (a=nil) and (b=nil) then writeln('Nie ma danych w kolejce') else
begin
  writeln('Usuwanie...');
  while a<>nil do begin
    usun:=a;
    a:=a^.wsk;
    dispose(usun);
    a:=nil;
  end;
dispose(b);
b:=nil;
if (a=nil) and (b=nil) then writeln('Usunieto wszystkie elementy z kolejki!');
end;
end;
1

bo zależy co podajesz jako drugi argument, jesli koniec, to go usunales juz iterujac od początki, więc pozniejsze dispose(b) probuje zwolnic juz zwolniona pamiec.

0

@morodis, zobacz jak zaimplementowana jest lista w tym artykule - http://4programmers.net/Delphi/Lista_jednokierunkowa; Nie chodzi mi o to, że całość jest opakowana w klasę - zobacz co jest wykonywane podczas dodawania węzłów i ich usuwania; Powinieneś zrobić w taki sam sposób, tyle że jako kod proceduralny, nie obiektowy.

1 użytkowników online, w tym zalogowanych: 0, gości: 1, botów: 0