Welcome, guest! Login / Register - Why register?
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

Your Name: Code Language: