На форумі обговорюються лише питання, пов'язані з олімпіадою
Ви не зайшли.
И еще мои:
1) <street>
program Street; const xmax = 260; var arr1, arr2, arr3: array[0..xmax] of longint; s, w: ansistring; z, N: longint; procedure SumX; var xI, xJ, ost: longint; begin if arr1[0] > arr2[0] then xJ:=arr1[0] else xJ:=arr2[0]; ost:=0; arr3[0]:=xJ; for xI:=xmax downto xmax - xJ + 1 do begin arr3[xI]:=arr1[xI] + arr2[xI] + ost; ost:=0; if arr3[xI] >= 1000000000 then begin ost:=1; dec(arr3[xI], 1000000000); end; end; if ost = 1 then begin inc(arr3[0]); arr3[xmax - xJ]:=1; end; end; procedure CopyX; var xI: longint; begin arr1[0]:=arr2[0]; for xI:=xmax downto xmax - arr2[0] + 1 do arr1[xI]:=arr2[xI]; arr2[0]:=arr3[0]; for xI:=xmax downto xmax - arr2[0] + 1 do arr2[xI]:=arr3[xI]; end; procedure SeeX; var xI, xJ: longint; begin if Z = N then writeln(arr3[xmax] mod 10) else begin for xI:=xmax to xmax do str(arr3[xmax - arr3[0] + 1], w); for xI:=xmax - arr3[0] + 2 to xmax do begin str(arr3[xI], s); for xJ:=length(s) + 1 to 9 do w:=w + '0'; w:=w + s; end; for xI:=length(w) - 1 downto 1 do begin dec(z); if N = z then begin writeln(w[xI]); break; end; end; end; end; begin fillchar(arr1, sizeof(arr1), 0); fillchar(arr2, sizeof(arr2), 0); fillchar(arr3, sizeof(arr3), 0); arr1[0]:=1; arr2[0]:=1; arr3[0]:=1; z:=3; arr1[xmax]:=2; arr2[xmax]:=3; arr3[xmax]:=5; readln(N); w:=''; if N < 4 then begin if N = 1 then writeln(2); if N = 2 then writeln(3); if N = 3 then writeln(5); end; while arr3[0] < 256 do begin CopyX; SumX; str(arr3[xmax - arr3[0] + 1], s); inc(z, (arr3[0] - 1) * 9 + length(s)); if Z >= N then begin SeeX; break; end; end; end.
2) <miniline>
program MiniLine; const nmax = 100; smax = 4; var sx, sy, sz, x1, y1, z1, x2, y2, z2: longint; i, sizevex, sizecon, minscore: longint; vex: array[1..nmax, 1..3] of longint; con: array[1..nmax, 1..2] of longint; function DistX(verx1, verx2: longint): longint; begin DistX:=abs(vex[verx1, 1] - vex[verx2, 1]) + abs(vex[verx1, 2] - vex[verx2, 2]) + abs(vex[verx1, 3] - vex[verx2, 3]); end; procedure TryToSolve(stepnum, lenx, curnum: longint); var xI: longint; begin if curnum = 10 then begin if minscore > lenx then minscore:=lenx; exit; end; if stepnum > smax then exit; for xI:=1 to sizecon do if con[xI, 1] = curnum then TryToSolve(stepnum + 1, lenx + DistX(curnum, con[xI, 2]), con[xI, 2]); end; begin read(sx); read(sy); read(sz); read(x1); read(y1); read(z1); read(x2); read(y2); read(z2); sx:=abs(sx); sy:=abs(sy); sz:=abs(sz); x1:=abs(x1); y1:=abs(y1); z1:=abs(z1); x2:=abs(x2); y2:=abs(y2); z2:=abs(z2); sizevex:=10; sizecon:=24; minscore:=maxlongint; vex[1, 1]:=0; vex[1, 2]:=0; vex[1, 3]:=0; vex[2, 1]:=sx; vex[2, 2]:=0; vex[2, 3]:=0; vex[3, 1]:=0; vex[3, 2]:=sy; vex[3, 3]:=0; vex[4, 1]:=0; vex[4, 2]:=0; vex[4, 3]:=sz; vex[5, 1]:=sx; vex[5, 2]:=sy; vex[5, 3]:=0; vex[6, 1]:=sx; vex[6, 2]:=0; vex[6, 3]:=sz; vex[7, 1]:=0; vex[7, 2]:=sy; vex[7, 3]:=sz; vex[8, 1]:=sx; vex[8, 2]:=sy; vex[8, 3]:=sz; vex[9, 1]:=x1; vex[9, 2]:=y1; vex[9, 3]:=z1; vex[10, 1]:=x2; vex[10, 2]:=y2; vex[10, 3]:=z2; con[ 1, 1]:=1; con[ 1, 2]:=2; con[ 2, 1]:=1; con[ 2, 2]:=3; con[ 3, 1]:=1; con[ 3, 2]:=4; con[ 4, 1]:=2; con[ 4, 2]:=5; con[ 5, 1]:=2; con[ 5, 2]:=6; con[ 6, 1]:=3; con[ 6, 2]:=5; con[ 7, 1]:=3; con[ 7, 2]:=7; con[ 8, 1]:=4; con[ 8, 2]:=6; con[ 9, 1]:=4; con[ 9, 2]:=7; con[10, 1]:=5; con[10, 2]:=8; con[11, 1]:=6; con[11, 2]:=8; con[12, 1]:=7; con[12, 2]:=8; con[13, 2]:=1; con[13, 1]:=2; con[14, 2]:=1; con[14, 1]:=3; con[15, 2]:=1; con[15, 1]:=4; con[16, 2]:=2; con[16, 1]:=5; con[17, 2]:=2; con[17, 1]:=6; con[18, 2]:=3; con[18, 1]:=5; con[19, 2]:=3; con[19, 1]:=7; con[20, 2]:=4; con[20, 1]:=6; con[21, 2]:=4; con[21, 1]:=7; con[22, 2]:=5; con[22, 1]:=8; con[23, 2]:=6; con[23, 1]:=8; con[24, 2]:=7; con[24, 1]:=8; for i:=1 to sizevex - 2 do if ((vex[i, 1] - x1 = 0) and (vex[i, 2] - y1 = 0)) or ((vex[i, 1] - x1 = 0) and (vex[i, 3] - z1 = 0)) or ((vex[i, 2] - y1 = 0) and (vex[i, 3] - z1 = 0)) then begin inc(sizecon); con[sizecon, 1]:=9; con[sizecon, 2]:=i; inc(sizecon); con[sizecon, 1]:=i; con[sizecon, 2]:=9; end; for i:=1 to sizevex - 1 do if ((vex[i, 1] - x2 = 0) and (vex[i, 2] - y2 = 0)) or ((vex[i, 1] - x2 = 0) and (vex[i, 3] - z2 = 0)) or ((vex[i, 2] - y2 = 0) and (vex[i, 3] - z2 = 0)) then begin inc(sizecon); con[sizecon, 1]:=10; con[sizecon, 2]:=i; inc(sizecon); con[sizecon, 1]:=i; con[sizecon, 2]:=10; end; TryToSolve(1, 0, 9); writeln(minscore); end.
3) <crossgroup>
{$N+} program CrossGroup; type current = extended; var z, x, v, u, n, q: longint; y: current; begin read(n, v, u, z); while n mod 4 <> 0 do inc(N); N:=N div 4; y:=(((2 * N * u) + v - u) * v) / ((2 * N * v) - v + u); y:=z / y; q:=trunc(y * 10000); if q mod 10 > 4 then inc(q, 10); q:=q div 10; write(q div 1000, '.', (q div 100) mod 10, (q div 10) mod 10, q mod 10); end.
4) <liquidation>
{$N+} program Liquidation; const nmax = 2000; limx = 25; eps = 0.000001; type current = extended; point = object x, y: current; procedure setPoint(xp,yp:current); end; procedure point.setPoint(xp,yp:current); begin x:=xp; y:=yp; end; var xN, yN, housz, tersz, mohsz, linezsz, i, living: longint; hou, ter, moh: array[1..nmax, 1..2] of longint; map: array[-limx..limx, -limx..limx] of longint; linez: array[1..nmax, 1..4] of longint; a1,a2,b1,b2,c: point; d, da, db: current; x1, y1, x2, y2: current; function ParallelIntersect(valx1, valy1, valx2, valy2, valx3, valy3, valx4, valy4: longint): boolean; var funcRes, flagxxx: boolean; xI: longint; begin funcRes:=true; if (valx1 < valx3) and (valx2 < valx4) then funcRes:=false; if (valx1 > valx3) and (valx2 > valx4) then funcRes:=false; if (valy1 < valy3) and (valy2 < valy4) then funcRes:=false; if (valy1 > valy3) and (valy2 > valy4) then funcRes:=false; if funcRes then begin if valy1 = valy3 then begin if valx1 > valx2 then begin xI:=valx1; valx1:=valx2; valx2:=xI; end; if valx3 > valx4 then begin xI:=valx3; valx3:=valx4; valx4:=xI; end; flagxxx:=(valx1 > valx3); if flagxxx then begin xI:=valx1; valx1:=valx3; valx3:=xI; xI:=valx2; valx2:=valx4; valx4:=xI; end; if valx2 < valx3 then funcRes:=false; end; if valx1 = valx3 then begin if valy1 > valy2 then begin xI:=valy1; valy1:=valy2; valy2:=xI; end; if valy3 > valy4 then begin xI:=valy3; valy3:=valy4; valy4:=xI; end; flagxxx:=(valy1 > valy3); if flagxxx then begin xI:=valy1; valy1:=valy3; valy3:=xI; xI:=valy2; valy2:=valy4; valy4:=xI; end; if valy2 < valy3 then funcRes:=false; end; end; ParallelIntersect:=funcRes; end; function checkIntersection:shortint; { returns 1 if there is one intersection point "c" 0 if chunks ar on parallel lines -1 if there are no intersection points } var d, da, db, ta, tb: current; begin d :=(a1.x-a2.x)*(b2.y-b1.y) - (a1.y-a2.y)*(b2.x-b1.x); da:=(a1.x-b1.x)*(b2.y-b1.y) - (a1.y-b1.y)*(b2.x-b1.x); db:=(a1.x-a2.x)*(a1.y-b1.y) - (a1.y-a2.y)*(a1.x-b1.x); if (abs(d)<eps) then checkIntersection:=0 else begin ta:=da/d; tb:=db/d; if (0<=ta) and (ta<=1) and (0<=tb) and (tb<=1) then begin c.setPoint(a1.x+ta*(a2.x-a1.x),a1.y+ta*(a2.y-a1.y)); checkIntersection:=1; end else checkIntersection:=-1; end; end; function GetKilledImproved(value: longint): boolean; var funcRes: boolean; xI, xJ: longint; begin x2:=ter[value, 1]; y2:=ter[value, 2]; a2.setPoint(x2, y2); funcRes:=true; for xI:=1 to linezsz do begin x1:=linez[xI, 1]; y1:=linez[xI, 2]; x2:=linez[xI, 3]; y2:=linez[xI, 4]; b1.setPoint(x1, y1); b2.setPoint(x2, y2); xJ:=checkIntersection; if xJ = 1 then begin funcRes:=false; break; end; if xJ = 0 then begin if ParallelIntersect(xN, yN, ter[value, 1], ter[value, 2], trunc(x1), trunc(y1), trunc(x2), trunc(y2)) then begin funcRes:=false; break; end; end; end; GetKilledImproved:=funcRes; end; function NodX(val1, val2: longint): longint; var funcRes, xI: longint; begin funcRes:=1; val1:=abs(val1); val2:=abs(val2); for xI:=2 to val1 do if (val1 mod xI = 0) and (val2 mod xI = 0) then funcRes:=xI; NodX:=funcRes; end; function GoodCoords(val1, val2: longint): boolean; begin if (val1 >= -limx) and (val1 <= limx) and (val2 >= -limx) and (val2 <= limx) then GoodCoords:=true else GoodCoords:=false; end; function GetKilled(value: longint): boolean; var funcRes: boolean; xz1, yz1, xz2, yz2, dzx, dzy, dzz, fzlag, xzI: longint; stepx, crx, cry: current; begin funcRes:=true; xz1:=xN; xz2:=ter[value, 1]; if xz1 > xN then fzlag:=0 else fzlag:=1; if fzlag = 0 then begin yz1:=ter[value, 2]; yz2:=yN; xz1:=ter[value, 1]; xz2:=xN; end else begin yz1:=yN; yz2:=ter[value, 2]; end; if yz1 < yz2 then fzlag:=0; if yz1 = yz2 then fzlag:=1; if yz1 > yz2 then fzlag:=2; case fzlag of 0: begin if xz1 = xz2 then begin for xzI:=yz1 to yz2 do if map[xzI, xz1] = 5 then funcRes:=false; end else begin dzx:=xz2 - xz1; dzy:=yz2 - yz1; dzz:=NodX(dzx, dzy); dzx:=dzx div dzz; dzy:=dzy div dzz; xzI:=1; while true do begin if GoodCoords(xz1 + (dzx * xzI), yz1 + (dzy * xzI)) then begin if xz1 + (dzx * xzI) > xz2 then break; if map[yz1 + (dzy * xzI), xz1 + (dzx * xzI)] = 5 then begin funcRes:=false; break; end; end else break; inc(xzI); end; crx:=xz1; cry:=yz1; if dzx < dzy then begin stepx:=dzx / dzy; while true do begin crx:=crx + stepx; cry:=cry + 1; if (map[round(cry), trunc(crx)] = 5) and (map[round(cry), trunc(crx) + 1] = 5) then begin funcRes:=false; break; end; if cry >= yz2 then break; end; end; if dzx > dzy then begin stepx:=dzy / dzx; while true do begin crx:=crx + 1; cry:=cry + stepx; if (map[trunc(cry), round(crx)] = 5) and (map[trunc(cry) + 1, round(crx)] = 5) then begin funcRes:=false; break; end; if crx >= xz2 then break; end; end; end; end; 1: begin for xzI:=xz1 to xz2 do if map[yz1, xzI] = 5 then funcRes:=false; end; 2: begin if xz1 = xz2 then begin for xzI:=yz2 to yz1 do if map[xzI, xz1] = 5 then funcRes:=false; end else begin dzx:=xz2 - xz1; dzy:=yz1 - yz2; dzz:=NodX(dzx, dzy); dzx:=dzx div dzz; dzy:=dzy div dzz; xzI:=1; while true do begin if GoodCoords(xz1 + (dzx * xzI), yz1 - (dzy * xzI)) then begin if xz1 + (dzx * xzI) > xz2 then break; if map[yz1 - (dzy * xzI), xz1 + (dzx * xzI)] = 5 then begin funcRes:=false; break; end; end else break; inc(xzI); end; crx:=xz1; cry:=yz1; if dzx < dzy then begin stepx:=dzx / dzy; while true do begin crx:=crx + stepx; cry:=cry - 1; if (map[round(cry), trunc(crx)] = 5) and (map[round(cry), trunc(crx) + 1] = 5) then begin funcRes:=false; break; end; if cry <= yz2 then break; end; end; if dzx > dzy then begin stepx:=dzy / dzx; while true do begin crx:=crx + 1; cry:=cry - stepx; if (map[trunc(cry), round(crx)] = 5) and (map[trunc(cry) + 1, round(crx)] = 5) then begin funcRes:=false; break; end; if crx >= xz2 then break; end; end; end; end; end; GetKilled:=funcRes; end; begin fillchar(map, sizeof(map), 0); read(xN); read(yN); x1:=xN; y1:=yN; linezsz:=0; a1.setPoint(x1,y1); map[yN, xN]:=9; read(tersz); living:=tersz; for i:=1 to tersz do begin read(ter[i, 1]); read(ter[i, 2]); map[ter[i, 2], ter[i, 1]]:=10; end; read(housz); mohsz:=0; for i:=1 to housz do begin read(hou[i, 1]); read(hou[i, 2]); inc(mohsz); moh[mohsz, 1]:=hou[i, 1]; moh[mohsz, 2]:=hou[i, 2]; inc(mohsz); moh[mohsz, 1]:=hou[i, 1] + 1; moh[mohsz, 2]:=hou[i, 2]; inc(mohsz); moh[mohsz, 1]:=hou[i, 1]; moh[mohsz, 2]:=hou[i, 2] + 1; inc(mohsz); moh[mohsz, 1]:=hou[i, 1] + 1; moh[mohsz, 2]:=hou[i, 2] + 1; inc(linezsz); linez[linezsz, 1]:=hou[i, 1]; linez[linezsz, 2]:=hou[i, 2]; linez[linezsz, 3]:=hou[i, 1] + 1; linez[linezsz, 4]:=hou[i, 2]; inc(linezsz); linez[linezsz, 1]:=hou[i, 1]; linez[linezsz, 2]:=hou[i, 2]; linez[linezsz, 3]:=hou[i, 1]; linez[linezsz, 4]:=hou[i, 2] + 1; inc(linezsz); linez[linezsz, 1]:=hou[i, 1] + 1; linez[linezsz, 2]:=hou[i, 2]; linez[linezsz, 3]:=hou[i, 1] + 1; linez[linezsz, 4]:=hou[i, 2] + 1; inc(linezsz); linez[linezsz, 1]:=hou[i, 1]; linez[linezsz, 2]:=hou[i, 2] + 1; linez[linezsz, 3]:=hou[i, 1] + 1; linez[linezsz, 4]:=hou[i, 2] + 1; end; for i:=1 to mohsz do map[moh[i, 2], moh[i, 1]]:=5; for i:=1 to tersz do if GetKilledImproved(i) then dec(living); writeln(living); end.
5) <newtower>
program NewTower; const nmax = 29; var arr: array[0..nmax] of longint; firstEl, allCount, blackCount, whiteCount: longint; i, n, m, resx: longint; function GradeX(grade: longint): longint; var funcRes, xI: longint; begin funcRes:=1; for xI:=1 to grade do inc(funcRes, funcRes); GradeX:=funcRes; end; function ParaX(val1, val2: longint): longint; begin if (val1 mod 2) = (val2 mod 2) then ParaX:=GradeX(val1) - GradeX(val2) else ParaX:=GradeX(val1) - GradeX(0); end; function AllEqual: boolean; var funcRes: boolean; xI: longint; begin funcRes:=true; for xI:=1 to allCount do if arr[xI] <> arr[xI - 1] then begin funcRes:=false; break; end; AllEqual:=funcRes; end; begin whiteCount:=0; blackCount:=0; read(allCount); for i:=0 to nmax do arr[i]:=2; for i:=allCount - 1 downto 0 do read(arr[i]); if allCount = 0 then write(0); if allCount = 1 then write(1); if allCount = 2 then begin if arr[0] = arr[1] then write(3) else write(2); end; if AllEqual then write(GradeX(allCount) - 1); if (allCount < 3) or (AllEqual) then halt(0); firstEl:=arr[allCount - 1]; i:=allCount - 2; while i >= 0 do begin if arr[i] <> firstEl then break; dec(i); end; resx:=0; N:=allCount - i - 1; if i <> 0 then begin if arr[i - 1] <> arr[i] then begin dec(i, 2); while i >= 0 do begin if arr[i] <> firstEl then break; dec(i); end; M:=allCount - N - i - 2; if firstEl = 1 then begin inc(blackCount, N + M); inc(whiteCount); end else begin inc(whiteCount, N + M); inc(blackCount); end; inc(resx, GradeX(N + M)); inc(i); for i:=i to allCount - 1 do arr[i]:=2; dec(allCount, N + M + 1); end; end; while arr[0] <> 2 do begin firstEl:=arr[allCount - 1]; i:=allCount - 2; while i >= 0 do begin if arr[i] <> firstEl then break; dec(i); end; N:=allCount - i - 1; if firstEl = 1 then begin inc(resx, ParaX(blackCount + N, blackCount)); inc(blackCount, N); end else begin inc(resx, ParaX(whiteCount + N, whiteCount)); inc(whiteCount, N); end; for i:=0 to N - 1 do arr[allCount - i - 1]:=2; dec(allCount, N); end; write(resx); end.
Відредаговано guest1 (2007-12-01 14:19:48)
Поза форумом
Задача Liquidation
Помогите разобраться, пожалуйста. У меня не проходит 10й тест, причем опытным путем установлено, что ответ там на 1 меньше, чем выдает моя программа.
При проверке пересечений идея следующая: берем прямую, содержащую Намцога и очередного террориста и для каждой точки дома считаем, с какой стороны прямой она лежит (или что лежит на прямой), но учитываем только точки, расположенные внутри прямоугольника, образованного Намцогом и террористом (если не лежит, то отрезок с одной из вершин в этой точке не пересечет исходный). В итоге, если есть точки с разных сторон, или на отрезке, пересечение присутствует, иначе нет.
{$APPTYPE CONSOLE} {$B-,R-,O+} const maxn=441; nummoves=4; moves:array[1..4,0..1] of smallint=((0,0),(1,0),(0,1),(1,1)); type point=record x,y:longint; end; var n,m,i,j:smallint; x,y:longint; a,h:array[1..maxn] of point; ans:smallint; aa,bb,cc:longint; num:array[-1..1] of smallint; function sign(a:longint):smallint; begin if a>0 then sign:=1 else if a<0 then sign:=-1 else sign:=0; end; function min(a,b:smallint):smallint; begin if a<b then min:=a else min:=b; end; function max(a,b:smallint):smallint; begin if a>b then max:=a else max:=b; end; function cross(man,house:smallint):boolean; var i,s:smallint; begin aa:=a[man].y-y; bb:=x-a[man].x; cc:=-x*a[man].y+y*a[man].x; fillchar(num,sizeof(num),0); for i:=1 to nummoves do begin s:=sign(aa*(h[house].x+moves[i,0])+bb*(h[house].y+moves[i,1])+cc); if ((h[house].x+moves[i,0]>=min(x,a[man].x))and(h[house].x+moves[i,0]<=max(x,a[man].x))or (h[house].y+moves[i,1]>=min(y,a[man].y))and(h[house].y+moves[i,1]<=max(y,a[man].y)))then inc(num[s]); end; cross:=(not((num[0]=0)and(not((num[-1]>0)and(num[1]>0))))); end; begin read(x,y,n); for i:=1 to n do read(a[i].x,a[i].y); read(m); for i:=1 to m do read(h[i].x,h[i].y); ans:=0; for i:=1 to n do begin j:=1; while (j<=m)and(not cross(i,j))do inc(j); if j<=m then inc(ans); end; writeln(ans); end.
Поза форумом
To Partisan:
Если поможет, вот один из вариантов, когда программа выдает неправильный результат.
Координаты Намцога 10 10.
Домов всего 10 штук, координаты их левых нижних углов:
[1 4] [2 17] [3 7] [4 5] [5 15] [6 14] [7 12] [8 7] [9 4] [10 14]
А вот террористы, которые должны бы умереть, но в Вашей программе они выживают:
[10 6] [10 7] [10 8] [10 9] [10 11] [10 12] [10 13]
В формулах не разобрался, после недельного отдыха это трудновато
Поза форумом
guest1 написав:
To Partisan:
Если поможет, вот один из вариантов, когда программа выдает неправильный результат.
Координаты Намцога 10 10.
Домов всего 10 штук, координаты их левых нижних углов:
[1 4] [2 17] [3 7] [4 5] [5 15] [6 14] [7 12] [8 7] [9 4] [10 14]
А вот террористы, которые должны бы умереть, но в Вашей программе они выживают:
[10 6] [10 7] [10 8] [10 9] [10 11] [10 12] [10 13]
В формулах не разобрался, после недельного отдыха это трудновато
Большое спасибо! Нашел глюк, такие нормально ищутся в отдохнувшем состоянии преверкой "а что собственно я написал?", если нету тестов: В проверке принадлежности прямоугольника поставил or вместо and, еще и не видно за экраном.
Поза форумом