Common BoardTo Lintao - China I have just repaired 2 problems ( 1074,1097 ) for you : - 1074 + when s='', you call s[1] = '-' --> crash; + Use {$R+} in the begining of source code to solved other error.
- 1097 + The initialize value of Max is 1, you use 0 --- --> wrong answer. + Your algo is too slow, you must change it. @ Good luck !!! PS : Can you tell me the way to solve 1018 ? Mail to : dinhhongminh@yahoo.com This is my 1018 program. Posted by Lin 30 Jul 2001 20:22 Var Map : Array[0..100,1..2] of Longint; Apples : Array[1..100,1..2] of Longint; Num : Array[1..100] of Byte; NumAll : Array[1..100] of Byte; Del : Array[0..100,0..100] of Longint; Tree : Array[1..100,1..100] of Integer; N,Q : Byte; Total : Longint; Procedure Init; Var i,j,k : Integer; l : Integer; D : Array[1..100] of Integer; B : Array[1..100] of Boolean; H,T : Integer; Begin Assign(Input,'1018.txt'); Reset(Input); Readln(N,Q); For i := 1 to N-1 do Begin Readln(j,k,l); Tree[j,k] := l; Tree[k,j] := l; Total := Total+l; End; Fillchar(B,Sizeof(B),True); D[1] := 1; H := 1; T := 1; B[1] := False; Repeat For i := 1 to N do If B[i] then If Tree[D[H],i]<>0 then Begin Inc(Num[D[H]]); Map[D[H],Num[D[H]]] := i; Apples[D[H],Num[D[H]]] := Tree[D[H],i]; Inc(T); D[T] := i; B[i] := False; End; Inc(H); Until H>T End; Function Pass(X : Byte) : Boolean; Var i,j : Integer; Begin Pass := False; If Num[X]=0 then Exit; For i := 1 to Num[X] do If Num[Map[X,i]]<>0 then exit; Pass := True; End; Procedure Main; Var i,j,k,l : Longint; No_Change : Boolean; C : Array[0..2] of Longint; Root : Integer; T1,T2 : Integer; Begin For i := 0 to N do For j := 1 to N do Del[i,j] := Maxlongint; Repeat No_Change := True; For i := 1 to N do If Pass(i) then Begin No_Change := False; Root := i; C[0] := 0; T1 := Map[i,1]; T2 := Map[i,2]; For j := 1 to N do For k := 0 to j do If Del[T1,k]<Maxlongint then Begin l := j-k; If Del[T2,l]<Maxlongint then If Del[T1,k]+Del[T2,l]<Del[i,j] then Del[i,j] := Del[T1,k]+Del[T2,l] End; For j := 0 to N-(NumAll[T1]+1) do If Del[T2,j]<Maxlongint then If Apples[i,1]+Del[T1,NumAll[T1]]+Del[T2,j] <Del[i,NumAll[T1]+1+j] then Del[i,NumAll[T1]+1+j] := Apples[i,1]+Del [T1,NumAll[T1]]+Del[T2,j]; If Num[i]=2 then Begin For j := 0 to N-(NumAll[T2]+1) do If Del[T1,j]<Maxlongint then If Apples[i,2]+Del[T2,NumAll[T2]]+Del [T1,j]<Del[i,NumAll[T2]+1+j] then Del[i,NumAll[T2]+1+j] := Apples[i,2]+Del [T2,NumAll[T2]]+Del[T1,j]; If Apples[i,1]+Apples[i,2]+Del[T1,NumAll[T1]] +Del[T2,NumAll[T2]]< Del[i,NumAll[T1]+NumAll[T2]+2] then Del[i,NumAll[T1]+NumAll[T2]+2] := Apples[i,1]+Apples[i,2]+Del[T1,NumAll[T1]] +Del[T2,NumAll[T2]] End; NumAll[i] := Num[i]; For j := 1 to Num[i] do Inc(NumAll[i],Numall[Map[i,j]]); Num[i] := 0; End; Until No_Change; Writeln(Total-Del[Root,N-1-Q]); End; Begin Init; Main; End. Thank you. I'll check my source. > Var Map : Array[0..100,1..2] of Longint; > Apples : Array[1..100,1..2] of Longint; > Num : Array[1..100] of Byte; > NumAll : Array[1..100] of Byte; > Del : Array[0..100,0..100] of Longint; > Tree : Array[1..100,1..100] of Integer; > N,Q : Byte; > Total : Longint; > > Procedure Init; > Var i,j,k : Integer; > l : Integer; > D : Array[1..100] of Integer; > B : Array[1..100] of Boolean; > H,T : Integer; > Begin > Assign(Input,'1018.txt'); Reset(Input); > Readln(N,Q); > For i := 1 to N-1 do > Begin > Readln(j,k,l); > Tree[j,k] := l; > Tree[k,j] := l; > Total := Total+l; > End; > Fillchar(B,Sizeof(B),True); > D[1] := 1; H := 1; T := 1; > B[1] := False; > Repeat > For i := 1 to N do > If B[i] then > If Tree[D[H],i]<>0 then > Begin > Inc(Num[D[H]]); > Map[D[H],Num[D[H]]] := i; > Apples[D[H],Num[D[H]]] := Tree[D[H],i]; > Inc(T); > D[T] := i; > B[i] := False; > End; > Inc(H); > Until H>T > End; > > Function Pass(X : Byte) : Boolean; > Var i,j : Integer; > Begin > Pass := False; > If Num[X]=0 then Exit; > For i := 1 to Num[X] do > If Num[Map[X,i]]<>0 then exit; > Pass := True; > End; > > Procedure Main; > Var i,j,k,l : Longint; > No_Change : Boolean; > C : Array[0..2] of Longint; > Root : Integer; > T1,T2 : Integer; > Begin > For i := 0 to N do > For j := 1 to N do > Del[i,j] := Maxlongint; > Repeat > No_Change := True; > For i := 1 to N do > If Pass(i) then > Begin > No_Change := False; > Root := i; > C[0] := 0; > T1 := Map[i,1]; T2 := Map[i,2]; > For j := 1 to N do > For k := 0 to j do > If Del[T1,k]<Maxlongint then > Begin > l := j-k; > If Del[T2,l]<Maxlongint then > If Del[T1,k]+Del[T2,l]<Del[i,j] then > Del[i,j] := Del[T1,k]+Del[T2,l] > End; > For j := 0 to N-(NumAll[T1]+1) do > If Del[T2,j]<Maxlongint then > If Apples[i,1]+Del[T1,NumAll[T1]]+Del[T2,j] > <Del[i,NumAll[T1]+1+j] then > Del[i,NumAll[T1]+1+j] := Apples[i,1]+Del > [T1,NumAll[T1]]+Del[T2,j]; > If Num[i]=2 then > Begin > For j := 0 to N-(NumAll[T2]+1) do > If Del[T1,j]<Maxlongint then > If Apples[i,2]+Del[T2,NumAll[T2]]+Del > [T1,j]<Del[i,NumAll[T2]+1+j] then > Del[i,NumAll[T2]+1+j] := Apples[i,2] +Del > [T2,NumAll[T2]]+Del[T1,j]; > If Apples[i,1]+Apples[i,2]+Del[T1,NumAll [T1]] > +Del[T2,NumAll[T2]]< > Del[i,NumAll[T1]+NumAll[T2]+2] then > Del[i,NumAll[T1]+NumAll[T2]+2] := > Apples[i,1]+Apples[i,2]+Del[T1,NumAll [T1]] > +Del[T2,NumAll[T2]] > End; > NumAll[i] := Num[i]; > For j := 1 to Num[i] do > Inc(NumAll[i],Numall[Map[i,j]]); > Num[i] := 0; > End; > Until No_Change; > Writeln(Total-Del[Root,N-1-Q]); > End; > > Begin > Init; > Main; > End. |