拙著 Haskell入門 のサンプルコードは lts-8.24 にしか対応していなかったので、現時点の最新である lts-10.6 に対応させた。変更したのはすべてライブラリがアップデートされたのを追随したもの。 master ではなく lts-10 というブランチにしてあるので、注意。
LTSのアップデートによって ghc-8.2 が使えるようになったのが嬉しい。引き続きHaskellでの開発をお楽しみくださいませ。
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 以外に、一般的な数値計算で必要な exp や log 、 sin などの関数も入っている。代表的なインスタンスは Double と Float 。
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 が定数ではなく型クラスのメソッドになっているのは、恐らく Float と Double で多相的に扱いたいからであろう。 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でアクセスできる- メソッドになっているため、
FloatとDoubleで多相的に扱える - 実数という型がないので、浮動小数点数上の演算としているのだろう
自分の開発環境用Vagrantfileを作った
ということでWindows上でvagrant使うことに決めたのだけど、Surface StudioとSurface Book 2の両方で環境構築するのはダルいので Vagrantfile 作って上げた。
最近はデフォルト厨なので Vagrantfile なんて要らんかなと思ったのだけど、細かい調整でハマって時間を潰してしまったりしたので、まとめることにした。細かい点とは、例えば以下の通り。
stackはaptで入れない (コマンドを覚えられないのでググるのがめんどい)init.elのinteroの設定をググらないと書けないlibtinfo-dev入れないとinteroが動かないLC_ALL指定しないと shell が日本語を受け付けない.tmux.confを適切に設定しないとキーバインドで俺が死ぬ- その他、今は忘れている暗黙知をこのリポジトリに集めて二度と同じハマり方をしないようにする
Windows 用にしているけど、OS Xでも使えるはず。とはいえ、OS X上ならVM使わずにローカルに開発環境作る気がする。
