Gaucheのreplとmodule
gaucheでreplを使おうと思って色々試してたんだけど、 replを開いたときのモジュールがどう決まるのかよくわからん。 特に問題ないんだけど気になる。
(select-module user) (print (current-module)) (read-eval-print-loop) (print) (print "-------------") (define-module aaa) (select-module aaa) (print (current-module)) (read-eval-print-loop) (print) (print "-------------") (select-module user) (with-module aaa (begin (print (current-module)) (read-eval-print-loop)))
とかして実行して、3回のreplでそれぞれ(current-module)と^Dを入れると,
#<module user> gosh> (current-module) #<module user> gosh> ------------- #<module aaa> gosh> (current-module) #<module aaa> gosh> ------------- #<module aaa> gosh> (current-module) #<module user> gosh>
うーん?
gosh -V Gauche scheme interpreter, version 0.8.14 [utf-8,pthreads]
Maximum flow (Dinic)
ゼミでやったので, 今更だけど最大フローを実装してみる.
O(n^2m)になってるはずだけど長い..
#!/usr/bin/env perl use strict; use warnings; #use Carp::Assert; use Data::Dumper; package Edge; sub new { my ($class, $source, $target, $weight) = @_; my $self = { source => int($source), target => int($target), weight => $weight, }; return bless $self, $class; } package Vertex; sub new { my ($class, $id) = @_; my $self = { id => int($id), edges => [], }; return bless $self, $class; } package main; use List::Util; my $INF = 1e+20; sub augment { # O(nm) my ($levelGraph, $flow, $source, $tink) = @_; my $dfs; $dfs = sub { # return new flow my ($v, $minCap) = @_; return $minCap if ($v->{id} == $tink); while (@{$v->{edges}}) { my $newflow = $dfs->($levelGraph->[$v->{edges}[0]{target}], List::Util::min ($minCap, $v->{edges}[0]{weight})); if ($newflow) { my $e = $v->{edges}[0]; $flow->[$e->{source}][$e->{target}] += $newflow; $e->{weight} -= $newflow; shift @{$v->{edges}} unless ($e->{weight}); return $newflow; } else { shift @{$v->{edges}}; } } return 0; }; my $ret; $ret += $dfs->($levelGraph->[$source], $INF) while(@{$levelGraph->[$source]{edges}}); #assert($ret) if DEBUG; return $ret; } sub makeLevelGraph { # O(n^2) my ($flow, $N, $capacity, $source, $tink) = @_; my (@level, @levelGraph, @queue); $level[$_] = 0 for(0..$N-1); $levelGraph[$_] = new Vertex($_) for(0..$N-1); push @queue, $levelGraph[$source]; $level[$source] = 1; while(@queue) { # bfs my $v = shift @queue; return \@levelGraph if ($v->{id} == $tink); for(my $i=0; $i<$N; $i++) { my $residualCapacity = $capacity->[$v->{id}][$i] - List::Util::max($flow->[$v->{id}][$i] - $flow->[$i][$v->{id}], 0); if(($level[$i] == 0 or $level[$i] == $level[$v->{id}]+1) and $residualCapacity > 0) { push @{$v->{edges}}, new Edge($v->{id}, $i, $residualCapacity); if($level[$i] == 0) { $level[$i] = $level[$v->{id}]+1; push @queue, $levelGraph[$i]; } } } } return 0; } sub maxFlow { my ($N, $edges, $source, $tink) = @_; my ($capacity, $flow); #adjacent matrix my $totalFlow; for(my $i=0;$i<$N;$i++) { for(my $j=0;$j<$N;$j++) { $flow->[$i][$j]=0; $capacity->[$i][$j]=0; } } foreach my $e (@$edges) { $capacity->[$e->{source}][$e->{target}]+=$e->{weight}; } while(my $levelGraph=makeLevelGraph($flow, $N, $capacity, $source, $tink)) { #at most n times $totalFlow+=augment($levelGraph, $flow, $source, $tink); } return $totalFlow; }
Problem64
use warnings; use strict; my $ans=0; for(1..10000) { $ans++ if (f($_) % 2 == 1); } print $ans; sub f { my $N = shift; return rec($N, 1, - int(sqrt($N)), 1, {}); } sub rec { no warnings 'recursion'; my ($N, $k, $l, $m, $ht) = @_; my $n_m = ($N - $l**2) / $m; return 0 if $n_m == 0; my $a = int((sqrt($N) - $l) / $n_m); my $n_l = - $l - $n_m * $a; return $k - $ht->{$n_l}{$n_m} if $ht->{$n_l}{$n_m}; $ht->{$n_l}{$n_m} = $k; rec($N, $k+1, $n_l, $n_m, $ht); }
emacsの*scratch*もどきをvimとgaucheで.
使い方
gauche_scratch.vimとgauche_scratch.pyを
http://github.com/mechairoi/gauche_scratch/tree/master
からとってきて, .vimrcに
autocmd FileType scheme source path/to/gauche_scratch.vim autocmd FileType scheme nmap <C-J> :call GaucheScratchEvalLastExpression()<CR>
とすると
いろいろ
よく考えたらいろいろまずい。ファイル書き込みのような副作用があるときとか.←なおした.- バッファごとにgosh -iを起動しているけど1個の方がよいかも.
- 入力のチェックに毎回別のgoshを起動するのが醜い.
エラーがでた時は表示が乱れるのをなんとかしたい.←なおった?- (read)とか標準入力を待つ式を評価すると帰ってこないよ.
6/21 スペルミスを修正.
6/21 さらに修正.
Project Euler Problem62
借りてきたラクダ本に力をわけてもらった.
まだ1章だけど.
リストコンテキストはちょっと楽しい.
#!/usr/bin/env perl use strict; use warnings; my (%count, %min); for(my $i=1;;$i++) { my $cube = $i**3; my $key = join '', sort $cube =~ /./go; $min{$key} = $cube unless $count{$key}; $count{$key}++; if ($count{$key} == 5) { print $min{$key} . "\n"; last; } }
Perlでパーサーコンビネータもどき
HaskellのMonadをJavaScriptで実装するとしたら - ラシウラ
を参考にほとんど写経.
#!/usr/bin/env perl use strict; use warnings; sub parse { my ($parser, $input) = @_; return $parser->({ result => [], source => $input, index => 0, }); } sub bind { my ($src, $dst) = @_; return sub { my $pstate = shift; my $nstate = $src->($pstate); return &fail($nstate) unless $nstate; return $dst->($nstate->{result})->($nstate); }; } sub return { my $value = shift; return sub { my $pstate = shift; my $nstate; %$nstate = %$pstate; $nstate->{result} = $value; return $nstate; }; } sub fail { return; } sub char { my $ch = shift; return sub { my $pstate = shift; if (substr($pstate->{source}, $pstate->{index}, 1) eq $ch) { my $nstate; %$nstate = %$pstate; $nstate->{index} = $pstate->{index} + 1; $nstate->{result} = $ch; return $nstate; } else { &fail; } } } sub many { my $parser = shift; return sub { my $pstate = shift; my $current = $pstate; my $result; for(;;) { my $next = $parser->($current); if ($next) { $result .= $next->{result}; $current = $next; } else { my $nstate; %$nstate = %$current; $nstate->{result} = $result; return $nstate; } } }; } sub orelse { my ($p1, $p2) = @_; return sub { my $pstate = shift; return $p1->($pstate) || $p2->($pstate); }; }
実行例
my $manydParser = many(&bind(char('d'), sub { my $a = shift; return &return($a); })); my $abcParser = &bind(char('a'), sub { my $a = shift; &bind(char('b'), sub { my $b = shift; &bind(char('c'), sub { my $c = shift; &return($a . $b . $c); }); }); }); print parse($manydParser, "ddda") ->{result}, "\n"; # "ddd" print parse($abcParser, "abcd") ->{result}, "\n"; # "abc" print parse($abcParser, "abd"), "\n"; # undef print parse(orelse($abcParser, $manydParser), "ddabd")->{result}, "\n"; # "dd"