From cd792ff15edc16b097f23b312c166a1fe602e07d Mon Sep 17 00:00:00 2001 From: AlephAlpha Date: Thu, 7 Sep 2023 15:39:52 +0800 Subject: [PATCH] :smile_cat: --- CHANGELOG.md | 2 +- analysis/Ideas.md | 27 ++++--- analysis/corpus.txt | 12 ++- analysis/freq_1gram.txt | 56 ++++++------- analysis/freq_2gram.txt | 63 +++++++++------ analysis/freq_3gram.txt | 54 ++++++++----- analysis/freq_4gram.txt | 48 ++++++----- analysis/freq_5gram.txt | 40 +++++----- analysis/particles.txt | 10 +-- doc/Builtins.md | 18 +++++ doc/CodePage.md | 4 +- src/Nekomata/Builtin.hs | 18 +++++ src/Nekomata/Builtin/List.hs | 10 +-- src/Nekomata/Builtin/Math.hs | 18 ++++- src/Nekomata/CodePage.hs | 4 +- src/Nekomata/Data.hs | 151 ++++++++++++++++++----------------- src/Nekomata/Function.hs | 26 ++++++ test/Eval.hs | 48 ++++++++++- 18 files changed, 382 insertions(+), 227 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3428a57..4fdd4f3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,7 +2,7 @@ ## 0.5.1.0 -- Unreleased -* New built-in functions: `\rle`, `\unrle`. +* New built-in functions: `\divMod`, `\popCount`, `\rle`, `\unrle`. ## 0.5.0.0 -- 2023-09-02 diff --git a/analysis/Ideas.md b/analysis/Ideas.md index e159a87..3037ad2 100644 --- a/analysis/Ideas.md +++ b/analysis/Ideas.md @@ -124,17 +124,6 @@ LiberationMono 字体所支持的字符列举于[此文件](analysis/LiberationM - [ ] `\pad`：输入一个列表的列表，将每个列表的长度补齐到最长的子列表的长度。比如说 `[[1, 2], [3, 4, 5]]` 补齐成 `[[1, 2, 0], [3, 4, 5]]`。 -### [Find Index of Rational Number in Calkin-Wilf Sequence](https://codegolf.stackexchange.com/q/260472/9288) - -需要 `-n` flag。 - - -``` -\iterate { \recip \decrement \neg1 \divMod \add \neg \nonZero } -``` - -- [ ] `\divMod`：同时求商和余数。由于有两个返回值，还不知道怎么向量化。 - ### [Is it a brainfuck instruction?](https://codegolf.stackexchange.com/q/203330/9288) ``` @@ -165,6 +154,22 @@ LiberationMono 字体所支持的字符列举于[此文件](analysis/LiberationM - [ ] `\complement`：1 减去一个数。 +### [How many trailing zeros in the hyperfactorial?](https://codegolf.stackexchange.com/q/263597/9288) + +``` +\range1 \dup 5 \valuation \dot +``` + +- [ ] `\valuation`：一个数的 p 进赋值。 + +### [Number of bits needed to represent the product of the first primes](https://codegolf.stackexchange.com/q/263531/9288) + +``` +\range1 \nthPrime \product \binary \length +``` + +- [ ] `\nthPrime`：求第 n 个质数。 + ## 关于字符串 从 v0.5.0.0 开始，Nekomata 将不再区分字符串和列表，增加了一个字符类型，当一个列表的全部元素都是字符时，就视为一个字符串。字符串和列表只在输入输出时有区别，其它时候都是一样的。 diff --git a/analysis/corpus.txt b/analysis/corpus.txt index 723f950..656664a 100644 --- a/analysis/corpus.txt +++ b/analysis/corpus.txt @@ -90,6 +90,7 @@ pƆᵗf ;ᶜç↔ᶻ+ poil ᵏ{ᵉ+→%Z +ᵏ{ᵐĝj= ˡ{C4+>‼ Ď∑ ←Ƃ≡ @@ -104,10 +105,10 @@ R:∙ 258Ɗ+12%→ 12Rᶠ{-Z3¦ RË3÷ -Ë:ᵒ{&Ƃ∑£E +Ë:ᵒ&Þ£E ŋ∑ũ ĉᵐ∫j -Ƃ∑½ +Þ½ Sđ*aŢṂ Sᵖ{đ∩z}ᵐj ;$N, @@ -136,6 +137,7 @@ RpN↔ oĉ~z Ť_= ïƊj1Ĉ +ƒz ËƂ∑± ᵉᵑ{ˣ∙ɔᵈç}T ᵐĈ @@ -181,6 +183,8 @@ Rᶠ{$R~ᵃƂ×Öƃ= ᵐµṀ o:h-l p↔:#:ËGT∑ +x:→&xï@ᵐ∑ +Ňᵖ{:ÄXÞ½= ˡ{ᵗ≡ĭ?}aṀ Ɗĭ∑ ᵏ{*+$/1%≡ @@ -224,7 +228,7 @@ RF£b ↕∆A1> ≈Z‼2M≡ ᵏᵚ{ᵑ{įŋ+}f -ˡ{ŗ:KÄ$-← +ˡ{ŗ←£þ+_ ᶦ{1%ŗ}kaC$∫←:_Ë£d§+ṇ$çlÐ o;*ṁ oĭ$∏ @@ -245,7 +249,7 @@ x:ᵒ-¬* 3Ňŧ←1c:↔_=3b Ňƒ$ƥ←ËƂ∙ŋ +ᵚ%-±ç1Ĩ -Ë:ᵒ{ᵃƂ+2Ĉ←A± +Ë:ᵒ&Þ←A± ƒ1> Ťᵐ↕∫Ɔž∑≤ ~ᵉ{$#ᵑ{ˣ@j,u}}∕~ diff --git a/analysis/freq_1gram.txt b/analysis/freq_1gram.txt index c7a6f64..77ab9cb 100644 --- a/analysis/freq_1gram.txt +++ b/analysis/freq_1gram.txt @@ -1,63 +1,64 @@ { : 61 -: : 49 -$ : 43 +: : 50 +$ : 42 += : 37 + : 35 -= : 35 -∑ : 35 +∑ : 34 ← : 28 +ᵐ : 28 R : 28 1 : 26 -ᵐ : 26 * : 26 } : 26 +→ : 24 ↔ : 23 -→ : 23 -- : 23 +- : 22 a : 22 ç : 20 -Ƃ : 19 -j : 19 -2 : 19 +j : 20 ᵉ : 18 , : 18 o : 18 +2 : 18 +x : 18 u : 17 # : 16 +Ƃ : 16 ᵒ : 16 p : 16 -x : 16 +ᵖ : 16 3 : 15 l : 15 -ᵖ : 15 ~ : 15 ↕ : 14 ĭ : 14 Ṁ : 14 ∫ : 13 Ë : 13 +Ň : 13 Ð : 13 +½ : 12 t : 12 -Ň : 12 ᶦ : 11 S : 11 -½ : 11 Q : 11 ≡ : 11 đ : 11 ᵑ : 11 Ɗ : 11 ĉ : 11 +_ : 11 " : 10 < : 10 -ᵃ : 10 Ť : 10 Ɔ : 10 Z : 10 ; : 10 ∏ : 10 -_ : 10 N : 9 +z : 9 Ţ : 9 +ᵃ : 9 ᶻ : 9 ŋ : 9 ? : 9 @@ -68,7 +69,6 @@ L : 9 ʷ : 8 P : 8 ᶜ : 8 -z : 8 ũ : 8 > : 8 × : 8 @@ -80,7 +80,7 @@ E : 8 ‼ : 8 c : 8 % : 8 -Ĉ : 8 +ƒ : 8 ṁ : 8 C : 8 ∆ : 8 @@ -88,15 +88,17 @@ J : 7 q : 7 ᵗ : 7 f : 7 +£ : 7 ɗ : 7 -ƒ : 7 +Ĉ : 7 Ĩ : 7 ∙ : 7 4 : 7 +@ : 7 ˡ : 6 +ᵏ : 6 ů : 6 ∕ : 6 -£ : 6 Ä : 6 / : 6 Ø : 6 @@ -107,8 +109,6 @@ A : 6 Ř : 6 į : 6 ¢ : 6 -@ : 6 -ᵏ : 5 Ö : 5 ƃ : 5 d : 5 @@ -139,10 +139,12 @@ F : 4 h : 4 i : 4 ÷ : 4 +Þ : 4 ˣ : 4 ň : 4 0 : 4 ᵋ : 4 +ĝ : 3 Ṃ : 3 ř : 3 U : 3 @@ -152,17 +154,18 @@ s : 3 ɔ : 3 M : 3 7 : 3 -K : 3 ĕ : 3 +& : 3 +ï : 3 Ṗ : 3 b : 3 § : 3 -ĝ : 2 Ƥ : 2 g : 2 D : 2 +X : 2 +K : 2 6 : 2 -ï : 2 m : 2 ' : 2 ≠ : 2 @@ -173,13 +176,12 @@ W : 1 ! : 1 ^ : 1 | : 1 -X : 1 -& : 1 Ž : 1 ṃ : 1 ¡ : 1 Ŭ : 1 Ļ : 1 +þ : 1 ṇ : 1 9 : 1 \ : 1 diff --git a/analysis/freq_2gram.txt b/analysis/freq_2gram.txt index 30e8aef..60c276a 100644 --- a/analysis/freq_2gram.txt +++ b/analysis/freq_2gram.txt @@ -1,5 +1,5 @@ ᶦ{ : 10 -ᵖ{ : 8 +ᵖ{ : 9 ʷ{ : 7 ᵑ{ : 7 ᶠ{ : 7 @@ -7,19 +7,20 @@ :↔ : 5 ˡ{ : 5 1> : 5 -ᵒ{ : 5 +{: : 5 Jᵐ : 4 {1 : 4 *→ : 4 -ᵃƂ : 4 -¬ : 4 Ɔž : 4 -{: : 4 +ᵏ{ : 4 :ᵒ : 4 +Ňᵖ : 4 ᵗz : 3 ↔= : 3 ŢṂ : 3 ←½ : 3 +ᵃƂ : 3 Ƃ× : 3 ᵒ- : 3 u∕ : 3 @@ -38,11 +39,9 @@ Rᶠ : 3 aṀ : 3 ËƂ : 3 1Ĩ : 3 -ᵏ{ : 3 R: : 3 :∙ : 3 2R : 3 -Ƃ∑ : 3 xŘ : 3 -_ : 3 u# : 3 @@ -50,12 +49,13 @@ u# : 3 pN : 3 {ˣ : 3 {į : 3 +ᵐ∑ : 3 ↕ũ : 3 +ᵒ{ : 3 }a : 3 aş : 3 ᵐ{ : 3 +} : 3 -Ňᵖ : 3 *$ : 3 #← : 3 R∑ : 3 @@ -81,7 +81,6 @@ pƆ : 2 p= : 2 al : 2 Z‼ : 2 -Ä$ : 2 →/ : 2 çƆ : 2 $ᵑ : 2 @@ -115,7 +114,6 @@ R~ : 2 +↔ : 2 aj : 2 Ṁ← : 2 -Ƃ+ : 2 ᵐ∏ : 2 }∑ : 2 :E : 2 @@ -136,8 +134,10 @@ Qƥ : 2 12 : 2 {- : 2 Ë: : 2 +ᵒ& : 2 +&Þ : 2 ĉᵐ : 2 -∑½ : 2 +Þ½ : 2 Sđ : 2 Sᵖ : 2 ∩z : 2 @@ -151,7 +151,6 @@ oĭ : 2 _= : 2 Ṁ→ : 2 -ň : 2 -ᵐ∑ : 2 aṁ : 2 0* : 2 x= : 2 @@ -172,12 +171,14 @@ ux : 2 ŇË : 2 tu : 2 ut : 2 +:→ : 2 {ᵋ : 2 ᶻ, : 2 ,Ť : 2 Ṗ↕ : 2 {J : 2 :# : 2 +x: : 2 {* : 2 ᵃ{ : 2 ŋ+ : 2 @@ -189,7 +190,6 @@ RS : 2 += : 2 3~ : 2 ~ᵑ : 2 -{ᵃ : 2 ᵋ∩ : 2 ↕∆ : 2 ←_ : 2 @@ -244,6 +244,7 @@ d! : 1 E∫ : 1 pZ : 1 ‼l : 1 +Ä$ : 1 $Ç : 1 Ç$ : 1 $→ : 1 @@ -337,6 +338,7 @@ l∑ : 1 :ṁ : 1 ṁĨ : 1 ĨË : 1 +Ƃ+ : 1 ᵒ% : 1 %ᵐ : 1 ∏¬ : 1 @@ -408,6 +410,10 @@ oi : 1 il : 1 →% : 1 %Z : 1 +{ᵐ : 1 +ᵐĝ : 1 +ĝj : 1 +j= : 1 C4 : 1 4+ : 1 +> : 1 @@ -440,9 +446,7 @@ Z3 : 1 RË : 1 Ë3 : 1 3÷ : 1 -{& : 1 -&Ƃ : 1 -∑£ : 1 +Þ£ : 1 ŋ∑ : 1 ∑ũ : 1 ᵐ∫ : 1 @@ -509,6 +513,8 @@ i≥ : 1 Ť_ : 1 ïƊ : 1 j1 : 1 +ƒz : 1 +Ƃ∑ : 1 ∑± : 1 ᵉᵑ : 1 ˣ∙ : 1 @@ -642,7 +648,6 @@ D: : 1 ×Ṁ : 1 #2 : 1 ÷: : 1 -:→ : 1 →: : 1 ᵋ{ : 1 -+ : 1 @@ -677,6 +682,15 @@ p↔ : 1 ËG : 1 GT : 1 T∑ : 1 +→& : 1 +&x : 1 +xï : 1 +ï@ : 1 +@ᵐ : 1 +:Ä : 1 +ÄX : 1 +XÞ : 1 +½= : 1 {ᵗ : 1 ᵗ≡ : 1 ≡ĭ : 1 @@ -802,6 +816,7 @@ Cᵈ : 1 ᵈA : 1 Ac : 1 c} : 1 +∑½ : 1 $ṁ : 1 ṁ± : 1 ±* : 1 @@ -839,6 +854,7 @@ aᵐ : 1 {0 : 1 *} : 1 ∑2 : 1 +{ᵃ : 1 Ƃᵈ : 1 ᵈ: : 1 :≈ : 1 @@ -910,11 +926,11 @@ M≡ : 1 įŋ : 1 }f : 1 {ŗ : 1 -ŗ: : 1 -:K : 1 -KÄ : 1 -$- : 1 --← : 1 +ŗ← : 1 +←£ : 1 +£þ : 1 +þ+ : 1 ++_ : 1 ka : 1 aC : 1 C$ : 1 @@ -995,7 +1011,6 @@ pᵉ : 1 ᵉl : 1 oÐ : 1 Ðũ : 1 -x: : 1 ¬* : 1 Ðᵒ : 1 ᵒ÷ : 1 @@ -1019,9 +1034,7 @@ $ƥ : 1 -± : 1 ±ç : 1 ç1 : 1 -+2 : 1 -2Ĉ : 1 -Ĉ← : 1 +Þ← : 1 ←A : 1 A± : 1 ƒ1 : 1 diff --git a/analysis/freq_3gram.txt b/analysis/freq_3gram.txt index 09cb310..c25fc80 100644 --- a/analysis/freq_3gram.txt +++ b/analysis/freq_3gram.txt @@ -1,10 +1,9 @@ +Ňᵖ{ : 4 ᵒ-¬ : 3 u∕u : 3 ∫Ɔž : 3 Ɔž≥ : 3 -:ᵒ{ : 3 ᵑ{ˣ : 3 -Ňᵖ{ : 3 "ᵉĝ : 2 ᵉĝ, : 2 ᵗz: : 2 @@ -26,14 +25,15 @@ $ᵑ{ : 2 ᶠ{$ : 2 Rᶠ{ : 2 Ë:ᵒ : 2 +:ᵒ& : 2 +ᵒ&Þ : 2 Sᵖ{ : 2 į→ŋ : 2 tut : 2 ᵒ{ᵋ : 2 +ᵖ{: : 2 ŋ+} : 2 3~ᵑ : 2 -ᵒ{ᵃ : 2 -{ᵃƂ : 2 }aş : 2 #ᵑ{ : 2 ←ᶠ{ : 2 @@ -270,6 +270,10 @@ oil : 1 ᵉ+→ : 1 +→% : 1 →%Z : 1 +ᵏ{ᵐ : 1 +{ᵐĝ : 1 +ᵐĝj : 1 +ĝj= : 1 ˡ{C : 1 {C4 : 1 C4+ : 1 @@ -305,15 +309,11 @@ $∑= : 1 Z3¦ : 1 RË3 : 1 Ë3÷ : 1 -ᵒ{& : 1 -{&Ƃ : 1 -&Ƃ∑ : 1 -Ƃ∑£ : 1 -∑£E : 1 +&Þ£ : 1 +Þ£E : 1 ŋ∑ũ : 1 ĉᵐ∫ : 1 ᵐ∫j : 1 -Ƃ∑½ : 1 Sđ* : 1 đ*a : 1 *aŢ : 1 @@ -533,6 +533,7 @@ D:× : 1 ÷:→ : 1 :→: : 1 →:ᵒ : 1 +:ᵒ{ : 1 {ᵋ{ : 1 ᵋ{- : 1 {-+ : 1 @@ -575,6 +576,18 @@ p↔: : 1 :ËG : 1 ËGT : 1 GT∑ : 1 +x:→ : 1 +:→& : 1 +→&x : 1 +&xï : 1 +xï@ : 1 +ï@ᵐ : 1 +@ᵐ∑ : 1 +{:Ä : 1 +:ÄX : 1 +ÄXÞ : 1 +XÞ½ : 1 +Þ½= : 1 ˡ{ᵗ : 1 {ᵗ≡ : 1 ᵗ≡ĭ : 1 @@ -686,7 +699,6 @@ Qao : 1 ŇPᵖ : 1 Pᵖf : 1 RSᵖ : 1 -ᵖ{: : 1 {:* : 1 :*Ɔ : 1 *Ɔ$ : 1 @@ -784,6 +796,8 @@ aᵐᶜ : 1 *}∑ : 1 }∑2 : 1 ∑2< : 1 +ᵒ{ᵃ : 1 +{ᵃƂ : 1 ᵃƂᵈ : 1 Ƃᵈ: : 1 ᵈ:≈ : 1 @@ -864,12 +878,11 @@ Z‼2 : 1 įŋ+ : 1 +}f : 1 ˡ{ŗ : 1 -{ŗ: : 1 -ŗ:K : 1 -:KÄ : 1 -KÄ$ : 1 -Ä$- : 1 -$-← : 1 +{ŗ← : 1 +ŗ←£ : 1 +←£þ : 1 +£þ+ : 1 +þ+_ : 1 }ka : 1 kaC : 1 aC$ : 1 @@ -992,11 +1005,8 @@ $ƥ← : 1 -±ç : 1 ±ç1 : 1 ç1Ĩ : 1 -ᵃƂ+ : 1 -Ƃ+2 : 1 -+2Ĉ : 1 -2Ĉ← : 1 -Ĉ←A : 1 +&Þ← : 1 +Þ←A : 1 ←A± : 1 ƒ1> : 1 Ťᵐ↕ : 1 diff --git a/analysis/freq_4gram.txt b/analysis/freq_4gram.txt index bfc0694..d4b7ed5 100644 --- a/analysis/freq_4gram.txt +++ b/analysis/freq_4gram.txt @@ -7,8 +7,8 @@ {1%ŗ : 2 1%ŗ} : 2 %ŗ}k : 2 -Ë:ᵒ{ : 2 -ᵒ{ᵃƂ : 2 +Ë:ᵒ& : 2 +:ᵒ&Þ : 2 #ᵑ{ˣ : 2 ᵉĝ," : 1 ĝ,"ᵉ : 1 @@ -187,6 +187,9 @@ poil : 1 {ᵉ+→ : 1 ᵉ+→% : 1 +→%Z : 1 +ᵏ{ᵐĝ : 1 +{ᵐĝj : 1 +ᵐĝj= : 1 ˡ{C4 : 1 {C4+ : 1 C4+> : 1 @@ -210,11 +213,8 @@ Rᶠ{- : 1 {-Z3 : 1 -Z3¦ : 1 RË3÷ : 1 -:ᵒ{& : 1 -ᵒ{&Ƃ : 1 -{&Ƃ∑ : 1 -&Ƃ∑£ : 1 -Ƃ∑£E : 1 +ᵒ&Þ£ : 1 +&Þ£E : 1 ĉᵐ∫j : 1 Sđ*a : 1 đ*aŢ : 1 @@ -422,6 +422,18 @@ p↔:# : 1 #:ËG : 1 :ËGT : 1 ËGT∑ : 1 +x:→& : 1 +:→&x : 1 +→&xï : 1 +&xï@ : 1 +xï@ᵐ : 1 +ï@ᵐ∑ : 1 +Ňᵖ{: : 1 +ᵖ{:Ä : 1 +{:ÄX : 1 +:ÄXÞ : 1 +ÄXÞ½ : 1 +XÞ½= : 1 ˡ{ᵗ≡ : 1 {ᵗ≡ĭ : 1 ᵗ≡ĭ? : 1 @@ -611,6 +623,7 @@ aᵐᶜ{ : 1 0*}∑ : 1 *}∑2 : 1 }∑2< : 1 +ᵒ{ᵃƂ : 1 {ᵃƂᵈ : 1 ᵃƂᵈ: : 1 Ƃᵈ:≈ : 1 @@ -681,12 +694,11 @@ Z‼2M : 1 {įŋ+ : 1 įŋ+} : 1 ŋ+}f : 1 -ˡ{ŗ: : 1 -{ŗ:K : 1 -ŗ:KÄ : 1 -:KÄ$ : 1 -KÄ$- : 1 -Ä$-← : 1 +ˡ{ŗ← : 1 +{ŗ←£ : 1 +ŗ←£þ : 1 +←£þ+ : 1 +£þ+_ : 1 ŗ}ka : 1 }kaC : 1 kaC$ : 1 @@ -793,13 +805,9 @@ $ƥ←Ë : 1 %-±ç : 1 -±ç1 : 1 ±ç1Ĩ : 1 -:ᵒ{ᵃ : 1 -{ᵃƂ+ : 1 -ᵃƂ+2 : 1 -Ƃ+2Ĉ : 1 -+2Ĉ← : 1 -2Ĉ←A : 1 -Ĉ←A± : 1 +ᵒ&Þ← : 1 +&Þ←A : 1 +Þ←A± : 1 Ťᵐ↕∫ : 1 ᵐ↕∫Ɔ : 1 ↕∫Ɔž : 1 diff --git a/analysis/freq_5gram.txt b/analysis/freq_5gram.txt index 7b47014..deccf97 100644 --- a/analysis/freq_5gram.txt +++ b/analysis/freq_5gram.txt @@ -2,6 +2,7 @@ ᶦ{1%ŗ : 2 {1%ŗ} : 2 1%ŗ}k : 2 +Ë:ᵒ&Þ : 2 "ᵉĝ," : 1 ᵉĝ,"ᵉ : 1 ĝ,"ᵉĝ : 1 @@ -125,6 +126,8 @@ o;↔ᶻÐ : 1 ᵏ{ᵉ+→ : 1 {ᵉ+→% : 1 ᵉ+→%Z : 1 +ᵏ{ᵐĝj : 1 +{ᵐĝj= : 1 ˡ{C4+ : 1 {C4+> : 1 C4+>‼ : 1 @@ -139,11 +142,8 @@ C4+>‼ : 1 Rᶠ{-Z : 1 ᶠ{-Z3 : 1 {-Z3¦ : 1 -Ë:ᵒ{& : 1 -:ᵒ{&Ƃ : 1 -ᵒ{&Ƃ∑ : 1 -{&Ƃ∑£ : 1 -&Ƃ∑£E : 1 +:ᵒ&Þ£ : 1 +ᵒ&Þ£E : 1 Sđ*aŢ : 1 đ*aŢṂ : 1 Sᵖ{đ∩ : 1 @@ -299,6 +299,16 @@ p↔:#: : 1 :#:ËG : 1 #:ËGT : 1 :ËGT∑ : 1 +x:→&x : 1 +:→&xï : 1 +→&xï@ : 1 +&xï@ᵐ : 1 +xï@ᵐ∑ : 1 +Ňᵖ{:Ä : 1 +ᵖ{:ÄX : 1 +{:ÄXÞ : 1 +:ÄXÞ½ : 1 +ÄXÞ½= : 1 ˡ{ᵗ≡ĭ : 1 {ᵗ≡ĭ? : 1 ᵗ≡ĭ?} : 1 @@ -518,11 +528,10 @@ Z‼2M≡ : 1 ᵑ{įŋ+ : 1 {įŋ+} : 1 įŋ+}f : 1 -ˡ{ŗ:K : 1 -{ŗ:KÄ : 1 -ŗ:KÄ$ : 1 -:KÄ$- : 1 -KÄ$-← : 1 +ˡ{ŗ←£ : 1 +{ŗ←£þ : 1 +ŗ←£þ+ : 1 +←£þ+_ : 1 %ŗ}ka : 1 ŗ}kaC : 1 }kaC$ : 1 @@ -611,14 +620,9 @@ $ƥ←ËƂ : 1 ᵚ%-±ç : 1 %-±ç1 : 1 -±ç1Ĩ : 1 -Ë:ᵒ{ᵃ : 1 -:ᵒ{ᵃƂ : 1 -ᵒ{ᵃƂ+ : 1 -{ᵃƂ+2 : 1 -ᵃƂ+2Ĉ : 1 -Ƃ+2Ĉ← : 1 -+2Ĉ←A : 1 -2Ĉ←A± : 1 +:ᵒ&Þ← : 1 +ᵒ&Þ←A : 1 +&Þ←A± : 1 Ťᵐ↕∫Ɔ : 1 ᵐ↕∫Ɔž : 1 ↕∫Ɔž∑ : 1 diff --git a/analysis/particles.txt b/analysis/particles.txt index a15f5ce..41a2dd8 100644 --- a/analysis/particles.txt +++ b/analysis/particles.txt @@ -4,15 +4,15 @@ particle : with "{" / total ˣ : 0 / 4 ᶻ : 0 / 9 ᵉ : 1 / 18 +ᵐ : 3 / 28 ᵚ : 1 / 9 -ᵐ : 3 / 26 ᶜ : 1 / 8 -ᵃ : 2 / 10 +ᵒ : 3 / 16 +ᵃ : 2 / 9 ᵋ : 1 / 4 -ᵒ : 5 / 16 -ᵖ : 8 / 15 -ᵏ : 3 / 5 +ᵖ : 9 / 16 ᵑ : 7 / 11 +ᵏ : 4 / 6 ᶠ : 7 / 9 ˡ : 5 / 6 ʷ : 7 / 8 diff --git a/doc/Builtins.md b/doc/Builtins.md index 654b076..635e935 100644 --- a/doc/Builtins.md +++ b/doc/Builtins.md @@ -310,6 +310,16 @@ If one or both of the arguments are chars, they are converted to numbers accordi This function is automatically vectorized and fails when the two lists are of different lengths. +### `divMod` (`þ`, `2 -> 2`) + +Divide two numbers and return both the quotient and the remainder. + +Fails when the divisor is zero. + +If one or both of the arguments are chars, they are converted to numbers according to Nekomata's code page. + +This function is automatically vectorized and fails when the two lists are of different lengths. + ### `half` (`½`, `1 -> 1`) Check if an integer is even, and divide it by 2. @@ -718,6 +728,14 @@ If one or both of the arguments are chars, they are converted to numbers accordi This function is automatically vectorized with padding. +### `popCount` (`Þ`, `1 -> 1`) + +Count the number of 1s in the binary digits of an integer. + +If the argument is a char, it is converted to a number according to Nekomata's code page. + +This function is automatically vectorized. + ### `charToInt` (`e`, `1 -> 1`) Convert a char to an integer according to Nekomata's code page. diff --git a/doc/CodePage.md b/doc/CodePage.md index 4c4a8f7..ae10084 100644 --- a/doc/CodePage.md +++ b/doc/CodePage.md @@ -17,9 +17,9 @@ The language is still in an early stage, so the code page is incomplete. Unassig |**8_**|`ᵃ`|`ᶜ`|`ᵈ`|`ᵉ`|`ᵋ`|`ᶠ`|`ᶦ`|`ᵏ`|`ˡ`|`ᵐ`|`ᵚ`|`ᵑ`|`ᵒ`|`ᵖ`|`ʳ`|`ᵗ`| |**9_**|`ʷ`|`ˣ`|`ᶻ`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`| |**A_**|`Ä`|`Ƃ`|`Ç`|`Ĉ`|`Ď`|`Ð`|`Ɗ`|`Ë`|`Ĝ`|`Ģ`|`Ĩ`|`Ĭ`|`Ļ`|`Ṁ`|`Ṃ`|`Ň`| -|**B_**|`Ö`|`Ø`|`Ɔ`|`Ƥ`|`Ṗ`|`Ř`|`Ş`|`Ţ`|`Ť`|`Ŭ`|`Ž`|`�`|`�`|`�`|`�`|`�`| +|**B_**|`Ö`|`Ø`|`Ɔ`|`Ƥ`|`Ṗ`|`Ř`|`Ş`|`Ţ`|`Ť`|`Ŭ`|`Ž`|`Þ`|`�`|`�`|`�`|`�`| |**C_**|`ä`|`ƃ`|`ç`|`ĉ`|`đ`|`ḍ`|`ɗ`|`ĕ`|`ƒ`|`ĝ`|`ï`|`ĭ`|`į`|`ṁ`|`ṃ`|`ň`| -|**D_**|`ŋ`|`ṇ`|`ɔ`|`ƥ`|`ŗ`|`ř`|`ş`|`ŧ`|`ũ`|`ů`|`ž`|`�`|`�`|`�`|`�`|`�`| +|**D_**|`ŋ`|`ṇ`|`ɔ`|`ƥ`|`ŗ`|`ř`|`ş`|`ŧ`|`ũ`|`ů`|`ž`|`þ`|`�`|`�`|`�`|`�`| |**E_**|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`| |**F_**|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`|`�`| diff --git a/src/Nekomata/Builtin.hs b/src/Nekomata/Builtin.hs index 784b377..8cf4c49 100644 --- a/src/Nekomata/Builtin.hs +++ b/src/Nekomata/Builtin.hs @@ -370,6 +370,16 @@ builtins = \they are converted to numbers according to Nekomata's code page.\n\ \This function is automatically vectorized \ \and fails when the two lists are of different lengths." + , Builtin + "divMod" + 'þ' + divMod' + "Divide two numbers and return both the quotient and the remainder.\n\ + \Fails when the divisor is zero.\n\ + \If one or both of the arguments are chars, \ + \they are converted to numbers according to Nekomata's code page.\n\ + \This function is automatically vectorized \ + \and fails when the two lists are of different lengths." , Builtin "half" '½' @@ -786,6 +796,14 @@ builtins = \If one or both of the arguments are chars, \ \they are converted to numbers according to Nekomata's code page.\n\ \This function is automatically vectorized with padding." + , Builtin + "popCount" + 'Þ' + popCount' + "Count the number of 1s in the binary digits of an integer.\n\ + \If the argument is a char, \ + \it is converted to a number according to Nekomata's code page.\n\ + \This function is automatically vectorized." , Builtin "charToInt" 'e' diff --git a/src/Nekomata/Builtin/List.hs b/src/Nekomata/Builtin/List.hs index 0c65d4e..f1b3ff6 100644 --- a/src/Nekomata/Builtin/List.hs +++ b/src/Nekomata/Builtin/List.hs @@ -553,12 +553,6 @@ count = binary count' let n = xs >>= count_ y in x >>= tryEq y >>= \b -> if b then (+ 1) <$> n else n -unzip' :: ListTry (a, b) -> (ListTry a, ListTry b) -unzip' Nil = (Nil, Nil) -unzip' (Cons x xs) = - let ys = unzip' <$> xs - in (Cons (fst x) (fst <$> ys), Cons (snd x) (snd <$> ys)) - tally :: Function tally = unary2 tally' where @@ -566,7 +560,7 @@ tally = unary2 tally' tally' _ _ = (Fail, Fail) tally_ :: (TryEq a) => Id -> ListTry (Try a) -> Try (ListTry a, ListTry Integer) - tally_ i xs = unzip' <$> tryFoldl insertCount i Nil xs + tally_ i xs = unzipF <$> tryFoldl insertCount i Nil xs insertCount _ Nil x = Val $ singleton (x, 1) insertCount i (Cons (y, n) ys) x = tryEq x y @@ -636,7 +630,7 @@ rle = unary2 rle' (TryEq a) => ListTry (Try a) -> Try (ListTry (Try a), ListTry (Try Integer)) - rle'' xs = unzip' <$> rle_ xs + rle'' xs = unzipF <$> rle_ xs rle_ :: (TryEq a) => ListTry (Try a) -> TryList (Try a, Try Integer) rle_ Nil = Val Nil rle_ (Cons x xs) = diff --git a/src/Nekomata/Builtin/Math.hs b/src/Nekomata/Builtin/Math.hs index e731b00..93fa678 100644 --- a/src/Nekomata/Builtin/Math.hs +++ b/src/Nekomata/Builtin/Math.hs @@ -2,7 +2,7 @@ module Nekomata.Builtin.Math where import Control.Arrow (second, (***)) import Control.Monad (liftM2) -import Data.Bits (xor, (.&.), (.|.)) +import Data.Bits (popCount, xor, (.&.), (.|.)) import Data.Functor ((<&>)) import Data.List (sort) import Data.Ratio (denominator, numerator, (%)) @@ -142,6 +142,14 @@ divExact = binaryNumFail $ const divExact_ divExact_ x y = let q = x / y in if denominator q == 1 then Val $ numerator q else Fail +divMod' :: Function +divMod' = binary2NumFail $ const divMod_ + where + divMod_ _ 0 = Fail + divMod_ x y = + let q = fromInteger . floor $ x / y + in Val (q, x - y * q) + half :: Function half = unaryInt $ const half' where @@ -312,7 +320,7 @@ delta = unary delta' delta' i (DListT xs) = liftList (delta_ i) xs delta' _ _ = Fail delta_ _ Nil = Fail - delta_ i s@(Cons _ xs) = xs >>= flip (zipWithTrunc sub' i) s + delta_ i s@(Cons _ xs) = xs >>= flip (Val .: zipWithTrunc sub' i) s binomial :: Function binomial = binaryNumFail $ const binomial' @@ -348,9 +356,8 @@ primePi = unaryNum $ const primePi_ primePi_ = Val . primeCount . floor factor :: Function -factor = unary2Vec factor' +factor = unary2Num $ const factor_ where - factor' _ x = liftNum12 factor_ $ toTryNum x factor_ 0 = Fail factor_ x = Val @@ -430,3 +437,6 @@ bitOr = binaryIntPad $ const (.|.) bitXor :: Function bitXor = binaryIntPad $ const xor + +popCount' :: Function +popCount' = unaryInt $ const (toInteger . popCount) diff --git a/src/Nekomata/CodePage.hs b/src/Nekomata/CodePage.hs index 554bb97..dcc3068 100644 --- a/src/Nekomata/CodePage.hs +++ b/src/Nekomata/CodePage.hs @@ -20,9 +20,9 @@ codePage = ++ "ᵃᶜᵈᵉᵋᶠᶦᵏˡᵐᵚᵑᵒᵖʳᵗ" ++ "ʷˣᶻ�������������" ++ "ÄƂÇĈĎÐƊËĜĢĨĬĻṀṂŇ" - ++ "ÖØƆƤṖŘŞŢŤŬŽ�����" + ++ "ÖØƆƤṖŘŞŢŤŬŽÞ����" ++ "äƃçĉđḍɗĕƒĝïĭįṁṃň" - ++ "ŋṇɔƥŗřşŧũůž�����" + ++ "ŋṇɔƥŗřşŧũůžþ����" ++ "����������������" ++ "����������������" diff --git a/src/Nekomata/Data.hs b/src/Nekomata/Data.hs index 4a05bf5..c84711d 100644 --- a/src/Nekomata/Data.hs +++ b/src/Nekomata/Data.hs @@ -5,6 +5,7 @@ module Nekomata.Data where import Control.Monad (join, liftM2) +import Data.Bifunctor (bimap) import Data.Functor ((<&>)) import Data.Ratio (denominator, numerator) import Nekomata.CodePage (charToInt) @@ -18,6 +19,10 @@ liftJoinM2 f x y = join $ liftM2 f x y (.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d (.:) = (.) . (.) +-- | A helper function to unzip a functor of pairs +unzipF :: (Functor f) => f (a, b) -> (f a, f b) +unzipF xs = (fst <$> xs, snd <$> xs) + data ListTry a = Nil | Cons a (TryList a) -- | A non-deterministic list @@ -39,10 +44,7 @@ are padded to the result. -} zipWithPad :: (Id -> a -> a -> Try a) -> - Id -> - ListTry (Try a) -> - ListTry (Try a) -> - ListTry (Try a) + (Id -> ListTry (Try a) -> ListTry (Try a) -> ListTry (Try a)) zipWithPad _ _ Nil xs = xs zipWithPad _ _ xs Nil = xs zipWithPad f i (Cons x xs) (Cons y ys) = @@ -56,10 +58,7 @@ Fail if the lists have different lengths. -} zipWithFail :: (Id -> a -> b -> Try c) -> - Id -> - ListTry (Try a) -> - ListTry (Try b) -> - TryList (Try c) + (Id -> ListTry (Try a) -> ListTry (Try b) -> TryList (Try c)) zipWithFail _ _ Nil Nil = Val Nil zipWithFail f i (Cons x xs) (Cons y ys) = Val @@ -74,17 +73,26 @@ Truncate the result to the length of the shorter list. -} zipWithTrunc :: (Id -> a -> b -> Try c) -> - Id -> - ListTry (Try a) -> - ListTry (Try b) -> - TryList (Try c) -zipWithTrunc _ _ Nil _ = Val Nil -zipWithTrunc _ _ _ Nil = Val Nil + (Id -> ListTry (Try a) -> ListTry (Try b) -> ListTry (Try c)) +zipWithTrunc _ _ Nil _ = Nil +zipWithTrunc _ _ _ Nil = Nil zipWithTrunc f i (Cons x xs) (Cons y ys) = - Val - $ Cons - (liftJoinM2 (f (leftId i)) x y) - (liftJoinM2 (zipWithTrunc f (rightId i)) xs ys) + Cons + (liftJoinM2 (f (leftId i)) x y) + (liftM2 (zipWithTrunc f (rightId i)) xs ys) + +{- | Zip two @TryList@s with a binary function + +Fail if the lists have different lengths. +-} +zipWithFail2 :: + (Id -> a -> b -> Try (c, d)) -> + ( Id -> + ListTry (Try a) -> + ListTry (Try b) -> + Try (ListTry (Try c), ListTry (Try d)) + ) +zipWithFail2 f i xs ys = unzipF . fmap unzipF <$> zipWithFail f i xs ys -- | Choose an element from a @TryList@ anyOf :: Id -> ListTry a -> Try a @@ -101,70 +109,58 @@ singleton :: a -> ListTry a singleton x = Cons x (Val Nil) -- | Map a non-deterministic function over a @TryList@ -tryMap :: (Id -> a -> Try b) -> Id -> ListTry (Try a) -> ListTry (Try b) +tryMap :: (Id -> a -> Try b) -> (Id -> ListTry (Try a) -> ListTry (Try b)) tryMap _ _ Nil = Nil tryMap f i (Cons x xs) = Cons (x >>= f (leftId i)) (tryMap f (rightId i) <$> xs) -- | Map over the first argument of a binary function tryMap1 :: (Id -> a -> b -> Try c) -> - Id -> - b -> - ListTry (Try a) -> - ListTry (Try c) + (Id -> b -> ListTry (Try a) -> ListTry (Try c)) tryMap1 f i y = tryMap (\i' x -> f i' x y) i -- | Map over the second argument of a binary function tryMap2 :: (Id -> a -> b -> Try c) -> - Id -> - a -> - ListTry (Try b) -> - ListTry (Try c) + (Id -> a -> ListTry (Try b) -> ListTry (Try c)) tryMap2 f i x = tryMap (`f` x) i -- | Map a non-deterministic function that returns two values over a @TryList@ tryUnzipWith :: (Id -> a -> Try (b, c)) -> - Id -> - ListTry (Try a) -> - (ListTry (Try b), ListTry (Try c)) -tryUnzipWith _ _ Nil = (Nil, Nil) -tryUnzipWith f i (Cons x xs) = - let y = x >>= f (leftId i) - ys = tryUnzipWith f (rightId i) <$> xs - in (Cons (fst <$> y) (fst <$> ys), Cons (snd <$> y) (snd <$> ys)) + (Id -> ListTry (Try a) -> (ListTry (Try b), ListTry (Try c))) +tryUnzipWith f i xs = unzipF $ unzipF <$> tryMap f i xs -- | Fold a non-deterministic function over a @TryList@ from right to left -tryFoldr :: (Id -> a -> b -> Try b) -> Id -> b -> ListTry (Try a) -> Try b +tryFoldr :: (Id -> a -> b -> Try b) -> (Id -> b -> ListTry (Try a) -> Try b) tryFoldr _ _ b Nil = Val b tryFoldr f i b (Cons x xs) = liftJoinM2 (f (leftId i)) x (xs >>= tryFoldr f (rightId i) b) -- | Fold a non-deterministic function over a @TryList@ from right to left -tryFoldr1 :: (Id -> a -> a -> Try a) -> Id -> ListTry (Try a) -> Try a +tryFoldr1 :: (Id -> a -> a -> Try a) -> (Id -> ListTry (Try a) -> Try a) tryFoldr1 _ _ Nil = Fail tryFoldr1 f i (Cons x xs) = liftJoinM2 (tryFoldr f i) x xs -- | Fold a non-deterministic function over a @TryList@ from left to right -tryFoldl :: (Id -> b -> a -> Try b) -> Id -> b -> ListTry (Try a) -> Try b +tryFoldl :: (Id -> b -> a -> Try b) -> (Id -> b -> ListTry (Try a) -> Try b) tryFoldl _ _ b Nil = Val b tryFoldl f i b (Cons x xs) = liftJoinM2 (tryFoldl f (leftId i)) (x >>= f (rightId i) b) xs -- | Fold a non-deterministic function over a @TryList@ from left to right -tryFoldl1 :: (Id -> a -> a -> Try a) -> Id -> ListTry (Try a) -> Try a +tryFoldl1 :: (Id -> a -> a -> Try a) -> (Id -> ListTry (Try a) -> Try a) tryFoldl1 _ _ Nil = Fail tryFoldl1 f i (Cons x xs) = liftJoinM2 (tryFoldl f i) x xs -- | Scan a non-deterministic function over a @TryList@ from left to right -tryScanl :: (Id -> b -> a -> Try b) -> Id -> b -> ListTry (Try a) -> ListTry b +tryScanl :: (Id -> b -> a -> Try b) -> (Id -> b -> ListTry (Try a) -> ListTry b) tryScanl _ _ b Nil = singleton b tryScanl f i b (Cons x xs) = Cons b (liftM2 (tryScanl f (leftId i)) (x >>= f (rightId i) b) xs) -- | Scan a non-deterministic function over a @TryList@ from left to right -tryScanl1 :: (Id -> a -> a -> Try a) -> Id -> ListTry (Try a) -> TryList a +tryScanl1 :: (Id -> a -> a -> Try a) -> (Id -> ListTry (Try a) -> TryList a) tryScanl1 _ _ Nil = Val Nil tryScanl1 f i (Cons x xs) = liftM2 (tryScanl f i) x xs @@ -173,14 +169,11 @@ return a @ListTry@ of @TryList@s -} tryOuter :: (Id -> a -> b -> Try c) -> - Id -> - ListTry (Try a) -> - ListTry (Try b) -> - ListTry (TryList (Try c)) + (Id -> ListTry (Try a) -> ListTry (Try b) -> ListTry (TryList (Try c))) tryOuter f i xs = tryMap (\i' y -> Val $ tryMap (\i'' x -> f i'' x y) i' xs) i -- | Filter a @TryList@ -tryFilter :: (Id -> a -> Try Bool) -> Id -> ListTry a -> TryList a +tryFilter :: (Id -> a -> Try Bool) -> (Id -> ListTry a -> TryList a) tryFilter _ _ Nil = Val Nil tryFilter f i (Cons x xs) = f (leftId i) x >>= \b -> @@ -339,8 +332,15 @@ liftNum12 :: (Rational -> Try (a, b)) -> (Try (Det Rational) -> (TryData, TryData)) liftNum12 f x = - let y = x >>= f . unDet - in (toTryData $ fst <$> y, toTryData $ snd <$> y) + bimap toTryData toTryData . unzipF $ toTry x >>= f + +-- | Lift a binary numeric function that returns two values to @TryData@ +liftNum22 :: + (ToTryData a, ToTryData b) => + (Rational -> Rational -> Try (a, b)) -> + (Try (Det Rational) -> Try (Det Rational) -> (TryData, TryData)) +liftNum22 f x y = + bimap toTryData toTryData . unzipF $ liftJoinM2 f (toTry x) (toTry y) -- | Lift a unary integer function to @TryData@ liftInt :: (ToTryData a) => (Integer -> a) -> (Try (Det Rational) -> TryData) @@ -383,21 +383,24 @@ liftList12 :: (ToTryData a, ToTryData b) => (ListTry TryData -> Try (a, b)) -> (TryList TryData -> (TryData, TryData)) -liftList12 f x = - let y = x >>= f in (toTryData $ fst <$> y, toTryData $ snd <$> y) +liftList12 f x = bimap toTryData toTryData . unzipF $ x >>= f + +-- | Lift a binary list function that returns two values to @TryData@ +liftList22 :: + (ToTryData a, ToTryData b) => + (ListTry TryData -> ListTry TryData -> Try (a, b)) -> + (TryList TryData -> TryList TryData -> (TryData, TryData)) +liftList22 f x y = bimap toTryData toTryData . unzipF $ liftJoinM2 f x y -- | Vectorize a unary function -vec1 :: (Id -> DataTry -> TryData) -> Id -> DataTry -> TryData +vec1 :: (Id -> DataTry -> TryData) -> (Id -> DataTry -> TryData) vec1 f i (DListT xs) = liftList (tryMap (vec1 f) i) xs vec1 f i x = f i x -- | Vectorize a binary function with padding vec2Pad :: (Id -> DataTry -> DataTry -> TryData) -> - Id -> - DataTry -> - DataTry -> - TryData + (Id -> DataTry -> DataTry -> TryData) vec2Pad f i (DListT xs) (DListT ys) = liftList2 (zipWithPad (vec2Pad f) i) xs ys vec2Pad f i (DListT xs) y = liftList (tryMap1 (vec2Pad f) i y) xs vec2Pad f i x (DListT ys) = liftList (tryMap2 (vec2Pad f) i x) ys @@ -406,10 +409,7 @@ vec2Pad f i x y = f i x y -- | Vectorize a binary function with failure on mismatched lengths vec2Fail :: (Id -> DataTry -> DataTry -> TryData) -> - Id -> - DataTry -> - DataTry -> - TryData + (Id -> DataTry -> DataTry -> TryData) vec2Fail f i (DListT xs) (DListT ys) = liftList2 (zipWithFail (vec2Fail f) i) xs ys vec2Fail f i (DListT xs) y = liftList (tryMap1 (vec2Fail f) i y) xs @@ -419,10 +419,7 @@ vec2Fail f i x y = f i x y -- | Vectorize a binary function with outer product vec2Outer :: (Id -> DataTry -> DataTry -> TryData) -> - Id -> - DataTry -> - DataTry -> - TryData + (Id -> DataTry -> DataTry -> TryData) vec2Outer f i (DListT xs) (DListT ys) = liftList2 (tryOuter (vec2Outer f) i) xs ys vec2Outer f i (DListT xs) y = liftList (tryMap1 (vec2Outer f) i y) xs @@ -432,32 +429,38 @@ vec2Outer f i x y = f i x y -- | Vectorize the first argument of a binary function vec2Arg1 :: (Id -> DataTry -> DataTry -> TryData) -> - Id -> - DataTry -> - DataTry -> - TryData + (Id -> DataTry -> DataTry -> TryData) vec2Arg1 f i (DListT xs) y = liftList (tryMap1 (vec2Arg1 f) i y) xs vec2Arg1 f i x y = f i x y -- | Vectorize the second argument of a binary function vec2Arg2 :: (Id -> DataTry -> DataTry -> TryData) -> - Id -> - DataTry -> - DataTry -> - TryData + (Id -> DataTry -> DataTry -> TryData) vec2Arg2 f i x (DListT ys) = liftList (tryMap2 (vec2Arg2 f) i x) ys vec2Arg2 f i x y = f i x y -- | Vectorize a unary function that returns two values vec12 :: (Id -> DataTry -> (TryData, TryData)) -> - Id -> - DataTry -> - (TryData, TryData) + (Id -> DataTry -> (TryData, TryData)) vec12 f i (DListT xs) = liftList12 (Val . tryUnzipWith (Val .: vec12 f) i) xs vec12 f i x = f i x +{- | Vectorize a binary function that returns two values +with failure on mismatched lengths +-} +vec22Fail :: + (Id -> DataTry -> DataTry -> (TryData, TryData)) -> + (Id -> DataTry -> DataTry -> (TryData, TryData)) +vec22Fail f i (DListT xs) (DListT ys) = + liftList22 (zipWithFail2 ((Val .) .: vec22Fail f) i) xs ys +vec22Fail f i (DListT xs) y = + liftList12 (Val . tryUnzipWith (\i' x -> Val $ vec22Fail f i' x y) i) xs +vec22Fail f i x (DListT ys) = + liftList12 (Val . tryUnzipWith (\i' y -> Val $ vec22Fail f i' x y) i) ys +vec22Fail f i x y = f i x y + -- | A helper class for checking for equality class TryEq a where tryEq :: a -> a -> Try Bool diff --git a/src/Nekomata/Function.hs b/src/Nekomata/Function.hs index 1ee5a75..6c73243 100644 --- a/src/Nekomata/Function.hs +++ b/src/Nekomata/Function.hs @@ -155,6 +155,12 @@ and vectorize the second argument binaryVecArg2 :: (Id -> DataTry -> DataTry -> TryData) -> Function binaryVecArg2 = binary . vec2Arg2 +{- | Convert and vectorize a binary function that returns two values +with failure on mismatched lengths +-} +binary2VecFail :: (Id -> DataTry -> DataTry -> (TryData, TryData)) -> Function +binary2VecFail = binary2 . vec22Fail + -- | Convert and vectorize a predicate to a Nekomata function predicateVec :: (Id -> DataTry -> Try Bool) -> Function predicateVec f = unaryVec $ \i x -> f i x >>= \b -> if b then Val x else Fail @@ -173,6 +179,15 @@ unaryNum f = unaryVec f' where f' i x = liftNum (f i) (toTryNum x) +-- | Convert and vectorize a unary numeric function that returns two values +unary2Num :: + (ToTryData a, ToTryData b) => + (Id -> Rational -> Try (a, b)) -> + Function +unary2Num f = unary2Vec f' + where + f' i x = liftNum12 (f i) (toTryNum x) + -- | Convert and vectorize a binary numeric function with padding binaryNumPad :: (ToTryData a) => (Id -> Rational -> Rational -> a) -> Function binaryNumPad f = binaryVecPad f' @@ -187,6 +202,17 @@ binaryNumFail f = binaryVecFail f' where f' i x y = liftNum2 (f i) (toTryNum x) (toTryNum y) +{- | Convert and vectorize a binary numeric function that returns two values +with failure on mismatched lengths +-} +binary2NumFail :: + (ToTryData a, ToTryData b) => + (Id -> Rational -> Rational -> Try (a, b)) -> + Function +binary2NumFail f = binary2VecFail f' + where + f' i x y = liftNum22 (f i) (toTryNum x) (toTryNum y) + -- | Convert and vectorize a unary integer function unaryInt :: (ToTryData a) => (Id -> Integer -> a) -> Function unaryInt f = unaryVec f' diff --git a/test/Eval.hs b/test/Eval.hs index 6761ec1..70c5fb6 100644 --- a/test/Eval.hs +++ b/test/Eval.hs @@ -1004,6 +1004,13 @@ testEval = describe "Evaluation" $ do , ("10", All ["1"]) , ("2521", All ["10"]) ] + describe "q139804: Undo a Range of Numbers" $ do + specEval + "ᵏ{ᵐĝj=" + [ ("\"0123\"", All ["4"]) + , ("\"0\"", All ["1"]) + , ("\"012345678910111213141516171819202122232425262728293031323334353637383940\"", All ["41"]) + ] describe "q141949: Count edits accounting for grace period" $ do specEval "ˡ{C4+>‼" @@ -1165,7 +1172,7 @@ testEval = describe "Evaluation" $ do ] describe "q162254: Generate a Walsh Matrix" $ do specEval - "Ë:ᵒ{&Ƃ∑£E" + "Ë:ᵒ&Þ£E" [ ("0", All ["[[1]]"]) , ("1", All ["[[1,1],[1,-1]]"]) , ("2", All ["[[1,1,1,1],[1,-1,1,-1],[1,1,-1,-1],[1,-1,-1,1]]"]) @@ -1190,7 +1197,7 @@ testEval = describe "Evaluation" $ do ] describe "q169724: Is this number evil?" $ do specEval - "Ƃ∑½" + "Þ½" [ ("3", Check True) , ("11", Check False) , ("777", Check True) @@ -1477,6 +1484,23 @@ testEval = describe "Evaluation" $ do , ("200 11", All ["138"]) , ("678 123", All ["182"]) ] + describe "q210162: Is it almost-prime?" $ do + specEval + "ƒz" + [ ("2", Check True) + , ("3", Check True) + , ("8", Check True) + , ("27", Check True) + , ("1331", Check True) + , ("4913", Check True) + , ("40353607", Check True) + , ("6", Check False) + , ("36", Check False) + , ("54", Check False) + , ("1938", Check False) + , ("175560", Check False) + , ("17294403", Check False) + ] describe "q216734: Jelly's Untruth" $ do specEval "ËƂ∑±" @@ -1974,6 +1998,22 @@ testEval = describe "Evaluation" $ do , ("[3,1,4]", All ["3", "4", "4"]) , ("[3,1,4,1,5,9,2,6]", All ["3", "4", "4", "9", "5", "14", "2", "31"]) ] + specEval + "x:→&xï@ᵐ∑" + [ ("[]", All ["[]"]) + , ("[999]", All ["[999]"]) + , ("[3,1,4]", All ["[3,4,4]"]) + , ("[3,1,4,1,5,9,2,6]", All ["[3,4,4,9,5,14,2,31]"]) + ] + describe "q255344: CGAC2022 Day 9: Playing with bits" $ do + specEval + "Ňᵖ{:ÄXÞ½=" + [ ("1", Truncated ["1", "2", "3", "4", "6", "7", "8", "12", "14", "15"]) + , ("2", Truncated ["5", "9", "10", "11", "13", "17", "18", "19", "20", "22"]) + , ("3", Truncated ["21", "37", "41", "42", "43", "45", "53", "69", "73", "74"]) + , ("4", Truncated ["85", "149", "165", "169", "170", "171", "173", "181", "213", "277"]) + , ("5", Truncated ["341", "597", "661", "677", "681", "682", "683", "685", "693", "725"]) + ] describe "q255373: CGAC2022 Day 10: Help Santa sort presents!" $ do specEval "ˡ{ᵗ≡ĭ?}aṀ" @@ -2421,7 +2461,7 @@ testEval = describe "Evaluation" $ do ] describe "q260472: Find Index of Rational Number in Calkin-Wilf Sequence" $ do specEval - "ˡ{ŗ:KÄ$-←" + "ˡ{ŗ←£þ+_" [ ("1", All ["1"]) , ("1/3", All ["4"]) , ("4/3", All ["9"]) @@ -2652,7 +2692,7 @@ testEval = describe "Evaluation" $ do ] describe "q263364: Compute this fractal matrix" $ do specEval - "Ë:ᵒ{ᵃƂ+2Ĉ←A±" + "Ë:ᵒ&Þ←A±" [ ("1", All ["[[1,1],[1,0]]"]) , ("2", All ["[[1,1,1,1],[1,0,1,0],[1,1,0,0],[1,0,0,1]]"]) , ("3", All ["[[1,1,1,1,1,1,1,1],[1,0,1,0,1,0,1,0],[1,1,0,0,1,1,0,0],[1,0,0,1,1,0,0,1],[1,1,1,1,0,0,0,0],[1,0,1,0,0,1,0,1],[1,1,0,0,0,0,1,1],[1,0,0,1,0,1,1,1]]"])