Задание: Дан текстовый файл с изображением целых чисел, которые
необходимо переписать в
список L1. Удалить из списка все числа – палиндромы, вставив вместо них
самое минимальное число всего списка.
Исходный код: Program
spiski; uses crt; Type TElement=^element; Element=record a:string; next:TElement; End;
var
Q,last,head:TElement; m,j,c:integer; mas:string[11];
function
polindrom(sl:string):boolean; var cl:string; i,j:integer; b:boolean; Begin
polindrom:=false; b:=true; j:=1; i:=length(sl); while
(j<i) and b do Begin if sl[i]<>sl[j] then
b:=false; j:=j+1; i:=i-1; End; polindrom:=b; End;
procedure
proverka(filename:string); var f:text; Begin {$I-}
Assign(f,filename); reset(f); {$I+} if ioresult<>0
then Begin textcolor(204); writeln('ERROR FILE!!!'); readln; halt; End
else writeln('fail "',filename,'" otkrit'); End;
procedure
printfile(filename:string); var f:text; a:string; b:integer; Begin Assign(f,filename); reset(f); while
not eof(f) do Begin readln(f,a); writeln(a); End; close(f); End;
{====sozdanie
spiska====}
procedure createhead(var head,last:TElement); Begin new(head); head^.next:=nil; last:=head; End;
{====zapolnenie
spiska=====}
Procedure add(var last:TElement; k:string); var
Q:TElement; Begin new(Q); Q^.a:=k; Q^.next:=nil;
last^.next:=Q; Last:=Q; End;
{====vivod na ekran
spiska====}
procedure print(head:TElement); var Q:TElement;
l:integer; Begin Q:=head^.next; while Q<>nil do
Begin if polindrom(Q^.a)=true then Begin textcolor(5);
write(Q^.a,'-->'); End else Begin textcolor(9); write(Q^.a,'-->');
End; Q:=Q^.next; End; writeln; End;
{====vipoln9Iet...====}
procedure
transfer(head:TElement; filename:string); var Q:TElement; F:text;
st,sl:string; l:integer;
Begin new(Q); Assign(f,filename); reset(f); st:=''; sl:=''; Q:=head^.next; while
not eof(f) do Begin readln(f,st); for l:=1 to
length(st) do Begin if st[l]<>' ' then
sl:=sl+st[l] else Begin Add(last,sl);
sl:=''; End; End; End; close(F); End;
procedure
poisk(head:TElement); var Q:TElement; sl:string;
b,code,min:integer; Begin {poisk minimalnogo} Q:=head^.next; sl:=Q^.a; val(sl,b,code); min:=b; Q:=Q^.next;
while Q^.next<>nil do Begin sl:=Q^.a;
val(sl,b,code); if b<min then min:=b; Q:=Q^.next;
End; writeln('min= ',min); Str(min,sl);
{zamena
polindromov} Q:=head^.next; while Q<>nil do Begin
if polindrom(Q^.a)=true then Q^.a:=sl; Q:=Q^.next; End;
