Detail of message

Online Judge

Problem Set

Authors

Online Contests

User

Web Board
Home Page
F.A.Qs
Statistical Charts

Current Contest
Past Contests
Scheduled Contests
Award Contest

谁能告诉我程序哪里不对，小妹将以身相许

Posted by Kali at 2005-06-17 21:34:54 on Problem 1486

初学几天，请gg多多指教！

const   maxn            =50;

var     sd              :array[1..maxn,1..4]of integer;
        p               :array[1..maxn,1..2]of integer;
        mp              :array[1..maxn,1..maxn]of boolean;
        cvr             :array[1..maxn]of boolean;
        lnk             :array[1..maxn]of integer;
        n,stp           :integer;

procedure read_in;
var     i:integer;
begin
        readln(n); if n=0 then halt;
        for i:=1 to n do readln(sd[i,1],sd[i,2],sd[i,3],sd[i,4]);
        for i:=1 to n do readln(p[i,1],p[i,2]);
end;

function btw(a,i,j:integer):boolean;
begin
        btw:=(i<a) and (a<j);
end;

procedure build_graph;
var     i,j:integer;
begin
        fillchar(mp,sizeof(mp),0);
        for i:=1 to n do
        for j:=1 to n do
                mp[i,j]:=btw(p[i,1],sd[j,1],sd[j,2]) and btw(p[i,2],sd[j,3],sd[j,4])
end;

function find(k:integer):boolean;
var     i,q:integer;
begin
        find:=true;
        for i:=1 to n do if mp[k,i] and not cvr[i] then begin
                cvr[i]:=true;
                q:=lnk[i]; lnk[i]:=k;
                if (q=0) or find(q) then exit;
                lnk[i]:=q;
        end;
        find:=false;
end;

procedure max_match;
var     i,q,w:integer;
begin
        fillchar(lnk,sizeof(lnk),0);
        for i:=1 to n do begin
                fillchar(cvr,sizeof(cvr),0);
                find(i);
        end;
        inc(stp);
        writeln('Heap ',stp);
        w:=0;
        for i:=1 to n do begin
                q:=lnk[i]; lnk[i]:=0;
                mp[q,i]:=false;
                fillchar(cvr,sizeof(cvr),0);
                if not find(q) then begin
                        lnk[i]:=q;
                        inc(w); if w>1 then write(' ');
                        write('(',chr(i+64),',',lnk[i],')');
                end;
                mp[q,i]:=true;
        end;
        if w=0 then write('none');
        writeln;
end;

begin
    stp:=0;
    repeat
        read_in;
        build_graph;
        max_match;
        writeln;
    until false;
end.

Followed by:

这年头，居然有这种事。。。 (2278) js05 2005-06-18 09:57:37
sigh!!!居然有这么优厚的条件！！btw，刚学几天程序风格就这么好，pfpf (2278) palmtenor 2005-06-18 10:03:17
- 看了一下，MS是匹配题~可以再次测试我的template~ (0) palmtenor 2005-06-18 10:30:53
不知小妹相貌如何 (2278) uni 2005-06-18 12:30:45
- 皑皑，你…… (0) frkstyc 2005-06-18 12:55:33
  - 皑皑？ (0) ciciatc 2005-06-18 13:06:25
    - 爱称...... (0) palmtenor 2005-06-18 13:12:00
      - 有病 (0) frkstyc 2005-06-18 13:12:27
        不许给我乱起名... (0) uni 2005-06-19 16:27:56
        谁给你起名了 (0) frkstyc 2005-06-19 16:29:16
      - uni叫皑皑？ (0) ciciatc 2005-06-18 13:25:15
得高人指点弄到数据了，但我的程序并没有错耶？到底是什么样的格式？ (22) Kali 2005-06-18 13:18:39
- 你不是在zoj那种变态地方做的吧？ (24) frkstyc 2005-06-18 13:26:41
  - 找数据要去zju译题站.... (0) palmtenor 2005-06-18 15:00:52
    - 早就上不了了 (0) JiangLY 2005-06-18 15:28:57
      - qysite可以上去 (0) palmtenor 2005-06-18 15:30:58
就没有英雄了吗？ (0) Kali 2005-06-19 00:07:35
- Pascle是一年前的事了，看着不是很舒服，要是c/c++我就看看了 (0) sunmoonstar_love 2005-06-19 00:09:25
- 您这个一说就要以身相许的，怎么敢冒这个险啊？ (0) js05 2005-06-19 00:25:51
  - 同意！ (0) frkstyc 2005-06-19 00:50:56
你好像从来都没提交过？如果是新手，先做些简单的吧 (2278) sunmoonstar_love 2005-06-19 00:10:40
- 初学几天就能写匹配了，强啊。。。 (0) js05 2005-06-19 00:26:31
这年头怪事好多啊！ (2278) CrazyBird 2006-07-09 19:57:58
陈年旧帖..OTL下 (5) xwbsw 2007-08-11 18:09:52
- Re:现在觉的学pascal还有好多其它用处　 (9) sweller 2007-08-11 19:45:42
- 强贴。。居然被翻出来。。 (9) TheBeet 2007-08-11 22:55:59
  - re (0) ecjtubaowp 2007-08-11 23:00:49
  - !!.... (0) ACM06_ghosthy 2007-10-04 19:50:27
Re:谁能告诉我程序哪里不对，小妹将以身相许 (2278) majar 2007-10-14 15:13:46
原来就是这个比赛题，我再写写看... (0) qiqilrq 2007-12-10 15:14:39
Re:这么多年了，这个帖子又被顶出来了，但不知道这位MM许身许出去了没 (2278) hudedi 2007-12-10 16:41:02
Re:谁能告诉我程序哪里不对，小妹将以身相许 (2278) majar 2008-01-02 08:16:07
悍！！！汗！！！ (8) 0huzi0 2009-04-08 17:51:18
Re:谁能告诉我程序哪里不对，小妹将以身相许 (2284) heianzhihuan 2009-09-18 16:04:42
- 顶 (10) yygy 2009-09-18 16:36:10
  - Re:顶 (14) heianzhihuan 2009-09-18 17:26:25

Post your reply here:

User ID:
Password:
Title:

Content:

> 初学几天，请gg多多指教！
> 
> const   maxn            =50;
> 
> var     sd              :array[1..maxn,1..4]of integer;
>         p               :array[1..maxn,1..2]of integer;
>         mp              :array[1..maxn,1..maxn]of boolean;
>         cvr             :array[1..maxn]of boolean;
>         lnk             :array[1..maxn]of integer;
>         n,stp           :integer;
> 
> procedure read_in;
> var     i:integer;
> begin
>         readln(n); if n=0 then halt;
>         for i:=1 to n do readln(sd[i,1],sd[i,2],sd[i,3],sd[i,4]);
>         for i:=1 to n do readln(p[i,1],p[i,2]);
> end;
> 
> function btw(a,i,j:integer):boolean;
> begin
>         btw:=(i<a) and (a<j);
> end;
> 
> procedure build_graph;
> var     i,j:integer;
> begin
>         fillchar(mp,sizeof(mp),0);
>         for i:=1 to n do
>         for j:=1 to n do
>                 mp[i,j]:=btw(p[i,1],sd[j,1],sd[j,2]) and btw(p[i,2],sd[j,3],sd[j,4])
> end;
> 
> function find(k:integer):boolean;
> var     i,q:integer;
> begin
>         find:=true;
>         for i:=1 to n do if mp[k,i] and not cvr[i] then begin
>                 cvr[i]:=true;
>                 q:=lnk[i]; lnk[i]:=k;
>                 if (q=0) or find(q) then exit;
>                 lnk[i]:=q;
>         end;
>         find:=false;
> end;
> 
> procedure max_match;
> var     i,q,w:integer;
> begin
>         fillchar(lnk,sizeof(lnk),0);
>         for i:=1 to n do begin
>                 fillchar(cvr,sizeof(cvr),0);
>                 find(i);
>         end;
>         inc(stp);
>         writeln('Heap ',stp);
>         w:=0;
>         for i:=1 to n do begin
>                 q:=lnk[i]; lnk[i]:=0;
>                 mp[q,i]:=false;
>                 fillchar(cvr,sizeof(cvr),0);
>                 if not find(q) then begin
>                         lnk[i]:=q;
>                         inc(w); if w>1 then write(' ');
>                         write('(',chr(i+64),',',lnk[i],')');
>                 end;
>                 mp[q,i]:=true;
>         end;
>         if w=0 then write('none');
>         writeln;
> end;
> 
> begin
>     stp:=0;
>     repeat
>         read_in;
>         build_graph;
>         max_match;
>         writeln;
>     until false;
> end.

Home Page Go Back To top