比赛 2008haoi模拟训练4 评测结果 EEEEEEEEEE
题目名称 遗传密码 最终得分 0
用户昵称 cuixiaofei 运行时间 0.000 s
代码语言 Pascal 内存使用 0.00 MiB
提交时间 2008-04-24 17:21:31
显示代码纯文本
//na                            :cuixiaofei;
//da                            :08_04_24;
program pie;
  type
    sss                         =record
                             ge :array[1..1000,1..2] of longint;
                           s,shu:longint;
                                end;
  var
    a                           :array[1..1000] of sss;
    zuida,n,jilu,shuchu         :longint;
    f1,f2                       :text;
  procedure init;
    var
      i,a1,a2                   :longint;
  begin
    assign(f1,'pie.in');
    reset(f1);
    assign(f2,'pie.out');
    rewrite(f2);
    fillchar(a,sizeof(a),0);
    readln(f1,n);
    shuchu:=n;
    jilu:=n;
    zuida:=0;
    for i:=1 to n do
      begin
        readln(f1,a1,a2);
        inc(a[a1].shu);
        inc(a[a1].s);
        a[a1].ge[a[a1].shu,1]:=a2;
        if a1>zuida then
          zuida:=a1;
        if a2>zuida then
          zuida:=a2;
      end;
  end;

  function panhuan(k:longint):longint;
    var
      tui                       :longint;
      pc                        :array[1..1000] of longint;
    procedure sousuo(mmm,c:longint);
      var
        i                       :longint;
    begin
      if (mmm=k) and (c<>1) then
        begin
          panhuan:=1;
          tui:=1;
          exit;
        end
      else
        begin
          for i:=1 to a[mmm].shu do
            if (a[mmm].ge[i,2]=0)and(pc[a[mmm].ge[i,1]]=0) then
              begin
                if tui=1 then
                  exit;
                pc[a[mmm].ge[i,1]]:=1;
                sousuo(a[mmm].ge[i,1],c+1);
                pc[a[mmm].ge[i,1]]:=0;
              end;
        end;
    end;
  begin
    panhuan:=0;
    fillchar(pc,sizeof(pc),0);
    sousuo(k,1);
  end;

  procedure guangsou(k:longint);
    var
      gs                        :array[0..1000,1..2] of longint;
      st,ed,i                   :longint;
  begin
    fillchar(gs,sizeof(gs),0);
    st:=1;
    ed:=1;
    gs[1,1]:=k;
    while st<=ed do
      begin
        for i:=1 to a[k].shu do
          if a[k].ge[i,2]=0 then
          begin
            inc(ed);
            gs[ed,1]:=a[k].ge[i,1];
            gs[ed,2]:=st;
          end;
        inc(st);
      end;
    while gs[ed,2]<>0 do
      begin
        for i:=1 to a[gs[gs[ed,2],1]].shu do
          if a[gs[gs[ed,2],1]].ge[i,1]=gs[ed,1] then
            begin
              a[gs[gs[ed,2],1]].ge[i,2]:=1;
              dec(jilu);
              dec(a[gs[gs[ed,2],1]].s);
              exit;
            end;
        ed:=gs[ed,2];
      end;
  end;


  procedure main;
    var
      i,mmm,jj,panduan         :longint;
      jihe                     :array[1..1000] of longint;
  begin
    while jilu>0 do
      begin
        inc(shuchu);
        mmm:=0;
        jj:=0;
        panduan:=0;
        fillchar(jihe,sizeof(jihe),0);
        while panduan=0 do
          begin
            for i:=1 to n do
            if a[i].s>mmm then
              begin
                mmm:=a[i].s;
                jj:=i;
              end;
            if panhuan(jj)=1 then
              begin
                jihe[jj]:=1;
                panduan:=0;
              end
            else
              panduan:=1;
            guangsou(jj);
          end;
      end;
  end;
  procedure print;
    var
      i,j                       :longint;
  begin
    writeln(f2,shuchu);
    close(f2);
    close(f1);
  end;

  begin
    init;
    main;
    print;
  end.