Skip to content

Commit b05dd73

Browse files
drkameleondrkameleon
authored
Merge pull request #1805 from arturo-lang/add-some-more-rosetta-code-examples
Add some more Rosetta Code solutions
2 parents b3f2fd6 + 982610d commit b05dd73

30 files changed

+799
-1
lines changed

‎examples/_drafts/undulating numbers.art

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,28 @@
1+
undulating?: function [n][
2+
ds: digits n
3+
if 2 <> size unique ds -> return false
4+
return (size ds) = size chunk ds => [&]
5+
]
6+
7+
print « 3 digit Undulating Numbers in base 10:
8+
9+
(100..999) | select => undulating?
10+
| split.every:9
11+
| map => [join map & 'x -> pad to :string x 4]
12+
| print.lines
13+
14+
print ""
15+
print « 4 digit Undulating Numbers in base 10:
16+
17+
(1000..9999) | select => undulating?
18+
| split.every:9
19+
| map => [join map & 'x -> pad to :string x 5]
20+
| print.lines
21+
22+
print ""
23+
print « Prime 3 digit Undulating Numbers in base 10:
24+
25+
(100..999) | select 'x [and? undulating? x prime? x]
26+
| split.every:9
27+
| map => [join map & 'x -> pad to :string x 4]
28+
| print.lines

‎examples/_drafts/vampire number - b.art

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
vampire?: function [n][
2+
f: (factors n)-- n
3+
i: 0
4+
ds: sort digits n
5+
while [i < (size f)/2][
6+
d: n / f\[i]
7+
if and? [contains? f d]
8+
[ds = sort (digits f\[i]) ++ digits d] -> return @[n, f\[i], d]
9+
i: i + 1
10+
]
11+
return []
12+
]
13+
14+
print select 1000..9999 => [not? empty? vampire? &]
15+
print select 100000..999999 => [not? empty? vampire? &]

‎examples/rosetta/abstract type.art

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
define :queue [
2+
init: method [][
3+
\items: []
4+
]
5+
6+
enqueue: method [item][
7+
panic "enqueue must be implemented by concrete type"
8+
]
9+
10+
dequeue: method [][
11+
panic "dequeue must be implemented by concrete type"
12+
]
13+
]
14+
15+
define :simpleQueue is :queue [
16+
enqueue: method [item][
17+
\items: \items ++ item
18+
]
19+
20+
dequeue: method [][
21+
if empty? \items -> return null
22+
ret: first \items
23+
\items: drop \items
24+
return ret
25+
]
26+
]
27+
28+
q: to :simpleQueue []!
29+
30+
q\enqueue "first"
31+
q\enqueue "second"
32+
33+
print q\dequeue
34+
print q\dequeue
35+
print q\dequeue

‎examples/rosetta/abstract type.res

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
first
2+
second
3+
null

‎examples/rosetta/bitmap - bresenham's line algorithm.art

Lines changed: 67 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,67 @@
1+
; Bitmap object definition
2+
define :bitmap [
3+
init: method [width :integer height :integer][
4+
\width: width
5+
\height: height
6+
\grid: array.of:@[width height] false
7+
]
8+
9+
setOn: method [x :integer y :integer][
10+
\grid\[y]\[x]: true
11+
]
12+
13+
line: method [x0 :integer y0 :integer x1 :integer y1 :integer][
14+
[dx,dy]: @[abs x1 - x0, abs y1 - y0]
15+
[x,y]: @[x0, y0]
16+
sx: (x0 > x1) ? -> neg 1 -> 1
17+
sy: (y0 > y1) ? -> neg 1 -> 1
18+
19+
switch dx > dy [
20+
err: dx // 2
21+
while [x <> x1][
22+
\setOn x y
23+
if negative? err: <= err - dy ->
24+
[y, err]: @[y + sy, err + dx]
25+
26+
x: x + sx
27+
]
28+
][
29+
err: dy // 2
30+
while [y <> y1][
31+
\setOn x y
32+
if negative? err: <= err - dx ->
33+
[x, err]: @[x + sx, err + dy]
34+
y: y + sy
35+
]
36+
]
37+
\setOn x y
38+
]
39+
40+
string: method [][
41+
join.with:"\n" @[
42+
"+" ++ (repeat "-" \width) ++ "+"
43+
join.with:"\n" map 0..dec \height 'y [
44+
"|" ++ (join.with:"" map 0..dec \width 'x ->
45+
\grid\[dec \height-y]\[x] ? -> "@" -> " "
46+
) ++ "|"
47+
]
48+
"+" ++ (repeat "-" \width) ++ "+"
49+
]
50+
]
51+
]
52+
53+
; Create bitmap
54+
bitmap: to :bitmap @[17 17]!
55+
56+
; and... draw a diamond shape
57+
points: @[
58+
[1 8 8 16]
59+
[8 16 16 8]
60+
[16 8 8 1]
61+
[8 1 1 8]
62+
]
63+
64+
loop points 'p ->
65+
bitmap\line p\0 p\1 p\2 p\3
66+
67+
print bitmap

‎examples/rosetta/bitmap - bresenham's line algorithm.res

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
+-----------------+
2+
| @ |
3+
| @ @ |
4+
| @ @ |
5+
| @ @ |
6+
| @ @ |
7+
| @ @ |
8+
| @ @ |
9+
| @ @ |
10+
| @ @|
11+
| @ @ |
12+
| @ @ |
13+
| @ @@ |
14+
| @ @ |
15+
| @ @ |
16+
| @ @ |
17+
| @ |
18+
| |
19+
+-----------------+

‎examples/rosetta/fermat pseudoprimes.art

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
pseudoprime?: function [n, b][
2+
and? [not? prime? n]
3+
[one? powmod b n-1 n]
4+
]
5+
6+
loop 1..20 'base [
7+
print ["- Base" base]
8+
print ["\tFirst 20 pseudoprimes:" join.with:" " to [:string] select.first:20 1..∞ => [pseudoprime? & base]]
9+
print ["\tUp to 12000:" enumerate 1..12000 => [pseudoprime? & base]]
10+
]

‎examples/rosetta/fermat pseudoprimes.res

Lines changed: 60 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,60 @@
1+
- Base 1
2+
First 20 pseudoprimes: 4 6 8 9 10 12 14 15 16 18 20 21 22 24 25 26 27 28 30 32
3+
Up to 12000: 10561
4+
- Base 2
5+
First 20 pseudoprimes: 341 561 645 1105 1387 1729 1905 2047 2465 2701 2821 3277 4033 4369 4371 4681 5461 6601 7957 8321
6+
Up to 12000: 25
7+
- Base 3
8+
First 20 pseudoprimes: 91 121 286 671 703 949 1105 1541 1729 1891 2465 2665 2701 2821 3281 3367 3751 4961 5551 6601
9+
Up to 12000: 25
10+
- Base 4
11+
First 20 pseudoprimes: 15 85 91 341 435 451 561 645 703 1105 1247 1271 1387 1581 1695 1729 1891 1905 2047 2071
12+
Up to 12000: 50
13+
- Base 5
14+
First 20 pseudoprimes: 4 124 217 561 781 1541 1729 1891 2821 4123 5461 5611 5662 5731 6601 7449 7813 8029 8911 9881
15+
Up to 12000: 22
16+
- Base 6
17+
First 20 pseudoprimes: 35 185 217 301 481 1105 1111 1261 1333 1729 2465 2701 2821 3421 3565 3589 3913 4123 4495 5713
18+
Up to 12000: 31
19+
- Base 7
20+
First 20 pseudoprimes: 6 25 325 561 703 817 1105 1825 2101 2353 2465 3277 4525 4825 6697 8321 10225 10585 10621 11041
21+
Up to 12000: 21
22+
- Base 8
23+
First 20 pseudoprimes: 9 21 45 63 65 105 117 133 153 231 273 341 481 511 561 585 645 651 861 949
24+
Up to 12000: 76
25+
- Base 9
26+
First 20 pseudoprimes: 4 8 28 52 91 121 205 286 364 511 532 616 671 697 703 946 949 1036 1105 1288
27+
Up to 12000: 55
28+
- Base 10
29+
First 20 pseudoprimes: 9 33 91 99 259 451 481 561 657 703 909 1233 1729 2409 2821 2981 3333 3367 4141 4187
30+
Up to 12000: 35
31+
- Base 11
32+
First 20 pseudoprimes: 10 15 70 133 190 259 305 481 645 703 793 1105 1330 1729 2047 2257 2465 2821 4577 4921
33+
Up to 12000: 30
34+
- Base 12
35+
First 20 pseudoprimes: 65 91 133 143 145 247 377 385 703 1045 1099 1105 1649 1729 1885 1891 2041 2233 2465 2701
36+
Up to 12000: 35
37+
- Base 13
38+
First 20 pseudoprimes: 4 6 12 21 85 105 231 244 276 357 427 561 1099 1785 1891 2465 2806 3605 5028 5149
39+
Up to 12000: 31
40+
- Base 14
41+
First 20 pseudoprimes: 15 39 65 195 481 561 781 793 841 985 1105 1111 1541 1891 2257 2465 2561 2665 2743 3277
42+
Up to 12000: 33
43+
- Base 15
44+
First 20 pseudoprimes: 14 341 742 946 1477 1541 1687 1729 1891 1921 2821 3133 3277 4187 6541 6601 7471 8701 8911 9073
45+
Up to 12000: 22
46+
- Base 16
47+
First 20 pseudoprimes: 15 51 85 91 255 341 435 451 561 595 645 703 1105 1247 1261 1271 1285 1387 1581 1687
48+
Up to 12000: 69
49+
- Base 17
50+
First 20 pseudoprimes: 4 8 9 16 45 91 145 261 781 1111 1228 1305 1729 1885 2149 2821 3991 4005 4033 4187
51+
Up to 12000: 31
52+
- Base 18
53+
First 20 pseudoprimes: 25 49 65 85 133 221 323 325 343 425 451 637 931 1105 1225 1369 1387 1649 1729 1921
54+
Up to 12000: 46
55+
- Base 19
56+
First 20 pseudoprimes: 6 9 15 18 45 49 153 169 343 561 637 889 905 906 1035 1105 1629 1661 1849 1891
57+
Up to 12000: 48
58+
- Base 20
59+
First 20 pseudoprimes: 21 57 133 231 399 561 671 861 889 1281 1653 1729 1891 2059 2413 2501 2761 2821 2947 3059
60+
Up to 12000: 35

‎examples/rosetta/inheritance - single.art

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
; Base Animal type
2+
define :animal [
3+
init: constructor [name :string]
4+
]
5+
6+
; Dog type inheriting from Animal
7+
define :dog is :animal [
8+
; ...
9+
]
10+
11+
; Cat type inheriting from Animal
12+
define :cat is :animal [
13+
; ...
14+
]
15+
16+
; Lab type inheriting from Dog
17+
define :lab is :dog [
18+
; ...
19+
]
20+
21+
; Collie type inheriting from Dog
22+
define :collie is :dog [
23+
; ...
24+
]

‎examples/rosetta/number names.art

Lines changed: 60 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,60 @@
1+
small: [
2+
"zero" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" "ten"
3+
"eleven" "twelve" "thirteen" "fourteen" "fifteen" "sixteen" "seventeen"
4+
"eighteen" "nineteen"
5+
]
6+
7+
tens: [
8+
"wrong" "wrong" "twenty" "thirty" "forty"
9+
"fifty" "sixty" "seventy" "eighty" "ninety"
10+
]
11+
12+
prefixes: ["m" "b" "tr" "quadr" "quint" "sext" "sept" "oct" "non" "dec"]
13+
big: ["" "thousand"] ++ map prefixes 'p -> p ++ "illion"
14+
15+
wordify: function [number :integer][
16+
if number < 0 ->
17+
return "negative " ++ wordify neg number
18+
19+
if number < 20 ->
20+
return small\[number]
21+
22+
if number < 100 [
23+
[d m]: divmod number 10
24+
return tens\[d] ++ (zero? m)? -> "" -> "-" ++ wordify m
25+
]
26+
27+
if number < 1000 [
28+
[d m]: divmod number 100
29+
return (~{|small\[d]| hundred}) ++ (zero? m)? -> "" -> " and " ++ wordify m
30+
]
31+
32+
chunks: []
33+
n: number
34+
while [not? zero? n][
35+
[n remainder]: divmod n 1000
36+
'chunks ++ remainder
37+
]
38+
39+
if (size chunks) > size big ->
40+
return "integer value too large"
41+
42+
words: []
43+
loop.with:'i chunks 'ch [
44+
scale: big\[i]
45+
unless zero? ch [
46+
chunkStr: wordify ch
47+
'words ++ (empty? scale)? -> chunkStr
48+
-> ~"|chunkStr| |scale|"
49+
]
50+
]
51+
52+
return join.with:", " reverse words
53+
]
54+
55+
loop @[
56+
0,1,4,5,10,15,18,25,83,140,300,678,1024,
57+
45039,123456,91740274651983,
58+
neg 83125311200, neg 12, neg 7
59+
] 'num ->
60+
print [pad to :string num 15, join.with: "\n"++ (repeat " " 16) split.lines wordwrap.at: 40 wordify num]

0 commit comments

Comments
 (0)