Discussion @ 1208. Legendary Teams Contest @ Timus Online Judge

I have fixed my program but still WA! HELP!!!!!!!!!!!

Posted by Ural_Happy New Year! 17 Apr 2003 16:40

Here is my solution:
program t1208;
const p=20;
      fin='f:\temp\in1.txt';
      fout='f:\temp\out.txt';
type arr=array[0..p,0..p]of integer;
     arr1=array[0..p]of boolean;
var s:arr; ss:arr1;
    a:array[1..p,1..3]of string[60];
    n,i,j,k,total,m,tt,s1,s2:longint;
    str:string;
    t,ttt:boolean;
procedure init;
begin
     assign(input,fin);
     reset(input);
     readln(n);
     total:=0;
     fillchar(s,sizeof(s),0);
     for i:=1 to n do
         s[i,i]:=1;
     for i:=1 to n do
         begin
         readln(str);
         for j:=1 to length(str) do if str[j]=' ' then break;
         a[i,1]:=copy(str,1,j-1);
         k:=j;
         for j:=k+1 to length(str) do if str[j]=' ' then break;
         a[i,2]:=copy(str,k+1,j-k-1);
         k:=j+1;
         a[i,3]:=copy(str,k,length(str));
         end;
     for i:=1 to n do
         begin
         t:=true;
         for j:=i+1 to n do
             begin
             t:=false;
             if (a[i,1]<>a[j,1])and(a[i,2]<>a[j,1])and(a[i,3]<>a[j,1])
and(a[i,1]<>a[j,2])and(a[i,2]<>a[j,2])and(a[i,3]<>a[j,2])
                and(a[i,1]<>a[j,3])and(a[i,2]<>a[j,3])and(a[i,3]<>a
[j,3]) then
                t:=true;
                if t=false then
                   begin
                   if s[i,j]<>1 then begin s[i,j]:=1; inc(s[i,0]);
end;
                   if s[j,i]<>1 then begin s[j,i]:=1; inc(s[j,0]);
end;
                   end;
             end;
         end;
     for i:=1 to n do
         if s[i,0]=0 then
            begin inc(total); a[i,1]:=''; a[i,2]:=''; a[i,3]:=''; end;
end;
procedure solve(var x,y,tt:longint; ss:arr1);
var i,j,k:longint;
begin
     ss[x]:=false;
     for i:=x to n do if a[i,1]<>'' then
         for j:=y to n do if a[j,1]<>'' then
             if (s[i,j]=0)and(ss[j]=true) then
                begin
                ss[j]:=false;
                tt:=tt+1;
                for k:=1 to n do if (s[i,k]=1)and(i<>k) then
                ss[k]:=false;
                if tt>m then m:=tt;
                y:=y+1;
                solve(x,y,tt,ss);
                for k:=1 to n do if (s[i,k]=1)and(i<>k) then ss
[k]:=true;
                tt:=tt-1;
                ss[j]:=true;
                end;
     ss[x]:=true;
end;
procedure sov(x:longint);
begin
     for i:=x to n do
         if (s[i,0]=1)and(a[i,1]<>'') then
            begin
            s[i,0]:=0;
            a[i,1]:=''; a[i,2]:=''; a[i,3]:='';
            inc(total);
            for j:=1 to n do if (i<>j)and(s[i,j]=1) then
                begin
                s[i,j]:=0;
                s[j,i]:=0; s[j,0]:=s[j,0]-1;
                a[j,1]:=''; a[j,2]:=''; a[j,3]:='';
                end;
            inc(x);
            sov(x);
            end;
end;
begin
     init;
     sov(1);
     s1:=1;
     s2:=0;
     fillchar(ss,sizeof(ss),true);
     solve(s1,s1,s2,ss);
     ttt:=false;
     for i:=1 to n do
         if s[i,0]<>0 then ttt:=true;
     total:=total+m;
     if ttt then total:=total+1;
     writeln(total);
end.

Re: I have fixed my program but still WA! HELP!!!!!!!!!!!

Posted by Tasman 20 Apr 2003 07:16

> const p=20;
>       fin='f:\temp\in1.txt';
>       fout='f:\temp\out.txt';

> procedure init;
> begin
>      assign(input,fin);
>      reset(input);

You can't use files!! Read and write not from/to files !!!

I didn't write that line when i solve it.

Posted by Ural_Happy New Year! 20 Apr 2003 18:26

That's not the real problem. I get WA without it.
Can you give me some test data??

Mail to walter_ddr@hotmail.com
Many Thanks

your program is so long and too difficult to read.

Posted by ACer 1 May 2003 19:15

> Here is my solution:
> program t1208;
> const p=20;
>       fin='f:\temp\in1.txt';
>       fout='f:\temp\out.txt';
> type arr=array[0..p,0..p]of integer;
>      arr1=array[0..p]of boolean;
> var s:arr; ss:arr1;
>     a:array[1..p,1..3]of string[60];
>     n,i,j,k,total,m,tt,s1,s2:longint;
>     str:string;
>     t,ttt:boolean;
> procedure init;
> begin
>      assign(input,fin);
>      reset(input);
>      readln(n);
>      total:=0;
>      fillchar(s,sizeof(s),0);
>      for i:=1 to n do
>          s[i,i]:=1;
>      for i:=1 to n do
>          begin
>          readln(str);
>          for j:=1 to length(str) do if str[j]=' ' then break;
>          a[i,1]:=copy(str,1,j-1);
>          k:=j;
>          for j:=k+1 to length(str) do if str[j]=' ' then break;
>          a[i,2]:=copy(str,k+1,j-k-1);
>          k:=j+1;
>          a[i,3]:=copy(str,k,length(str));
>          end;
>      for i:=1 to n do
>          begin
>          t:=true;
>          for j:=i+1 to n do
>              begin
>              t:=false;
>              if (a[i,1]<>a[j,1])and(a[i,2]<>a[j,1])and(a[i,3]<>a
[j,1])
> and(a[i,1]<>a[j,2])and(a[i,2]<>a[j,2])and(a[i,3]<>a[j,2])
>                 and(a[i,1]<>a[j,3])and(a[i,2]<>a[j,3])and(a[i,3]<>a
> [j,3]) then
>                 t:=true;
>                 if t=false then
>                    begin
>                    if s[i,j]<>1 then begin s[i,j]:=1; inc(s[i,0]);
> end;
>                    if s[j,i]<>1 then begin s[j,i]:=1; inc(s[j,0]);
> end;
>                    end;
>              end;
>          end;
>      for i:=1 to n do
>          if s[i,0]=0 then
>             begin inc(total); a[i,1]:=''; a[i,2]:=''; a[i,3]:='';
end;
> end;
> procedure solve(var x,y,tt:longint; ss:arr1);
> var i,j,k:longint;
> begin
>      ss[x]:=false;
>      for i:=x to n do if a[i,1]<>'' then
>          for j:=y to n do if a[j,1]<>'' then
>              if (s[i,j]=0)and(ss[j]=true) then
>                 begin
>                 ss[j]:=false;
>                 tt:=tt+1;
>                 for k:=1 to n do if (s[i,k]=1)and(i<>k) then
>                 ss[k]:=false;
>                 if tt>m then m:=tt;
>                 y:=y+1;
>                 solve(x,y,tt,ss);
>                 for k:=1 to n do if (s[i,k]=1)and(i<>k) then ss
> [k]:=true;
>                 tt:=tt-1;
>                 ss[j]:=true;
>                 end;
>      ss[x]:=true;
> end;
> procedure sov(x:longint);
> begin
>      for i:=x to n do
>          if (s[i,0]=1)and(a[i,1]<>'') then
>             begin
>             s[i,0]:=0;
>             a[i,1]:=''; a[i,2]:=''; a[i,3]:='';
>             inc(total);
>             for j:=1 to n do if (i<>j)and(s[i,j]=1) then
>                 begin
>                 s[i,j]:=0;
>                 s[j,i]:=0; s[j,0]:=s[j,0]-1;
>                 a[j,1]:=''; a[j,2]:=''; a[j,3]:='';
>                 end;
>             inc(x);
>             sov(x);
>             end;
> end;
> begin
>      init;
>      sov(1);
>

Discussion of Problem 1208. Legendary Teams Contest