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

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

Re: 凸頂点の数 横へな2016.4.2 問題

凸頂点の数 。30分。

今回は共通化したいところをグッとこらえてコピペ。前回まで初めから抽象化にこだわって問題を解いていたが、具象例が集まってからのほうが良い抽象化ができることから、60分という時間を考えると抽象化はし過ぎないほうが良い選択だということだろう。

この問題の場合、各頂点に2つの図形が隣接するが、そのうちいずれかと隣接してしまうと凸頂点ではなくなる。 00 でも同じ性質を満たしており、ほぼ同じ関数が使いまわせたのは面白いと感じた。

package Nofconv;
use strict;
use warnings;
use Exporter qw(import);
use List::Util qw(sum);

our @EXPORT_OK = qw(solve);

my @chars = ('a' .. 't');
my %chars = map { $chars[$_] => $_ } 0 .. $#chars;

sub _next ($) {
    my $c = shift;
    my $next = ($chars{$c} + 1) % @chars;
    $chars[$next];
}

sub _prev ($) {
    my $c = shift;
    my $prev = ($chars{$c} + @chars - 1) % @chars;
    $chars[$prev];
}

sub round1 ($) {
    my $c = shift;
    (
        '00',
        '00',
        '1' . _prev($c),
        '2' . _prev($c),
        "2$c",
        '1' . _next($c),
    );
}

sub count1 ($$) {
    my ($c, $ps) = @_;
    my @round = round1 $c;
    my $result = 6;
    for (0 .. $#round - 1) {
        $result-- if $ps->{$round[$_]} || $ps->{$round[$_ + 1]};
    }
    $result-- if $ps->{$round[$#round]} || $ps->{$round[0]};

    $result;
}

sub round2 ($) {
    my $c = shift;
    (
        '1' . _next($c),
        "1$c",
        '2' . _prev($c),
        '3' . _prev($c),
        "3$c",
        '2' . _next($c),
    );
}

sub count2 ($$) {
    my ($c, $ps) = @_;
    my @round = round2 $c;
    my $result = 6;
    for (0 .. $#round - 1) {
        $result-- if $ps->{$round[$_]} || $ps->{$round[$_ + 1]};
    }
    $result-- if $ps->{$round[$#round]} || $ps->{$round[0]};

    $result;
}

sub round3 ($) {
    my $c = shift;
    (
        '2' . _next($c),
        "2$c",
        '3' . _prev($c),
        '4' . _prev($c),
        "4$c",
        '3' . _next($c),
    );
}

sub count3 ($$) {
    my ($c, $ps) = @_;
    my @round = round3 $c;
    my $result = 6;
    for (0 .. $#round - 1) {
        $result-- if $ps->{$round[$_]} || $ps->{$round[$_ + 1]};
    }
    $result-- if $ps->{$round[$#round]} || $ps->{$round[0]};

    $result;
}

sub round4 ($) {
    my $c = shift;
    (
        '3' . _next($c),
        "3$c",
        '4' . _prev($c),
        '5' . _prev($c),
        "5$c",
        '4' . _next($c),
    );
}

sub count4 ($$) {
    my ($c, $ps) = @_;
    my @round = round4 $c;
    my $result = 6;
    for (0 .. $#round - 1) {
        $result-- if $ps->{$round[$_]} || $ps->{$round[$_ + 1]};
    }
    $result-- if $ps->{$round[$#round]} || $ps->{$round[0]};

    $result;
}

sub round0 ($) {
    my $c = shift;
    map { "1$_" } 'a' .. 't';
}

sub count0 ($$) {
    my ($c, $ps) = @_;
    my @round = round0 $c;
    my $result = 20;
    for (0 .. $#round - 1) {
        $result-- if $ps->{$round[$_]} || $ps->{$round[$_ + 1]};
    }
    $result-- if $ps->{$round[$#round]} || $ps->{$round[0]};

    $result;
}

sub count ($$) {
    no strict 'refs';
    my ($name, $ps) = @_;
    $name =~ /^(\d)(\w)/;
    &{"count$1"}($2, $ps);
   
}

sub solve ($) {
    my %ps;
    while ($_[0] =~ /(..)/g) {
        $ps{$1}++;
    }
    return sum map { count($_, \%ps) } keys %ps;
}

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

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

done_testing;

__END__
0  1a2t3s2s    11  リンク
1  1a1c1d00    22  リンク
2  00  20  リンク
3  3q  6   リンク
4  3t2a    8   リンク
5  3t3a    8   リンク
6  3t4a    12  リンク
7  004q2g  32  リンク
8  4c2g2k4i    24  リンク
9  1o1a4f4i1t  26  リンク
10 4t3a4g2a2o2p    24  リンク
11 4i4o3i3c3n3h2c  30  リンク
12 4m3n3m002b1b3a  34  リンク
13 001b2a3t4s3s2s1s    27  リンク
14 1n1j3o4o1h2n2r1k    36  リンク
15 4o2a2j1m2e4l2l3m3o  42  リンク
16 1j2p1a4r4b1i3h4e3i2i    42  リンク
17 001a1c1e1g1i1k1m1o1q1s  30  リンク
18 3n2j3e3a2n1f1p2q3t4t3h  53  リンク
19 4a4b4c3d2e1e1d1c3a2a1b  22  リンク
20 3n3e3t4i3m2d2g3i1j4o2i4t    52  リンク
21 3t2m4n2l4g4h1a1n2t4m2h3a1m  44  リンク
22 1p1i2n3q1d2o2c1q3m3f003k3l2s    53  リンク
23 3r1q3p2d4k4n1r3o4l2j2c1a4o3q4f  56  リンク
24 4d2f4r3f2p4t1j1p4g1q4f1k2j2s4i4j    62  リンク
25 002c2d1f2f3e4d4c4b4a3a1b2t1t2a2g1h  40  リンク
26 3r2i2j3d2t3j3g2s1p2o2p1n1m2d1k1r3i  59  リンク
27 4o4s1i4p3p3s3b4n3r1k4a3t4g3n1o2m3i2o    66  リンク
28 3k2j1i2p2n3l2f2s3f1n4s2h3s1l1m4n4k4q2k  65  リンク
29 1a1b1c1d1e1f1g1h1i1j1k1l1m1n1o1p1q1r1s1t    40  リンク
30 4n3f1c1a3o2s1h2p2k3g3n2e4s2t1j1b3h2a1n3k    73  リンク
31 1a1b1c1d1e1f1g1h1i1j1k1l1m1n1o1p1q1r1s1t00  20  リンク
32 2a2b2c2d2e2f2g2h2i2j2k2l2m2n2o2p2q2r2s2t00  60  リンク
33 2m1p2c2o2n4n002s1m3i2t4l2b3r2h1j4q1c4t1s1a  65  リンク
34 4m2t4r4h3b4b2e3g3n2i4e3m1q4i2q2b2m3i2a1b2s1h    77  リンク
35 1c004g1k4o3p3l3h1r4d2t2c2d1n4t2e1s1j2p1d4j1h1f  74  リンク
36 1s3j4a4h3h3q3n3b3f2m3o3c4i3r2r1f1c2p4s1e3a2j2o3e    80  リンク
37 2c1b3b3k2f1e4q1d1m4n3t4b4s3h3d3g3n1f4p4j2e4f4c3e1k  78  リンク
38 2p4k3t1h4e1n3g4p2j1a1k1p4f1o3a4s4q4i3p2t4l3k2k3s2r4h    77  リンク
39 1d1p4o3n3m4d1m2f3c1o3f3g3a2o1f4n2c4e2j4p4f1b1j1i1k1h2m  74  リンク
40 3m4d4e1i3t4f1f3n2p2g1q4g2c2m1s2r2i3f3o1h3g2e1o3a4r3h3r4o    75  リンク

後、細かい点だけど、 キーバインドを整いきれてないIDE (Cloud9) を使うのであれば、マウスをどんどん使ったほうがいいという点にも気が付き始めた。

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は用意されておらず、インデントを直す気力はない。プログラムなんて考えるのがほとんどでしょ、って思ったこともあったが、エディタがここまで作業に支障を与えるとは。

Re: まわせ! Bouwkamp!! 横へな2016.2.6 問題

まわせ! Bouwkamp!! に挑戦したが、惜敗。90分かかった。

正攻法で挑むと楽しい良問ではあったが、意外に手数が多い。

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

our @EXPORT_OK = qw(solve);

sub decode_bouwkamp ($) {
    my @result;
    while ($_[0] =~ /\((\d+(?:,\d+)*)\)/g) {
        push @result, [split /,/, $1, -1];
    }
    \@result;
}

sub sort_points (@) {
    sort { $a->[1] <=> $b->[1] or $a->[0] <=> $b->[0] } @_;
}

sub rotate_point ($$$) {
    my ($w, $h, $p) = @_;
    [$w - $p->[1] - $p->[2], $p->[0], $p->[2]];
}

sub parse_bouwkamp ($) {
    my $bouwkamp = $_[0];
    my @results;
    my ($w, $h) = (0,0);
    my @next_points = ([0, 0]);

    for my $edges (@$bouwkamp) {
        @next_points = sort_points @next_points;
        my $cur_point = shift @next_points;
        for my $edge (@$edges) {
            push @results, [$cur_point->[0], $cur_point->[1], $edge];
            # ここで、 @next_points から上辺がかぶる点を消す
            @next_points = grep { ! ($_->[1] == $cur_point->[1] and $cur_point->[0] <= $_->[0] and $_->[0] <= $cur_point->[0] + $edge) } @next_points;

            push @next_points, [$cur_point->[0], $cur_point->[1] + $edge];
            $cur_point = [$cur_point->[0] + $edge, $cur_point->[1]];

            $w = $cur_point->[0] if $cur_point->[0] > $w;
            $h = $cur_point->[1] + $edge if $cur_point->[1] + $edge > $h;
        }
    }
    
    (\@results, $w, $h);
}

sub deparse_bouwkamp ($) {
    my @points = @{$_[0]};

    my @results;
    while (@points) {
        my $point = shift @points;
        my @cur_group = $point->[2];
        my $next_point = [$point->[0] + $point->[2], $point->[1]];
        while (my ($x) = grep { $next_point->[0] == $_->[0] and $next_point->[1] == $_->[1] } @points) {
            push @cur_group, $x->[2];
            @points = grep { $next_point->[0] != $_->[0] or $next_point->[1] != $_->[1] } @points;
            $next_point = [$next_point->[0] + $x->[2], $next_point->[1]];
        }
        push @results, \@cur_group;
    }
    
    \@results;
}

sub solve ($) {
    my ($answer_num, $encoded_bouwkamp) = split /:/, $_[0], 2;
    my $bouwkamps = decode_bouwkamp $encoded_bouwkamp;
    my ($points, $w, $h) = parse_bouwkamp $bouwkamps;
    my @new_points = map { rotate_point $w, $h, $_ } @$points;
    @new_points = sort_points @new_points;
    my $new_bouwkamp = deparse_bouwkamp \@new_points;
    '(' . join(',', @{$new_bouwkamp->[$answer_num - 1] // []}) . ')';
}

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

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

is_deeply Bouwkamp::decode_bouwkamp('(33,29,50)(4,25)(37)(15,35)(16,9)(7,2)(17)(42,18)(6,11)(8,27)(24)(19)'),
          [[33,29,50], [4,25], [37], [15,35], [16,9], [7,2], [17], [42,18], [6,11], [8,27], [24], [19]];

is_deeply [Bouwkamp::sort_points([3, 4, undef], [2, 3, undef])],
          [[2, 3, undef], [3, 4, undef]];

is_deeply [Bouwkamp::parse_bouwkamp [[2, 2, 2], [3, 3]]],
          [[[0, 0, 2], [2, 0, 2], [4, 0, 2], [0, 2, 3], [3, 2, 3]], 6, 5];

is_deeply Bouwkamp::deparse_bouwkamp [[0, 0, 2], [2, 0, 2], [4, 0, 2], [0, 2, 3], [3, 2, 3]],
          [[2, 2, 2], [3, 3]];

is_deeply Bouwkamp::rotate_point(6, 5, [0, 0, 3]),
          [3, 0, 3];

done_testing;
__END__
0  4:(55,44,48)(40,4)(52)(26,29)(23,3)(20,31,21)(5,47)(43)(9,17)(1,8)(32)(25)  (32,31) リンク
1  6:(33,29,50)(4,25)(37)(15,35)(16,9)(7,2)(17)(42,18)(6,11)(8,27)(24)(19) (6,17,2)    リンク
2  7:(60,50)(23,27)(24,22,14)(7,16)(8,6)(12,15)(13)(2,28)(26)(4,21,3)(18)(17)  (4,16)  リンク
3  6:(99,73,56)(17,39)(68,22)(36,25)(57,42)(9,16)(2,7)(10,28)(23)(15,87,18)(72)(69)    (10,36,22)  リンク
4  7:(79,49,66,63)(32,17)(3,60)(29,57)(55,22,2)(20,14)(15,28)(33,9)(24)(11,134)(123)   (29,17) リンク
5  7:(159,129)(57,72)(56,39,25,16,23)(9,7)(2,28)(36)(42,15)(17,22)(87)(10,18)(73)(68)(60)  (10,28) リンク
6  14:(113,71,68)(32,36)(42,29)(13,44,4)(40)(62,37,38,31)(7,108)(25,12)(11,34)(23)(77,10)(67)  (36)    リンク
7  8:(145,125)(53,72)(45,11,9,16,31,33)(2,7)(13)(8,15)(21)(14,32)(30,37,19)(80)(18,73)(62)(55) (31)    リンク
8  1:(175,140,164)(35,29,52,24)(28,160)(6,23)(130,86)(43,60)(26,17)(77)(44,68)(174)(5,155)(150)    (174,130,175)   リンク
9  6:(240,168,187)(149,19)(206)(163,77)(86,82,58)(40,18)(22,202)(4,78)(192,61)(62)(48,13)(35,118)(83)  (4,82)  リンク
10 5:(100,73,59)(14,45)(56,31)(58,42)(25,51)(19,36,26)(16,18,8)(2,17)(10)(77)(74)(28)(23,30)(44,7)(37) (2,19,56,73)    リンク
11 8:(100,88,76)(27,49)(12,19,39,18)(95,11,6)(3,24)(5,1)(21)(20)(16)(2,47)(77,45)(92)(69,26)(17,60)(43)    (19)    リンク
12 11:(262,196,203)(83,106,7)(210)(161,84,17)(36,41,23)(18,111)(31,5)(64)(77,38)(102)(73,248)(238)(175)    (248)   リンク
13 9:(117,79,74)(5,69)(84)(71,46)(20,49)(25,39,57,29)(82,14)(78)(35,18)(13,12,50)(1,11)(4,10)(33,6)(27)    (1,12)  リンク
14 7:(163,95,78)(17,61)(68,44)(24,81)(89,94,72)(15,66)(42,45)(84,5)(79,20)(59,3)(26,22)(16,50)(4,34)(30)   (30,26,3)   リンク
15 10:(100,95,69)(26,43)(11,16,77,17)(88,12)(6,5)(1,20)(19)(60)(39)(18,21)(45,92)(76,27,3)(24)(49,2)(47)   (47,2)  リンク
16 8:(120,78,102)(34,20,24)(14,6)(2,10,23,91)(8)(53,13)(75,45)(36)(4,32)(30,47,25)(22,3)(19,107)(105)(88)  (4,36,13)   リンク
17 13:(119,124,96)(28,68)(114,5)(117,40)(56,52)(4,48)(21,15,24)(106,8)(6,9)(98,38,16)(13,20)(22,7)(75)(60) (20)    リンク
18 2:(302,277,246)(57,189)(25,117,109,26)(235,92)(83)(8,135,49)(90,127)(81,157)(53,37)(5,76)(304)(288)(233)    (53,90,92)  リンク
19 13:(158,109,240)(49,60)(114,82,11)(71)(126,267)(62,52)(10,42)(40,32)(8,51,141)(48)(14,37)(39,9)(23)(7,53)(46)   (60)    リンク
20 8:(132,113,251)(19,36,58)(107,27,17)(10,21,22)(25,12)(1,20)(13)(80)(32,6)(26)(23,35)(130)(121,245)(127,3)(124)  (26,6)  リンク
21 4:(187,127,194)(60,67)(131,76,40)(33,72,156)(44,29)(19,10)(55,21)(82)(13,27,4)(23)(34)(50)(190,30)(160,2)(158)  (60,127)    リンク
22 12:(239,245)(132,107)(124,121)(27,25,32,23)(3,118)(35,115)(113,19)(12,13)(17,10)(6,26)(21,1)(20)(36)(22,80)(58) (124,245)   リンク
23 3:(176,152)(24,38,90)(80,63,43,14)(52)(20,23)(17,26,40)(37,42,86)(72,25)(16,10)(6,4)(49,19,8,5)(47)(3,44)(11)(30)   (17,63) リンク
24 15:(171,181)(95,76)(93,88)(19,30,27)(42,40,32)(5,83)(3,15,29,78)(21,12)(9,18)(8,54)(4,25)(2,46)(22)(44)(1,24)(23)   (93,181)    リンク
25 13:(152,88,112)(64,24)(44,92)(200,12,4)(8,7,33)(1,6)(16,5)(11)(27)(18,15)(3,31,73)(29,19)(10,9)(40)(39)(77,2)(75)   (3,15)  リンク
26 13:(484,316,379)(108,145,63)(82,360)(42,66)(29,198)(18,24)(308,194)(119)(69,50)(168,80)(114,149)(440)(387,35)(352)  (379)   リンク
27 12:(181,191)(93,88)(24,23,54,46,44)(1,22)(25)(2,42)(4,18)(8,40)(29)(9,21,32)(15,12)(3,30)(5,103,27)(98)(19,95)(76)  (21)    リンク
28 18:(83,79,123)(35,44)(52,31)(21,36,9)(27,60,89)(48,25)(10,20,33)(23,12)(2,5,13)(11,3)(8)(102,49,45)(16,73)(4,57)(53)    (123)   リンク
29 4:(649,439,456)(214,208,17)(473)(6,55,147)(385,260,4)(175,49)(104)(12,135)(116)(81,94)(125,216)(203,7)(615)(510)(419)   (81,175,4)  リンク
30 17:(100,114,48,53)(43,5)(58)(23,20)(61,25,14)(3,75)(11,47,96)(36)(95,49)(24,51)(37,105,27)(78)(9,28)(59,26,19)(7,40)(33)    (58,5)  リンク

1時間経過次点で残ってしまった問題は以下。それぞれ15分くらいかかった。

  • 左上の頂点のみ保持する方針だったが、90度回転すると左上の頂点も変わるのだった
    • しかもその計算に辺の長さが必要なので、頂点と辺の長さを両方持つ必要があった
  • 次のグループの座標候補 @next_points が、正方形の配置時に辺と重なったら消さねばならない
    • 気がついていたけど、放置してもテスト一個くらい通るだろうと思ったら、一個も通らず

テストを真面目に書いたせいで時間を費やしたってのもあるけど、テストで手を抜いていたら後半のリカバリ時にかなりきつかった気がする。

Re: 不良セクタの隣〜 横へな 2014.3.7 問題

不良セクタの隣 の問題で肩慣らし。

以下はとりあえずテスト通しただけの状態そのままのコード。単体テスト含めてフルスクラッチからで45分くらい。場当たり的にモジュール化したので、無駄が多い。

初め「複数の」を見落としてて、最後に方針転換したけど、適度にモジュール化されてたのでなんとかなった。

Cloud9上で解いたので、キーバインドでも苦しんだ。Ctrl-s 押し忘れてセーブされてなかったり Ctrl-k 押してよくわからなくなったり。あと、45分の時間には含んでないけど、 コアモジュールのインストールも必要

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

our @EXPORT_OK = qw(solve);

my @all_sectors = (
    [100 .. 107],
    [200 .. 215],
    [300 .. 323],
    [400 .. 431],
);

sub degrees ($$) {
    my ($sectors, $sector) = @_;
    my $deg = 360 / @$sectors;
    my $sec_num = $sector - $sectors->[0];
    if ($sec_num == 0) {
        ([360 - $deg / 2, 360], [0, $deg / 2]);
    } else {
        ([($sec_num - .5) * $deg, ($sec_num + .5) * $deg]);
    }
}

sub sectors_in_degrees ($$$) {
    my ($sectors, $deg1, $deg2) = @_;
    my %result;
    for my $sec (@$sectors) {
        my @ds = degrees($sectors, $sec);
        for (@ds) {
            my ($d1, $d2) = @$_;
            $result{$sec}++ unless ($d1 <= $deg1 && $d2 <= $deg1) || ($deg2 <= $d1 && $deg2 <= $d2);
        }
    }
    return keys %result;
}

sub warning_sectors ($$) {
    my ($all_sectors, $sector) = @_;
    my $ringnum = int($sector / 100) - 1;
    my @degrees = degrees($all_sectors->[$ringnum], $sector);

    my %result;
    
    my $localnum = $sector % 100;
    my $localmax = @{$all_sectors->[$ringnum]};
    $result{$all_sectors->[$ringnum][($localnum + 1) % $localmax]}++;
    $result{$all_sectors->[$ringnum][($localnum + $localmax - 1) % $localmax]}++;

    if (0 < $ringnum) {
        my @secs = map { sectors_in_degrees($all_sectors->[$ringnum - 1], $_->[0], $_->[1]) } @degrees;
        $result{$_}++ for @secs;
    }
    if ($ringnum < $#$all_sectors) {
        my @secs = map { sectors_in_degrees($all_sectors->[$ringnum + 1], $_->[0], $_->[1]) } @degrees;
        $result{$_}++ for @secs;
    }
    
    keys %result;
}

sub _diff ($$) {
    my ($ar1, $ar2) = @_;
    my %ar2 = map { $_ => 1 } @$ar2;
    grep { ! $ar2{$_} } @$ar1;
}

sub _uniq ($) {
    my $ar = shift;
    my %ar = map { $_ => 1} @$ar;
    keys %ar;
}

sub solve ($) {
    my @broken = split /,/, $_[0];
    my %warnings;
    for (map { warning_sectors(\@all_sectors, $_) } @broken) {
        $warnings{$_}++;
    }
    my @many_warnings = grep { $warnings{$_} >= 2} keys %warnings;
    my @pure_warnings = _uniq [_diff(\@many_warnings, \@broken)];
    join ',', sort @pure_warnings or 'none';
}
use strict;
use warnings;
use Test::More import => [qw(done_testing is)];
use Sector qw(solve);

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

done_testing;
__END__
0  400,401,302 300,301,402
1  105,100,306,414 none
2  100 none
3  211 none
4  317 none
5  414 none
6  100,106 107
7  205,203 102,204
8  303,305 304
9  407,409 306,408
10 104,103 207
11 204,203 102,305
12 313,314 209,418
13 419,418 314
14 100,102,101 201,203
15 103,206,309 205,207,308,310
16 414,310,309 206,311,413
17 104,102,206,307,102,202 101,103,203,204,205,207,308
18 104,206,308,409,407 103,205,207,306,307,309,408,410
19 313,406,213,301,409,422,412,102,428 none
20 101,300,210,308,423,321,403,408,415 none
21 304,316,307,207,427,402,107,431,412,418,424 none
22 205,408,210,215,425,302,311,400,428,412 none
23 200,311,306,412,403,318,427,105,420 none
24 105,305,407,408,309,208,427 104,209,306,406
25 311,304,322,404,429,305,316 203,303,321,405,406,430
26 210,401,316,425,101 211,315
27 414,403,404,416,428,421 303,415
28 207,300,103,211,428 104,206
29 322,314,310 none
30 427,200,215 100,323
31 311,402,424,307,318,430,323,305,201 200,204,301,302,306,322,423,425,431
32 425,430,408 none
33 202,320,209,426 319,427
34 430,209,302,310,304,431,320 202,303,323
35 208,206,406,424,213,312 207,311,313
36 420,302,313,413,317,402 301,403
37 319,306,309,418,204,411 305,307,308,412
38 400,308,105,430,203,428,209 104,210,429,431
39 200,305,214 215
40 214,408,410,407,317,422 306,316,409,423

毎回そうなんだけど、実装中、部品の単体テストをしてないので、最後にテスト全部通るかは神のみぞ知る。とはいえ、1時間で部品の単体テストまで書くのは、時間配分的に現実的ではないと思う。

追記: 3年前の自分の回答 。今書いたコードより整ってるようには見えるけど、 $D ってなんだっけ・・・。

GHCi上でpiと打てば円周率が表示されるという話

裏書きに残りっぱなしになってたのを書いておく。GHCI上で pi と打つと、πの値が表示できる。

Prelude> pi
3.141592653589793

Pythonだとそうはいかない。

>>> pi
Traceback (most recent call last):
  File "<stdin>", line 1, in <module>
NameError: name 'pi' is not defined
>>> from math import pi
>>> pi
3.141592653589793

つまり、Haskellではグローバルな名前空間pi が出ているように見えるということ。これはなかなか気持ち悪い。

pi の正体を見てみよう。

Prelude> :i pi
class Fractional a => Floating a where
  pi :: a
  ...
        -- Defined in ‘GHC.Float’

Floating 型クラスに定義されているようだ。 Floating 型クラスは Prelude モジュールに含まれているので、 import などしなくても名前にアクセスできる。なるほど。

さて、拙著 Haskell入門 にも書いたが、この型クラスは浮動小数点数を意味する。この型クラスには pi 以外に、一般的な数値計算で必要な explogsin などの関数も入っている。代表的なインスタンスDoubleFloat

Prelude> :i Floating
class Fractional a => Floating a where
  pi :: a
  exp :: a -> a
  log :: a -> a
  sqrt :: a -> a
  (**) :: a -> a -> a
  logBase :: a -> a -> a
  sin :: a -> a
  cos :: a -> a
  tan :: a -> a
  asin :: a -> a
  acos :: a -> a
  atan :: a -> a
  sinh :: a -> a
  cosh :: a -> a
  tanh :: a -> a
  asinh :: a -> a
  acosh :: a -> a
  atanh :: a -> a
  GHC.Float.log1p :: a -> a
  GHC.Float.expm1 :: a -> a
  GHC.Float.log1pexp :: a -> a
  GHC.Float.log1mexp :: a -> a
  {-# MINIMAL pi, exp, log, sin, cos, asin, acos, atan, sinh, cosh,
              asinh, acosh, atanh #-}
        -- Defined in ‘GHC.Float’
instance Floating Float -- Defined in ‘GHC.Float’
instance Floating Double -- Defined in ‘GHC.Float’

pi が定数ではなく型クラスのメソッドになっているのは、恐らく FloatDouble で多相的に扱いたいからであろう。 GHCの実際の定義 は、以下。お、おう、といった感想。浮動小数点数だから、リテラルに小数点を何桁まで書いたかは精度とは関係ないってことだろう。結局は親の型クラスが持つ fromRational を使って処理される。

instance  Floating Float  where
    pi                  =  3.141592653589793238

instance  Floating Double  where
    pi                  =  3.141592653589793238

一応、ghci上で違いを見ておく。

Prelude> pi :: Double
3.141592653589793
Prelude> pi :: Float
3.1415927

もう一つ疑問が残るのは、数ある数値系の型クラスの中で、なぜ Floating というより具体性の高い型クラスに pi が定義されたのか。 Floating に定義されている関数は、実数値上に定義される関数である。Haskellでは、有理数Fractional 型クラスで表現されている。しかし、当然ながら実数値を正確に表現できる型はない。そこで、コンピュータが一般的に用いる浮動小数点数にこれらの関数を定義した、ということだろう。

最後にまとめると、 pi については以下となる。

  • Prelude に定義されているので、識別子 pi でアクセスできる
  • メソッドになっているため、 FloatDouble で多相的に扱える
  • 実数という型がないので、浮動小数点数上の演算としているのだろう

自分の開発環境用Vagrantfileを作った

qiita.com

ubuntuのインストール作業に勤しむ意味はないので、vagrantに任せることに。

ということでWindows上でvagrant使うことに決めたのだけど、Surface StudioとSurface Book 2の両方で環境構築するのはダルいので Vagrantfile 作って上げた。

github.com

最近はデフォルト厨なので Vagrantfile なんて要らんかなと思ったのだけど、細かい調整でハマって時間を潰してしまったりしたので、まとめることにした。細かい点とは、例えば以下の通り。

  • stackapt で入れない (コマンドを覚えられないのでググるのがめんどい)
  • init.elintero の設定をググらないと書けない
  • libtinfo-dev 入れないと intero が動かない
  • LC_ALL 指定しないと shell が日本語を受け付けない
  • .tmux.conf を適切に設定しないとキーバインドで俺が死ぬ
  • その他、今は忘れている暗黙知をこのリポジトリに集めて二度と同じハマり方をしないようにする

Windows 用にしているけど、OS Xでも使えるはず。とはいえ、OS X上ならVM使わずにローカルに開発環境作る気がする。

WindowsのreaderアプリがEdgeに惨殺される

Windowsreaderアプリが2/15で使えなくなるとのこと 。騒いでいる人がほとんどいないけど、Surfaceタブレットモードで使ったときの相性が非常に良かったので、どうしてそんなことをするのか全く理解ができない1。これでSurfaceを使う理由が1つなくなってしまった。

2/15までサポートされるということになっているが、readerアプリを立ち上げると画面上部がメッセージで専有されてUIがぶっ壊れるので、もうすでに使い物にならない。スクリーンショット取るのが億劫だったのでTwitterから拝借。

が、代替を探したところ、幸い Pico Viewer が要件を満たしてくれることがわかった。使用頻度が高かったサムネイルを一覧するビューがないのだけは残念だが、それ以外のタブレットモードの閲覧に関しては reader とほぼ同じ使い勝手、いや、それ以上使い勝手なので、十分満足できる。価格も財布に優しい。もし、代替品に困っている人が居たら試してみて欲しい。


  1. Edge使わせるため、というのは明白だけど、思考が短絡的過ぎる。