Help me PLEASE !!!! Please help me !!!! What's wrong in my code ???????????????????????? var a:array[1..100,1..100]of integer; nn:array[1..100]of string; s,s1:string; kol:integer; w:integer; function find(s:string):integer; var i:integer; begin for i:=1 to kol do if nn[i]=s then begin find:=i; exit; end; find:=kol+1; end; procedure init; var k:integer; ch1,ch2,pp:integer; begin kol:=1; {assign(input,'input.txt'); reset(input);} readln(s); nn[kol]:=s; readln(s); while s<>'#' do begin k:=pos('-',s); s1:=copy(s,1,k-1); delete(s,1,k); pp:=find(s1); if pp> kol then kol:=pp; nn[pp]:=s1; ch1:=pp; pp:=find(s); if pp> kol then kol:=pp; nn[pp]:=s; ch2:=pp; a[ch1,ch2]:=1; a[ch2,ch1]:=1; readln(s); end; {close(input);} end; procedure solve; var i,k,l,p:integer; ss,sp:set of 1..200; min,t,j:integer; ok:boolean; begin ss:=[1..kol];sp:=[]; for i:=1 to kol do if a[1,i]<>0 then begin p:=i; break; end; w:=1; ss:=ss-[1,p];sp:=[1,p]; while ss<>[] do begin for i:=1 to kol do begin ok:=false; if not(i in sp)then for j:=1 to kol do if (j in sp)and(a[i,j]<>0)then begin ss:=ss-[i,j]; sp:=sp+[i,j]; inc(w); break; ok:=true; end; if ok then break; end; end; end; procedure outt; begin writeln(w); end; begin init; solve; outt; end. Sorry !!!!!! I got AC !!!!! > Please help me !!!! > What's wrong in my code ???????????????????????? > > var a:array[1..100,1..100]of integer; > nn:array[1..100]of string; > s,s1:string; > kol:integer; > w:integer; > function find(s:string):integer; > var i:integer; > begin > for i:=1 to kol do > if nn[i]=s then > begin > find:=i; > exit; > end; > find:=kol+1; > end; > procedure init; > var k:integer; > ch1,ch2,pp:integer; > begin > kol:=1; > {assign(input,'input.txt'); > reset(input);} > readln(s); > nn[kol]:=s; > readln(s); > while s<>'#' do > begin > k:=pos('-',s); > s1:=copy(s,1,k-1); > delete(s,1,k); > pp:=find(s1); > if pp> kol then kol:=pp; > nn[pp]:=s1; > ch1:=pp; > pp:=find(s); > if pp> kol then kol:=pp; > nn[pp]:=s; > ch2:=pp; > a[ch1,ch2]:=1; > a[ch2,ch1]:=1; > readln(s); > end; > {close(input);} > end; > procedure solve; > var i,k,l,p:integer; > ss,sp:set of 1..200; > min,t,j:integer; > ok:boolean; > begin > ss:=[1..kol];sp:=[]; > for i:=1 to kol do > if a[1,i]<>0 then > begin > p:=i; > break; > end; > w:=1; > ss:=ss-[1,p];sp:=[1,p]; > while ss<>[] do > begin > for i:=1 to kol do > begin > ok:=false; > if not(i in sp)then > for j:=1 to kol do > if (j in sp)and(a[i,j]<>0)then > begin > ss:=ss-[i,j]; > sp:=sp+[i,j]; > inc(w); > break; > ok:=true; > end; > if ok then break; > end; > end; > end; > procedure outt; > begin > writeln(w); > end; > begin > init; > solve; > outt; > end. Re: Sorry !!!!!! I got AC !!!!! Don't forget about min and max tests)) |