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.

0

Dzięki za pomoc. Mam pytanie jeszcze odnośnie procedury, która będzie zapisywać wszystkie elementy kolejki do tablicy dynamicznej z wyświetlaniem stanu tej tablicy. Jak ona powinna prawidłowo wyglądać wiem, że na będę potrzebował SetLength, żeby zmieniać jej długość.

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;
type
  lista = ^tlista;
    tlista = record
    imie: string[20];
    nazwisko: string[30];
    wiek: byte;
    pesel: string;
    wsk: lista;
end;
dane = record
  imie: string[20];
  nazwisko: string[30];
  wiek: byte;
  pesel: string[20]
end;
///// Tablica dynamiczna - czy to potrzebne
t = array of dane;
var
  pocz, kon: lista;
  menu: integer;
  plik: textfile;
  tab: t;
---------------
procedure TablicaDynamiczna(a:lista; b:lista; var tab:t);
var
  i,n: integer;
begin
  if ((a = nil) and (b = nil))  then writeln('Kolejka jest pusta!');
  n:= 0;
  SetLength(tab,n); // n - długość dynamicznej tablicy
  while (a <> nil) do begin
    SetLength(tab,n+1);
    tab[n].imie:= a^.imie;
    tab[n].nazwisko:= a^.nazwisko;
    tab[n].wiek:= a^.wiek;
    tab[n].pesel:= a^.pesel;
    a:=a^.wsk;
  end;
  for i:= 0 to n - 1 do
    writeln(tab[i].imie,'; ',tab[i].nazwisko,'; ',tab[i].wiek,'; ',tab[i].pesel,'; ');
end;

------------------

TablicaDynamiczna(pocz, kon, tab);
0

Źle się za to zabierasz, na dodatek formatowanie tragiczne, więc bardzo ciężko będzie coś doradzić...

Napisałem Ci wcześniej, abyć sformatował kod; Wcięcia są gdzieniegdzie niedbałe, nadal używasz polskich i jednoliterowych identyfikatorów, które nie wiadomo czym są i do czego służą; Kod jest zbyt nieczytelny, żeby się w niego zagłębiać; Wywal ten kod i zacznij jeszcze raz, mając za podstawy poniższe typy:

type
  TData = record
    Name: String;
    Surname: String;
    Age: Byte;
    PESEL: String;
  end;

type
  PListNode = ^TListNode;
  TListNode = record
    Data: TData;
    Next: PListNode;
  end;

type
  TDataList = record
    Head: PListNode;
    Tail: PListNode;
    Size: Integer;
  end;

type
  TDataMatrix = array of TData;

Zobaczysz, że o wiele łatwiej będzie zapanować nad kodem; Dodałem pole Size w strukturze TDataList, przyda się podczas kopiowania listy do macierzy dynamicznej (i nie tylko) - dzięki niemu od razu będzie wiadomo jaki rozmiar powinna przyjąć macierz, zanim zacznie się iterowanie po węzłach listy i przepisywanie danych;

Tylko pamiętaj - do wszystkich procedur/funkcji przekazuj rekord całej listy, czyli zmienną typu TDataList, a nie osobno wskaźniki na głowę i ogon listy; Dzięki temu jeden parametr da Ci dostęp do trzech pól rekordu - głowy i ogona, a także rozmiaru.

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