Programalama > PASCAL


Ort. 0
Puan ver:
(* declaration part of program *)
type
    nodeptr=^node;
    node=record
                info:integer;
                link:nodeptr;
                end;
var
   start:nodeptr;
   choice:integer;

(* creating the linked list *)
procedure creatlist (var start:nodeptr);
begin
     start:=nil;
     write('list is created');
end;

(* write any element of the list *)
procedure printlist(var start:nodeptr);
var
   ptr,p:nodeptr;
   begin
        ptr:=start;
        if start=nil then (*check list empyt or not*)
        begin
             write('list is empty.');
        end
        else
        begin
             while ptr <> nil do  (* traversing and writing part*)
             begin
             p:=ptr;
             write(p^.info,' ');
             ptr:=p^.link;
             end;
        end;
   end;

procedure exit;(*end of the program *)
begin
     writeln('end of program');
     readln;
     halt;
end;



(* search any element in the list *)
procedure searchlist(var start:nodeptr);
var
   item:integer;
   ptr,p:nodeptr;
begin
     writeln('enter the value to search in the list');
     readln(item);
     ptr:=start;
     if start = nil then   (* check the list empty or not*)
        writeln('list is empty')
     else
         begin
              while (ptr <> nil)and(ptr^.info <> item) do(* check end of list and value entered*)
              begin
                   ptr:=ptr^.link;
              end;
              if ptr = nil then (*check traveller pointer*)
              writeln(item,'=was not found')
                   else
                       writeln(item,'=was found');
              end;
end;

(* insert new data to list *)
procedure addlist(var start:nodeptr);
var
   q,z:nodeptr;
   item:integer;
begin
     writeln;
     writeln('enter integer values until -99');
     repeat    (* loop for checking *)
     readln(item);
     if (start = nil) and (item <> -99) then   (* checking list is empty or not,and item *)
     begin
          new(q);             (*creat new node*)
          q^.info:=item;
          q^.link:=start;     (*new node become starting adress*)
          start:=q;
     end
     else
     begin
         z:=start;
         new(q);
         q^.info:=item;
         while z^.link<>nil do  (*check until null*)
         begin
              z:=z^.link;
         end;
              if q^.info<>-99 then (*check item *)
              begin
                   z^.link:=q;     (* adding to list*)
                   q^.link:=nil;
              end;
     end;
     until item = -99;      
end;


(* delete any elemant in list*)
procedure deletelist(var start:nodeptr);
var
   ptr,temp:nodeptr;
   value:integer;
begin
     writeln('enter integer value to delete from the list');
     readln(value);
     ptr:=start;
     temp:=nil;
     if start=nil then (* check list empty or not*)
         writeln('list is empty you can not delete:',value)
     else
         begin
         if value=start^.info then   (* check if first node*)
         begin
              ptr:=start;
              start:=start^.link;
         end
         else
             begin
                  temp:=start;
                  while temp^.link^.info<> value  do (*search rest of list*)
                       temp:=temp^.link; (* delete ptr^.link *)
                       ptr:=temp^.link;
                       ptr^.link:=ptr^.link^.link

             end;
          writeln(value,': deleted from the list');
         dispose(ptr)(*delete*)
       end;
  end;

   (* main program *)
begin
     repeat
          writeln;
          writeln;
          writeln('MENU OF ASSIGNMENT # 1 ');
          writeln('------------------------');
          writeln;
          writeln('1.CREAT LIST');
          writeln('2.INSERTING TO LIST');
          writeln('3.PRINT LIST ');
          writeln('4.SEARCH IN LIST ');
          writeln('5.DELETE IN  LIST ');
          writeln('6.EXIT ');
          writeln;
          writeln('choice:');
          readln(choice);
          case choice of
               1:     creatlist(start);
               2:     addlist(start);
               3:     printlist(start);
               4:     searchlist(start);
               5:     deletelist(start);
               6:     exit;
               end;
     until choice<>choice;
end.


Yorumlar                 Yorum Yaz
Bu hazır kod'a ilk yorumu siz yapın!
KATEGORİLER
ASP - 240
ASP.NET - 24
C# - 75
C++ - 174
CGI - 8
DELPHI - 247
FLASH - 49
HTML - 536
PASCAL - 246
PERL - 11
PHP - 160
WML - 9
XML - 2
Copyright © 2002 - 2020 Hazır Kod - Tüm Hakları Saklıdır.
Siteden yararlanırken gizlilik ilkelerini okumanızı tavsiye ederiz.
hazirkod.com bir İSOBİL projesidir.