На форумі обговорюються лише питання, пов'язані з олімпіадою
Ви не зайшли.
пардон - удалил первое сообщение и провтыкал что удаляется тема
востанавливаем:
Відредаговано redman17 (2009-01-21 00:12:18)
Поза форумом
По лампплюсу просветите кто-то пжлст
хотя если мое "долгоиграющее" решение наберет приличненько - обязательно поделюсь
Поза форумом
А третья таки прекалком
Ответы выложи на неё, пожалуйста (для сравнения).
Опять же, мой Treasure, с поиском пересечения отрезков и поиском в ширину.
{$N+} program Treasure; const xmax = 1000; eps = 0.000001; type current = extended; ptx = object x, y: current; procedure SetPoint(xp, yp: current); end; var pts: array[1..xmax, 1..2] of current; con: array[1..xmax, 0..xmax] of longint; ovx, nvx: array[0..xmax] of longint; dix: array[0..xmax] of current; N, i, j, ptscount: longint; procedure ptx.SetPoint(xp, yp: current); begin x:=xp; y:=yp; end; function DistX(val1, val2: longint): current; begin DistX:=sqrt(sqr(pts[val1, 1] - pts[val2, 1]) + sqr(pts[val1, 2] - pts[val2, 2])); end; procedure SolveX; var xI, xJ: longint; xK: current; begin fillchar(nvx, sizeof(nvx), 0); for xI:=1 to ptscount do if ovx[xI] > 0 then begin for xJ:=1 to con[xI, 0] do begin nvx[con[xI, xJ]]:=1; xK:=dix[xI] + DistX(xI, con[xI, xJ]); if dix[con[xI, xJ]] > xK then dix[con[xI, xJ]]:=xK; end; end; for xI:=1 to ptscount do ovx[xI]:=nvx[xI]; end; procedure IntersectX(ax1, ay1, ax2, ay2, bx1, by1, bx2, by2: longint); var xI, xQ: longint; flag: boolean; a1, a2, b1, b2, c: ptx; 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; 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 (ta >= 0) and (ta <= 1) and (tb >= 0) 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; begin flag:=(ax1 > ax2); if flag then begin xI:=ax1; ax1:=ax2; ax2:=xI; xI:=ay1; ay1:=ay2; ay2:=xI; end; flag:=(bx1 > bx2); if flag then begin xI:=bx1; bx1:=bx2; bx2:=xI; xI:=by1; by1:=by2; by2:=xI; end; a1.SetPoint(ax1, ay1); a2.SetPoint(ax2, ay2); b1.SetPoint(bx1, by1); b2.SetPoint(bx2, by2); c.SetPoint(-maxlongint, 0); xQ:=CheckIntersection; if xQ = 0 then begin flag:=ParallelIntersect(ax1, ay1, ax2, ay2, bx1, by1, bx2, by2); if flag then begin if ax1 >= bx1 then c.SetPoint(ax1, ay1) else c.SetPoint(bx1, by1); end; end; if c.x <> -maxlongint then begin inc(ptscount); pts[ptscount, 1]:=c.x; pts[ptscount, 2]:=c.y; con[ptscount, 0]:=4; con[ptscount, 1]:=i; con[ptscount, 2]:=i + 1; con[ptscount, 3]:=j; con[ptscount, 4]:=j + 1; inc(con[i, 0]); con[i, con[i, 0]]:=ptscount; inc(con[i + 1, 0]); con[i + 1, con[i + 1, 0]]:=ptscount; inc(con[j, 0]); con[j, con[j, 0]]:=ptscount; inc(con[j + 1, 0]); con[j + 1, con[j + 1, 0]]:=ptscount; end; end; begin fillchar(con, sizeof(con), 0); fillchar(ovx, sizeof(ovx), 0); for N:=0 to xmax do begin ovx[N]:=0; nvx[N]:=0; dix[N]:=maxlongint; end; read(N); ptscount:=N + 1; ovx[0]:=1; ovx[1]:=1; dix[1]:=0; for i:=1 to N + 1 do read(pts[i, 1], pts[i, 2]); con[1, 0]:=1; con[1, 1]:=2; con[N + 1, 0]:=1; con[N + 1, 1]:=N; for i:=2 to N do begin con[i, 0]:=2; con[i, 1]:=i - 1; con[i, 2]:=i + 1; end; for i:=1 to N - 2 do for j:=i + 2 to N do IntersectX(round(pts[i, 1]), round(pts[i, 2]), round(pts[i + 1, 1]), round(pts[i + 1, 2]), round(pts[j, 1]), round(pts[j, 2]), round(pts[j + 1, 1]), round(pts[j + 1, 2])); for i:=1 to 3 * N do SolveX; writeln(dix[N + 1]); end.
Поза форумом
NEWCALC
Возможно я и провтыкал оптимальное решение, но нормально организованый перебор с некоторыми усечениями дает вполне приемлемый результат. Итак:
- будем искать кол-во отдельных цифр в искомом числе, сортировать и выдавать ответ
- легко заметить что тут например цифры 2,3,5,... - это одно и то же кол-во полосок так что их не следует рассматривать отдельно
- если не выполняется 2n<=k<=7n то ответ NO SOLUTION
- аккуратно прописываем минимум - там ноль не может быть в начале
если что не понятно - пишите мо что-то забыл
{$I-,Q-,R-,S-} program newcalc; const dd:array[0..15] of longint = (6,2,5,5,4,5,6,3,7,6,6,5,4,5,5,4); symb:array[0..15] of char = ('0','1','2','3','4','5','6','7', '8','9','A','b','C','d','E','F'); max_num=maxlongint div 2; type spt1=array[1..10,1..2] of longint; spt2=array[0..15] of longint; var n,k,p,i,j,minq,minl,minr,maxq,maxl,maxr:longint; amin,amax,minlr,maxlr:spt1; void:boolean; ans_min,ans_max:spt2; function min(a,b:longint):longint; begin if a<b then min:=a else min:=b; end; function max(a,b:longint):longint; begin if a>b then max:=a else max:=b; end; procedure sort(var a:spt1; k:longint; var q:longint; var lr:spt1); var i,j,t,m:longint; begin for i:=1 to 9 do begin m:=i; for j:=i+1 to 10 do if k*(a[j,2]-a[m,2])<0 then m:=j; t:=a[i,1]; a[i,1]:=a[m,1]; a[m,1]:=t; t:=a[i,2]; a[i,2]:=a[m,2]; a[m,2]:=t; end; q:=10; while abs(a[q,2])=max_num do q:=q-1; lr[q,1]:=a[q,1]; lr[q,2]:=a[q,1]; for i:=q-1 downto 1 do begin if a[i,1]<lr[i+1,1] then lr[i,1]:=a[i,1] else lr[i,1]:=lr[i+1,1]; if a[i,1]>lr[i+1,2] then lr[i,2]:=a[i,1] else lr[i,2]:=lr[i+1,2]; end; end; function get_num(a:spt1; q:longint; lr:spt1; k,n:longint; var ans:spt2; zero_flag:boolean):boolean; var find_ans:boolean; res:spt2; procedure rec(i,fn,fk:longint; r:spt2); var j:longint; begin if find_ans then exit; if i>q then begin if (fn=n) and (fk=k) and ((r[0]<>n) or (n=0) or zero_flag) then begin find_ans:=true; ans:=r; end; exit; end; if (fn>n) or (fk>k) then exit; if ((n-fn)*lr[i,1]>k-fk) then exit; if ((n-fn)*lr[i,2]<k-fk) then exit; j:=n-fn; while (j*a[i,1]+fk>k) and (j>=0) do j:=j-1; while (j>=0) do begin r[a[i,2]]:=j; rec(i+1,fn+j,fk+j*a[i,1],r); if find_ans then exit; j:=j-1; end; end; begin fillchar(res,sizeof(res),0); find_ans:=false; rec(1,0,0,res); get_num:=find_ans; end; begin read(n,k,p); for i:=1 to 10 do begin amin[i,1]:=i; amin[i,2]:=max_num; amax[i,1]:=i; amax[i,2]:=-max_num; end; amin[1,1]:=6; amin[1,2]:=0; amax[1,1]:=6; amax[1,2]:=0; for i:=1 to p-1 do begin amin[dd[i],2]:=min(amin[dd[i],2],i); amax[dd[i],2]:=max(amax[dd[i],2],i); end; sort(amin,1,minq,minlr); sort(amax,-1,maxq,maxlr); i:=1; repeat i:=i+1; void:=get_num(amin,minq,minlr,k-dd[amin[i,2]],n-1,ans_min,TRUE); until void or (i>=minq); inc(ans_min[amin[i,2]]); if void then begin void:=get_num(amax,maxq,maxlr,k,n,ans_max,FALSE); i:=1; while ans_min[i]=0 do i:=i+1; write(symb[i]); dec(ans_min[i]); for i:=0 to 15 do for j:=1 to ans_min[i] do write(symb[i]); write(' '); for i:=15 downto 0 do for j:=1 to ans_max[i] do write(symb[i]); end else write('NO SOLUTION'); end.
Поза форумом
STREAMER
Один из бесчисленного множества способов решить эту задачу - посчитать площадь пересечения многоугольника справа от прямой перегиба и того что был слева, отраженного симетрично
Главное - ничего не провтыкать (как и в любой геометрии):
{$I-,Q-,R-,S-} program streamer; const mn=100; eps=1e-4; type extended=double; point_type=record x,y:extended; end; line_type=record a,b,c:extended; p1,p2:point_type; alfa:extended; end; polygon_type=record n:longint; ln:array[1..mn] of line_type; pt:array[1..mn+1] of point_type; end; points_array_type=record m:longint; pat:array[1..mn+1] of point_type; end; var a,b,x,y,s:extended; r1,r2,r:polygon_type; ml:line_type; v,w:point_type; i,np,j:longint; ap:points_array_type; function min(a,b:extended):extended; begin if a-b<-eps then min:=a else min:=b; end; function max(a,b:extended):extended; begin if a-b>eps then max:=a else max:=b; end; procedure two_points_to_line(p1,p2:point_type; var l:line_type); begin l.p1:=p1; l.p2:=p2; l.a:=p2.y-p1.y; l.b:=p1.x-p2.x; l.c:=p1.x*(p1.y-p2.y)+p1.y*(p2.x-p1.x); if abs(l.b)<=eps then l.alfa:=pi/2 else l.alfa:=arctan(-l.a/l.b); end; procedure complete_polygon(var r:polygon_type); var i,j:longint; begin with r do begin pt[n+1]:=pt[1]; i:=1; while i<=n do begin if (abs(pt[i].x-pt[i+1].x)<=eps) and (abs(pt[i].y-pt[i+1].y)<=eps) then begin for j:=i+1 to n do pt[j]:=pt[j+1]; pt[n+1].x:=0; pt[n+1].y:=0; n:=n-1; end else begin two_points_to_line(pt[i],pt[i+1],ln[i]); i:=i+1; end; end; end; end; function dst_point_line(p:point_type; l:line_type):extended; begin dst_point_line:=abs(l.a*p.x+l.b*p.y+l.c)/sqrt(l.a*l.a+l.b*l.b); end; function inside(p:point_type):boolean; begin if (p.x-a<=eps) and (p.y>=-eps) and (p.y-b<=eps) then inside:=true else inside:=false; end; function eqP(p1,p2:point_type):boolean; begin eqP:=(abs(p1.x-p2.x)<=eps) and (abs(p1.y-p2.y)<=eps); end; procedure get_symmetry(x,y:extended;sl:line_type;var p:point_type); var p0:point_type; d,dx,dy:extended; kx,ky:longint; begin p0.x:=x; p0.y:=y; d:=dst_point_line(p0,sl); dx:=abs(2*d*sin(sl.alfa)); dy:=abs(2*d*cos(sl.alfa)); for kx:=-1 to 1 do for ky:=-1 to 1 do begin p.x:=p0.x+kx*dx; p.y:=p0.y+ky*dy; if (abs(sl.a*(p.x+p0.x)+sl.b*(p.y+p0.y)+2*sl.c)<=eps) and (kx<>0) and (ky<>0) then exit; end; end; procedure in_outside_points_polygon(l:line_type; var p:point_type); var z:point_type; minx,maxx:extended; begin minx:=min(l.p1.x,l.p2.x); maxx:=max(l.p1.x,l.p2.x); if abs(l.a)<=eps then begin if l.p1.x<=l.p2.x then p.x:=l.p1.x else p.x:=l.p2.x; p.y:=-l.c/l.b; if (abs(p.y-b)<=eps) and (p.x-a<=eps) and (p.x-minx>=-eps) and (p.x-maxx<=eps) then begin z:=p; if (not eqP(p,l.p1)) and (not eqP(p,l.p2)) then exit; end; p.x:=a; p.y:=-l.c/l.b; if (p.y>=-eps) and (p.y-b<=eps) and ((l.p1.x-p.x)*(l.p2.x-p.x)<=eps) and (p.x-minx>=-eps) and (p.x-maxx<=eps) then begin z:=p; if (not eqP(p,l.p1)) and (not eqP(p,l.p2)) then exit; end; if l.p1.x<=l.p2.x then p.x:=l.p1.x else p.x:=l.p2.x; p.y:=0; if (abs(-l.c/l.b)<=eps) and (p.x-a<=eps) and (p.x-minx>=-eps) and (p.x-maxx<=eps) then begin z:=p; if (not eqP(p,l.p1)) and (not eqP(p,l.p2)) then exit; end; end else if abs(l.b)<=eps then begin p.x:=-l.c/l.a; p.y:=b; if (p.x-x>=-eps) and (p.x-a<=eps) and ((l.p1.y-p.y)*(l.p2.y-p.y)<=eps) and (p.x-minx>=-eps) and (p.x-maxx<=eps) then begin z:=p; if (not eqP(p,l.p1)) and (not eqP(p,l.p2)) then exit; end; p.x:=a; if l.p1.y<=l.p2.y then p.y:=l.p1.y else p.y:=l.p2.y; if (abs(-l.c/l.a-p.x)<=eps) and (p.y-b<=eps) and (p.x-minx>=-eps) and (p.x-maxx<=eps) then begin z:=p; if (not eqP(p,l.p1)) and (not eqP(p,l.p2)) then exit; end; p.x:=-l.c/l.a; p.y:=0; if (p.x-y>=-eps) and (p.x-a<=eps) and (l.p1.y*l.p2.y<=eps) and (p.x-minx>=-eps) and (p.x-maxx<=eps) then begin z:=p; if (not eqP(p,l.p1)) and (not eqP(p,l.p2)) then exit; end; end else begin p.x:=-(l.b*b+l.c)/l.a; p.y:=b; if (p.x-x>=-eps) and (p.x-a<=eps) and (p.x-minx>=-eps) and (p.x-maxx<=eps) then begin z:=p; if (not eqP(p,l.p1)) and (not eqP(p,l.p2)) then exit; end; p.x:=a; p.y:=-(l.a*a+l.c)/l.b; if (p.y>=-eps) and (p.y-b<=eps) and (p.x-minx>=-eps) and (p.x-maxx<=eps) then begin z:=p; if (not eqP(p,l.p1)) and (not eqP(p,l.p2)) then exit; end; p.x:=-l.c/l.a; p.y:=0; if (p.x-y>=-eps) and (p.x-a<=eps) and (p.x-minx>=-eps) and (p.x-maxx<=eps) then begin z:=p; if (not eqP(p,l.p1)) and (not eqP(p,l.p2)) then exit; end; end; p:=z; end; function outside_points_polygon(l:line_type; var ap:points_array_type):longint; var minx,maxx:extended; p:point_type; begin minx:=min(l.p1.x,l.p2.x); maxx:=max(l.p1.x,l.p2.x); ap.m:=0; if abs(l.a)<=eps then begin if l.p1.x<=l.p2.x then p.x:=l.p1.x else p.x:=l.p2.x; p.y:=-l.c/l.b; if (abs(p.y-b)<=eps) and (p.x-a<=eps) and (p.x-minx>=-eps) and (p.x-maxx<=eps) then begin if (not eqP(p,l.p1)) and (not eqP(p,l.p2)) then begin inc(ap.m); ap.pat[ap.m]:=p; end; end; p.x:=a; p.y:=-l.c/l.b; if (p.y>=-eps) and (p.y-b<=eps) and ((l.p1.x-p.x)*(l.p2.x-p.x)<=eps) and (p.x-minx>=-eps) and (p.x-maxx<=eps) then begin if (not eqP(p,l.p1)) and (not eqP(p,l.p2)) then begin inc(ap.m); ap.pat[ap.m]:=p; end; end; if l.p1.x<=l.p2.x then p.x:=l.p1.x else p.x:=l.p2.x; p.y:=0; if (abs(-l.c/l.b)<=eps) and (p.x-a<=eps) and (p.x-minx>=-eps) and (p.x-maxx<=eps) then begin if (not eqP(p,l.p1)) and (not eqP(p,l.p2)) then begin inc(ap.m); ap.pat[ap.m]:=p; end; end; end else if abs(l.b)<=eps then begin p.x:=-l.c/l.a; p.y:=b; if (p.x-x>=-eps) and (p.x-a<=eps) and ((l.p1.y-p.y)*(l.p2.y-p.y)<=eps) and (p.x-minx>=-eps) and (p.x-maxx<=eps) then begin if (not eqP(p,l.p1)) and (not eqP(p,l.p2)) then begin inc(ap.m); ap.pat[ap.m]:=p; end; end; p.x:=a; if l.p1.y<=l.p2.y then p.y:=l.p1.y else p.y:=l.p2.y; if (abs(-l.c/l.a-p.x)<=eps) and (p.y-b<=eps) and (p.x-minx>=-eps) and (p.x-maxx<=eps) then begin if (not eqP(p,l.p1)) and (not eqP(p,l.p2)) then begin inc(ap.m); ap.pat[ap.m]:=p; end; end; p.x:=-l.c/l.a; p.y:=0; if (p.x-y>=-eps) and (p.x-a<=eps) and (l.p1.y*l.p2.y<=eps) and (p.x-minx>=-eps) and (p.x-maxx<=eps) then begin if (not eqP(p,l.p1)) and (not eqP(p,l.p2)) then begin inc(ap.m); ap.pat[ap.m]:=p; end; end; end else begin p.x:=-(l.b*b+l.c)/l.a; p.y:=b; if (p.x-x>=-eps) and (p.x-a<=eps) and (p.x-minx>=-eps) and (p.x-maxx<=eps) then begin if (not eqP(p,l.p1)) and (not eqP(p,l.p2)) then begin inc(ap.m); ap.pat[ap.m]:=p; end; end; p.x:=a; p.y:=-(l.a*a+l.c)/l.b; if (p.y>=-eps) and (p.y-b<=eps) and (p.x-minx>=-eps) and (p.x-maxx<=eps) then begin if (not eqP(p,l.p1)) and (not eqP(p,l.p2)) then begin inc(ap.m); ap.pat[ap.m]:=p; end; end; p.x:=-l.c/l.a; p.y:=0; if (p.x-y>=-eps) and (p.x-a<=eps) and (p.x-minx>=-eps) and (p.x-maxx<=eps) then begin if (not eqP(p,l.p1)) and (not eqP(p,l.p2)) then begin inc(ap.m); ap.pat[ap.m]:=p; end; end; end; outside_points_polygon:=ap.m; end; function Spolygon(r:polygon_type):extended; var i:longint; s:extended; begin s:=0; for i:=1 to r.n do s:=s+(r.pt[i].y+r.pt[i+1].y)*(r.pt[i+1].x-r.pt[i].x)/2; Spolygon:=abs(s); end; begin read(a,b,x,y); ml.p1.x:=x; ml.p1.y:=b; ml.p2.x:=y; ml.p2.y:=0; two_points_to_line(ml.p1,ml.p2,ml); with r1 do begin n:=4; pt[1].x:=x; pt[1].y:=b; pt[2].x:=a; pt[2].y:=b; pt[3].x:=a; pt[3].y:=0; pt[4].x:=y; pt[4].y:=0; end; complete_polygon(r1); with r2 do begin n:=4; pt[1].x:=x; pt[1].y:=b; get_symmetry(0,b,ml,pt[2]); get_symmetry(0,0,ml,pt[3]); pt[4].x:=y; pt[4].y:=0; end; complete_polygon(r2); r.n:=1; r.pt[1]:=ml.p1; i:=2; while i<=r2.n do begin if inside(r2.pt[i]) then begin r.n:=r.n+1; r.pt[r.n]:=r2.pt[i]; i:=i+1; end else begin in_outside_points_polygon(r2.ln[i-1],v); r.n:=r.n+1; r.pt[r.n]:=v; i:=i+1; while not inside(r2.pt[i]) do begin np:=outside_points_polygon(r2.ln[i-1],ap); for j:=1 to np do begin r.n:=r.n+1; r.pt[r.n]:=ap.pat[j]; v:=ap.pat[j]; end; i:=i+1; end; in_outside_points_polygon(r2.ln[i-1],w); if (abs(v.y-b)<=eps) and (abs(w.x-a)<=eps) then begin r.n:=r.n+1; r.pt[r.n]:=r1.pt[2]; end else if (abs(v.x-a)<=eps) and (abs(w.y)<=eps) then begin r.n:=r.n+1; r.pt[r.n]:=r1.pt[3]; end else if (abs(v.y-b)<=eps) and (abs(w.y)<=eps) then begin r.n:=r.n+1; r.pt[r.n]:=r1.pt[2]; r.n:=r.n+1; r.pt[r.n]:=r1.pt[3]; end; r.n:=r.n+1; r.pt[r.n]:=w; end; end; complete_polygon(r); s:=a*b-Spolygon(r); write(s); end.
Поза форумом
TETRIS
Если посидеть и пописать получим такую формулу:
....
....
**.. /это левый конец с квадратиком
**..
h[x]=2h[x-2]+p[x-3]+p[x-5]+h[x-6]
....
....
.... /это левый конец пустой
....
p[x]=2h[x-1]+2p[x-2]+2h[x-3]+4p[x-4]+2p[x-6]
Осталось не забыть по длиную арифметику (и кстати p[2n+1]=0):
{$I-,Q-,R-,S-} program tetris; const mn=50; type bn=array[0..mn] of integer; var i,j,n:longint; p,h:array[0..6] of bn; ph:array[0..6] of integer; procedure sum(a,b:bn; var c:bn); var i,p:longint; begin i:=1; p:=0; while (i<=a[0]) or (i<=b[0]) or (p>0) do begin c[i]:=(a[i]+b[i]+p) mod 10; p:=(a[i]+b[i]+p) div 10; i:=i+1; end; c[0]:=i-1; end; procedure mul(a:bn; k:longint; var c:bn); var i,p:longint; begin i:=1; p:=0; while (i<=a[0]) or (p>0) do begin c[i]:=(a[i]*k+p) mod 10; p:=(a[i]*k+p) div 10; i:=i+1; end; c[0]:=i-1; end; begin read(n); fillchar(p,sizeof(p),0); fillchar(h,sizeof(h),0); for i:=0 to 6 do ph[i]:=i; p[0][0]:=1; p[0][1]:=1; if n mod 2=1 then n:=1; for i:=1 to n do begin for j:=0 to 6 do ph[j]:=(ph[j]+6) mod 7; for j:=0 to h[ph[0]][0] do h[ph[0]][j]:=0; sum(h[ph[2]],h[ph[2]],h[ph[0]]); sum(h[ph[0]],p[ph[3]],h[ph[0]]); sum(h[ph[0]],p[ph[5]],h[ph[0]]); sum(h[ph[0]],h[ph[6]],h[ph[0]]); for j:=0 to p[ph[0]][0] do p[ph[0]][j]:=0; mul(p[ph[4]],2,p[ph[0]]); sum(p[ph[0]],h[ph[1]],p[ph[0]]); sum(p[ph[0]],p[ph[2]],p[ph[0]]); sum(p[ph[0]],h[ph[3]],p[ph[0]]); sum(p[ph[0]],p[ph[6]],p[ph[0]]); mul(p[ph[0]],2,p[ph[0]]); end; if p[ph[0]][0]=0 then p[ph[0]][0]:=1; for i:=p[ph[0]][0] downto 1 do write(p[ph[0]][i]); end.
Поза форумом
TREASURE
..."смесь бульдога с носорогом" (с)
если серъезно сместь геометрии c теорией графов:
- геометрия : найти точки пересечения отрезков (опять же *геометрия* - не втыкаем например когда отрезки накладываются)
- например Дейкстрой найти путь от 1 до n+1 точки (тут уже проще)
{$I-,Q-,R-,S-} program treasure; type point_type=record x,y:extended; end; line_type=record a,b,c:extended; p1,p2:point_type; end; arrpoint_type=array [1..10] of point_type; const mn=30; mm=3000; max_num=1e100; eps=1e-4; var i,j,n,m,k,szq,iq,start,ii:longint; p:array[1..mn+1] of point_type; d:array[1..mm,1..mm] of extended; l:array[1..mn] of line_type; dA:array[1..mm] of byte; dB:array[1..mm] of extended; dC:array[1..mm] of longint; w,w1,w2:extended; q:arrpoint_type; procedure two_points_to_line(p1,p2:point_type; var l:line_type); begin l.a:=p2.y-p1.y; l.b:=p1.x-p2.x; l.c:=p1.x*(p1.y-p2.y)+p1.y*(p2.x-p1.x); l.p1:=p1; l.p2:=p2; end; function dst(p1,p2:point_type):extended; begin dst:=sqrt(sqr(p1.x-p2.x)+sqr(p1.y-p2.y)); end; function min(a,b:extended):extended; begin if a<b then min:=a else min:=b; end; function max(a,b:extended):extended; begin if a>b then max:=a else max:=b; end; function cross(l1,l2:line_type;var q:arrpoint_type):longint; var r:extended; fq:point_type; szq:longint; begin r:=l1.b*l2.a-l1.a*l2.b; if abs(r)>eps then begin q[1].y:=(l1.a*l2.c-l1.c*l2.a)/r; q[1].x:=(l1.c*l2.b-l1.b*l2.c)/r; if (q[1].x>=min(l1.p1.x,l1.p2.x)) and (q[1].x<=max(l1.p1.x,l1.p2.x)) and (q[1].x>=min(l2.p1.x,l2.p2.x)) and (q[1].x<=max(l2.p1.x,l2.p2.x)) and (q[1].y>=min(l1.p1.y,l1.p2.y)) and (q[1].y<=max(l1.p1.y,l1.p2.y)) and (q[1].y>=min(l2.p1.y,l2.p2.y)) and (q[1].y<=max(l2.p1.y,l2.p2.y)) then cross:=1 else cross:=0 end else begin szq:=0; fq.x:=l1.p1.x; fq.y:=l1.p1.y; if (fq.x>=min(l1.p1.x,l1.p2.x)) and (fq.x<=max(l1.p1.x,l1.p2.x)) and (fq.x>=min(l2.p1.x,l2.p2.x)) and (fq.x<=max(l2.p1.x,l2.p2.x)) and (fq.y>=min(l1.p1.y,l1.p2.y)) and (fq.y<=max(l1.p1.y,l1.p2.y)) and (fq.y>=min(l2.p1.y,l2.p2.y)) and (fq.y<=max(l2.p1.y,l2.p2.y)) then begin inc(szq); q[szq]:=fq; end; fq.x:=l1.p2.x; fq.y:=l1.p2.y; if (fq.x>=min(l1.p1.x,l1.p2.x)) and (fq.x<=max(l1.p1.x,l1.p2.x)) and (fq.x>=min(l2.p1.x,l2.p2.x)) and (fq.x<=max(l2.p1.x,l2.p2.x)) and (fq.y>=min(l1.p1.y,l1.p2.y)) and (fq.y<=max(l1.p1.y,l1.p2.y)) and (fq.y>=min(l2.p1.y,l2.p2.y)) and (fq.y<=max(l2.p1.y,l2.p2.y)) then begin inc(szq); q[szq]:=fq; end; fq.x:=l2.p1.x; fq.y:=l2.p1.y; if (fq.x>=min(l1.p1.x,l1.p2.x)) and (fq.x<=max(l1.p1.x,l1.p2.x)) and (fq.x>=min(l2.p1.x,l2.p2.x)) and (fq.x<=max(l2.p1.x,l2.p2.x)) and (fq.y>=min(l1.p1.y,l1.p2.y)) and (fq.y<=max(l1.p1.y,l1.p2.y)) and (fq.y>=min(l2.p1.y,l2.p2.y)) and (fq.y<=max(l2.p1.y,l2.p2.y)) then begin inc(szq); q[szq]:=fq; end; fq.x:=l2.p2.x; fq.y:=l2.p2.y; if (fq.x>=min(l1.p1.x,l1.p2.x)) and (fq.x<=max(l1.p1.x,l1.p2.x)) and (fq.x>=min(l2.p1.x,l2.p2.x)) and (fq.x<=max(l2.p1.x,l2.p2.x)) and (fq.y>=min(l1.p1.y,l1.p2.y)) and (fq.y<=max(l1.p1.y,l1.p2.y)) and (fq.y>=min(l2.p1.y,l2.p2.y)) and (fq.y<=max(l2.p1.y,l2.p2.y)) then begin inc(szq); q[szq]:=fq; end; cross:=szq; end; end; begin read(n); for i:=1 to n+1 do read(p[i].x,p[i].y); for i:=1 to n+1 do begin for j:=1 to n+1 do d[i,j]:=max_num; d[i,i]:=0; end; m:=n+1; start:=n+1; for i:=1 to n do begin two_points_to_line(p[i],p[i+1],l[i]); w:=dst(p[i],p[i+1]); d[i,i+1]:=w; d[i+1,i]:=w; for j:=1 to i-2 do begin szq:=cross(l[i],l[j],q); for iq:=1 to szq do begin m:=m+1; for ii:=1 to m do begin d[ii,m]:=max_num; d[m,ii]:=max_num; end; d[m,m]:=0; w1:=dst(q[iq],p[i]); w2:=dst(q[iq],p[i+1]); d[m,i]:=w1; d[i,m]:=w1; d[m,i+1]:=w2; d[i+1,m]:=w2; w1:=dst(q[iq],p[j]); w2:=dst(q[iq],p[j+1]); d[m,j]:=w1; d[j,m]:=w1; d[m,j+1]:=w2; d[j+1,m]:=w2; end; end; end; dA[start]:=1; for i:=1 to m do begin dB[i]:=d[start,i]; dC[i]:=start; end; while dA[1]=0 do begin w:=max_num; for k:=1 to m do if (dA[k]=0) and (dB[k]<w) then begin j:=k; w:=dB[k] end; dA[j]:=1; for k:=1 to m do begin if (dB[j]+d[j,k]<dB[k]) and (dA[k]=0) then begin dB[k]:=dB[j]+d[j,k]; dC[k]:=j; end; end; end; w:=dB[1]; write(w); end.
Поза форумом
готов к конструктивной дискусии
по поводу улучшений
и непоняток
только отвечать уже завтра будо
а сейчас *после долгий дней и ночей упорных трудов* - спать
Поза форумом
Честно говоря, не понял, как получилась такая простая динамика в тетрисе. Я над одним лишь переходом сидел около пяти часов. В итоге вывел дерево зависимости для K заполненых полностью рядов с выступами не более, чем на две позиции, от K-1 заполненых полностью рядов с выступами не более, чем на две позиции. То есть бред. Все равно запостил решение caseом))
Поза форумом
Я тетріс рішав динамікою по краю...
ось тут(пример 2) http://ips.ifmo.ru/courses/course1/chG/l7/index.html
є сама ідея...
Звісно тестріс солідно ускладнена від тієї задачі що у прикладі....але сама ідея паше...
Одне - це грамотно і швидко написати довгу...
Відредаговано ZuTa (2009-01-21 14:44:03)
Поза форумом
Я тоже сделал Tetris динамикой по краю(профилю). На моем компе макс. тест работал 0,01 сек. Но все равно отправил массив констант, ограничения ведь небольшие, да и половина возможных тестов-ответ 0. Скажите ответы для n=8, и n=10 у меня получилось 182 и 790.
Поза форумом
да 8 - 182; 10 - 790
но самый интересный тест - 50:
4562636060668666
Поза форумом
redman17 написав:
да 8 - 182; 10 - 790
но самый интересный тест - 50:
4562636060668666
Эти ответы твоя динамика выдала? Если честно не думал что она правильная. Вернее не предполагал как эту задачу делать без профилей. И теперь макс. Тест - ответ:40878963711143476874191412799254
Поза форумом
Seyaua написав:
Если честно не думал что она правильная. Вернее не предполагал как эту задачу делать без профилей. И теперь макс. Тест - ответ:40878963711143476874191412799254
Обидел ты меня (и я тебя чуть-чуть))))
Как ни странно мой - 40878963711143476874191412799254.
Відредаговано redman17 (2009-01-21 15:02:52)
Поза форумом
http://www2.olymp.vinnica.ua/cgi-bin/v_ … nguage=ukr
Балы за 1-3 тур будут после проверки!!!
Відредаговано salyony (2009-01-21 15:29:20)
Поза форумом
Seyaua написав:
В моем сообщение там должен стоять не смайлик а '='. Опять же эти формулы...
нажми на своем посте "редактировать" и внизу увидишь:
Свойства
Не показывать текстовые смайлики в виде графических изображений в этом сообщении
Поза форумом
redman17 написав:
TETRIS
Если посидеть и пописать получим такую формулу:
....
....
**.. /это левый конец с квадратиком
**..
h[x]=2h[x-2]+p[x-3]+p[x-5]+h[x-6]
....
....
.... /это левый конец пустой
....
p[x]=2h[x-1]+2p[x-2]+2h[x-3]+4p[x-4]+2p[x-6]
Я також робив динамікою, але не так.
Поза форумом
redman17
ты ведь из винницы, не знаешь когда результаты появятся, или хотя бы он-лайн проверка на всех тестах?
Поза форумом
Seyaua написав:
redman17
ты ведь из винницы, не знаешь когда результаты появятся, или хотя бы он-лайн проверка на всех тестах?
не скажу ... бо не знаю((
Поза форумом
Забули зробити
Поза форумом
А вообще, что интересно - при онлайн-проверке задачи Streamer говорит "Набрано 0.0 из 0.0". Получается за тест не целое кол-во очков? оО
Відредаговано Darkslide (2009-01-21 21:05:04)
Поза форумом