Форум Всеукраїнської інтернет-олімпіади NetOI


На форумі обговорюються лише питання, пов'язані з олімпіадою

Ви не зайшли.

#1 2009-01-21 00:11:45

redman17
Новий користувач
Звідки: Винница
Зареєстрований: 2008-09-04
Повідомлень: 82

Разбор задач третьего тура интернет-олимпиады Net-OI-2008

пардон - удалил первое сообщение и провтыкал что удаляется тема
востанавливаем:

Відредаговано redman17 (2009-01-21 00:12:18)


WE DIE HARD!!!

Поза форумом

 

#2 2009-01-21 00:12:46

redman17
Новий користувач
Звідки: Винница
Зареєстрований: 2008-09-04
Повідомлень: 82

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

По лампплюсу просветите кто-то пжлст
хотя если мое "долгоиграющее" решение наберет приличненько - обязательно поделюсь


WE DIE HARD!!!

Поза форумом

 

#3 2009-01-21 00:13:31

guest1
Новий користувач
Зареєстрований: 2006-12-19
Повідомлень: 309
Вебсайт

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

big_smile

А третья таки прекалком tongue
Ответы выложи на неё, пожалуйста (для сравнения).

Опять же, мой 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.

Поза форумом

 

#4 2009-01-21 00:13:48

redman17
Новий користувач
Звідки: Винница
Зареєстрований: 2008-09-04
Повідомлень: 82

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

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.

WE DIE HARD!!!

Поза форумом

 

#5 2009-01-21 00:14:57

redman17
Новий користувач
Звідки: Винница
Зареєстрований: 2008-09-04
Повідомлень: 82

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

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.

WE DIE HARD!!!

Поза форумом

 

#6 2009-01-21 00:16:12

redman17
Новий користувач
Звідки: Винница
Зареєстрований: 2008-09-04
Повідомлень: 82

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

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.

WE DIE HARD!!!

Поза форумом

 

#7 2009-01-21 00:17:24

redman17
Новий користувач
Звідки: Винница
Зареєстрований: 2008-09-04
Повідомлень: 82

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

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.

WE DIE HARD!!!

Поза форумом

 

#8 2009-01-21 00:18:34

redman17
Новий користувач
Звідки: Винница
Зареєстрований: 2008-09-04
Повідомлень: 82

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

готов к конструктивной дискусии
по поводу улучшений
и непоняток
только отвечать уже завтра будо
а сейчас *после долгий дней и ночей упорных трудов* - спать


WE DIE HARD!!!

Поза форумом

 

#9 2009-01-21 00:19:47

guest1
Новий користувач
Зареєстрований: 2006-12-19
Повідомлень: 309
Вебсайт

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

Спокойной ночи.

Поза форумом

 

#10 2009-01-21 10:59:27

Брэнд
Новий користувач
Звідки: Днепропетровск
Зареєстрований: 2007-09-30
Повідомлень: 44

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

Честно говоря, не понял, как получилась такая простая динамика в тетрисе. Я над одним лишь переходом сидел около пяти часов. В итоге вывел дерево зависимости для K заполненых полностью рядов с выступами не более, чем на две позиции, от K-1 заполненых полностью рядов с выступами не более, чем на две позиции. То есть бред. Все равно запостил решение caseом))

Поза форумом

 

#11 2009-01-21 14:29:49

ZuTa
Новий користувач
Зареєстрований: 2007-09-30
Повідомлень: 90
Вебсайт

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

Я тетріс рішав динамікою по краю...
ось тут(пример 2) http://ips.ifmo.ru/courses/course1/chG/l7/index.html
є сама ідея...

Звісно тестріс солідно ускладнена від тієї задачі що у прикладі....але сама ідея паше...
Одне - це грамотно і швидко написати довгу...

Відредаговано ZuTa (2009-01-21 14:44:03)

Поза форумом

 

#12 2009-01-21 14:37:21

Seyaua
Новий користувач
Звідки: Харьков
Зареєстрований: 2009-01-07
Повідомлень: 12

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

Я тоже сделал Tetris динамикой по краю(профилю). На моем компе макс. тест работал 0,01 сек. Но все равно отправил массив констант, ограничения ведь небольшие, да и половина возможных тестов-ответ 0. Скажите ответы для n=8, и n=10 у меня получилось 182 и 790.

Поза форумом

 

#13 2009-01-21 14:45:03

redman17
Новий користувач
Звідки: Винница
Зареєстрований: 2008-09-04
Повідомлень: 82

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

да 8 - 182; 10 - 790
но самый интересный тест - 50:
4562636060668666


WE DIE HARD!!!

Поза форумом

 

#14 2009-01-21 14:45:25

ZuTa
Новий користувач
Зареєстрований: 2007-09-30
Повідомлень: 90
Вебсайт

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

Seyaua
Да, відповіді в мене такі ж...

Поза форумом

 

#15 2009-01-21 14:50:36

Seyaua
Новий користувач
Звідки: Харьков
Зареєстрований: 2009-01-07
Повідомлень: 12

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

redman17 написав:

да 8 - 182; 10 - 790
но самый интересный тест - 50:
4562636060668666

Эти ответы твоя динамика выдала? Если честно не думал что она правильная. Вернее не предполагал как эту задачу делать без профилей. И теперь макс. Тест - ответ:40878963711143476874191412799254

Поза форумом

 

#16 2009-01-21 14:57:41

ZuTa
Новий користувач
Зареєстрований: 2007-09-30
Повідомлень: 90
Вебсайт

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

лампплюс писав динаміку...але трохи погано її оптимізував...не думаю шо набере повний бал(ТЛЕ)

Поза форумом

 

#17 2009-01-21 15:00:54

redman17
Новий користувач
Звідки: Винница
Зареєстрований: 2008-09-04
Повідомлень: 82

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

Seyaua написав:

Если честно не думал что она правильная. Вернее не предполагал как эту задачу делать без профилей. И теперь макс. Тест - ответ:40878963711143476874191412799254

Обидел ты меня (и я тебя чуть-чуть))))
Как ни странно мой - 40878963711143476874191412799254.

Відредаговано redman17 (2009-01-21 15:02:52)


WE DIE HARD!!!

Поза форумом

 

#18 2009-01-21 15:26:48

salyony
Новий користувач
Звідки: Винница
Зареєстрований: 2007-11-05
Повідомлень: 2

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

http://www2.olymp.vinnica.ua/cgi-bin/v_ … nguage=ukr




Балы за 1-3 тур будут после проверки!!!

Відредаговано salyony (2009-01-21 15:29:20)

Поза форумом

 

#19 2009-01-21 15:47:07

redman17
Новий користувач
Звідки: Винница
Зареєстрований: 2008-09-04
Повідомлень: 82

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

Seyaua написав:

В моем сообщение там должен стоять не смайлик а '='. Опять же эти формулы...

нажми на своем посте "редактировать" и внизу увидишь:
Свойства
Не показывать текстовые смайлики в виде графических изображений в этом сообщении


WE DIE HARD!!!

Поза форумом

 

#20 2009-01-21 15:48:40

fdg
Новий користувач
Зареєстрований: 2006-11-16
Повідомлень: 33

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

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]

Я також робив динамікою, але не так.


Let arriving night explain,
Day fade I remain

Поза форумом

 

#21 2009-01-21 20:26:15

Seyaua
Новий користувач
Звідки: Харьков
Зареєстрований: 2009-01-07
Повідомлень: 12

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

redman17

ты ведь из винницы, не знаешь когда результаты появятся, или хотя бы он-лайн проверка на всех тестах?

Поза форумом

 

#22 2009-01-21 20:33:08

redman17
Новий користувач
Звідки: Винница
Зареєстрований: 2008-09-04
Повідомлень: 82

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

Seyaua написав:

redman17

ты ведь из винницы, не знаешь когда результаты появятся, или хотя бы он-лайн проверка на всех тестах?

не скажу ... бо не знаю((


WE DIE HARD!!!

Поза форумом

 

#23 2009-01-21 20:35:45

ZuTa
Новий користувач
Зареєстрований: 2007-09-30
Повідомлень: 90
Вебсайт

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

Шось довго 3 тур перевіряють....хоча робіт по ідеї менше має бути....значить є ймовірніть того, шо трабл з тестами smile Г

Поза форумом

 

#24 2009-01-21 20:58:29

kadr
Новий користувач
Зареєстрований: 2007-11-29
Повідомлень: 75

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

Забули зробити smile

Поза форумом

 

#25 2009-01-21 21:03:14

Darkslide
Новий користувач
Звідки: м. Київ
Зареєстрований: 2007-10-26
Повідомлень: 27

Re: Разбор задач третьего тура интернет-олимпиады Net-OI-2008

А вообще, что интересно - при онлайн-проверке задачи Streamer говорит "Набрано 0.0 из 0.0". Получается за тест не целое кол-во очков? оО

Відредаговано Darkslide (2009-01-21 21:05:04)


Everything simple is genious, everything genious is simple.

Поза форумом

 

Нижній колонтитул

Powered by Likt
© Copyright 2002–2009 Likt