I have fixed my program but still WA! HELP!!!!!!!!!!! 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!!!!!!!!!!! Послано Tasman 20 апр 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. 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. Послано ACer 1 май 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); > |