Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)
Paste
Pasted by Natali ( 15 years ago )
program L14_23;
{dan neuporyadochenii lineinii odnosvyaznii spisok i massiv,sodergachii
nomera sootvetstv elementov v uporyadochenom spiske. Perestroite dannii
spisok v sootvetstvii s nomerami, zadannimi massivom.
Hatkovskaya Nataliya, gr 93492, L14_23}
uses
crt; {dlya ispol'zovaniya readkey i clrscr}
type
Tinf=integer; {tip dannih elementa spiska}
List=^TList; {ukazatel na element tipa TList}
TList=record
data:Tinf;
next:List;
end;
mass=array[1..10] of integer;
stroka=string[30];
var
spis1,spis2:List;
flag:boolean;
a:mass;
procedure vvodlist (var spis1:List);
var
tmp:List;
x:integer;
f:text;
begin
assign(f,'L14_spis.txt');
reset(f);
while not eof(f) do
begin
new(tmp);
read(f,x);
tmp^.data:=x;
tmp^.next:=spis1;
spis1:=tmp;
end;
close(f);
end;
procedure vivodlist(var spis1:List; flag:boolean;zag:stroka);
var
fout:text;
begin
assign(fout,'L14_itog.txt');
if flag then
rewrite(fout)
else
append(fout);
writeln(fout,zag);
while spis1<>nil do
begin
write(fout,spis1^.data,' ');
spis1:=spis1^.next;
end;
writeln(fout);
close(fout);
end;
procedure vvodmatr(var a:mass);
var
i:integer;
f:text;
begin
assign(f,'L14_mass.txt');
reset(f);
for i:=1 to 10 do
begin
read(f,a[i]);
readln(f);
end;
close(f);
end;
procedure vivodmatr(a:mass);
var
i:integer;
fout:text;
begin
assign(fout,'L14_itog.txt');
append(fout);
for i:=1 to 10 do
begin
write(fout,a[i],' ');
writeln(fout);
end;
close(fout);
end;
procedure AddElem(var spis1:List;znach1:TInf);
var
tmp:List;
begin
if spis1=nil then {Проверяем не пуст ли список, если пуст, то }
begin
GetMem(spis1,sizeof(TList)); {создаём его первый элемент}
tmp:=spis1;
end
else {в случае если список не пуст}
begin
tmp:=spis1;
while tmp^.next<>nil do
tmp:=tmp^.next; {ставим tmp на последний элемент списка}
GetMem(tmp^.next,sizeof(TList)); {создаём следующий элемент}
tmp:=tmp^.next; {переносим tmp на новый элемент}
end;
tmp^.next:=nil; {зануляем указатель}
tmp^.data:=znach1; {заносим значение}
end;
procedure sort(var spis1,spis2:List; a:mass);
var
k,i:integer;
tmp:list;
begin
for i:=1 to 10 do
begin
k:=1;
tmp:=spis1;
while (tmp<>nil) and (a[i]<>k) do
begin
tmp:=tmp^.next;
inc(k);
end;
spis2:=tmp;
AddElem (spis2,tmp^.data);
end;
end;
begin
spis1:=nil;
spis2:=nil;
vvodlist(spis1);
flag:=true;
vivodlist(spis1,flag,'First Spisok');
vvodmatr(a);
vivodmatr(a);
sort(spis1,spis2,a);
flag:=false;
vivodlist(spis2,flag,'Otsort Spisok');
end.
Revise this Paste