Не могу так... Мне претит такое количество глобальных переменных, и вообще такой стиль.
Вот для 7 турбопаскаля:
(Идея проста, из исходного списка копируем элементы в новый, но без повторов. Потом пробегаем по новому списку и выводим только те, которые в исходном повторяются не менее 3 раз)
Код: Выделить всё
type
TData=integer;
PItem=^TItem;
TItem=record
data:TData;
next:PItem;
end;
TListIteratorProc=procedure(Itm:PItem;First,Last:boolean; var Cancel:boolean);
const
TraceIsOn:boolean=false;
procedure printlog(S:string);
const n:longint=0;
begin
inc(n); if TraceIsOn then writeln(n,':',S);
end;
procedure ForEach(Lst:Pitem; CallBackProc:TListIteratorProc);
var
Cancel,First:boolean;
begin
printlog('(ForEach) iterator started.');
Cancel:=false; First:=true;
while (Lst<>nil) and (not Cancel) do begin
CallBackProc(Lst,First,Lst^.next=nil,Cancel);
Lst:=Lst^.next;
First:=false;
end;
printlog('(ForEach) iterator finished.');
end;
procedure WriteList(Lst:PItem);
begin
printlog('(WriteList) started.');
while Lst<>nil do begin
write(Lst^.data,' ');
Lst:=Lst^.next;
end;
writeln;
printlog('(WriteList) finished.');
end;
procedure AddToBegin(var Lst:PItem; X:TData);
var
nxt:PItem;
begin
nxt:=Lst;
new(Lst);
with Lst^ do begin
data:=X; next:=nxt;
end;
printlog('(AddToBegin) new item has been added to the head.');
end;
procedure AddToTail(var Lst:PItem; X:TData);
var
prev:PItem;
begin
if Lst=nil then begin
printlog('(AddToTail) list is empty, new item will be added to the head.');
AddToBegin(Lst,X);
end else begin
prev:=Lst;
while prev^.next<>nil do prev:=prev^.next;
new(prev^.next);
with prev^.next^ do begin
data:=X; next:=nil;
end;
end;
printlog('(AddToTail) new item has been added to the tail.');
end;
function Count(Lst:PItem):longint;
var
Cnt:longint;
begin
Cnt:=0;
while Lst<>nil do begin
inc(Cnt);
Lst:=Lst^.next;
end;
Count:=Cnt;
end;
function CountOf(Lst:PItem;X:TData):longint;
var
Cnt:longint;
begin
Cnt:=0;
while Lst<>nil do begin
if Lst^.data=X then inc(Cnt);
Lst:=Lst^.next;
end;
CountOf:=Cnt;
end;
function ItemExists(Lst:PItem;X:TData):boolean;
var
NotFound:boolean;
begin
printlog('(ItemExists) started.');
NotFound:=true;
while NotFound and (Lst<>nil) do begin
NotFound:=Lst^.data<>X;
Lst:=Lst^.next;
end;
if NotFound then printlog('(ItemExists) item not found.') else printlog('(ItemExists) item found.');
ItemExists:=not NotFound;
end;
procedure AddUnique(var Lst:Pitem; X:Tdata);
begin
printlog('(AddUnique) searching for the item.');
if ItemExists(Lst,X)
then printlog('(AddUnique) item ignored, already present.')
else begin
printlog('(AddUnique) will be added to the head.');
AddToBegin(Lst,X)
end;
end;
function FillFromKeyboard:PItem;
var
Lst:Pitem; Count:longint; S:string; V:TData; k:integer;
begin
printlog('(FillFromKeyboard) started.');
Lst:=nil;
Count:=0;
repeat
write('Input an item or press Enter to cancel: '); readln(S);
if S<>'' then begin
val(S,V,k);
if k=0
then AddToTail(Lst,V)
else Write('Wrong input. ')
end;
until S='';
FillFromKeyboard:=Lst;
printlog('(FillFromKeyboard) finished.')
end;
const
L1:PItem=nil;
L2:PItem=nil;
L3:PItem=nil;
procedure CallBackWriteItem(Itm:PItem;First,Last:boolean; var Cancel:boolean); far;
begin
if First then write('List contains ',Count(Itm),' item(s): ');
write(Itm^.data);
if Last then writeln('.') else write(', ');
end;
const CallBackWriteItemPtr:TListIteratorProc=CallBackWriteItem;
procedure CallBackWriteItemIfDuplicated(Itm:PItem;First,Last:boolean; var Cancel:boolean); far;
begin
if First then write('Items repeated more then 3 times in L2: ');
if CountOf(L2,Itm^.data)>=3 then begin
write(Itm^.data);
if Last then writeln('.') else write(', ');
end;
end;
const CallBackWriteItemIfDuplicatedPtr:TListIteratorProc=CallBackWriteItemIfDuplicated;
procedure CallBackUniqueCopyL3(Itm:PItem;First,Last:boolean; var Cancel:boolean); far;
begin
AddUnique(L3,Itm^.data);
end;
const CallBackUniqueCopyL3Ptr:TListIteratorProc=CallBackUniqueCopyL3;
begin
TraceIsOn:=false;
L2:=FillFromKeyboard;
{вывод}
WriteList(L2);
{вывод через итератор}
ForEach(L2,CallBackWriteItemPtr);
TraceIsOn:=true;
printlog('Creating unique list');
ForEach(L2,CallBackUniqueCopyL3); {Строим L3}
ForEach(L3,CallBackWriteItemPtr); {L3 - это L2 без повторов}
TraceIsOn:=false;
ForEach(L3,CallBackWriteItemIfDuplicated); {Выводим с проверкой}
end.
