program ljkkk;
type
 linktype=^node;
 node=record
   num:integer;
   link:linktype;
  end;
var
 n,m:integer;
 i,j:integer;
 root,pre:linktype;
 p,q:linktype;
begin
 readln(n,m);
 root^.num:=1;
 root^.link:=nil;
 p:=root;
 for i:=2 to n do
 begin
  new(q);
  q^.num:=i;
  p^.link:=q;
  p:=q;
 end;
  pre:=p;
  p^.link:=root;
 p:=root;
 j:=1;
 while (p^.link<>p) do
 begin
  if (j=m)  then
  begin
   pre^.link:=p^.link;
   writeln(p^.num);
   dispose(p);
   p:=pre^.link;
   j:=1;
  end
  else
  begin
   pre:=p;
   p:=p^.link;
   j:=j+1;
  end;
 end;
 writeln(p^.num);
end.

 

 

program asdkj;
type
 tree=^treetype;
 treetype=record
    wd:string;
    tm:integer;
    lt,rt:tree;
    end;
 link=^linktype;
 linktype=record
     wd:string;
     tm:integer;
     next:link;
     end;
const
  letter=['a'..'z','A'..'Z'];
var
 head:link;
 root:tree;
 n,st:string;
procedure  readword;
var
 q,p:link;
 w:string;
begin
 head:=nil;
 repeat
   readln(w);
   if (w<>'') then
   begin
    p:=head;
    while (p<>nil) and (p^.wd<>w) do
     p:=p^.next;
    if p=nil then
    begin
     new(q);
     q^.wd:=w;
     q^.tm:=1;
     q^.next:=head;
     head:=q;
    end
    else
    inc(p^.tm);
    end;
  until (w='');
end;
procedure create;
var
 p,r:tree;
 f:boolean;
 q:link;
begin
  new(root);
  with root^ do
  begin
   wd:=head^.wd;
   tm:=head^.tm;
   lt:=nil;
   rt:=nil;
  end;
  q:=head^.next;
  while q<>nil do
  begin
   p:=root;
   new(r);
   r^.lt:=nil;
   r^.rt:=nil;
   r^.wd:=q^.wd;
   r^.tm:=q^.tm;
   f:=true;
    while f do
    begin
     if (q^.wd<p^.wd) then
     if (p^.lt<>nil)  then p:=p^.lt
     else   begin
            p^.lt:=r;
            f:=false;
            end
     else
     if (p^.rt<>nil) then p:=p^.rt
     else  begin
           p^.rt:=r;
           f:=false;
           end;
    end;
    q:=q^.next;
  end;
end;
procedure pr_tree(p:tree);
begin
 if p^.lt<>nil then pr_tree(p^.lt);
 write(p^.wd:20,p^.tm:5);
 if p^.rt<>nil then pr_tree(p^.rt);
end;
begin
 readword;
 create;
 pr_tree(root);
end.
program duoxiangshi;
type
 link=^node;
 node=record
    coef  :real;
    exp   :integer;
    next  :link;
   end;
 poly=link;
var
 p,pa,pb:poly;
procedure jl(var a:poly);
var
  p,q  :poly;
  co   :real;
  ex   :integer;
begin
 p:=nil;
 repeat
  read(co,ex);
  new(q);
  q^.coef:=co;
  q^.exp:=ex;
  q^.next:=p;
  p:=q;
  until (ex=-1) and (co=-1);
  a:=p;
  readln;
end;
procedure add_poly(var a:poly; b:poly);
var
 p,q,u,pre:poly;
 x:real;
begin
 p:=a^.next;
 q:=b^.next;
 pre:=a;
 while (p<>nil) and (q<>nil) do
 if (p^.exp>q^.exp)  then
 begin
  pre:=p;
  p:=p^.next;
 end
 else
 if (p^.exp=q^.exp)  then
 begin
  x:=p^.coef+q^.coef;
  if (x<>0) then
  begin
  p^.coef:=x;
  pre:=p;
  end
  else
  begin
    pre^.next:=p^.next;
    dispose(p);
  end;
  p:=pre^.next;
  u:=q;
  q:=q^.next;
  dispose(u);
 end
 else
 begin
 u:=q^.next;
 q^.next:=p;
 pre^.next:=q;
 pre:=q;
 q:=u;
 end;
 if (q<>nil) then
 pre^.next:=q;
 dispose(b);
end;
begin
 jl(pa);
 jl(pb);
 add_poly(pa,pb);
 p:=pa;
 p:=p^.next;
 while (p<>nil) do
  begin
   writeln(p^.coef:8:2,p^.exp:5);
   p:=p^.next;
  end;
end.

program p_1;
const
 n=10;
var
 s:array[1..n] of integer;
 m:integer;
procedure sort(lx,rx:integer);
var
 i,j,t:integer;
begin
 i:=lx; j:=rx; t:=s[i];
 repeat
   while (s[j]>t) and (i<j) do  j:=j-1;
   if (i<j) then
   begin
    s[i]:=s[j];
    i:=i+1;
    while (s[i]<t) and (i<j) do i:=i+1;
    if (i<j) then
    begin
     s[j]:=s[i];
     j:=j-1;
    end;
   end;
   until i=j;
   s[i]:=t; i:=i+1; j:=j-1;
   if (lx<j) then sort(lx,j);
   if (i<rx) then sort(i,rx);
end;
begin
 write('input data');
 for m:=1 to n do
  read(s[m]);
  sort(1,n);
 for m:=1 to n do
  write(s[m],' ');
end.

输入边数与矩阵
program agrinet;
var
  n,i,j,minj:integer;
  mark:array[1..100] of boolean;
  map:array[1..100,1..100] of longint;
  dist:array[1..100] of longint;
  min,ans:longint;
begin
  ans:=0;
  readln(n);
  for i:=1 to n do
    for j:=1 to n do
      read(map[i,j]);
  for i:=1 to n do dist[i]:=maxlongint;
  dist[1]:=0;
  mark[1]:=true;
  minj:=1;
  for i:=1 to n-1 do begin
    for j:=1 to n do
      if dist[j]>map[minj,j] then begin dist[j]:=map[minj,j];  end;
    min:=maxlongint;
    for j:=1 to n do
      if (dist[j]<min) and (not mark[j]) then begin
        minj:=j;
        min:=dist[j];
      end;
    mark[minj]:=true;
    inc(ans,min);
  end;
writeln(ans);
end.

 

用文件输入输出
input: n,k
     输入一个矩阵表示边的信息
output: n个数，表示k到各个点的最短路

program dijkstra;
const
 inp =  'input.txt';
 oup =  'output.txt';
 maxn=   100;
var
 ga   :    array[1..maxn,1..maxn] of integer;
 dist :    array[1..maxn]         of integer;
 s    :    array[1..maxn]         of    0..1;
 n,k  :    integer;
 fp   :    text;
procedure init;
var
 i,j: integer;
begin
 assign(fp,inp);  reset(fp);
 readln(fp,n,k);
 for i:=1 to n do
 for j:=1 to n do
 read(fp,ga[i,j]);
 close(fp);
end;
procedure main;
var
 i,j,w,m:integer;
begin
 fillchar(s,sizeof(s),0);
 for i:=1 to n do
 dist[i]:=maxint;
 dist[k]:=0;
 for i:=1 to n-1 do
 begin
      m:=maxint;
      for j:=1 to n do
       if (s[j]=0) and (dist[j]<m) then
       begin
             m:=dist[j];
             w:=j;
       end;
       s[w]:=1;
       for j:=1 to n do
       if (s[j]=0) and (ga[w,j]>0) and (dist[w]+ga[w,j]<dist[j]) then
        dist[j]:=dist[w]+ga[w,j];
 end;
end;
procedure print;
var
 i,j:integer;
begin
 assign(fp,oup);
 rewrite(fp);
 for i:=1 to n do
 write(fp,dist[i],' ');
 close(fp);
end;
begin
 init;
 main;
 print;
end.