I don't use heap, but I've got wa7. Please give me some contrtests. Thanks. CONST MaxN = 50000; TYPE List = Record s, f, t : Longint; b : BooLean; End; VAR N, M, K, P, Res : Longint; A : Array [1 .. MaxN] of List; Ans : Array [1 .. MaxN] of Longint; PROCEDURE In_Data; Var i : Longint; Begin ReadLn(N, M, K, P); for i := 1 to K do begin ReadLn(A[i].s, A[i].f); A[i].t := i; A[i].b := false; end; End; PROCEDURE qSort(L, R : Longint); Var i, j, x, y, temp : Longint; Begin i := L; j := R; x := A[(L + R) div 2].f; y := A[(L + R) div 2].s; Repeat while (A[i].f < x) or ((A[i].f = x) and (A[i].s < y)) do inc(i); while (A[j].f > x) or ((A[j].f = x) and (A[j].s > y)) do dec(j); if i <= j then begin temp := A[i].s; A[i].s := A[j].s; A[j].s := temp; temp := A[i].f; A[i].f := A[j].f; A[j].f := temp; temp := A[i].t; A[i].t := A[j].t; A[j].t := temp; inc(i); dec(j); end; UntiL i > j; if L < j then qSort(L, j); if i < R then qSort(i, R); End; PROCEDURE Solve; Var i, j, temp : Longint; Begin j := 1; while A[j].b and (j < K) do inc(j); if (j = K) and A[j].b then Exit; temp := 0; for i := j to K do if not A[i].b then if temp <= A[i].s then begin inc(Res); Ans[Res] := A[i].t; A[i].b := true; temp := A[i].f; end; End; PROCEDURE Out_Data; Var i : Longint; Begin WriteLn(Res * P); for i := 1 to Res do Write(Ans[i], ' '); End; PROCEDURE Run; Var i : Longint; Begin In_Data; if K > 1 then qSort(1, K); Res := 0; for i := 1 to M do Solve; Out_Data; End; BEGIN Run; END. Re: I don't use heap, but I've got wa7. Please give me some contrtests. Thanks. You Algo is Wrong for 100 percent. First i solved as you now i AC CONST MaxN = 50000; TYPE List = Record s, f, t : Longint; b : BooLean; End; VAR N, M, K, P, Res : Longint; A : Array [1 .. MaxN] of List; Ans : Array [1 .. MaxN] of Longint; PROCEDURE In_Data; Var i : Longint; Begin ReadLn(N, M, K, P); for i := 1 to K do begin ReadLn(A[i].s, A[i].f); A[i].t := i; A[i].b := false; end; End; PROCEDURE qSort(L, R : Longint); Var i, j, x, y, temp : Longint; Begin i := L; j := R; x := A[(L + R) div 2].f; y := A[(L + R) div 2].s; Repeat while (A[i].f < x) or ((A[i].f = x) and (A[i].s < y)) do inc(i); while (A[j].f > x) or ((A[j].f = x) and (A[j].s > y)) do dec(j); if i <= j then begin temp := A[i].s; A[i].s := A[j].s; A[j].s := temp; temp := A[i].f; A[i].f := A[j].f; A[j].f := temp; temp := A[i].t; A[i].t := A[j].t; A[j].t := temp; inc(i); dec(j); end; UntiL i > j; if L < j then qSort(L, j); if i < R then qSort(i, R); End; PROCEDURE Solve; Var i, j, temp : Longint; Begin j := 1; while A[j].b and (j < K) do inc(j); if (j = K) and A[j].b then Exit; temp := 0; for i := j to K do if not A[i].b then if temp <= A[i].s then begin inc(Res); Ans[Res] := A[i].t; A[i].b := true; temp := A[i].f; end; End; PROCEDURE Out_Data; Var i : Longint; Begin WriteLn(Res * P); for i := 1 to Res do Write(Ans[i], ' '); End; PROCEDURE Run; Var i : Longint; Begin In_Data; if K > 1 then qSort(1, K); Res := 0; for i := 1 to M do Solve; Out_Data; End; BEGIN Run; END. Re: I don't use heap, but I've got wa7. Please give me some contrtests. Thanks. what idea in your solution? sory for my bad english Edited by author 06.08.2008 22:14 |