egison 3.3.13 → 3.3.14
raw patch · 7 files changed
+208/−106 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- egison.cabal +1/−1
- lib/core/collection.egi +56/−23
- lib/core/number.egi +4/−0
- lib/core/order.egi +16/−11
- lib/string/japanese.egi +91/−45
- lib/string/string.egi +4/−26
- sample/salesman.egi +36/−0
egison.cabal view
@@ -1,5 +1,5 @@ Name: egison-Version: 3.3.13+Version: 3.3.14 Synopsis: Programming language with non-linear pattern-matching against unfree data Description: An interpreter for Egison, the programming langugage that realized non-linear pattern-matching against unfree data types.
lib/core/collection.egi view
@@ -24,19 +24,9 @@ [<snoc $ $> [a (list a)] {[{@$xs $x} {[x xs]}] [_ {}]}]- [<join ,$pxs $> [(list a)]- {[$tgt (match-all [pxs tgt] [(list a) (list a)]- [[(loop $i [1 $n] <cons $xa_i ...> <nil>)- (loop $i [1 n] <cons ,xa_i ...> $rs)]- rs])]}] [<join $ $> [(list a) (list a)] {[$tgt (match-all tgt (list a) [(loop $i [1 $n] <cons $xa_i ...> $rs) [(map (lambda [$i] xa_i) (between 1 n)) rs]])]}]- [<nioj ,$pxs $> [(list a)]- {[$tgt (match-all [pxs tgt] [(list a) (list a)]- [[(loop $i [1 $n] <snoc $xa_i ...> <nil>)- (loop $i [1 n] <snoc ,xa_i ...> $rs)]- rs])]}] [<nioj $ $> [(list a) (list a)] {[$tgt (match-all tgt (list a) [(loop $i [1 $n] <snoc $xa_i ...> $rs) [(map (lambda [$i] xa_i) (between 1 n)) rs]])]}]@@ -44,6 +34,47 @@ {[$tgt {tgt}]}] }))) +(define $ordered-list+ (lambda [$a]+ (matcher+ {[,$val []+ {[$tgt (match [val tgt] [(ordered-list a) (ordered-list a)]+ {[[<nil> <nil>] {[]}]+ [[<cons $x $xs> <cons ,x ,xs>] {[]}]+ [[_ _] {}]})]}]+ [<nil> []+ {[{} {[]}]+ [_ {}]}]+ [<join $ <cons ,$px $>> [(ordered-list a) (ordered-list a)]+ {[{} {}]+ [$tgt (match-all tgt (list a)+ [(loop $i [1 $n] <cons (& ?(lt? $ px) $xa_i) ...> <cons ,px $rs>) [(map (lambda [$i] xa_i) (between 1 n)) rs]])]}]+ [<join $ $> [(ordered-list a) (ordered-list a)]+ {[$tgt (match-all tgt (list a)+ [(loop $i [1 $n] <cons $xa_i ...> $rs) [(map (lambda [$i] xa_i) (between 1 n)) rs]])]}]+ [<cons ,$px $> [(ordered-list a)]+ {[{$x @$xs} (if (gt? x px)+ {}+ {[xs]})]+ [_ {}]}]+ [<cons $ $> [a (ordered-list a)]+ {[{$x @$xs} {[x xs]}]+ [_ {}]}]+ [<nioj $ $> [(ordered-list a) (ordered-list a)]+ {[$tgt (match-all tgt (list a)+ [(loop $i [1 $n] <snoc $xa_i ...> $rs) [(map (lambda [$i] xa_i) (between 1 n)) rs]])]}]+ [<snoc ,$px $> [a (ordered-list a)]+ {[{@$xs $x} (if (lt? x px)+ {}+ {[xs]})]+ [_ {}]}]+ [<snoc $ $> [a (ordered-list a)]+ {[{@$xs $x} {[x xs]}]+ [_ {}]}]+ [$ [something]+ {[$tgt {tgt}]}]+ })))+ ;; ;; Helper function for List matcher, be careful for recursive calls ;;@@ -83,11 +114,7 @@ {[<nil> init] [<cons $x $xs> (fn x (foldr fn init xs))]}))) -(define $foldl- (lambda [$fn $init $ls]- (match ls (list something)- {[<nil> init]- [<cons $x $xs> (foldl fn (fn init x) xs)]})))+(define $foldl foldl') (define $foldl' (lambda [$fn $init $ls]@@ -97,6 +124,20 @@ (let {[$z (fn init x)]} (seq z (foldl' fn z xs)))]}))) +(define $foldl-naive+ (lambda [$fn $init $ls]+ (match ls (list something)+ {[<nil> init]+ [<cons $x $xs> (foldl fn (fn init x) xs)]})))++(define $enumerate+ (lambda [$fn $init $ls]+ (match ls (list something)+ {[<nil> {}]+ [<cons $x $xs>+ (let {[$ret (fn init x)]}+ {ret @(enumerate fn ret xs)})]})))+ (define $filter (lambda [$pred $xs] (foldr (lambda [$y $ys] (if (pred y) {y @ys} ys))@@ -335,10 +376,6 @@ [<nil> [] {[{} {[]}] [_ {}]}]- [<cons ,$px $> [(multiset a)]- {[$tgt (match tgt (list a)- {[<join $hs <cons ,px $ts>> {{@hs @ts}}]- [_ {}]})]}] [<cons $ $> [a (multiset a)] {[$tgt (match-all tgt (list a) [<join $hs <cons $x $ts>> [x {@hs @ts}]])]}]@@ -445,10 +482,6 @@ {[<nil> [] {[{} {[]}] [_ {}]}]- [<cons ,$px $> [(set a)]- {[$tgt (match tgt (list a)- {[<join _ <cons ,px _>> {tgt}]- [_ {}]})]}] [<cons $ $> [a (set a)] {[$tgt (match-all tgt (list a) [<join _ <cons $x _>> [x tgt]])]}]
lib/core/number.egi view
@@ -120,6 +120,10 @@ (lambda [$m $n $x] (and (lte? m x) (lte? x n)))) +(define $sum+ (lambda [$xs]+ (foldl' + 0 xs)))+ ;;; ;;; Float Numbers ;;;
lib/core/order.egi view
@@ -34,22 +34,27 @@ [(car ns) (car ns)] (cdr ns)))) -(define $split-by-ordering- (lambda [$xs $p]+(define $split-by-ordering (split-by-ordering/f compare $ $))++(define $split-by-ordering/f+ (lambda [$f $p $xs] (match xs (list something) {[<nil> [{} {} {}]] [<cons $x $rs>- (let {[[$ys1 $ys2 $ys3] (split-by-ordering rs p)]}- (match (compare x p) ordering+ (let {[[$ys1 $ys2 $ys3] (split-by-ordering/f f p rs)]}+ (match (f x p) ordering {[<less> [{x @ys1} ys2 ys3]] [<equal> [ys1 {x @ys2} ys3]] [<greater> [ys1 ys2 {x @ys3}]]}))]}))) -(define $qsort- (match-lambda (list something)- {[<nil> {}]- [<cons $x <nil>> {x}]- [$xs (let {[$n (length xs)]}+(define $qsort (qsort/f compare $))++(define $qsort/f+ (lambda [$f $xs]+ (match xs (list something)+ {[<nil> {}]+ [<cons $x <nil>> {x}]+ [_ (let {[$n (length xs)]} (let {[$p (nth (quotient n 2) xs)]}- (let {[[$ys1 $ys2 $ys3] (split-by-ordering xs p)]}- {@(qsort ys1) @ys2 @(qsort ys3)})))]}))+ (let {[[$ys1 $ys2 $ys3] (split-by-ordering/f f p xs)]}+ {@(qsort/f f ys1) @ys2 @(qsort/f f ys3)})))]})))
lib/string/japanese.egi view
@@ -1,38 +1,106 @@+(define $katakana?+ (match-lambda char+ {[,'ア' #t] [,'イ' #t] [,'ウ' #t] [,'エ' #t] [,'オ' #t]+ [,'カ' #t] [,'キ' #t] [,'ク' #t] [,'ケ' #t] [,'コ' #t]+ [,'サ' #t] [,'シ' #t] [,'ス' #t] [,'セ' #t] [,'ソ' #t]+ [,'タ' #t] [,'チ' #t] [,'ツ' #t] [,'テ' #t] [,'ト' #t]+ [,'ナ' #t] [,'ニ' #t] [,'ヌ' #t] [,'ネ' #t] [,'ノ' #t]+ [,'ハ' #t] [,'ヒ' #t] [,'フ' #t] [,'ヘ' #t] [,'ホ' #t]+ [,'マ' #t] [,'ミ' #t] [,'ム' #t] [,'メ' #t] [,'モ' #t]+ [,'ヤ' #t] [,'ユ' #t] [,'ヨ' #t]+ [,'ラ' #t] [,'リ' #t] [,'ル' #t] [,'レ' #t] [,'ロ' #t]+ [,'ワ' #t] [,'ヲ' #t] [,'ン' #t]+ [,'ガ' #t] [,'ギ' #t] [,'グ' #t] [,'ゲ' #t] [,'ゴ' #t]+ [,'ザ' #t] [,'ジ' #t] [,'ズ' #t] [,'ゼ' #t] [,'ゾ' #t]+ [,'ダ' #t] [,'ヂ' #t] [,'ヅ' #t] [,'デ' #t] [,'ド' #t]+ [,'バ' #t] [,'ビ' #t] [,'ブ' #t] [,'ベ' #t] [,'ボ' #t]+ [,'パ' #t] [,'ピ' #t] [,'プ' #t] [,'ペ' #t] [,'ポ' #t]+ [,'ァ' #t] [,'ィ' #t] [,'ゥ' #t] [,'ェ' #t] [,'ォ' #t]+ [,'ャ' #t] [,'ュ' #t] [,'ョ' #t]+ [,'ッ' #t] [,'ー' #t]+ [_ #f]}))++(define $katakanas?+ (lambda [$s]+ (all katakana? (unpack s))))+ (define $katakana-to-yomi (lambda [$s] (match s string- {[<cons $c <cons ,'ャ' $rs>>- (append (katakana-to-yomi1 {c 'ャ'}) (katakana-to-yomi rs))]- [<cons $c <cons ,'ュ' $rs>>- (append (katakana-to-yomi1 {c 'ュ'}) (katakana-to-yomi rs))]- [<cons $c <cons ,'ョ' $rs>>- (append (katakana-to-yomi1 {c 'ョ'}) (katakana-to-yomi rs))]- [<cons $c <cons ,'ァ' $rs>>- (append (katakana-to-yomi1 {c 'ァ'}) (katakana-to-yomi rs))]- [<cons $c <cons ,'ィ' $rs>>- (append (katakana-to-yomi1 {c 'ィ'}) (katakana-to-yomi rs))]- [<cons $c <cons ,'ゥ' $rs>>- (append (katakana-to-yomi1 {c 'ゥ'}) (katakana-to-yomi rs))]- [<cons $c <cons ,'ェ' $rs>>- (append (katakana-to-yomi1 {c 'ェ'}) (katakana-to-yomi rs))]- [<cons $c <cons ,'ォ' $rs>>- (append (katakana-to-yomi1 {c 'ォ'}) (katakana-to-yomi rs))]- [<cons ,'ー' $rs>+ {[<cons ,'ッ' $rs> (katakana-to-yomi rs)]- [<cons ,'ッ' $rs>+ [<cons ,'ー' $rs> (katakana-to-yomi rs)]+ [<cons (& (| ,'ァ' ,'ィ' ,'ゥ' ,'ェ' ,'ォ') $c) <cons ,'ー' $rs>>+ {(match c char {[,'ァ' "A"] [,'ィ' "I"] [,'ゥ' "U"] [,'ェ' "E"] [,'ォ' "O"]}) @(katakana-to-yomi rs)}]+ [<cons (& (| ,'ァ' ,'ィ' ,'ゥ' ,'ェ' ,'ォ') $c) $rs>+ {(match c char {[,'ァ' "A"] [,'ィ' "I"] [,'ゥ' "U"] [,'ェ' "E"] [,'ォ' "O"]}) @(katakana-to-yomi rs)}]+ [<cons (& (| ,'ャ' ,'ュ' ,'ョ') $c) <cons ,'ー' $rs>>+ {@(match c char {[,'ャ' {"Y" "A"}] [,'ュ' {"Y" "U"}] [,'ョ' {"Y" "O"}]}) @(katakana-to-yomi rs)}]+ [<cons (& (| ,'ャ' ,'ュ' ,'ョ') $c) $rs>+ {@(match c char {[,'ャ' {"Y" "A"}] [,'ュ' {"Y" "U"}] [,'ョ' {"Y" "O"}]}) @(katakana-to-yomi rs)}]+ [<cons $c1 <cons (& (| ,'ャ' ,'ュ' ,'ョ') $c2) <cons ,'ー' $rs>>>+ (append (katakana-to-yomi-y-1 {c1 c2}) (katakana-to-yomi rs))]+ [<cons $c1 <cons (& (| ,'ャ' ,'ュ' ,'ョ') $c2) $rs>>+ (append (katakana-to-yomi-y-1 {c1 c2}) (katakana-to-yomi rs))]+ [<cons $c1 <cons (& (| ,'ァ' ,'ィ' ,'ゥ' ,'ェ' ,'ォ') $c2) <cons ,'ー' $rs>>>+ (append (katakana-to-yomi-x-1 {c1 c2}) (katakana-to-yomi rs))]+ [<cons $c1 <cons (& (| ,'ァ' ,'ィ' ,'ゥ' ,'ェ' ,'ォ') $c2) $rs>>+ (append (katakana-to-yomi-x-1 {c1 c2}) (katakana-to-yomi rs))]+ [<cons $c <cons ,'ー' $rs>>+ (append (katakana-to-yomi-1 {c}) (katakana-to-yomi rs))] [<cons $c $rs>- (append (katakana-to-yomi1 {c}) (katakana-to-yomi rs))]+ (append (katakana-to-yomi-1 {c}) (katakana-to-yomi rs))] [<nil> {}] }))) -(define $katakana-to-yomi1+(define $katakana-to-yomi-y-1 (lambda [$cs] (match cs (list char)+ {[,{'キ' 'ャ'} {"K" "Y" "A"}] [,{'キ' 'ュ'} {"K" "Y" "U"}] [,{'キ' 'ョ'} {"K" "Y" "O"}]+ [,{'ギ' 'ャ'} {"G" "Y" "A"}] [,{'ギ' 'ュ'} {"G" "Y" "U"}] [,{'ギ' 'ョ'} {"G" "Y" "O"}]+ [,{'シ' 'ャ'} {"SH" "Y" "A"}] [,{'シ' 'ュ'} {"SH" "U"}] [,{'シ' 'ョ'} {"SH" "O"}]+ [,{'ジ' 'ャ'} {"J" "A"}] [,{'ジ' 'ュ'} {"J" "U"}] [,{'ジ' 'ョ'} {"J" "O"}]+ [,{'チ' 'ャ'} {"CH" "A"}] [,{'チ' 'ュ'} {"CH" "U"}] [,{'チ' 'ョ'} {"CH" "O"}]+ [,{'ヂ' 'ャ'} {"J" "A"}] [,{'ヂ' 'ュ'} {"J" "U"}] [,{'ヂ' 'ョ'} {"J" "O"}]+ [,{'ニ' 'ャ'} {"N" "Y" "A"}] [,{'ニ' 'ュ'} {"N" "U"}] [,{'ニ' 'ョ'} {"N" "O"}]+ [,{'ヒ' 'ャ'} {"H" "Y" "A"}] [,{'ヒ' 'ュ'} {"H" "Y" "U"}] [,{'ヒ' 'ョ'} {"H" "Y" "O"}]+ [,{'ビ' 'ャ'} {"B" "Y" "A"}] [,{'ビ' 'ュ'} {"B" "Y" "U"}] [,{'ビ' 'ョ'} {"B" "Y" "O"}]+ [,{'ピ' 'ャ'} {"P" "Y" "A"}] [,{'ピ' 'ュ'} {"P" "Y" "U"}] [,{'ピ' 'ョ'} {"P" "Y" "O"}]+ [,{'ミ' 'ャ'} {"M" "Y" "A"}] [,{'ミ' 'ュ'} {"M" "Y" "U"}] [,{'ミ' 'ョ'} {"M" "Y" "O"}]+ [,{'リ' 'ャ'} {"R" "Y" "A"}] [,{'リ' 'ュ'} {"R" "Y" "U"}] [,{'リ' 'ョ'} {"R" "Y" "O"}]+ [,{'フ' 'ュ'} {"F" "Y" "U"}] [,{'テ' 'ュ'} {"CH" "U"}] [,{'デ' 'ュ'} {"D" "Y" "U"}]+ [<cons $c1 <cons $c2 <nil>>> {@(katakana-to-yomi-1 {c1})+ @(match c2 char {[,'ャ' {"Y" "A"}] [,'ュ' {"Y" "A"}] [,'ョ' {"Y" "A"}]})}]+ })))++(define $katakana-to-yomi-x-1+ (lambda [$cs]+ (match cs (list char)+ {[,{'ウ' 'ィ'} {"W" "I"}] [,{'ウ' 'ェ'} {"W" "E"}] [,{'ウ' 'ォ'} {"W" "O"}]+ [,{'キ' 'ィ'} {"K" "I"}]+ [,{'ク' 'ァ'} {"K" "W" "A"}] [,{'ク' 'ィ'} {"K" "W" "I"}] [,{'ク' 'ェ'} {"K" "W" "E"}] [,{'ク' 'ォ'} {"K" "W" "O"}]+ [,{'シ' 'ィ'} {"S" "I"}] [,{'シ' 'ェ'} {"SH" "E"}]+ [,{'ジ' 'ェ'} {"J" "E"}]+ [,{'ツ' 'ァ'} {"TS" "A"}] [,{'ツ' 'ゥ'} {"T" "U"}] + [,{'チ' 'ェ'} {"CH" "E"}]+ [,{'フ' 'ァ'} {"F" "A"}] [,{'フ' 'ィ'} {"F" "I"}] [,{'フ' 'ェ'} {"F" "E"}] [,{'フ' 'ォ'} {"F" "O"}]+ [,{'ヴ' 'ァ'} {"V" "A"}] [,{'ヴ' 'ィ'} {"V" "I"}] [,{'ヴ' 'ェ'} {"V" "E"}] [,{'ヴ' 'ォ'} {"V" "O"}]+ [,{'シ' 'ィ'} {"S" "I"}] [,{'ス' 'ィ'} {"S" "I"}] [,{'ズ' 'ィ'} {"Z" "I"}]+ [,{'テ' 'ィ'} {"T" "I"}] [,{'デ' 'ィ'} {"D" "I"}]+ [,{'ト' 'ゥ'} {"T" "U"}] [,{'ヅ' 'ゥ'} {"D" "U"}] [,{'ド' 'ゥ'} {"D" "U"}]+ [<cons $c1 <cons $c2 <nil>>> {@(katakana-to-yomi-1 {c1})+ (match c2 char {[,'ァ' "A"] [,'ィ' "I"] [,'ゥ' "U"] [,'ェ' "E"] [,'ォ' "O"]})+ }]+ })))++(define $katakana-to-yomi-1+ (lambda [$cs]+ (match cs (list char) {[,{'ア'} {"A"}] [,{'イ'} {"I"}] [,{'ウ'} {"U"}] [,{'エ'} {"E"}] [,{'オ'} {"O"}] [,{'カ'} {"K" "A"}] [,{'キ'} {"K" "I"}] [,{'ク'} {"K" "U"}] [,{'ケ'} {"K" "E"}] [,{'コ'} {"K" "O"}] [,{'サ'} {"S" "A"}] [,{'シ'} {"SH" "I"}] [,{'ス'} {"S" "U"}] [,{'セ'} {"S" "E"}] [,{'ソ'} {"S" "O"}]- [,{'タ'} {"T" "A"}] [,{'チ'} {"CH" "I"}] [,{'ツ'} {"T" "U"}] [,{'テ'} {"T" "E"}] [,{'ト'} {"T" "O"}]+ [,{'タ'} {"T" "A"}] [,{'チ'} {"CH" "I"}] [,{'ツ'} {"TS" "U"}] [,{'テ'} {"T" "E"}] [,{'ト'} {"T" "O"}] [,{'ナ'} {"N" "A"}] [,{'ニ'} {"N" "I"}] [,{'ヌ'} {"N" "U"}] [,{'ネ'} {"N" "E"}] [,{'ノ'} {"N" "O"}] [,{'ハ'} {"H" "A"}] [,{'ヒ'} {"H" "I"}] [,{'フ'} {"F" "U"}] [,{'ヘ'} {"H" "E"}] [,{'ホ'} {"H" "O"}] [,{'マ'} {"M" "A"}] [,{'ミ'} {"M" "I"}] [,{'ム'} {"M" "U"}] [,{'メ'} {"M" "E"}] [,{'モ'} {"M" "O"}]@@ -44,28 +112,6 @@ [,{'ダ'} {"D" "A"}] [,{'ヂ'} {"D" "I"}] [,{'ヅ'} {"D" "U"}] [,{'デ'} {"D" "E"}] [,{'ド'} {"D" "O"}] [,{'バ'} {"B" "A"}] [,{'ビ'} {"B" "I"}] [,{'ブ'} {"B" "U"}] [,{'ベ'} {"B" "E"}] [,{'ボ'} {"B" "O"}] [,{'パ'} {"P" "A"}] [,{'ピ'} {"P" "I"}] [,{'プ'} {"P" "U"}] [,{'ペ'} {"P" "E"}] [,{'ポ'} {"P" "O"}]- [,{'キ' 'ャ'} {"K" "AE"}] [,{'キ' 'ュ'} {"K" "YU"}] [,{'キ' 'ョ'} {"K" "YO"}]- [,{'ギ' 'ャ'} {"G" "AE"}] [,{'ギ' 'ュ'} {"G" "YU"}] [,{'ギ' 'ョ'} {"G" "YO"}]- [,{'シ' 'ャ'} {"SH" "AE"}] [,{'シ' 'ュ'} {"SH" "U"}] [,{'シ' 'ョ'} {"SH" "O"}]- [,{'ジ' 'ャ'} {"J" "A"}] [,{'ジ' 'ュ'} {"J" "U"}] [,{'ジ' 'ョ'} {"J" "O"}]- [,{'チ' 'ャ'} {"CH" "AE"}] [,{'チ' 'ュ'} {"CH" "U"}] [,{'チ' 'ョ'} {"CH" "O"}]- [,{'ニ' 'ャ'} {"N" "AE"}] [,{'ニ' 'ュ'} {"N" "U"}] [,{'ニ' 'ョ'} {"N" "O"}]- [,{'ヒ' 'ャ'} {"H" "AE"}] [,{'ヒ' 'ュ'} {"H" "YU"}] [,{'ヒ' 'ョ'} {"H" "YO"}]- [,{'ビ' 'ャ'} {"B" "AE"}] [,{'ビ' 'ュ'} {"B" "YU"}] [,{'ビ' 'ョ'} {"B" "YO"}]- [,{'ピ' 'ャ'} {"P" "AE"}] [,{'ピ' 'ュ'} {"P" "YU"}] [,{'ピ' 'ョ'} {"P" "YO"}]- [,{'ミ' 'ャ'} {"M" "AE"}] [,{'ミ' 'ュ'} {"M" "YU"}] [,{'ミ' 'ョ'} {"M" "YO"}]- [,{'リ' 'ャ'} {"R" "AE"}] [,{'リ' 'ュ'} {"R" "YU"}] [,{'リ' 'ョ'} {"R" "YO"}]- [,{'ウ' 'ィ'} {"WI"}] [,{'ウ' 'ェ'} {"WE"}] [,{'ウ' 'ォ'} {"WO"}]- [,{'キ' 'ィ'} {"K" "I"}]- [,{'ク' 'ィ'} {"K" "WI"}] [,{'ク' 'ェ'} {"K" "WE"}] [,{'ク' 'ォ'} {"K" "WO"}]- [,{'シ' 'ィ'} {"S" "I"}] [,{'シ' 'ェ'} {"SH" "E"}]- [,{'ジ' 'ェ'} {"J" "E"}]- [,{'チ' 'ェ'} {"CH" "E"}]- [,{'フ' 'ァ'} {"F" "A"}] [,{'フ' 'ィ'} {"F" "I"}] [,{'フ' 'ェ'} {"F" "E"}] [,{'フ' 'ォ'} {"F" "O"}]- [,{'ヴ' 'ァ'} {"V" "A"}] [,{'ヴ' 'ィ'} {"V" "I"}] [,{'ヴ' 'ェ'} {"V" "E"}] [,{'ヴ' 'ォ'} {"V" "O"}]- [,{'シ' 'ィ'} {"S" "I"}] [,{'ス' 'ィ'} {"S" "I"}] [,{'ズ' 'ィ'} {"Z" "I"}]- [,{'テ' 'ィ'} {"T" "I"}] [,{'デ' 'ィ'} {"D" "I"}] [,{'デ' 'ュ'} {"D" "YU"}]- [,{'ツ' 'ゥ'} {"T" "U"}] [,{'ト' 'ゥ'} {"T" "U"}] [,{'ヅ' 'ゥ'} {"D" "U"}] [,{'ド' 'ゥ'} {"D" "U"}] [,{'フ' 'ュ'} {"F" "YU"}]- [,{'ァ'} {"A"}] [,{'ィ'} {"I"}] [,{'ゥ'} {"U"}] [,{'ェ'} {"E"}] [,{'ォ'} {"O"}]- [<cons $c <cons _>> (katakana-to-yomi1 {c})]+ [,{'ヴ'} {"V" "U"}] [,{'ヮ'} {"W" "A"}] })))+
lib/string/string.egi view
@@ -45,6 +45,10 @@ ;;; String as Collection ;;; +(define $S.empty?+ (lambda [$xs]+ (eq? xs "")))+ (define $S.map (lambda [$f $xs] (pack (map f (unpack xs)))))@@ -68,32 +72,6 @@ xss))) (define $S.intercalate (compose intersperse S.concat))--(define $katakana?- (match-lambda char- {[,'ア' #t] [,'イ' #t] [,'ウ' #t] [,'エ' #t] [,'オ' #t]- [,'カ' #t] [,'キ' #t] [,'ク' #t] [,'ケ' #t] [,'コ' #t]- [,'サ' #t] [,'シ' #t] [,'ス' #t] [,'セ' #t] [,'ソ' #t]- [,'タ' #t] [,'チ' #t] [,'ツ' #t] [,'テ' #t] [,'ト' #t]- [,'ナ' #t] [,'ニ' #t] [,'ヌ' #t] [,'ネ' #t] [,'ノ' #t]- [,'ハ' #t] [,'ヒ' #t] [,'フ' #t] [,'ヘ' #t] [,'ホ' #t]- [,'マ' #t] [,'ミ' #t] [,'ム' #t] [,'メ' #t] [,'モ' #t]- [,'ヤ' #t] [,'ユ' #t] [,'ヨ' #t]- [,'ラ' #t] [,'リ' #t] [,'ル' #t] [,'レ' #t] [,'ロ' #t]- [,'ワ' #t] [,'ヲ' #t] [,'ン' #t]- [,'ガ' #t] [,'ギ' #t] [,'グ' #t] [,'ゲ' #t] [,'ゴ' #t]- [,'ザ' #t] [,'ジ' #t] [,'ズ' #t] [,'ゼ' #t] [,'ゾ' #t]- [,'ダ' #t] [,'ヂ' #t] [,'ヅ' #t] [,'デ' #t] [,'ド' #t]- [,'バ' #t] [,'ビ' #t] [,'ブ' #t] [,'ベ' #t] [,'ボ' #t]- [,'パ' #t] [,'ピ' #t] [,'プ' #t] [,'ペ' #t] [,'ポ' #t]- [,'ァ' #t] [,'ィ' #t] [,'ゥ' #t] [,'ェ' #t] [,'ォ' #t]- [,'ャ' #t] [,'ュ' #t] [,'ョ' #t]- [,'ッ' #t] [,'ー' #t]- [_ #f]}))--(define $katakanas?- (lambda [$s]- (all katakana? (unpack s)))) (define $alphabet? (match-lambda char
+ sample/salesman.egi view
@@ -0,0 +1,36 @@+;;;+;;; Travelling Salesman Problem+;;;++(define $station string) ; 駅は文字列として表現+(define $price integer) ; 運賃は整数値として表現+(define $graph (multiset [station (multiset [station price])])) ; 運賃グラフのマッチャー++(define $graph-data ; 運賃データ+ {+ ["東京" { ["新宿" 200] ["渋谷" 200] ["三鷹" 390] ["錦糸町" 160] ["北千住" 220]}]+ ["新宿" {["東京" 200] ["渋谷" 160] ["三鷹" 220] ["錦糸町" 220] ["北千住" 310]}]+ ["渋谷" {["東京" 200] ["新宿" 160] ["三鷹" 310] ["錦糸町" 220] ["北千住" 310]}]+ ["三鷹" {["東京" 390] ["新宿" 220] ["渋谷" 310] ["錦糸町" 470] ["北千住" 550]}]+ ["錦糸町" {["東京" 160] ["新宿" 220] ["渋谷" 220] ["三鷹" 470] ["北千住" 220]}]+ ["北千住" {["東京" 220] ["新宿" 310] ["渋谷" 310] ["三鷹" 550] ["錦糸町" 220] }]+ })++(define $trips ; 全ての経路をパターンマッチを用いて列挙+ (match-all graph-data graph+ [<cons [,"東京" <cons [$s_1 $p_1] _>]+ (loop $i [2 5]+ <cons [,s_(- i 1) <cons [$s_i $p_i] _>]+ ...>+ <cons [,s_5 <cons [(& ,"東京" $s_6) $p_6] _>]+ _>)>+ [(sum (map (lambda [$i] p_i) (between 1 6)))+ s]]))++(define $main+ (lambda [$args]+ (do {[(print "経路一覧:")]+ [(each (compose show print) trips)] ; 全ての経路を出力+ [(write "最安値:")]+ [(print (show (min (map (lambda [$x $y] x) trips))))]}))) ; 最安値を出力+