fork download
copy 
  1. const
  2.   fi='';//stone1.inp';
  3.   fo='';//stone1.out';
  4.   maxn=403;
  5.   maxm=403;
  6. type
  7.   arr1 = array[1..maxn] of longint;
  8. var
  9.   link,head,ke : array[-maxm..maxm] of longint;
  10.   f,deg : array[1..maxn] of longint;
  11.   i,j,n,m,k : longint;
  12.   st : array[1..maxn,1..maxn] of longint;
  13.   top : array[1..maxn] of longint;
  14.   a : array[1..maxn,1..maxn] of boolean;
  15.   cx : array[1..maxn] of boolean;
  16. procedure add(i,u,v : longint);
  17.   begin
  18.     link[i] := head[u];
  19.     head[u] := i;
  20.     ke[i] := v;
  21.   end;
  22. procedure enter;
  23.   var u,v,i : longint;
  24.   begin
  25.     assign(input,fi);reset(input);
  26.     read(n);
  27.     for i := 1 to n do
  28.       begin
  29.         read(u,k);
  30.         for j:=1 to k do
  31.           begin
  32.             read(v);
  33.             if a[u,v] = false then
  34.               begin
  35.                 a[u,v] := true;
  36.                 inc(deg[u]);
  37.               end;
  38.             if a[v,u] = false then
  39.               begin
  40.                 a[v,u] := true;
  41.                 inc(deg[v]);
  42.               end;
  43.           end;
  44.       end;
  45.     close(input);
  46.   end;
  47. procedure push(i,x : longint);
  48.   begin
  49.     inc(top[i]);
  50.     st[i,top[i]] := x;
  51.   end;
  52. procedure swap(var x,y : longint);
  53.   var tg : longint;
  54.   begin
  55.     tg:=x;x:=y;y:=tg;
  56.   end;
  57. procedure qs(l,r : longint; var a : arr1);
  58.   var i,j,x : longint;
  59.   begin
  60.     i :=l;j:=r;
  61.     x := a[(l+r) div 2];
  62.     repeat
  63.       while a[i] > x do inc(i);
  64.       while a[j] < x do dec(j);
  65.       if i<=j then
  66.         begin
  67.           swap(a[i],a[j]);
  68.           inc(i);dec(j);
  69.         end;
  70.     until i>j;
  71.     if i<r then qs(i,r,a);
  72.     if j>l then qs(l,j,a);
  73.   end;
  74. procedure dfs(u : longint);
  75.   var i,v,s : longint;
  76.   begin
  77.     cx[u] := false;
  78.     if deg[u] <= 1 then begin f[u] := 1; exit; end;
  79.     for v := 1 to n do
  80.       if a[u,v] then
  81.       if cx[v] then
  82.         begin
  83.           dfs(v);
  84.           push(u,f[v]);
  85.         end;
  86.     qs(1,top[u],st[u]);
  87.     s := st[u,1];
  88.     v := st[u,1]-1;
  89.     for i:= 2 to top[u] do
  90.       if v < st[u,i] then
  91.       begin
  92.         s := s + (st[u,i]-v);
  93.         v := v + (st[u,i]-v);
  94.         v := v - 1;
  95.       end else v := v-1;
  96.     f[u] := s;
  97.   end;
  98. procedure process;
  99.   begin
  100.     fillchar(cx,sizeof(cx),true);
  101.     dfs(1);
  102.   end;
  103. procedure print;
  104.   begin
  105.     assign(output,fo);rewrite(output);
  106.     writeln(f[1]);
  107.     close(output);
  108.   end;
  109. begin
  110.   enter;
  111.   process;
  112.   print;
  113. end.
Compilation error #stdin compilation error #stdout 0s 0KB
comments (?)
stdin
copy 
Standard input is empty
compilation info 
prog.pas:1: warning: missing program header
prog.pas: In procedure `dfs':
prog.pas:86: error: type mismatch in argument 3 of `qs'
prog.pas:57: error:  routine declaration
stdout
copy 
Standard output is empty
https://ideone.com/CLMlCQ
language:
Pascal (gpc 20070904)
created:
6 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!