Znam da je kod aljkav, ali tamo gde mi javlja gresku, ne znam da ga optimizujem.
Code:
program domaci0;
uses crt;
type
Pdvostruka = ^Tdvostruka; {Definisemo dvostruko ulancanu listu}
Tdvostruka = record
element : char;
prethodni, sledeci : Pdvostruka;
end;
Pjednostruka = ^Tjednostruka; {Definisemo jednostruko ulancanu listu}
Tjednostruka = record
element : char;
sledeci : Pjednostruka;
end;
etalon = array[1..100] of char; {Niz u koji smestamo skup znakova }
procedure add(var tail : Pdvostruka;var s : etalon;var niz : integer);
var
cur, next : Pdvostruka;
prviput : boolean;
a: char;
i : integer;
begin
i:=1;
prviput := true;
clrscr;
writeln('Unesite element, pa pritisnite enter!');
writeln('Za zavrsetak unosa pritisnite taster ESC.');
while (4>3) do
begin
if prviput then
begin
new(tail);
cur:=tail;
cur^.prethodni:=nil;
cur^.sledeci:= nil;
prviput:=false;
write(i,' - ');
a:=readkey;
i:=i+1;
writeln(a);
if ord(a)<>27 then
cur^.element :=a
else break;
end
else
begin
new(next);
cur^.sledeci:=next;
cur:=cur^.sledeci;
cur^.prethodni:=tail;
cur^.sledeci:=nil;
write(i,' - ');
a:=readkey;
i:= i+1;
writeln(a);
if ord(a)<>27 then
cur^.element :=a
else break
end;
end;
clrscr;
i := 1;
writeln('Sada unesite znakove sa kojima se upredjuje');
while 5>3 do
begin
a:=readkey;
writeln(i,' - ',a);
if ord(a)<>27 then
begin
s[i]:=a;
i:=i+1;
end
else
begin
niz := i;
break;
end;
end;
end;
procedure toscreen(prvi:pdvostruka;s:etalon;niz:integer);
var
trenutni : pdvostruka;
i,n : integer;
begin
i:=1;
n := 48;
trenutni := prvi;
clrscr;
while trenutni <> nil do
begin
writeln(i,' - ',trenutni^.element);
trenutni:=trenutni^.sledeci;
i:=i+1;
if (i div n > 0) then
begin
n:=n+48;
writeln('pritisnite <enter> za sledecu stranu');
readln;
end;
end;
writeln('pritisnite bilo koji taster za listu znakova sa kojom se upredjuje');
repeat until keypressed;
n := 48;
for i := 1 to niz do
begin
writeln(i,' - ',s[i]);
if (i div n > 0) then
begin
n:=n+48;
writeln('pritisnite <enter> za sledecu stranu');
readln;
end;
end;
readln;
end;
procedure obrada(var prvi1 : pjednostruka; var prvi2 : pdvostruka;s : etalon;niz : integer);
var
prviput : boolean;
sledeci1, trenutni1 : pjednostruka;
sledeci2, trenutni2 : pdvostruka;
i:integer;
begin
trenutni2:=prvi2;
prviput := true;
while trenutni2 <> nil do
begin
for i := 1 to niz do
begin
if trenutni2^.element = s[i] then
begin
trenutni2 := prvi2;
if prviput then begin
new(prvi1);
trenutni1:=prvi1;
prviput := false;
end
else
begin
new(Sledeci1);
trenutni1^.Sledeci:=Sledeci1;
Trenutni1:=Trenutni1^.Sledeci;
end;
Trenutni1^.element := s[i];
Trenutni1^.Sledeci:=nil;
end;
end;
trenutni2:=trenutni2^.sledeci;
end;
end;
procedure resenje(prvi : pjednostruka);
var
trenutni : pjednostruka;
begin
trenutni := prvi;
while trenutni<>nil do
begin
writeln(trenutni^.element);
trenutni := trenutni^.sledeci;
end;
end;
var
lista : Pdvostruka;
listaResenje : Pjednostruka;
skup : etalon;
duzNiza : integer;
begin
lista := nil;
listaResenje := nil;
add(lista,skup,duzniza);
toscreen(lista,skup,duzniza);
obrada(listaresenje, lista, skup, duzniza);
resenje(listaResenje);
end.
program domaci0;
uses crt;
type
Pdvostruka = ^Tdvostruka; {Definisemo dvostruko ulancanu listu}
Tdvostruka = record
element : char;
prethodni, sledeci : Pdvostruka;
end;
Pjednostruka = ^Tjednostruka; {Definisemo jednostruko ulancanu listu}
Tjednostruka = record
element : char;
sledeci : Pjednostruka;
end;
etalon = array[1..100] of char; {Niz u koji smestamo skup znakova }
procedure add(var tail : Pdvostruka;var s : etalon;var niz : integer);
var
cur, next : Pdvostruka;
prviput : boolean;
a: char;
i : integer;
begin
i:=1;
prviput := true;
clrscr;
writeln('Unesite element, pa pritisnite enter!');
writeln('Za zavrsetak unosa pritisnite taster ESC.');
while (4>3) do
begin
if prviput then
begin
new(tail);
cur:=tail;
cur^.prethodni:=nil;
cur^.sledeci:= nil;
prviput:=false;
write(i,' - ');
a:=readkey;
i:=i+1;
writeln(a);
if ord(a)<>27 then
cur^.element :=a
else break;
end
else
begin
new(next);
cur^.sledeci:=next;
cur:=cur^.sledeci;
cur^.prethodni:=tail;
cur^.sledeci:=nil;
write(i,' - ');
a:=readkey;
i:= i+1;
writeln(a);
if ord(a)<>27 then
cur^.element :=a
else break
end;
end;
clrscr;
i := 1;
writeln('Sada unesite znakove sa kojima se upredjuje');
while 5>3 do
begin
a:=readkey;
writeln(i,' - ',a);
if ord(a)<>27 then
begin
s[i]:=a;
i:=i+1;
end
else
begin
niz := i;
break;
end;
end;
end;
procedure toscreen(prvi:pdvostruka;s:etalon;niz:integer);
var
trenutni : pdvostruka;
i,n : integer;
begin
i:=1;
n := 48;
trenutni := prvi;
clrscr;
while trenutni <> nil do
begin
writeln(i,' - ',trenutni^.element);
trenutni:=trenutni^.sledeci;
i:=i+1;
if (i div n > 0) then
begin
n:=n+48;
writeln('pritisnite <enter> za sledecu stranu');
readln;
end;
end;
writeln('pritisnite bilo koji taster za listu znakova sa kojom se upredjuje');
repeat until keypressed;
n := 48;
for i := 1 to niz do
begin
writeln(i,' - ',s[i]);
if (i div n > 0) then
begin
n:=n+48;
writeln('pritisnite <enter> za sledecu stranu');
readln;
end;
end;
readln;
end;
procedure obrada(var prvi1 : pjednostruka; var prvi2 : pdvostruka;s : etalon;niz : integer);
var
prviput : boolean;
sledeci1, trenutni1 : pjednostruka;
sledeci2, trenutni2 : pdvostruka;
i:integer;
begin
trenutni2:=prvi2;
prviput := true;
while trenutni2 <> nil do
begin
for i := 1 to niz do
begin
if trenutni2^.element = s[i] then
begin
trenutni2 := prvi2;
if prviput then begin
new(prvi1);
trenutni1:=prvi1;
prviput := false;
end
else
begin
new(Sledeci1);
trenutni1^.Sledeci:=Sledeci1;
Trenutni1:=Trenutni1^.Sledeci;
end;
Trenutni1^.element := s[i];
Trenutni1^.Sledeci:=nil;
end;
end;
trenutni2:=trenutni2^.sledeci;
end;
end;
procedure resenje(prvi : pjednostruka);
var
trenutni : pjednostruka;
begin
trenutni := prvi;
while trenutni<>nil do
begin
writeln(trenutni^.element);
trenutni := trenutni^.sledeci;
end;
end;
var
lista : Pdvostruka;
listaResenje : Pjednostruka;
skup : etalon;
duzNiza : integer;
begin
lista := nil;
listaResenje := nil;
add(lista,skup,duzniza);
toscreen(lista,skup,duzniza);
obrada(listaresenje, lista, skup, duzniza);
resenje(listaResenje);
end.
A da, problem je u obradi (bar mislim da je tako). :(
i radio sam u Turbo pascalu 7