Сортировка линейного односвязного списка

[Klik_1602]

Задача звучит так: 'Дан неупорядоченный линейный односвязный список и массив , содержащий номера соответствующих элементов в упорядоченном списке . Перестройте данный список в соответствии с номерами , заданными массивом''

.я не понимаю как реализовать перестановку..подскажите,пожалуйста , как это можно сделать, буду очень благодарна!)

[Летучий_СкилетиК]

а наработки есть?

[Klik_1602]

да, пыталась сделать..но видимо где-то чего-то недопоняла, вот код

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,news1: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
  read(f,x);
  if spis1=nil then
  begin
   GetMem(spis1,sizeof(TList));
   tmp^.data:=x;
   tmp:=spis1;
 end
 else
 begin
  tmp:=spis1;
  while tmp^.next<>nil do
  tmp:=tmp^.next;
  GetMem(tmp^.next,sizeof(TList));
  tmp:=tmp^.next;
 end;
 tmp^.next:=nil;
 Tmp^.data:=x;
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]);
    end;
 close(f);
end;

procedure vivodmatr(a:mass);
var
 i:integer;
 fout:text;
begin
 assign(fout,'L14_itog.txt');
 append(fout);
 writeln(fout,'Massiv');
 for i:=1 to 10 do
 begin
   write(fout,a[i],' ');
 end;
  writeln(fout);
 close(fout);
end;

procedure sort(var spis1,news1:List; a:mass);
var
 pos,i:integer;
 tmp,tmp2:list;
 znach:Tinf;
begin
 for i:=1 to 10 do
 begin
  pos:=1;
  tmp:=spis1;
  while (tmp<>nil) and (a[i]<>pos) do
  begin
   tmp:=tmp^.next;
   inc(pos);
  end;
  znach:=tmp^.data;
  tmp2:=tmp;
  if news1=nil then
  begin
   GetMem(news1,sizeof(TList));
   tmp2:=news1;
   end
 else
 begin
 tmp2:=news1;
 while tmp2^.next<>nil do
  tmp2:=tmp2^.next;
  GetMem(tmp2^.next,sizeof(TList));
  tmp2:=tmp2^.next;
  end;
 tmp2^.next:=nil;
 tmp2^.data:=znach;
end;
end;


begin
 spis1:=nil;
 news1:=nil;
 vvodlist(spis1);
 flag:=true;
 vivodlist(spis1,flag,'First Spisok');
 vvodmatr(a);
 vivodmatr(a);
 sort(spis1,news1,a);
 flag:=false;
 vivodlist(news1,flag,'Otsort Spisok');
end.

[Klik_1602]

что??? никто не знает - и не может помочь???

[Летучий_СкилетиК]

не стал заморачиватся ввод и вывод процедуры вгонять сделать все в одном коде:

uses crt;
type
    ptr = ^element;
    element = record
         inf:integer;
         link:ptr;
    end;
    var p,pred,First:ptr;
        a:array[byte]of integer;
        i,j,n,x,t:integer;
        f:text;
        g:boolean;
begin
assign(f,'d:\input.txt');
reset(f);
pred:=nil;j:=0;
while (not eoln(f))do
begin
    read(f,x);
    new (p);
    p^.inf:=x;
    p^.link:=pred;
    pred:=p;
    write(p^.inf,' ');
    inc(j);
end;
readln(f);writeln('   ');
while (not eoln(f))do
begin
    read(f,a[n]);
    write(a[n],' ');
    inc(n);
end;
close(f); writeln('   ');
First:=p;
pred:=p;
for i:=n downto 1 do
begin
      p:=First;
      j:=n;g:=false;
      while ((p^.link <> nil) and (j <> a [i])) do
      begin
             j:=j-1;
             p:=p^.link;
             g:=true;
      end;
         t:=First^.inf;
         First^.inf:=p^.inf;
         p^.inf:=t;
         t := a[i]; a[i] := a [j];a [j] := t;
      if not g then begin n:=n-1; First := First^.link;end;
end;
While (pred <> nil) do
begin
      write(pred^.inf,' ');
      pred:=pred^.link;
end;
repeat until keypressed;
end.