北海道苫小牧市出身の初老PGが書くブログ

永遠のプログラマを夢見る、苫小牧市出身のおじさんのちらしの裏

Re: ぴったり含む長方形 横へな2016.3.5 問題

ぴったり含む長方形 。点1個から帰納的に最小の長方形を出そうと方針を誤り、敗北。

方針変換後は45分。これはさらに15分かけて足切りを入れたもの。そもそも点を累積して数えるようにすればもっと速い。

package Pire;
use strict;
use warnings;
use Exporter qw(import);

our @EXPORT_OK = qw(solve);

my @chars = ('0' .. '9', 'A' .. 'Z', 'a' .. 'z');
my %chars = do {
    my $i = 0;
    map { $_ => $i++ } @chars;
};

sub eq_point ($$) {
    my ($p1, $p2) = @_;
    $p1->[0] == $p2->[0] and $p1->[1] == $p2->[1];
}

sub uniq {
    my %done;
    grep { ! $done{$_}++ } @_;
}

sub area ($$$$) {
    my ($x1, $x2, $y1, $y2) = @_;
    (abs($x1 - $x2) + 1) * (abs($y1 - $y2) + 1);
}

sub contains ($$$$$) {
    my ($points, $x1, $x2, $y1, $y2) = @_;

    my @contains = grep { $x1 <= $_->[0] and $_->[0] <= $x2 and $y1 <= $_->[1] and $_->[1] <= $y2  } @$points;
    scalar @contains;
}

sub solve ($) {
    my ($point_num, $encoded_points) = split /:/, $_[0], 2;
    my @points = map { [map { $chars{$_} } split //, $_, 2] } split /,/, $encoded_points;

    my @xs = sort {$a <=> $b} uniq (0, 61, map { $_->[0] - 1, $_->[0], $_->[0] + 1 } @points);
    my @ys = sort {$a <=> $b} uniq (0, 61, map { $_->[1] - 1, $_->[1], $_->[1] + 1 } @points);

    my $min_area = 63 * 63;
    my $max_area = 0;
    my %done;
    for my $x1 (0 .. $#xs) {
            for my $y1 (0 .. $#ys) {
      GROWUPX: for my $x2 ($x1 .. $#xs) {
                for my $y2 ($y1 .. $#ys) {
                    next if $xs[$x1] < 0 or $xs[$x1]  > 61;
                    next if $xs[$x2] < 0 or $xs[$x2] > 61;
                    next if $ys[$y1] < 0 or $ys[$y1] > 61;
                    next if $ys[$y2] < 0 or $ys[$y2] > 61;
                    next if $done{join ',', $xs[$x1], $xs[$x2], $ys[$y1], $ys[$y2]}++;
                    my $contains = contains(\@points, $xs[$x1], $xs[$x2], $ys[$y1], $ys[$y2]);
                    next if $contains < $point_num;
                    next GROWUPX if $contains > $point_num;
                    my $area = area($xs[$x1], $xs[$x2], $ys[$y1], $ys[$y2]);
                    $min_area = $area if $area < $min_area;
                    $max_area = $area if $area > $max_area;
                }
            }   
        }
    }

    $min_area <= $max_area ? "$min_area,$max_area" : '-';
}

1;
use strict;
use warnings;
use Test::More import => [qw(is done_testing)];
use Pire qw(solve);

while (<DATA>) {
    tr/\r\n//d;
    my ($num, $in, $out) = split /\s+/, $_;
    is solve($in), $out, "Test #$num";
}


done_testing;
__END__
0  3:Oh,Be,AF,in,eG,ir,l5,Q8,mC,7T,Ty,tT   108,1920    リンク
1  3:00,zz,0z,z0   -   リンク
2  1:ho    1,3844  リンク
3  2:am    -   リンク
4  4:00,zz,0z,z0   3844,3844   リンク
5  4:00,11,zz,yy,1y,y1 3600,3721   リンク
6  2:00,01,10,11,yz,zy,yy,zz   2,3660  リンク
7  2:AA,AB,BA,BB,SZ,SY,TZ,TY   2,2046  リンク
8  3:Lw,qw,cw,Ow,2w,fw,yw,ow,Zw,iw 7,2170  リンク
9  4:0o,0s,0x,0C,0L,0k,0V,0y,0m,0S 9,2852  リンク
10 5:Tz,gz,Ez,Pz,3z,Jz,iz,Bz,ez,9z 17,2604 リンク
11 6:mQ,mp,mv,mW,mo,mZ,mC,mc,mt,mH 23,3100 リンク
12 5:a0,a4,aa,ac,ag,aB,aG,aK,aO,aY,az  19,2480 リンク
13 10:Ep,Jx,Qh,M7,Zr,lk,yp,Ya,aW,J3,OJ 1938,3720   リンク
14 5:00,01,10,0y,0z,1z,y0,z0,z1,yz,zz,zy   3721,3721   リンク
15 7:00,01,10,0y,0z,1z,y0,z0,z1,yz,zz,zy   -   リンク
16 8:00,01,10,0y,0z,1z,y0,z0,z1,yz,zz,zy,TE    -   リンク
17 11:bU,cl,d5,Fn,NW,gA,2O,YU,H4,0y,qE,Hd,ZH   1748,3658   リンク
18 12:SM,cf,AD,6P,cm,mo,if,s0,Mt,GJ,9m,Sp,lA,x4,NE 1806,3186   リンク
19 2:00,I0,c0,z0,0I,II,cI,zI,0c,Ic,cc,zc,0z,Iz,cz,zz   19,2520 リンク
20 3:00,I0,c0,z0,0I,II,cI,zI,0c,Ic,cc,zc,0z,Iz,cz,zz   39,2562 リンク
21 5:00,I0,c0,z0,0I,II,cI,zI,0c,Ic,cc,zc,0z,Iz,cz,zz   -   リンク
22 6:00,I0,c0,z0,0I,II,cI,zI,0c,Ic,cc,zc,0z,Iz,cz,zz   741,3660    リンク
23 7:00,I0,c0,z0,0I,II,cI,zI,0c,Ic,cc,zc,0z,Iz,cz,zz   -   リンク
24 7:00,I0,c0,z0,0I,II,cJ,zI,0c,Ic,cc,zc,0z,Iz,cz,zz   1178,2623   リンク
25 13:Lk,y3,uO,Gk,sF,7y,ED,FP,rK,vw,Lo,kT,ib,MR,sC,Cu,xQ   1794,3472   リンク
26 1:lz,en,81,M2,M1,8p,7m,ND,m0,gd,3v,hr,hA,Yr,XB,x2,AR,5Q,3V,B3   1,1785  リンク
27 2:s1,Dx,yu,H8,c4,6C,95,FK,xV,Q7,h2,Wk,BI,i0,bl,9Q,KF,1q,52,PS,Jh    6,1824  リンク
28 2:0R,20,fz,0a,0X,zp,P0,0b,0S,zw,e0,0G,g0,06,a0,Zz,zW,zn,00,z6,zq,U0 2,3660  リンク
29 3:H5,jF,AT,HH,k7,Ho,Mz,07,Tt,Sq,Zh,Yt,e5,oS,qf,YY,JD,bP,s4,hB,TC,PW 28,1224 リンク
30 4:oe,pg,Np,zP,ho,pe,OV,S0,oM,wO,pM,Ah,Vq,9d,6U,3I,C9,AR,1L,rg,69,as,Nx  12,1989 リンク
31 2:n0,V0,zL,i0,4z,Nz,xz,z0,z1,0f,P0,zw,80,zC,zB,Az,0P,50,k0,rz,0D,jz,qz,E0   2,2928  リンク
32 2:tz,0F,0y,zo,0K,01,qz,zU,gz,Xz,zc,0m,zD,Q0,Yz,zb,0a,zp,zW,z7,0o,h0,1z,0p   2,3660  リンク
33 5:8r,NI,gL,3z,EK,hy,L9,g2,Kh,Gw,Dg,ZB,Sg,LY,ig,sS,I8,U0,DI,cq,Bu,qJ,C4,jP   143,1520    リンク
34 2:7s,z7,so,zw,X2,59,r1,0Q,70,q2,C6,J6,wz,at,2w,Vq,f9,st,sI,rf,wG,zg,f3,L2,4j    4,2340  リンク
35 2:kw,Gz,zp,se,8e,2S,C7,1A,B9,5v,AM,sN,zH,m8,Cx,rG,4w,q2,W0,ta,AC,G5,y0,Vq,3i    4,2080  リンク
36 3:Lr,pX,y7,2Y,qI,6w,t5,R6,e8,57,5f,R1,Up,9q,33,1Z,05,Eu,6S,AW,au,7S,zd,CA,R7    7,2120  リンク
37 3:ut,0C,6p,5w,9M,uj,I6,sq,Yr,Tz,Bp,p7,Rt,JB,6O,Bw,T1,tY,pn,MA,7I,GC,BO,m0,ts    12,2016 リンク
38 4:sE,Wy,Oo,uY,4t,os,B1,xq,4j,ex,s7,y7,54,ud,Cj,0L,S7,fx,11,cs,zc,tn,S6,Zq,2r    56,2400 リンク
39 6:eZ,5V,xT,2x,W7,vy,yT,8R,XT,4c,yX,s9,3E,KZ,tp,Sj,Su,wp,4F,BV,aC,qw,cJ,Gl,aA    192,1849    リンク
40 7:6Q,av,UZ,0c,IV,fo,Vv,mg,no,qM,06,zy,jW,R0,Qo,sK,wQ,1b,De,Iy,zI,cx,rn,ot,cN,45 250,2303    リンク
41 4:0A,15,5k,Bi,mz,0f,vr,EZ,4z,vj,6p,vP,8X,16,x7,S3,2z,zJ,wI,wY,Wv,ky,9K,8u,Eo,4s,y0  48,2700 リンク
42 8:zN,2J,ta,HL,Dg,up,Qn,W8,8K,k4,Is,uL,dT,tA,PN,UQ,DB,gA,OO,lv,4h,Rv,D6,23,Tg,4S,Zb  418,1763    リンク
43 5:px,sp,cr,dB,fz,65,gq,zb,sN,42,o0,y3,iE,pv,sn,Al,RE,48,l0,7X,DE,xL,wC,qQ,w5,C3,P3,i1   102,2397    リンク
44 9:Ic,Dk,Ef,6R,GK,NZ,76,L0,oQ,9f,S3,oL,lX,7v,8d,pX,dZ,z7,zx,fR,pe,w7,aj,U9,lO,kv,wL,s0   396,2088    リンク
45 10:JJ,LR,Xe,kg,LU,lI,3w,ZV,Td,Mu,tA,g8,VC,I7,N8,zN,kY,Ux,3t,mg,4m,FO,Ug,vQ,qY,jl,Ne,Zq,GN   416,1794    リンク
46 11:lQ,EN,vO,tn,qO,F3,9k,K2,UC,P0,XY,DB,QO,ps,hy,fl,Dt,ex,Vc,vF,Pf,Vk,uo,Xc,Sh,KE,9g,3H,l6   658,1995    リンク

Cloud9 を Windows 上から使っているのだが、 emacs キーバインドが使えない のが死ぬほど辛い。全身を鎖で巻かれて海中に放り込まれた状態で解いているような感覚。コードフォーマッタもPerlは用意されておらず、インデントを直す気力はない。プログラムなんて考えるのがほとんどでしょ、って思ったこともあったが、エディタがここまで作業に支障を与えるとは。