aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2023-09-16 17:28:03 -07:00
parent 5af6d93694
commit 796d366b97
455 changed files with 7413 additions and 1900 deletions
Download patch file Download diff file Expand all files Collapse all files

16
Task/100-doors/EasyLang/100-doors.easy
View file

@ -1,13 +1,13 @@
len d[] 100
for p = 1 to 100
i = p
while i <= 100
d[i] = 1 - d[i]
i += p
.
i = p
while i <= 100
d[i] = 1 - d[i]
i += p
.
.
for i = 1 to 100
if d[i] = 1
print i
.
if d[i] = 1
print i
.
.

4
Task/100-doors/Zig/100-doors-3.zig
View file

@ -1,6 +1,6 @@
const stdout = @import("std").io.getStdOut().writer();
pub fn main() !void {
const stdout = @import("std").io.getStdOut().writer();
var square: u8 = 1;
var increment: u8 = 3;
for (1..101) |door| {

4
Task/100-doors/Zig/100-doors-4.zig
View file

@ -1,6 +1,6 @@
const stdout = @import("std").io.getStdOut().writer();
pub fn main() !void {
const stdout = @import("std").io.getStdOut().writer();
var door: u8 = 1;
while (door * door <= 100) : (door += 1) {
try stdout.print("Door {d} is open\n", .{door * door});

80
Task/100-prisoners/EasyLang/100-prisoners.easy
View file

@ -1,60 +1,60 @@
for i = 1 to 100
drawer[] &= i
sampler[] &= i
drawer[] &= i
sampler[] &= i
.
subr shuffle_drawer
for i = len drawer[] downto 2
r = random i
swap drawer[r] drawer[i]
.
for i = len drawer[] downto 2
r = random i
swap drawer[r] drawer[i]
.
.
subr play_random
call shuffle_drawer
for prisoner = 1 to 100
found = 0
for i = 1 to 50
r = random (100 - i)
card = drawer[sampler[r]]
swap sampler[r] sampler[100 - i - 1]
if card = prisoner
found = 1
break 1
shuffle_drawer
for prisoner = 1 to 100
found = 0
for i = 1 to 50
r = random (100 - i)
card = drawer[sampler[r]]
swap sampler[r] sampler[100 - i - 1]
if card = prisoner
found = 1
break 1
.
.
.
if found = 0
break 1
.
.
if found = 0
break 1
.
.
.
subr play_optimal
call shuffle_drawer
for prisoner = 1 to 100
reveal = prisoner
found = 0
for i = 1 to 50
card = drawer[reveal]
if card = prisoner
found = 1
break 1
shuffle_drawer
for prisoner = 1 to 100
reveal = prisoner
found = 0
for i = 1 to 50
card = drawer[reveal]
if card = prisoner
found = 1
break 1
.
reveal = card
.
reveal = card
.
if found = 0
break 1
.
.
if found = 0
break 1
.
.
.
n = 10000
win = 0
for _ = 1 to n
call play_random
win += found
play_random
win += found
.
print "random: " & 100.0 * win / n & "%"
#
win = 0
for _ = 1 to n
call play_optimal
win += found
play_optimal
win += found
.
print "optimal: " & 100.0 * win / n & "%"

156
Task/15-puzzle-game/EasyLang/15-puzzle-game.easy
View file

@ -3,81 +3,101 @@ background 432
textsize 13
len f[] 16
proc draw . .
clear
for i = 1 to 16
h = f[i]
if h < 16
x = (i - 1) mod 4 * 24 + 3
y = (i - 1) div 4 * 24 + 3
color 210
move x y
rect 22 22
move x + 4 y + 6
if h < 10
move x + 6 y + 6
clear
for i = 1 to 16
h = f[i]
if h < 16
x = (i - 1) mod 4 * 24 + 3
y = (i - 1) div 4 * 24 + 3
color 210
move x y
rect 22 22
move x + 4 y + 6
if h < 10
move x + 6 y + 6
.
color 885
text h
.
color 885
text h
.
.
.
.
global done .
proc smiley . .
s = 3.5
x = 86
y = 86
move x y
color 983
circle 2.8 * s
color 000
move x - s y - s
circle s / 3
move x + 3.5 y - 3.5
circle s / 3
linewidth s / 3
curve [ x - s y + s x y + 2 * s x + s y + s ]
.
proc init . .
done = 0
for i = 1 to 16
f[i] = i
.
# shuffle
for i = 15 downto 2
r = random i
swap f[r] f[i]
.
# make it solvable
inv = 0
for i = 1 to 15
for j = 1 to i - 1
if f[j] > f[i]
inv += 1
done = 0
for i = 1 to 16
f[i] = i
.
# shuffle
for i = 15 downto 2
r = random i
swap f[r] f[i]
.
# make it solvable
inv = 0
for i = 1 to 15
for j = 1 to i - 1
if f[j] > f[i]
inv += 1
.
.
.
.
if inv mod 2 <> 0
swap f[1] f[2]
.
textsize 12
call draw
.
if inv mod 2 <> 0
swap f[1] f[2]
.
textsize 12
draw
.
proc move_tile . .
c = mouse_x div 25
r = mouse_y div 25
i = r * 4 + c + 1
if c > 0 and f[i - 1] = 16
swap f[i] f[i - 1]
elif r > 0 and f[i - 4] = 16
swap f[i] f[i - 4]
elif r < 3 and f[i + 4] = 16
swap f[i] f[i + 4]
elif c < 3 and f[i + 1] = 16
swap f[i] f[i + 1]
.
call draw
done = 1
for i = 1 to 15
if f[i] > f[i + 1]
done = 0
.
.
if done = 1
clear
move 10 30
text "Well done!"
.
c = mouse_x div 25
r = mouse_y div 25
i = r * 4 + c + 1
if c > 0 and f[i - 1] = 16
swap f[i] f[i - 1]
elif r > 0 and f[i - 4] = 16
swap f[i] f[i - 4]
elif r < 3 and f[i + 4] = 16
swap f[i] f[i + 4]
elif c < 3 and f[i + 1] = 16
swap f[i] f[i + 1]
.
draw
for i = 1 to 15
if f[i] > f[i + 1]
return
.
.
done = 1
timer 0.5
.
on mouse_down
if done = 1
call init
else
call move_tile
.
if done = 0
move_tile
elif done = 3
init
.
.
call init
on timer
if done = 1
smiley
done = 2
timer 2
else
done = 3
.
.
init

126
Task/2048/Koka/2048.koka Normal file
View file

@ -0,0 +1,126 @@
import std/num/random
import std/os/readline
val empty = list(0, 15).map(fn(_) 0)
fun win(l)
l.any(fn(x) x == 2048)
fun stack(l)
match l
Cons(0, tl) -> tl.stack ++ [0]
Cons(hd, tl) -> Cons(hd, tl.stack)
Nil -> Nil
fun join(l: list<int>)
match l
Cons(a, Cons(b, c)) | a == b -> Cons((a + b), c.join) ++ [0]
Cons(a, b) -> Cons(a, b.join)
Nil -> Nil
fun hit(l)
l.stack.join
fun hitBack(l)
l.reverse.hit.reverse
fun splitBy(l: list<a>, i: int): div list<list<a>>
val (a, b) = l.split(i)
match b
Cons -> Cons(a, b.splitBy(i))
Nil -> Cons(a, Nil)
fun transpose(l: list<list<a>>): <exn> list<list<a>>
match l
Cons(Cons(a, b), c) -> Cons(Cons(a, c.map(fn(x) x.head.unjust)), transpose(Cons(b, c.map(fn(x) x.tail)).unsafe-decreasing))
Cons(Nil, b) -> transpose(b)
Nil -> Nil
fun rows(l)
l.splitBy(4)
fun left(l)
l.rows.map(hit).concat
fun right(l)
l.rows.map(hitBack).concat
fun up(l)
l.rows.transpose.map(hit).transpose.concat
fun down(l)
l.rows.transpose.map(hitBack).transpose.concat
fun (==)(l1: list<int>, l2: list<int>): bool
match l1
Cons(a, b) -> match l2
Cons(c, d) -> a == c && b == d
Nil -> False
Nil -> match l2
Cons -> False
Nil -> True
fun lose(l)
l.left == l && l.right == l && l.up == l && l.down == l
fun numZeros(l: list<int>): int
l.filter(fn(x) x == 0).length
fun insert(l: list<int>, what: int, toWhere: int)
match l
Cons(0, tail) | tail.numZeros == toWhere -> Cons(what, tail)
Cons(head, tail) -> Cons(head, tail.insert(what, toWhere))
Nil -> Nil
fun spawnOn(l)
val newTileValue = if random-int() % 10 == 0 then 4 else 2
val newPosition = random-int() % (l.numZeros - 1)
l.insert(newTileValue, newPosition)
fun show-board(l: list<int>): div string
"\n" ++ l.rows.map(fn(r) r.map(fn(x) x.show.pad-left(4)).join("")).intersperse("\n").join("") ++ "\n"
fun quit(l)
[]
fun quitted(l)
l.is-nil
fun dispatch(c)
match c
'i' -> up
'j' -> left
'k' -> down
'l' -> right
'q' -> quit
_ ->
println("Unknown command: keys are ijkl to move, q to quit")
id
fun key()
readline().head-char.default('_')
fun turn(l)
l.show-board.println
val next = dispatch(key())(l)
if !(next == l) && next.quitted.not then
spawnOn(next)
else
next
fun play(state)
if state.win || state.lose || state.quitted then
if state.quitted then
"You quit!".println
else if state.win then
"You won!".println
else
"You lost!".println
else
"play".println
play(turn(state))
fun main()
print("ijkl to move, q to quit\n")
val initial = empty.spawnOn
println("Starting game...")
play(initial)

53
Task/24-game-Solve/FutureBasic/24-game-solve.basic Normal file
View file

@ -0,0 +1,53 @@
begin globals
Short k
end globals
void local fn eval( t as CFStringRef )
CFMutableStringRef s = fn MutableStringNew
ExpressionRef x = fn ExpressionWithFormat( t )
CFRange r = fn CFRangeMake(0, fn StringLength( t ) )
CFNumberRef n = fn ExpressionValueWithObject( x, Null, Null )
Float f = dblval( n )
if f = 24 // found, so clean up
MutableStringSetString( s, t ) // duplicate string and pretend it was integers all along
MutableStringReplaceOccurrencesOfString( s, @".000000", @"", Null, r )
print s; @" = 24" : k ++
end if
end fn
clear local fn work( t as CFStringRef )
Short a, b, c, d, e, f, g
CGFloat n(3)
CFStringRef s, os = @"*/+-", o(3)
print t, : k = 0
// Put digits (as floats) and operators (as strings) in arrays
for a = 0 to 3 : s = mid( t, a, 1 ) : n(a) = fn StringFloatValue( s ) : o(a) = mid( os, a, 1 ) : next
// Permutions for the digits ...
for d = 0 to 3 : for e = 0 to 3 : for f = 0 to 3 : for g = 0 to 3
if d != e and d != f and d != g and e != f and e != g and f != g // ... without duplications
// Combinations for the operators (3 from 4, with replacement)
for a = 0 to 3 : for b = 0 to 3 : for c = 0 to 3
fn eval( fn StringWithFormat( @"%f %@ %f %@ %f %@ %f", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn
fn eval( fn StringWithFormat( @"%f %@ ( %f %@ %f ) %@ %f", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn
fn eval( fn StringWithFormat( @"%f %@ %f %@ ( %f %@ %f )", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn
fn eval( fn StringWithFormat( @"%f %@ ( %f %@ %f %@ %f )", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn
fn eval( fn StringWithFormat( @"( %f %@ %f ) %@ %f %@ %f", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn
fn eval( fn StringWithFormat( @"( %f %@ %f %@ %f ) %@ %f", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn
fn eval( fn StringWithFormat( @"%f %@ ( %f %@ ( %f %@ %f ) )", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn
fn eval( fn StringWithFormat( @"( %f %@ %f ) %@ ( %f %@ %f )", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn
fn eval( fn StringWithFormat( @"( %f %@ ( %f %@ %f )) %@ %f", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn
fn eval( fn StringWithFormat( @"( ( %f %@ %f ) %@ %f ) %@ %f", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn
fn eval( fn StringWithFormat( @"%f %@ ( ( %f %@ %f ) %@ %f )", n(d), o(a), n(e), o(b), n(f), o(c), n(g) ) ) : if k > 0 then exit fn
next : next : next
end if
next : next : next : next
end fn
window 1, @"24 Game", ( 0, 0, 250, 250 )
fn work(@"3388")
fn work(@"1346")
fn work(@"8752")
handleevents

25
Task/99-bottles-of-beer/EasyLang/99-bottles-of-beer.easy
View file

@ -1,21 +1,18 @@
proc checkPlural num . word$ .
func$ bottle num .
if num = 1
word$ = "bottle"
else
word$ = "bottles"
return "bottle"
.
return "bottles"
.
#
for i = 99 step -1 to 1
call checkPlural i pluralWord$
print i & " " & pluralWord$ & " of beer on the wall"
print i & " " & pluralWord$ & " of beer"
i = 99
repeat
print i & " " & bottle i & " of beer on the wall"
print i & " " & bottle i & " of beer"
print "Take one down, pass it around"
call checkPlural i - 1 pluralWord$
if i - 1 = 0
print "No more bottles of beer on the wall"
else
print i - 1 & " " & pluralWord$ & " of beer on the wall"
.
i -= 1
until i = 0
print i & " " & bottle i & " of beer on the wall"
print ""
.
print "No more bottles of beer on the wall"

22
Task/AKS-test-for-primes/Zig/aks-test-for-primes.zig
View file

@ -1,11 +1,12 @@
const std = @import("std");
const assert = std.debug.assert;
const stdout = std.io.getStdOut().writer();
pub fn main() !void {
const stdout = std.io.getStdOut().writer();
var i: u6 = 0;
while (i < 8) : (i += 1)
try showBinomial(i);
try showBinomial(stdout, i);
try stdout.print("\nThe primes upto 50 (via AKS) are: ", .{});
i = 2;
@ -14,26 +15,26 @@ pub fn main() !void {
try stdout.print("\n", .{});
}
fn showBinomial(n: u6) !void {
fn showBinomial(writer: anytype, n: u6) !void {
const row = binomial(n).?;
var sign: u8 = '+';
var exp = row.len;
try stdout.print("(x - 1)^{} =", .{n});
try writer.print("(x - 1)^{} =", .{n});
for (row) |coef| {
try stdout.print(" ", .{});
try writer.print(" ", .{});
if (exp != row.len)
try stdout.print("{c} ", .{sign});
try writer.print("{c} ", .{sign});
exp -= 1;
if (coef != 1 or exp == 0)
try stdout.print("{}", .{coef});
try writer.print("{}", .{coef});
if (exp >= 1) {
try stdout.print("x", .{});
try writer.print("x", .{});
if (exp > 1)
try stdout.print("^{}", .{exp});
try writer.print("^{}", .{exp});
}
sign = if (sign == '+') '-' else '+';
}
try stdout.print("\n", .{});
try writer.print("\n", .{});
}
fn aksPrime(n: u6) bool {
@ -54,6 +55,7 @@ pub fn binomial(n: u32) ?[]const u64 {
const rmax = 68;
// evaluated and created at compile-time
const pascal = build: {
@setEvalBranchQuota(100_000);
var coefficients: [(rmax * (rmax + 1)) / 2]u64 = undefined;

2
Task/Abelian-sandpile-model/00-META.yaml
View file

@ -1,2 +1,4 @@
---
category:
- Cellular automata
from: http://rosettacode.org/wiki/Abelian_sandpile_model

58
Task/Achilles-numbers/Quackery/achilles-numbers.quackery Normal file
View file

@ -0,0 +1,58 @@
[ ' [ 1 ] swap
behead swap witheach
[ dup dip
[ = iff
[ -1 pluck
1+ join ]
else
[ 1 join ] ] ]
drop ] is runs ( [ --> [ )
[ 1 over find swap found not ] is powerful ( [ --> b )
[ behead swap witheach gcd
1 = ] is imperfect ( [ --> b )
[ dup 2 < iff
[ drop false ] done
primefactors runs
dup powerful iff
imperfect
else [ drop false ] ] is achilles ( [ --> b )
[ dup achilles iff
[ totient achilles ]
else [ drop false ] ] is strong ( [ --> b )
[] 0
[ 1+ dup achilles if
[ tuck join swap ]
over size 50 = until ]
drop
say "First fifty achilles numbers:" cr
echo
cr cr
[] 0
[ 1+ dup strong if
[ tuck join swap ]
over size 20 = until ]
drop
say "First twenty strong achilles numbers:" cr
echo
cr cr
0 100 times
[ i^ achilles if 1+ ]
say "Achilles numbers with 2 digits: " echo
cr
0 900 times
[ i^ 100 + achilles if 1+ ]
say "Achilles numbers with 3 digits: " echo
cr
0 9000 times
[ i^ 1000 + achilles if 1+ ]
say "Achilles numbers with 4 digits: " echo
cr
0 90000 times
[ i^ 10000 + achilles if 1+ ]
say "Achilles numbers with 5 digits: " echo
cr

4
Task/Ackermann-function/Acornsoft-Lisp/ackermann-function.lisp Normal file
View file

@ -0,0 +1,4 @@
(defun ack (m n)
(cond ((zerop m) (add1 n))
((zerop n) (ack (sub1 m) 1))
(t (ack (sub1 m) (ack m (sub1 n))))))

20
Task/Ackermann-function/EasyLang/ackermann-function.easy
View file

@ -1,12 +1,10 @@
proc ackerm m n . r .
if m = 0
r = n + 1
elif n = 0
call ackerm m - 1 1 r
else
call ackerm m n - 1 h
call ackerm m - 1 h r
.
func ackerm m n .
if m = 0
return n + 1
elif n = 0
return ackerm (m - 1) 1
else
return ackerm (m - 1) ackerm m (n - 1)
.
.
call ackerm 3 6 r
print r
print ackerm 3 6

31
Task/Additive-primes/EasyLang/additive-primes.easy
View file

@ -1,25 +1,28 @@
proc isprime x . r .
r = 1
for i = 2 to sqrt x
if x mod i = 0
r = 0
break 2
.
func prime n .
if n mod 2 = 0 and n > 2
return 0
.
i = 3
sq = sqrt n
while i <= sq
if n mod i = 0
return 0
.
i += 2
.
return 1
.
proc digsum n . sum .
sum = 0
func digsum n .
while n > 0
sum += n mod 10
n = n div 10
.
return sum
.
for i = 2 to 500
call isprime i r
if r = 1
call digsum i s
call isprime s r
if r = 1
if prime i = 1
s = digsum i
if prime s = 1
write i & " "
.
.

17
Task/Additive-primes/Maxima/additive-primes.maxima Normal file
View file

@ -0,0 +1,17 @@
/* Function that returns a list of digits given a nonnegative integer */
decompose(num) := block([digits, remainder],
digits: [],
while num > 0 do
(remainder: mod(num, 10),
digits: cons(remainder, digits),
num: floor(num/10)),
digits
)$
/* Routine that extracts from primes between 2 and 500, inclusive, the additive primes */
block(
primes(2,500),
sublist(%%,lambda([x],primep(apply("+",decompose(x))))));
/* Number of additive primes in the rank */
length(%);

2
Task/Address-of-a-variable/Zig/address-of-a-variable.zig
View file

@ -5,5 +5,5 @@ pub fn main() !void {
var i: i32 = undefined;
var address_of_i: *i32 = &i;
try stdout.print("{x}\n", .{@ptrToInt(address_of_i)});
try stdout.print("{x}\n", .{@intFromPtr(address_of_i)});
}

16
Task/Almost-prime/Maxima/almost-prime.maxima Normal file
View file

@ -0,0 +1,16 @@
/* Predicate function that checks k-almost primality for given integer n and parameter k */
k_almost_primep(n,k):=if integerp((n)^(1/k)) and primep((n)^(1/k)) then true else
lambda([x],(length(ifactors(x))=k and unique(map(second,ifactors(x)))=[1]) or (length(ifactors(x))<k and apply("+",map(second,ifactors(x)))=k))(n)$
/* Function that given a parameter k1 returns the first len k1-almost primes */
k_almost_prime_count(k1,len):=block(
count:len,
while length(sublist(makelist(i,i,count),lambda([x],k_almost_primep(x,k1))))<len do (count:count+1),
sublist(makelist(i,i,count),lambda([x],k_almost_primep(x,k1))))$
/* Test cases */
k_almost_prime_count(1,10);
k_almost_prime_count(2,10);
k_almost_prime_count(3,10);
k_almost_prime_count(4,10);
k_almost_prime_count(5,10);

2
Task/Amb/Wren/amb.wren
View file

@ -23,7 +23,7 @@ var wordsets = [
[ "frog", "elephant", "thing" ],
[ "walked", "treaded", "grows" ],
[ "slowly", "quickly" ]
}
]
if (amb.call(wordsets, [])) {
System.print(finalRes.join(" "))

17
Task/Amicable-pairs/EasyLang/amicable-pairs.easy Normal file
View file

@ -0,0 +1,17 @@
func sumdivs n .
sum = 1
for d = 2 to sqrt n
if n mod d = 0
sum += d + n div d
.
.
return sum
.
for n = 1 to 20000
m = sumdivs n
if m > n
if sumdivs m = n
print n & " " & m
.
.
.

3
Task/Anagrams-Deranged-anagrams/FutureBasic/anagrams-deranged-anagrams-1.basic Normal file
View file

@ -0,0 +1,3 @@
Anagrams
length ZzYyXx WwVvUuTt SsRrQqPp OoNnMmLl KkJjIiHh GgFfEeDd CcBbAa
00001000 00000000 00000000 01010000 00010100 00000000 01000000 00001100

100
Task/Anagrams-Deranged-anagrams/FutureBasic/anagrams-deranged-anagrams-2.basic Normal file
View file

@ -0,0 +1,100 @@
#plist NSAppTransportSecurity @{NSAllowsArbitraryLoads:YES}
defstr long
begin globals
xref xwords( 210000 ) as char
long gAvatars( 26000 )
uint32 gwordNum, gfilen, gcount = 0, gOffset( 26000 )
uint16 gndx( 26000 ), deranged( 600, 1 )
long sh : sh = system( _scrnHeight ) -100
long sw : sw = (system( _scrnWidth ) -360 ) / 2
CFTimeInterval t
_len = 56
end globals
local fn loadDictionary
CFURLRef url = fn URLWithString( @"http://wiki.puzzlers.org/pub/wordlists/unixdict.txt" )
CFStringRef dictStr = fn StringWithContentsOfURL( url, NSUTF8StringEncoding, NULL )
dictStr = fn StringByAppendingString( @" ", dictStr )
xwords = fn StringUTF8String( dictstr )
gfilen = len(dictstr)
end fn
local fn deranagrams
uint64 ch, p, wordStart = 0
long avatar = 0
uint32 med, bot, top
byte chk, L
for p = 1 to gfilen
ch = xwords(p) //build avatar
if ch > _" " then avatar += (long) 1 << ( ch and 31 ) * 2: continue
avatar += (long)(p - wordStart - 1) << _len //complete avatar by adding word length
gAvatars(gWordNum) = avatar //store the avatar in list
gOffset( gWordNum) = wordStart //store offset to the word
//Insert into ordered list of avatars
bot = 0 : top = gwordNum //quick search for place to insert
while (top - bot) > 1
med = ( top + bot ) >> 1
if avatar > gAvatars(gndx(med)) then bot = med else top = med
wend
blockmove( @gndx( top ), @gndx( top + 1 ), ( gwordNum - top ) * 2 )
gndx(top) = gWordNum
gwordNum++ : wordStart = p : avatar = 0 //ready for new word
next p
//Check for matching avatars
for p = gWordNum to 1 step -1
chk = 1 //to make sure each word is compared with all matching avatars
while gAvatars( gndx( p ) ) == gAvatars( gndx( p - chk ) )
// found anagram; now check for chars in same position
L = ( gAvatars( gndx( p ) ) >> _len ) //get word length
while L
if xwords(gOffset(gndx(p)) +L) == xwords(gOffset(gndx(p-chk)) +L) then break
L--
wend
if L == 0
//no matching chars: found Deranged Anagram!
deranged( gcount, 0 ) = gndx( p )
deranged( gcount, 1 ) = gndx( p - chk )
gcount++
end if
chk++
wend
next
end fn
local fn printPair( ndx as uint32, chrsToCntr as byte )
ptr p : str255 pair : pair = ""
short n = ( gAvatars( deranged( ndx, 0 ) ) >> _len )
if n < chrsToCntr then print string$( chrsToCntr - n, " " );
p = xwords + gOffset( deranged( ndx, 0 ) )
p.0`` = n : print p.0$; " ";
p = xwords + gOffset( deranged( ndx, 1 ) )
p.0`` = n : print p.0$
end fn
local fn doDialog(evt as long)
if evt == _btnclick
long r
button -1 : window 1,,(sw,50,335,sh-50)
for r = 1 to gcount-1
fn printPair( r, 21 )
next
end if
end fn
fn loadDictionary : t = fn CACurrentMediaTime
fn deranagrams : t = fn CACurrentMediaTime - t
window 1, @"Deranged Anagrams in FutureBasic",(sw,sh-130,335,130)
printf @"\n %u deranged anagrams found among \n %u words ¬
in %.2f ms.\n", gcount, gWordNum, t * 1000
print " Longest:";: fn printPair( 0, 11 )
button 1,,,fn StringWithFormat(@"Show remaining %u deranged anagrams.",gcount-1),(24,20,285,34)
on dialog fn doDialog
handleevents

3
Task/Anonymous-recursion/00-TASK.txt
View file

@ -15,5 +15,8 @@ Anonymous recursion can also be accomplished using the &nbsp; [[Y combinator]].
;Task:
If possible, demonstrate this by writing the recursive version of the fibonacci function &nbsp; (see [[Fibonacci sequence]]) &nbsp; which checks for a negative argument before doing the actual recursion.
;Related tasks:
:* &nbsp; [[Y combinator]]
<br><br>

9
Task/Archimedean-spiral/EasyLang/archimedean-spiral.easy Normal file
View file

@ -0,0 +1,9 @@
linewidth 0.2
x = 50
y = 50
move x y
while r < 50
line r * cos t + x r * sin t + y
r += 0.1
t += 6
.

2
Task/Archimedean-spiral/Maxima/archimedean-spiral.maxima Normal file
View file

@ -0,0 +1,2 @@
archi_spi(a,b):=wxdraw2d(nticks=200,polar(a+b*theta,theta,1,10*%pi))$
archi_spi(1,1);

1
Task/Arithmetic-derivative/00-TASK.txt
View file

@ -33,4 +33,3 @@ Find (the arithmetic derivative of 10^m) then divided by 7, where m is from 1 to
;* [[oeis:A003415|OEIS:A003415 - a(n) = n' = arithmetic derivative of n.]]
;*[[wp:Arithmetic_derivative|Wikipedia: Arithmetic Derivative]]

22
Task/Arithmetic-derivative/ALGOL-68/arithmetic-derivative.alg Normal file
View file

@ -0,0 +1,22 @@
BEGIN PROC lagarias = (LONG INT n) LONG INT: # Lagarias arithmetic derivative #
IF n < 0
THEN -lagarias (-n)
ELIF n = 0 OR n = 1
THEN 0
ELIF PROC small pf = (LONG INT j, k) LONG INT: # Smallest prime factor #
(j %* k = 0 | k | small pf (j, k + 1));
LONG INT f = small pf (n, 2); LONG INT q = n % f;
q = 1
THEN 1
ELSE q * lagarias (f) + f * lagarias (q)
FI;
FOR n FROM -99 TO 100
DO print (("D(", whole (n, 0), ") = ", whole (lagarias (n), 0), new line))
OD;
new line (standout);
FOR n TO 20
DO LONG INT m = LONG 10 ^ n;
print (("D(", whole (m, 0), ") / 7 = ", whole (lagarias (m) % 7, 0), new line))
OD
END

142
Task/Arithmetic-evaluation/EasyLang/arithmetic-evaluation.easy Normal file
View file

@ -0,0 +1,142 @@
subr nch
if inp_ind > len inp$[]
ch$ = strchar 0
else
ch$ = inp$[inp_ind]
inp_ind += 1
.
ch = strcode ch$
.
#
subr ntok
while ch$ = " "
nch
.
if ch >= 48 and ch <= 58
tok$ = "n"
s$ = ""
while ch >= 48 and ch <= 58 or ch$ = "."
s$ &= ch$
nch
.
tokv = number s$
elif ch = 0
tok$ = "end of text"
else
tok$ = ch$
nch
.
.
subr init0
astop$[] = [ ]
astleft[] = [ ]
astright[] = [ ]
err = 0
.
proc init s$ . .
inp$[] = strchars s$
inp_ind = 1
nch
ntok
init0
.
proc ast_print nd . .
write "AST:"
for i to len astop$[]
write " ( "
write astop$[i] & " "
write astleft[i] & " "
write astright[i]
write " )"
.
print " Start: " & nd
.
func node .
astop$[] &= ""
astleft[] &= 0
astright[] &= 0
return len astop$[]
.
#
funcdecl parse_expr .
#
func parse_factor .
if tok$ = "n"
nd = node
astop$[nd] = "n"
astleft[nd] = tokv
ntok
elif tok$ = "("
ntok
nd = parse_expr
if tok$ <> ")"
err = 1
print "error: ) expected, got " & tok$
.
ntok
else
err = 1
print "error: factor expected, got " & tok$
.
return nd
.
func parse_term .
ndx = parse_factor
while tok$ = "*" or tok$ = "/"
nd = node
astleft[nd] = ndx
astop$[nd] = tok$
ntok
astright[nd] = parse_factor
ndx = nd
.
return ndx
.
func parse_expr .
ndx = parse_term
while tok$ = "+" or tok$ = "-"
nd = node
astleft[nd] = ndx
astop$[nd] = tok$
ntok
astright[nd] = parse_term
ndx = nd
.
return ndx
.
func parse s$ .
init s$
return parse_expr
.
func eval nd .
if astop$[nd] = "n"
return astleft[nd]
.
le = eval astleft[nd]
ri = eval astright[nd]
a$ = astop$[nd]
if a$ = "+"
return le + ri
elif a$ = "-"
return le - ri
elif a$ = "*"
return le * ri
elif a$ = "/"
return le / ri
.
.
repeat
inp$ = input
until inp$ = ""
print "Inp: " & inp$
nd = parse inp$
ast_print nd
if err = 0
print "Eval: " & eval nd
.
print ""
.
input_data
4 *
4.2 * ((5.3+8)*3 + 4)
2.5 * 2 + 2 * 3.14

15
Task/Arithmetic-numbers/APL/arithmetic-numbers.apl Normal file
View file

@ -0,0 +1,15 @@
task←{
facs ← ⍸0=⍳|⊢
aritm ← (0=≢|+/)∘facs
comp ← 2<(≢facs)
aritms ← ⍸aritm¨⍳15000
⎕←'First 100 arithmetic numbers:'
⎕←10 10⍴aritms
{
⎕←''
⎕←'The ',(⍕⍵),'th arithmetic number: ',(⍕aritms[⍵])
ncomps ← +/comp¨⍵↑aritms
⎕←'Of the first ',(⍕⍵),' arithmetic numbers, ',(⍕ncomps),' are composite.'
}¨10*3 4
}

406
Task/Arithmetic-numbers/ARM-Assembly/arithmetic-numbers.arm Normal file
View file

@ -0,0 +1,406 @@
/* ARM assembly Raspberry PI */
/* program arithnumber.s */
/************************************/
/* Constantes */
/************************************/
/* for this file see task include a file in language ARM assembly*/
.include "../constantes.inc"
.equ NBDIVISORS, 2000
//.include "../../ficmacros32.inc" @ use for developper debugging
/*******************************************/
/* Initialized data */
/*******************************************/
.data
szMessStartPgm: .asciz "Program 32 bits start. \n"
szMessEndPgm: .asciz "Program normal end.\n"
szMessErrorArea: .asciz "\033[31mError : area divisors too small.\n"
szMessError: .asciz "\033[31mError !!!\n"
szMessErrGen: .asciz "Error end program.\n"
szMessResultFact: .asciz "@ "
szCarriageReturn: .asciz "\n"
szMessEntete: .asciz "The first 150 arithmetic numbers are:\n"
szMessResult: .asciz " @ "
szMessEntete1: .asciz "The 1000 aritmetic number :"
szMessEntete2: .asciz "The 10000 aritmetic number :"
szMessEntete3: .asciz "The 100000 aritmetic number :"
szMessEntete4: .asciz "The 1000000 aritmetic number :"
szMessComposite: .asciz "Composite number : "
/*******************************************/
/* UnInitialized data */
/*******************************************/
.bss
.align 4
sZoneConv: .skip 24
tbZoneDecom: .skip 4 * NBDIVISORS // facteur 4 octets
/*******************************************/
/* code section */
/*******************************************/
.text
.global main
main: @ program start
ldr r0,iAdrszMessStartPgm @ display start message
bl affichageMess
ldr r0,iAdrszMessEntete @ display result message
bl affichageMess
mov r2,#1 @ start number
mov r3,#0 @ counter result
mov r6,#0 @ counter result by line
1:
mov r0,r2 @ number
ldr r1,iAdrtbZoneDecom
bl testNbArith @ test
cmp r0,#1 @ ok ?
bne 3f
add r3,#1
mov r0,r2 @ number
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
ldr r0,iAdrszMessResult
ldr r1,iAdrsZoneConv
bl strInsertAtCharInc @ and put in message
bl affichageMess
add r6,r6,#1
cmp r6,#6
blt 3f
mov r6,#0
ldr r0,iAdrszCarriageReturn
bl affichageMess
3:
add r2,r2,#1
cmp r3,#100
blt 1b
ldr r0,iAdrszCarriageReturn
bl affichageMess
/* count arithmetic number */
mov r2,#1
mov r3,#0
ldr r5,iN10P4
ldr r6,iN10P5
ldr r7,iN10P6
mov r8,#0 @ counter composite
4:
mov r0,r2 @ number
ldr r1,iAdrtbZoneDecom
bl testNbArith
cmp r0,#1
bne 6f
cmp r1,#1
bne 5f
add r8,r8,#1
5:
add r3,#1
6:
cmp r3,#1000
beq 7f
cmp r3,r5 @ 10000
beq 8f
cmp r3,r6 @ 100000
beq 9f
cmp r3,r7 @ 1000000
beq 10f
b 11f
7:
ldr r0,iAdrszMessEntete1
bl affichageMess
mov r0,r2
mov r4,r1 @ save sum
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r0,r1
bl affichageMess
ldr r0,iAdrszMessComposite
bl affichageMess
mov r0,r8
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r0,r1
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
b 11f
8:
ldr r0,iAdrszMessEntete2
bl affichageMess
mov r0,r2
mov r4,r1 @ save sum
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r0,r1
bl affichageMess
ldr r0,iAdrszMessComposite
bl affichageMess
mov r0,r8
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r0,r1
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
b 11f
9:
ldr r0,iAdrszMessEntete3
bl affichageMess
mov r0,r2
mov r4,r1 @ save sum
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r0,r1
bl affichageMess
ldr r0,iAdrszMessComposite
bl affichageMess
mov r0,r8
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r0,r1
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
b 11f
10:
ldr r0,iAdrszMessEntete4
bl affichageMess
mov r0,r2
mov r4,r1 @ save sum
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r0,r1
bl affichageMess
ldr r0,iAdrszMessComposite
bl affichageMess
mov r0,r8
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r0,r1
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
b 12f
11:
add r2,r2,#1
b 4b
12:
ldr r0,iAdrszMessEndPgm @ display end message
bl affichageMess
b 100f
99: @ display error message
ldr r0,iAdrszMessError
bl affichageMess
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc 0 @ perform system call
iAdrszMessStartPgm: .int szMessStartPgm
iAdrszMessEndPgm: .int szMessEndPgm
iAdrszMessError: .int szMessError
iAdrszCarriageReturn: .int szCarriageReturn
iAdrtbZoneDecom: .int tbZoneDecom
iAdrszMessEntete: .int szMessEntete
iAdrszMessEntete1: .int szMessEntete1
iAdrszMessEntete2: .int szMessEntete2
iAdrszMessEntete3: .int szMessEntete3
iAdrszMessEntete4: .int szMessEntete4
iAdrszMessResult: .int szMessResult
iAdrszMessComposite: .int szMessComposite
iAdrsZoneConv: .int sZoneConv
iN10P4: .int 10000
iN10P5: .int 100000
iN10P6: .int 1000000
/******************************************************************/
/* test if number is aritmetic number */
/******************************************************************/
/* r0 contains number */
/* r1 contains address of divisors area */
/* r0 return 1 if ok else return 0 */
/* r1 return 1 if composite */
testNbArith:
push {r2-r11,lr} @ save registers
cmp r0,#1 @ 1 is arithmetique
moveq r0,#1
moveq r1,#0
beq 100f
cmp r0,#2 @ 2 is not aritmetic
moveq r0,#0
moveq r1,#0
beq 100f
mov r5,r1
mov r8,r0 @ save number
bl isPrime @ prime ?
cmp r0,#1
moveq r0,#1 @ yes is prime and arithmetic
moveq r1,#0 @ but not composite
beq 100f @ end
mov r1,#1
str r1,[r5] @ first factor
mov r11,#1 @ divisors sum
mov r4,#1 @ indice divisors table
mov r1,#2 @ first divisor
mov r6,#0 @ previous divisor
mov r7,#0 @ number of same divisors
1:
mov r0,r8 @ dividende
bl division @ r1 divisor r2 quotient r3 remainder
cmp r3,#0
bne 6f @ if remainder <> zero -> no divisor
mov r8,r2 @ else quotient -> new dividende
cmp r1,r6 @ same divisor ?
beq 3f @ yes
mov r7,r4 @ number factors in table
mov r9,#0 @ indice
2: @ for each new prime factor compute all factors of number
ldr r10,[r5,r9,lsl #2 ] @ load one factor
mul r10,r1,r10 @ multiply
str r10,[r5,r7,lsl #2] @ and store in the table
add r11,r10 @ sum of factors
add r7,r7,#1 @ and increment counter
add r9,r9,#1 @ increment index
cmp r9,r4 @ end array factors ?
blt 2b
mov r4,r7
mov r6,r1 @ new divisor
b 7f
3: @ same divisor
sub r9,r4,#1
mov r7,r4
4: @ for each prime factor compute all factors of number
ldr r10,[r5,r9,lsl #2 ] @ this prime factor is in factor array ?
cmp r10,r1
subne r9,#1
bne 4b
sub r9,r4,r9
5:
ldr r10,[r5,r9,lsl #2 ]
mul r10,r1,r10
str r10,[r5,r7,lsl #2] @ and store in the table
add r11,r10
add r7,r7,#1 @ and increment counter
add r9,r9,#1
cmp r9,r4
blt 5b
mov r4,r7
b 7f @ and loop
/* not divisor -> increment next divisor */
6:
cmp r1,#2 @ if divisor = 2 -> add 1
addeq r1,#1
addne r1,#2 @ else add 2
b 1b @ and loop
/* divisor -> test if new dividende is prime */
7:
mov r3,r1 @ save divisor
cmp r8,#1 @ dividende = 1 ? -> end
beq 13f
mov r0,r8 @ new dividende is prime ?
mov r1,#0
bl isPrime @ the new dividende is prime ?
cmp r0,#1
bne 12f @ the new dividende is not prime
cmp r8,r6 @ else new dividende prime is same divisor ?
beq 9f @ yes
@ no -> compute all factors
mov r7,r4 @ number factors in table
mov r9,#0 @ indice
8:
ldr r10,[r5,r9,lsl #2 ] @ load one factor
mul r10,r8,r10 @ multiply
str r10,[r5,r7,lsl #2] @ and store in the table
add r11,r10
add r7,r7,#1 @ and increment counter
add r9,r9,#1
cmp r9,r4
blt 8b
mov r4,r7
mov r7,#0
b 13f
9:
sub r9,r4,#1
mov r7,r4
10:
ldr r10,[r5,r9,lsl #2 ]
cmp r10,r8
subne r9,#1
bne 10b
sub r9,r4,r9
11:
ldr r10,[r5,r9,lsl #2 ]
mul r10,r8,r10
str r10,[r5,r7,lsl #2] @ and store in the table
add r11,r10
add r7,r7,#1 @ and increment counter
add r9,r9,#1
cmp r9,r4
blt 11b
mov r4,r7
b 13f
12:
mov r1,r3 @ current divisor = new divisor
cmp r1,r8 @ current divisor > new dividende ?
ble 1b @ no -> loop
/* end decomposition */
13:
mov r1,r4 @ control if arithmetic
mov r0,r11 @ compute average
bl division
mov r1,#1
cmp r3,#0 @ no remainder
moveq r0,#1 @ average is integer
beq 100f @ no -> end
mov r0,#0
mov r1,#0
100:
pop {r2-r11,pc} @ restaur registers
//iAdrszMessNbPrem: .int szMessNbPrem
/******************************************************************/
/* test if number is prime trial test */
/******************************************************************/
/* r0 contains the number */
/* r0 return 1 if prime else return 0 */
isPrime:
push {r4,lr} @ save registers
cmp r0,#1 @ <= 1 ?
movls r0,#0 @ not prime
bls 100f
cmp r0,#3 @ 2 and 3 prime
movls r0,#1
bls 100f
tst r0,#1 @ even ?
moveq r0,#0 @ not prime
beq 100f
mov r4,r0 @ save number
mov r1,#3 @ first divisor
1:
mov r0,r4 @ number
bl division
add r1,r1,#2 @ increment divisor
cmp r3,#0 @ remainder = zero ?
moveq r0,#0 @ not prime
beq 100f
cmp r1,r2 @ divisors<=quotient ?
ble 1b @ loop
mov r0,#1 @ return prime
100:
pop {r4,pc} @ restaur registers
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
/* for this file see task include a file in language ARM assembly*/
.include "../affichage.inc"

24
Task/Arithmetic-numbers/Maxima/arithmetic-numbers.maxima Normal file
View file

@ -0,0 +1,24 @@
/* Predicate function that checks wether a positive integer is arithmetic or not */
arith_nump(n):=block(listify(divisors(n)),apply("+",%%)/length(%%),if integerp(%%) then true)$
/* Function that returns a list of the first len arithmetic numbers */
arith_num_count(len):=block(
[i:1,count:0,result:[]],
while count<len do (if arith_nump(i) then (result:endcons(i,result),count:count+1),i:i+1),
result)$
/* Test cases */
/* First 100 arithmetic numbers */
arith_num_count(100);
/* The 1000th arithmetic number */
last(arith_num_count(1000));
/* The 10000th arithmetic number */
last(arith_num_count(10000));
/* Number of composites among the first 1000 arithmetic numbers */
block(rest(arith_num_count(1000)),sublist(%%,lambda([x],primep(x)=false)),length(%%));
/* Number of composites among the first 10000 arithmetic numbers */
block(rest(arith_num_count(10000)),sublist(%%,lambda([x],primep(x)=false)),length(%%));

92
Task/Array-concatenation/COBOL/array-concatenation.cobol
View file

@ -1,57 +1,47 @@
identification division.
program-id. array-concat.
IDENTIFICATION DIVISION.
PROGRAM-ID. array-concat.
environment division.
configuration section.
repository.
function all intrinsic.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 table-one.
05 int-field PIC 999 OCCURS 0 TO 5 TIMES DEPENDING ON t1.
01 table-two.
05 int-field PIC 9(4) OCCURS 0 TO 10 TIMES DEPENDING ON t2.
77 tally USAGE IS INDEX.
77 t1 PIC 99.
77 t2 PIC 99.
77 show PIC Z(4) USAGE IS DISPLAY.
data division.
working-storage section.
01 table-one.
05 int-field pic 999 occurs 0 to 5 depending on t1.
01 table-two.
05 int-field pic 9(4) occurs 0 to 10 depending on t2.
PROCEDURE DIVISION.
array-concat-main.
PERFORM initialize-tables
PERFORM concatenate-tables
PERFORM display-result
GOBACK.
77 t1 pic 99.
77 t2 pic 99.
initialize-tables.
MOVE 4 TO t1
PERFORM VARYING tally FROM 1 BY 1 UNTIL tally > t1
COMPUTE int-field OF table-one(tally) = tally * 3
END-PERFORM
MOVE 3 TO t2
PERFORM VARYING tally FROM 1 BY 1 UNTIL tally > t2
COMPUTE int-field OF table-two(tally) = tally * 6
END-PERFORM.
77 show pic z(4).
concatenate-tables.
PERFORM VARYING tally FROM 1 BY 1 UNTIL tally > t1
ADD 1 TO t2
MOVE int-field OF table-one(tally)
TO int-field OF table-two(t2)
END-PERFORM.
procedure division.
array-concat-main.
perform initialize-tables
perform concatenate-tables
perform display-result
goback.
display-result.
PERFORM VARYING tally FROM 1 BY 1 UNTIL tally = t2
MOVE int-field OF table-two(tally) TO show
DISPLAY FUNCTION TRIM(show) ", " WITH NO ADVANCING
END-PERFORM
MOVE int-field OF table-two(tally) TO show
DISPLAY FUNCTION TRIM(show).
initialize-tables.
move 4 to t1
perform varying tally from 1 by 1 until tally > t1
compute int-field of table-one(tally) = tally * 3
end-perform
move 3 to t2
perform varying tally from 1 by 1 until tally > t2
compute int-field of table-two(tally) = tally * 6
end-perform
.
concatenate-tables.
perform varying tally from 1 by 1 until tally > t1
add 1 to t2
move int-field of table-one(tally)
to int-field of table-two(t2)
end-perform
.
display-result.
perform varying tally from 1 by 1 until tally = t2
move int-field of table-two(tally) to show
display trim(show) ", " with no advancing
end-perform
move int-field of table-two(tally) to show
display trim(show)
.
end program array-concat.
END PROGRAM array-concat.

33
Task/Array-concatenation/Zig/array-concatenation.zig
View file

@ -1,16 +1,23 @@
const std = @import("std");
fn concat(allocator: std.mem.Allocator, a: []const u32, b: []const u32) ![]u32 {
const result = try allocator.alloc(u32, a.len + b.len);
std.mem.copy(u32, result, a);
std.mem.copy(u32, result[a.len..], b);
return result;
}
pub fn main() void {
var general_purpose_allocator = std.heap.GeneralPurposeAllocator(.{}){};
const gpa = general_purpose_allocator.allocator();
var array1 = [_]u32{ 1, 2, 3, 4, 5 };
var array2 = [_]u32{ 6, 7, 8, 9, 10, 11, 12 };
const array3 = concat(gpa, &array1, &array2);
std.debug.print("Array 1: {any}\nArray 2: {any}\nArray 3: {any}", .{ array1, array2, array3 });
pub fn main() !void {
var gpa = std.heap.GeneralPurposeAllocator(.{}){};
defer _ = gpa.deinit();
const allocator = gpa.allocator();
var array1 = [_]u32{ 1, 2, 3, 4, 5 };
var array2 = [_]u32{ 6, 7, 8, 9, 10, 11, 12 };
const slice3 = try std.mem.concat(allocator, u32, &[_][]const u32{ &array1, &array2 });
defer allocator.free(slice3);
// Same result, alternative syntax
const slice4 = try std.mem.concat(allocator, u32, &[_][]const u32{ array1[0..], array2[0..] });
defer allocator.free(slice4);
std.debug.print(
"Array 1: {any}\nArray 2: {any}\nSlice 3: {any}\nSlice 4: {any}\n",
.{ array1, array2, slice3, slice4 },
);
}

3
Task/Assertions/Zig/assertions.zig
View file

@ -1,5 +1,6 @@
const assert = @import("std").debug.assert;
pub fn main() void {
assert(1 == 0); // On failure, an `unreachable` is reached
const n: i64 = 43;
assert(n == 42); // On failure, an `unreachable` is reached
}

35
Task/Attractive-numbers/FutureBasic/attractive-numbers.basic Normal file
View file

@ -0,0 +1,35 @@
local fn IsPrime( n as NSUInteger ) as BOOL
NSUInteger i
if ( n < 2 ) then exit fn = NO
if ( n = 2 ) then exit fn = YES
if ( n mod 2 == 0 ) then exit fn = NO
for i = 3 to int(n^.5) step 2
if ( n mod i == 0 ) then exit fn = NO
next
end fn = YES
local fn Factors( n as NSInteger ) as NSInteger
NSInteger count = 0, f = 2
do
if n mod f == 0 then count++ : n /= f else f++
until ( f > n )
end fn = count
void local fn AttractiveNumbers( limit as NSInteger )
NSInteger c = 0, n
printf @"Attractive numbers through %d are:", limit
for n = 4 to limit
if fn IsPrime( fn Factors( n ) )
printf @"%4d \b", n
c++
if ( c mod 10 == 0 ) then print
end if
next
end fn
fn AttractiveNumbers( 120 )
HandleEvents

0
Task/Attractive-numbers/Maxima/attractive-numbers.maxima → Task/Attractive-numbers/Maxima/attractive-numbers-1.maxima
View file

2
Task/Attractive-numbers/Maxima/attractive-numbers-2.maxima Normal file
View file

@ -0,0 +1,2 @@
attractivep(n):=block(ifactors(n),apply("+",map(second,%%)),if primep(%%) then true)$
sublist(makelist(i,i,120),attractivep);

69
Task/Attractive-numbers/Odin/attractive-numbers.odin Normal file
View file

@ -0,0 +1,69 @@
import "core:fmt"
main :: proc() {
const_max :: 120
fmt.println("\nAttractive numbers up to and including", const_max, "are: ")
count := 0
for i in 1 ..= const_max {
n := countPrimeFactors(i)
if isPrime(n) {
fmt.print(i, " ")
count += 1
if count % 20 == 0 {
fmt.println()
}
}
}
fmt.println()
}
/* definitions */
isPrime :: proc(n: int) -> bool {
switch {
case n < 2:
return false
case n % 2 == 0:
return n == 2
case n % 3 == 0:
return n == 3
case:
d := 5
for d * d <= n {
if n % d == 0 {
return false
}
d += 2
if n % d == 0 {
return false
}
d += 4
}
return true
}
}
countPrimeFactors :: proc(n: int) -> int {
n := n
switch {
case n == 1:
return 0
case isPrime(n):
return 1
case:
count, f := 0, 2
for {
if n % f == 0 {
count += 1
n /= f
if n == 1 {
return count
}
if isPrime(n) {
f = n
}
} else if f >= 3 {
f += 2
} else {
f = 3
}
}
return count
}
}

8
Task/Average-loop-length/Wren/average-loop-length.wren
View file

@ -1,5 +1,5 @@
import "random" for Random
import "/fmt" for Fmt
import "./fmt" for Fmt
var nmax = 20
var rand = Random.new()
@ -35,10 +35,6 @@ System.print("=== ========= ============ =========")
for (n in 1..nmax) {
var a = avg.call(n)
var b = ana.call(n)
var ns = Fmt.d(3, n)
var as = Fmt.f(9, a, 4)
var bs = Fmt.f(12, b, 4)
var e = (a - b).abs/ b * 100
var es = Fmt.f(6, e, 2)
System.print("%(ns) %(as) %(bs) (%(es)\%)")
Fmt.print("$3d $9.4f $12.4f ($6.2f\%)", n, a, b, e)
}

12
Task/Averages-Arithmetic-mean/EasyLang/averages-arithmetic-mean.easy
View file

@ -1,9 +1,9 @@
func mean . f[] r .
for i = 1 to len f[]
s += f[i]
.
r = s / len f[]
proc mean . f[] r .
for i = 1 to len f[]
s += f[i]
.
r = s / len f[]
.
f[] = [ 1 2 3 4 5 6 7 8 ]
call mean f[] r
mean f[] r
print r

62
Task/Averages-Median/EasyLang/averages-median.easy
View file

@ -1,40 +1,40 @@
proc quickselect k . list[] res .
#
subr partition
mid = left
for i = left + 1 to right
if list[i] < list[left]
mid += 1
swap list[i] list[mid]
#
subr partition
mid = left
for i = left + 1 to right
if list[i] < list[left]
mid += 1
swap list[i] list[mid]
.
.
.
swap list[left] list[mid]
.
left = 1
right = len list[]
while left < right
call partition
if mid < k
left = mid + 1
elif mid > k
right = mid - 1
else
left = right
.
.
res = list[k]
swap list[left] list[mid]
.
left = 1
right = len list[]
while left < right
partition
if mid < k
left = mid + 1
elif mid > k
right = mid - 1
else
left = right
.
.
res = list[k]
.
proc median . list[] res .
h = len list[] div 2 + 1
call quickselect h list[] res
if len list[] mod 2 = 0
call quickselect h - 1 list[] h
res = (res + h) / 2
.
h = len list[] div 2 + 1
quickselect h list[] res
if len list[] mod 2 = 0
quickselect h - 1 list[] h
res = (res + h) / 2
.
.
test[] = [ 4.1 5.6 7.2 1.7 9.3 4.4 3.2 ]
call median test[] med
median test[] med
print med
test[] = [ 4.1 7.2 1.7 9.3 4.4 3.2 ]
call median test[] med
median test[] med
print med

13
Task/Averages-Median/FutureBasic/averages-median.basic Normal file
View file

@ -0,0 +1,13 @@
local fn MedianAverage( arguments as CFArrayRef ) as CFStringRef
ExpressionRef expRef = fn ExpressionForFunction( @"median:", @[fn ExpressionForConstantValue( arguments )] )
CFNumberRef result = fn ExpressionValueWithObject( expRef, NULL, NULL )
CFStringRef median = fn NumberStringValue( result )
end fn = median
print fn MedianAverage( @[@1, @9, @2] ) // 2
print fn MedianAverage( @[@1, @9, @2, @4] ) // 3
print fn MedianAverage( @[@5.961475, @2.025856, @7.262835, @1.814272, @2.281911, @4.854716] ) // 3.5683135
print fn MedianAverage( @[@4.1, @5.6, @7.2, @1.7, @9.3, @4.4, @3.2] ) // 4.4
print fn MedianAverage( @[@40.12, @860.77, @960.29, @920.13] ) // 890.45
HandleEvents

13
Task/Averages-Mode/FutureBasic/averages-mode.basic Normal file
View file

@ -0,0 +1,13 @@
local fn ModeAverage( arguments as CFArrayRef ) as CFStringRef
ExpressionRef expRef = fn ExpressionForFunction( @"mode:", @[fn ExpressionForConstantValue( arguments )] )
CFArrayRef modeArray = fn ExpressionValueWithObject( expRef, NULL, NULL )
CFNumberRef number
CFMutableStringRef modeStr = fn MutableStringNew
for number in modeArray
MutableStringAppendFormat( modeStr, @"value = %@\n", number )
next
end fn = modeStr
print fn ModeAverage( @[@1, @3, @6, @6, @6, @6, @7, @7, @12, @12, @12, @12, @17] )
HandleEvents

18
Task/Binary-digits/EasyLang/binary-digits.easy
View file

@ -1,16 +1,14 @@
proc toBinary num . binary$ .
binary$ = ""
func$ bin num .
b$ = ""
if num = 0
binary$ = "0"
b$ = "0"
.
while num > 0
binary$ = num mod 2 & binary$
b$ = num mod 2 & b$
num = num div 2
.
return b$
.
call toBinary 2 binary$
print binary$
call toBinary 50 binary$
print binary$
call toBinary 9000 binary$
print binary$
print bin 2
print bin 50
print bin 9000

30
Task/Binary-search/EasyLang/binary-search.easy
View file

@ -1,18 +1,18 @@
proc bin_search val . a[] res .
low = 1
high = len a[]
res = 0
while low <= high and res = 0
mid = (low + high) div 2
if a[mid] > val
high = mid - 1
elif a[mid] < val
low = mid + 1
else
res = mid
.
.
proc binSearch val . a[] res .
low = 1
high = len a[]
res = 0
while low <= high and res = 0
mid = (low + high) div 2
if a[mid] > val
high = mid - 1
elif a[mid] < val
low = mid + 1
else
res = mid
.
.
.
a[] = [ 2 4 6 8 9 ]
call bin_search 8 a[] r
binSearch 8 a[] r
print r

15
Task/Blum-integer/Maxima/blum-integer.maxima Normal file
View file

@ -0,0 +1,15 @@
/* Predicate functions that checks wether an integer is a Blum integer or not */
blum_p(n):=lambda([x],length(ifactors(x))=2 and unique(map(second,ifactors(x)))=[1] and mod(ifactors(x)[1][1],4)=3 and mod(ifactors(x)[2][1],4)=3)(n)$
/* Function that returns a list of the first len Blum integers */
blum_count(len):=block(
[i:1,count:0,result:[]],
while count<len do (if blum_p(i) then (result:endcons(i,result),count:count+1),i:i+1),
result)$
/* Test cases */
/* First 50 Blum integers */
blum_count(50);
/* Blum integer number 26828 */
last(blum_count(26828));

6
Task/Boolean-values/EasyLang/boolean-values.easy
View file

@ -4,9 +4,3 @@ if boolNumber = 1
else
print "False"
.
boolString$ = "true"
if boolString$ = "true"
print "True"
else
print "False"
.

24
Task/Box-the-compass/Zig/box-the-compass-2.zig
View file

@ -1,20 +1,20 @@
/// Degrees are not constrained to the range 0 to 360
/// Degrees is not constrained to the range 0 to 360
fn degreesToCompassPoint(degrees: f32) []const u8 {
var d = degrees + comptime (11.25 / 2.0);
while (d < 0) d += 360;
while (d >= 360) d -= 360;
const index: usize = @floatToInt(usize, @divFloor(d, 11.25));
const index: usize = @intFromFloat(@divFloor(d, 11.25));
// Concatenation to overcome the inability of "zig fmt" to nicely format long arrays.
const points: [32][]const u8 = comptime .{} ++
.{ "North", "North by east", "North-northeast", "Northeast by north" } ++
.{ "Northeast", "Northeast by east", "East-northeast", "East by north" } ++
.{ "East", "East by south", "East-southeast", "Southeast by east" } ++
.{ "Southeast", "Southeast by south", "South-southeast", "South by east" } ++
.{ "South", "South by west", "South-southwest", "Southwest by south" } ++
.{ "Southwest", "Southwest by west", "West-southwest", "West by south" } ++
.{ "West", "West by north", "West-northwest", "Northwest by west" } ++
.{ "Northwest", "Northwest by north", "North-northwest", "North by west" };
const points: [32][]const u8 = comptime .{
"North", "North by east", "North-northeast", "Northeast by north",
"Northeast", "Northeast by east", "East-northeast", "East by north",
"East", "East by south", "East-southeast", "Southeast by east",
"Southeast", "Southeast by south", "South-southeast", "South by east",
"South", "South by west", "South-southwest", "Southwest by south",
"Southwest", "Southwest by west", "West-southwest", "West by south",
"West", "West by north", "West-northwest", "Northwest by west",
"Northwest", "Northwest by north", "North-northwest", "North by west",
};
return points[index];
}

6
Task/Box-the-compass/Zig/box-the-compass-3.zig
View file

@ -1,16 +1,16 @@
pub fn main() anyerror!void {
const stdout = std.io.getStdOut().writer();
_ = try stdout.print("Index Heading Compass point\n", .{});
try stdout.print("Index Heading Compass point\n", .{});
for (0..33) |i| {
var heading = @intToFloat(f32, i) * 11.25;
var heading = @as(f32, @floatFromInt(i)) * 11.25;
heading += switch (i % 3) {
1 => 5.62,
2 => -5.62,
else => 0,
};
const index = i % 32 + 1;
_ = try stdout.print(" {d:2} {d:>6.2}° {s}\n", .{ index, heading, degreesToCompassPoint(heading) });
try stdout.print(" {d:2} {d:>6.2}° {s}\n", .{ index, heading, degreesToCompassPoint(heading) });
}
}

51
Task/Brazilian-numbers/EasyLang/brazilian-numbers.easy
View file

@ -1,56 +1,46 @@
proc sameDigits n b . r .
r = 1
func sameDigits n b .
f = n mod b
repeat
n = n div b
until n = 0
if n mod b <> f
r = 0
break 1
return 0
.
.
return 1
.
proc isBrazilian7 n . r .
func isBrazilian7 n .
# n >= 7
r = 0
if n mod 2 = 0
r = 1
break 1
return 1
.
for b = 2 to n - 2
call sameDigits n b h
if h = 1
r = 1
break 2
if sameDigits n b = 1
return 1
.
.
return 0
.
proc isPrime4 n . r .
# n >= 4
r = 0
if n mod 2 = 0 or n mod 3 = 0
break 1
func prime n .
if n mod 2 = 0 and n > 2
return 0
.
d = 5
while d * d <= n
if n mod d = 0
break 2
i = 3
sq = sqrt n
while i <= sq
if n mod i = 0
return 0
.
d += 2
if n mod d = 0
break 2
.
d += 4
i += 2
.
r = 1
return 1
.
for kind$ in [ "" "odd" "prime" ]
print "First 20 " & kind$ & " Brazilian numbers:"
n = 7
cnt = 1
while cnt <= 20
call isBrazilian7 n r
if r = 1
if isBrazilian7 n = 1
write n & " "
cnt += 1
.
@ -61,8 +51,7 @@ for kind$ in [ "" "odd" "prime" ]
else
repeat
n += 2
call isPrime4 n r
until r = 1
until prime n = 1
.
.
.

64
Task/Bulls-and-cows-Player/ALGOL-68/bulls-and-cows-player.alg Normal file
View file

@ -0,0 +1,64 @@
# This breaks a unique code of `n' pegs and `m' colours you think of. #
INT pegs = 4, colours = 6;
MODE LIST = FLEX [1 : 0] COMBINATION,
COMBINATION = [pegs] COLOUR,
COLOUR = INT;
OP +:= = (REF LIST u, COMBINATION v) REF LIST:
# Add one combination to a list. #
([UPB u + 1] COMBINATION w; w[ : UPB u] := u; w[UPB w] := v; u := w);
PROC gen = (REF COMBINATION part, INT peg) VOID:
# Generate all unique [colours!/(colours-pegs)!] combinations. #
IF peg > pegs
THEN all combs +:= part
ELSE FOR i TO colours
DO IF BOOL unique := TRUE;
FOR j TO peg - 1 WHILE unique
DO unique := part[j] ~= i
OD;
unique
THEN part[peg] := i;
gen (part, peg + 1)
FI
OD
FI;
LIST all combs;
gen (LOC COMBINATION, 1);
PROC break code = (LIST sieved) VOID:
# Present a trial and sieve the list with the entered score. #
CASE UPB sieved + 1
IN # No elements. # printf ($l"Inconsistent scores"l$),
# One element. # printf (($l"Solution is "4(xd)l$, sieved[1]))
OUT printf (($l4(dx)$, sieved[1]));
# Read the score as a sequence of "c" and "b". #
INT col ok := 0, pos ok := 0, STRING z := "";
WHILE z = ""
DO read ((z, new line))
OD;
FOR i TO UPB z
DO (z[i] = "c" | col ok |: z[i] = "b" | pos ok) +:= 1
OD;
(pos ok = pegs | stop);
# Survivors are combinations with score as entered. #
LIST survivors;
FOR i FROM 2 TO UPB sieved
DO INT col ok i := 0, pos ok i := 0;
FOR u TO pegs
DO FOR v TO pegs
DO IF sieved[1][u] = sieved[i][v]
THEN (u = v | pos ok i | col ok i) +:= 1
FI
OD
OD;
(col ok = col ok i AND pos ok = pos ok i | survivors +:= sieved[i])
OD;
# Solution must be among the survivors. #
break code (survivors)
ESAC;
break code (all combs)

2
Task/Calculating-the-value-of-e/EasyLang/calculating-the-value-of-e.easy
View file

@ -1,4 +1,4 @@
numfmt 0 5
numfmt 5 0
fact = 1
n = 2
e = 2

2
Task/Calkin-Wilf-sequence/00-TASK.txt
View file

@ -26,6 +26,8 @@ The fraction &nbsp; '''9/4''' &nbsp; has odd continued fraction representation &
;Task part 2:
* Find the position of the number &nbsp; <big>'''<sup>83116</sup>'''<big>'''/'''</big>'''<sub>51639</sub>'''</big> &nbsp; in the Calkin-Wilf sequence.
;Related tasks:
:* &nbsp; [[Fusc sequence]].
;See also:
* Wikipedia entry: [[wp:Calkin%E2%80%93Wilf_tree|Calkin-Wilf tree]]

2
Task/Calkin-Wilf-sequence/Maxima/calkin-wilf-sequence.maxima
View file

@ -12,7 +12,7 @@ cf_bin(fracti):=block(
cf_list:cf(fracti),
cf_len:length(cf_list),
if oddp(cf_len) then cf_list:reverse(cf_list) else cf_list:reverse(append(at(cf_list,[cf_list[cf_len]=cf_list[cf_len]-1]),[1])),
makelist(lambda([x],if oddp(x) then makelist(1,j,1,cf_list[x]) else makelist(0,j,1,cf_list[x]))(i),i,1,length(cf_list)),
makelist(lambda([x],if oddp(x) then makelist(1,j,1,cf_list[x]) else makelist(0,j,1,cf_list[x]))(i),i,1,length(cf_list)), /* decoding part begins here */
apply(append,%%),
apply("+",makelist(2^i,i,0,length(%%)-1)*reverse(%%)))$

21
Task/Call-a-function/EasyLang/call-a-function.easy
View file

@ -1,3 +1,18 @@
call somesubr # call a subroutine
call someproc1 # call a procedure with no arguments
call someproc2 arg1 arg2 res # call a procedure with in-arguments and an inout-argument
func sqr n .
return n * n
.
sqr 3
#
proc divmod a b . q r .
q = a div b
r = a mod b
.
divmod 11 3 q r
print q & " " & r
#
subr sqr2
a = a * a
.
a = 5
sqr2
print a

7
Task/Call-an-object-method/Zig/call-an-object-method.zig
View file

@ -1,4 +1,4 @@
const assert = @import("std").debug.assert;
const testing = @import("std").testing;
pub const ID = struct {
name: []const u8,
@ -28,6 +28,7 @@ test "call an object method" {
.age = 20,
};
assert(person1.getAge() == 18);
assert(ID.getAge(person2) == 20);
// test getAge() method call
try testing.expectEqual(@as(u7, 18), person1.getAge());
try testing.expectEqual(@as(u7, 20), ID.getAge(person2));
}

11
Task/Catalan-numbers-Pascals-triangle/EasyLang/catalan-numbers-pascals-triangle.easy Normal file
View file

@ -0,0 +1,11 @@
print 1
for n = 2 to 15
num = 1
den = 1
for k = 2 to n
num *= n + k
den *= k
cat = num / den
.
print cat
.

4
Task/Catalan-numbers-Pascals-triangle/Zig/catalan-numbers-pascals-triangle.zig
View file

@ -1,7 +1,8 @@
const std = @import("std");
const stdout = std.io.getStdOut().outStream();
pub fn main() !void {
const stdout = std.io.getStdOut().writer();
var n: u32 = 1;
while (n <= 15) : (n += 1) {
const row = binomial(n * 2).?;
@ -20,6 +21,7 @@ pub fn binomial(n: u32) ?[]const u64 {
const rmax = 68;
// evaluated and created at compile-time
const pascal = build: {
@setEvalBranchQuota(100_000);
var coefficients: [(rmax * (rmax + 1)) / 2]u64 = undefined;

15
Task/Catalan-numbers/EasyLang/catalan-numbers.easy
View file

@ -1,12 +1,9 @@
proc catalan n . ans .
if n = 0
ans = 1
else
call catalan n - 1 h
ans = 2 * (2 * n - 1) * h div (1 + n)
.
func catalan n .
if n = 0
return 1
.
return 2 * (2 * n - 1) * catalan (n - 1) div (1 + n)
.
for i = 0 to 14
call catalan i h
print h
print catalan i
.

142
Task/Chaocipher/QBasic/chaocipher.basic Normal file
View file

@ -0,0 +1,142 @@
DECLARE FUNCTION AlphaLeft$ (ct$, pt$, CharPos!)
DECLARE FUNCTION AlphaRight$ (ct$, pt$, CharPos!)
DECLARE FUNCTION Decode$ (Text$, ct$, pt$)
DECLARE FUNCTION Encode$ (Text$, ct$, pt$)
CLS
' Deciphering a Chaocipher-encrypted message is identical to the steps used
' for enciphering. The sole difference is that the decipherer locates the
' known ciphertext letter in the left (ct$) alphabet, with the plaintext
' letter being the corresponding letter in the right (pt$) alphabet
'
' Alphabet permuting is identical in enciphering and deciphering
' Start of Main Code
' LEFT (Cipher Text$): HXUCZVAMDSLKPEFJRIGTWOBNYQ
tLeft$ = "HXUCZVAMDSLKPEFJRIGTWOBNYQ"
' RIGHT (Plain Text$): PTLNBQDEOYSFAVZKGJRIHWXUMC
tRight$ = "PTLNBQDEOYSFAVZKGJRIHWXUMC"
' Cipher Message (Used to verify a good encoding)
cText$ = "OAHQHCNYNXTSZJRRHJBYHQKSOUJY"
' Plain Text$ Message
pText$ = "WELLDONEISBETTERTHANWELLSAID"
PRINT " Plain Text$: "; pText$
PRINT
ctLeft$ = tLeft$
ptRight$ = tRight$
' Final Cipher Text$
eText$ = Encode$(pText$, ctLeft$, ptRight$)
PRINT " Cipher Text$: "; eText$
PRINT
IF eText$ = cText$ THEN PRINT "Successful" ELSE PRINT "Failed"
ctLeft$ = tLeft$
ptRight$ = tRight$
dText$ = Decode$(eText$, ctLeft$, ptRight$)
PRINT
PRINT " Plain Text$: "; dText$
PRINT
IF dText$ = pText$ THEN PRINT "Successful" ELSE PRINT "Failed"
END
' Left Alphabet
FUNCTION AlphaLeft$ (ct$, pt$, CharPos)
tStr$ = ct$
' 1. Shift the entire left alphabet cyclically so the ciphertext letter
' just enciphered is positioned at the zenith (i.e., position 1).
tStr$ = RIGHT$(ct$, LEN(ct$) - CharPos + 1) + LEFT$(ct$, CharPos - 1)
' 2. Extract the letter found at position zenith+1 (i.e., the letter to
' the right of the zenith), taking it out of the alphabet, temporarily
' leaving an unfilled "Hole$"
Hole$ = MID$(tStr$, 2, 1)
MID$(tStr$, 2, 1) = " "
' 3. Shift all letters in positions zenith+2 up to, and including, the
' nadir (zenith+13), moving them one position to the left
tStr$ = LEFT$(tStr$, 1) + MID$(tStr$, 3, 12) + " " + RIGHT$(tStr$, 12)
' 4. Insert the just-extracted letter into the nadir position
' (i.e., zenith+13)
MID$(tStr$, 14, 1) = Hole$
AlphaLeft$ = tStr$
END FUNCTION
' Right Alphabet
FUNCTION AlphaRight$ (ct$, pt$, CharPos)
tStr$ = pt$
' 1. Shift the entire right alphabet cyclically so the plaintext letter
' just enciphered is positioned at the zenith.
tStr$ = RIGHT$(tStr$, LEN(tStr$) - CharPos + 1) + LEFT$(tStr$, CharPos - 1)
' 2. Now shift the entire alphabet one more position to the left (i.e.,
' the leftmost letter moves cyclically to the far right), moving a new
' letter into the zenith position.
tStr$ = RIGHT$(tStr$, 25) + LEFT$(tStr$, 1)
' 3. Extract the letter at position zenith+2, taking it out of the
' alphabet, temporarily leaving an unfilled "Hole$".
Hole$ = MID$(tStr$, 3, 1)
MID$(tStr$, 3, 1) = " ":
' 4. Shift all letters beginning with zenith+3 up to, and including, the
' nadir (zenith+13), moving them one position to the left.
tStr$ = LEFT$(tStr$, 2) + MID$(tStr$, 4, 11) + " " + RIGHT$(tStr$, 12)
' 5. Insert the just-extracted letter into the nadir position (zenith+13)
MID$(tStr$, 14, 1) = Hole$
AlphaRight$ = tStr$
END FUNCTION
FUNCTION Decode$ (Text$, ct$, pt$)
tStr$ = ""
FOR t = 1 TO LEN(Text$)
Char$ = MID$(Text$, t, 1)
CharPos = INSTR(ct$, Char$)
ct$ = AlphaLeft$(ct$, pt$, CharPos)
pt$ = AlphaRight$(ct$, pt$, CharPos)
tStr$ = tStr$ + RIGHT$(pt$, 1)
NEXT
Decode$ = tStr$
END FUNCTION
FUNCTION Encode$ (Text$, ct$, pt$)
tStr$ = ""
FOR t = 1 TO LEN(Text$)
Char$ = MID$(Text$, t, 1)
CharPos = INSTR(pt$, Char$)
ct$ = AlphaLeft$(ct$, pt$, CharPos)
pt$ = AlphaRight$(ct$, pt$, CharPos)
tStr$ = tStr$ + LEFT$(ct$, 1)
NEXT
Encode$ = tStr$
END FUNCTION

37
Task/Character-codes/Zig/character-codes.zig
View file

@ -1,31 +1,38 @@
const std = @import("std");
const debug = std.debug;
const unicode = std.unicode;
test "character codes" {
debug.warn("\n", .{});
pub fn main() !void {
const stdout = std.io.getStdOut().writer();
// Zig's string is just an array of bytes (u8).
const message = "ABCabc";
for (message) |val| {
debug.warn(" '{c}' code: {} [hexa: 0x{x}]\n", .{ val, val, val });
}
try characterAsciiCodes(stdout);
try characterUnicodeCodes(stdout);
}
test "character (uni)codes" {
debug.warn("\n", .{});
fn characterAsciiCodes(writer: anytype) !void {
try writer.writeAll("Sample ASCII characters and codes:\n");
const message = "あいうえお";
// Zig's string is just an array of bytes (u8).
const message: []const u8 = "ABCabc";
for (message) |val| {
try writer.print(" '{c}' code: {d} [hexa: 0x{x}]\n", .{ val, val, val });
}
try writer.writeByte('\n');
}
fn characterUnicodeCodes(writer: anytype) !void {
try writer.writeAll("Sample Unicode characters and codes:\n");
const message: []const u8 = "あいうえお";
const utf8_view = unicode.Utf8View.initUnchecked(message);
var iter = utf8_view.iterator();
while (iter.nextCodepoint()) |val| {
var array: [4]u8 = undefined;
var slice = array[0..try unicode.utf8Encode(val, &array)];
const slice = array[0..try unicode.utf8Encode(val, &array)];
debug.warn(" '{}' code: {} [hexa: U+{x}]\n", .{ slice, val, val });
try writer.print(" '{s}' code: {d} [hexa: U+{x}]\n", .{ slice, val, val });
}
try writer.writeByte('\n');
}

58
Task/Chinese-remainder-theorem/EasyLang/chinese-remainder-theorem.easy
View file

@ -1,35 +1,35 @@
proc mul_inv a b . x1 .
b0 = b
x1 = 1
if b <> 1
while a > 1
q = a div b
t = b
b = a mod b
a = t
t = x0
x0 = x1 - q * x0
x1 = t
.
if x1 < 0
x1 += b0
.
.
func mul_inv a b .
b0 = b
x1 = 1
if b <> 1
while a > 1
q = a div b
t = b
b = a mod b
a = t
t = x0
x0 = x1 - q * x0
x1 = t
.
if x1 < 0
x1 += b0
.
.
return x1
.
proc remainder . n[] a[] r .
prod = 1
sum = 0
for i = 1 to len n[]
prod *= n[i]
.
for i = 1 to len n[]
p = prod / n[i]
call mul_inv p n[i] h
sum += a[i] * h * p
r = sum mod prod
.
prod = 1
sum = 0
for i = 1 to len n[]
prod *= n[i]
.
for i = 1 to len n[]
p = prod / n[i]
sum += a[i] * (mul_inv p n[i]) * p
r = sum mod prod
.
.
n[] = [ 3 5 7 ]
a[] = [ 2 3 2 ]
call remainder n[] a[] h
remainder n[] a[] h
print h

21
Task/Chinese-zodiac/Quackery/chinese-zodiac.quackery Normal file
View file

@ -0,0 +1,21 @@
[ dup echo
say " is the year of the "
4 - dup 10 mod 2 /
[ table $ "Wood" $ "Fire" $ "Earth"
$ "Metal" $ "Water" ]
do echo$
sp
dup 12 mod
[ table
$ "Rat" $ "Ox" $ "Tiger" $ "Rabbit"
$ "Dragon" $ "Snake" $ "Horse" $ "Goat"
$ "Monkey" $ "Rooster" $ "Dog" $ "Pig" ]
do echo$
say " ("
2 mod
[ table $ "yang" $ "yin" ]
do echo$
say ")." cr ] is zodiac ( $ --> )
' [ 1935 1938 1968 1972 1976 1984 1985 2017 ]
witheach zodiac

154
Task/Chowla-numbers/EasyLang/chowla-numbers.easy
View file

@ -1,90 +1,88 @@
proc chowla n . sum .
sum = 0
i = 2
while i * i <= n
if n mod i = 0
j = n div i
if i = j
sum += i
else
sum += i + j
fastfunc chowla n .
sum = 0
i = 2
while i * i <= n
if n mod i = 0
j = n div i
if i = j
sum += i
else
sum += i + j
.
.
.
i += 1
.
i += 1
.
return sum
.
proc sieve . c[] .
i = 3
while i * 3 <= len c[]
if c[i] = 0
call chowla i h
if h = 0
j = 3 * i
while j <= len c[]
c[j] = 1
j += 2 * i
.
i = 3
while i * 3 <= len c[]
if c[i] = 0
if chowla i = 0
j = 3 * i
while j <= len c[]
c[j] = 1
j += 2 * i
.
.
.
.
i += 2
.
i += 2
.
.
proc commatize n . s$ .
s$[] = strchars n
s$ = ""
l = len s$[]
for i = 1 to len s$[]
if i > 1 and l mod 3 = 0
s$ &= ","
.
l -= 1
s$ &= s$[i]
.
s$[] = strchars n
s$ = ""
l = len s$[]
for i = 1 to len s$[]
if i > 1 and l mod 3 = 0
s$ &= ","
.
l -= 1
s$ &= s$[i]
.
.
print "chowla number from 1 to 37"
for i = 1 to 37
call chowla i h
print " " & i & ": " & h
print " " & i & ": " & chowla i
.
proc main . .
print ""
len c[] 10000000
count = 1
call sieve c[]
power = 100
i = 3
while i <= len c[]
if c[i] = 0
count += 1
.
if i = power - 1
call commatize power p$
call commatize count c$
print "There are " & c$ & " primes up to " & p$
power *= 10
.
i += 2
.
print ""
limit = 35000000
count = 0
i = 2
k = 2
kk = 3
repeat
p = k * kk
until p > limit
call chowla p h
if h = p - 1
call commatize p s$
print s$ & " is a perfect number"
count += 1
.
k = kk + 1
kk += k
i += 1
.
call commatize limit s$
print "There are " & count & " perfect mumbers up to " & s$
print ""
len c[] 10000000
count = 1
sieve c[]
power = 100
i = 3
while i <= len c[]
if c[i] = 0
count += 1
.
if i = power - 1
commatize power p$
commatize count c$
print "There are " & c$ & " primes up to " & p$
power *= 10
.
i += 2
.
print ""
limit = 35000000
count = 0
i = 2
k = 2
kk = 3
repeat
p = k * kk
until p > limit
if chowla p = p - 1
commatize p s$
print s$ & " is a perfect number"
count += 1
.
k = kk + 1
kk += k
i += 1
.
commatize limit s$
print "There are " & count & " perfect mumbers up to " & s$
.
call main
main

38
Task/Church-numerals/Acornsoft-Lisp/church-numerals.lisp Normal file
View file

@ -0,0 +1,38 @@
(setq zero '(lambda (f x) x))
(defun succ (n)
(freeze '(n) '(lambda (f x) (f (n f x)))))
(defun add (m n)
(freeze '(m n) '(lambda (f x) (m f (n f x)))))
(defun mul (m n)
(n (freeze '(m) '(lambda (sum) (add m sum))) zero))
(defun pow (m n)
(n (freeze '(m) '(lambda (product) (mul m product))) one))
(defun church (i)
(cond ((zerop i) zero)
(t (succ (church (sub1 i))))))
(defun unchurch (n)
(n add1 0))
(setq one (succ zero))
(setq two (succ one))
(setq three (succ two))
(setq four (succ three))
(defun show (example)
(prin example)
(princ '! =>! )
(print (unchurch (eval example))))
(defun examples ()
(show '(church 3))
(show '(add three four))
(show '(mul three four))
(show '(pow three four))
(show '(pow four three))
(show '(pow (pow two two) (add two one))))

34
Task/Church-numerals/Common-Lisp/church-numerals-1.lisp Normal file
View file

@ -0,0 +1,34 @@
(defvar zero (lambda (f x) x))
(defun succ (n) (lambda (f x) (funcall f (funcall n f x))))
(defun plus (m n)
(lambda (f x) (funcall m f (funcall n f x))))
(defun times (m n)
(funcall n (lambda (sum) (plus m sum)) zero))
(defun power (m n)
(funcall n (lambda (product) (times m product)) one))
(defun church (i) ; int -> Church
(if (zerop i) zero (succ (church (1- i)))))
(defun unchurch (n) ; Church -> int
(funcall n #'1+ 0))
(defun show (example)
(format t "~(~S => ~S~)~%"
example (unchurch (eval example))))
(defvar one (succ zero))
(defvar two (succ one))
(defvar three (succ two))
(defvar four (succ three))
(show '(church 3))
(show '(plus three four))
(show '(times three four))
(show '(power three four))
(show '(power four three))
(show '(power (power two two) (plus two one)))

21
Task/Church-numerals/Common-Lisp/church-numerals-2.lisp Normal file
View file

@ -0,0 +1,21 @@
(defvar zero (lambda (f) (lambda (x) x)))
(defun succ (n) (lambda (f) (compose f (funcall n f))))
(defun plus (m n)
(lambda (f) (compose (funcall m f) (funcall n f))))
(defun times (m n)
(compose m n))
(defun power (m n)
(funcall n m))
(defun compose (f g)
(lambda (x) (funcall f (funcall g x))))
(defun church (i) ; int -> Church
(if (zerop i) zero (succ (church (1- i)))))
(defun unchurch (n) ; Church -> int
(funcall (funcall n #'1+) 0))

10
Task/Church-numerals/Common-Lisp/church-numerals-3.lisp Normal file
View file

@ -0,0 +1,10 @@
(defun pred (n)
(flet ((value (v) (lambda (h) (funcall h v)))
(extract (k) (funcall k (lambda (u) u))))
(lambda (f x)
(let ((inc (lambda (g) (value (funcall g f))))
(const (lambda (u) x)))
(extract (funcall n inc const))))))
(defun minus (m n)
(funcall n #'pred m))

5
Task/Church-numerals/Common-Lisp/church-numerals-4.lisp Normal file
View file

@ -0,0 +1,5 @@
(defmacro church-if (test then else)
`(funcall ,test (lambda () ,then) (lambda () ,else)))
(defvar true (lambda (f g) (funcall f)))
(defvar false (lambda (f g) (funcall g)))

11
Task/Church-numerals/Common-Lisp/church-numerals-5.lisp Normal file
View file

@ -0,0 +1,11 @@
(defun is-zero (n)
(funcall n (lambda (x) false) true))
(defun divide (m n)
(divide1 (succ m) n))
(defun divide1 (m n)
(let ((d (minus m n)))
(church-if (is-zero d)
zero
(succ (divide1 d n)))))

4
Task/Church-numerals/Common-Lisp/church-numerals-6.lisp Normal file
View file

@ -0,0 +1,4 @@
(show '(pred four))
(show '(minus (church 11) three))
(show '(divide (church 11) three))
(show '(divide (church 12) three))

18
Task/Church-numerals/Common-Lisp/church-numerals-7.lisp Normal file
View file

@ -0,0 +1,18 @@
(defun pred (n)
(flet ((value (v) (lambda (h) (funcall h v)))
(extract (k) (funcall k (lambda (u) u))))
(lambda (f)
(lambda (x)
(let ((inc (lambda (g) (value (funcall g f))))
(const (lambda (u) x)))
(extract (funcall (funcall n inc) const)))))))
(defun minus (m n)
(funcall (funcall n #'pred) m))
...
(defun is-zero (n)
(funcall (funcall n (lambda (x) false)) true))
...

44
Task/Circular-primes/EasyLang/circular-primes.easy Normal file
View file

@ -0,0 +1,44 @@
fastfunc prime n .
if n mod 2 = 0 and n > 2
return 0
.
i = 3
sq = sqrt n
while i <= sq
if n mod i = 0
return 0
.
i += 2
.
return 1
.
func cycle n .
m = n
p = 1
while m >= 10
p *= 10
m = m div 10
.
return m + n mod p * 10
.
func circprime p .
if prime p = 0
return 0
.
p2 = cycle p
while p2 <> p
if p2 < p or prime p2 = 0
return 0
.
p2 = cycle p2
.
return 1
.
p = 2
while count < 19
if circprime p = 1
print p
count += 1
.
p += 1
.

19
Task/Circular-primes/Zig/circular-primes.zig
View file

@ -1,15 +1,18 @@
const std = @import("std");
const math = std.math;
const heap = std.heap;
const stdout = std.io.getStdOut().writer();
pub fn main() !void {
var arena = heap.ArenaAllocator.init(heap.page_allocator);
defer arena.deinit();
var candidates = std.PriorityQueue(u32).init(&arena.allocator, u32cmp);
const allocator = arena.allocator();
var candidates = std.PriorityQueue(u32, void, u32cmp).init(allocator, {});
defer candidates.deinit();
const stdout = std.io.getStdOut().writer();
try stdout.print("The circular primes are:\n", .{});
try stdout.print("{:10}" ** 4, .{ 2, 3, 5, 7 });
@ -33,19 +36,19 @@ pub fn main() !void {
try stdout.print("\n", .{});
}
fn u32cmp(a: u32, b: u32) math.Order {
fn u32cmp(_: void, a: u32, b: u32) math.Order {
return math.order(a, b);
}
fn circular(n0: u32) bool {
if (!isprime(n0))
if (!isPrime(n0))
return false
else {
var n = n0;
var d = @floatToInt(u32, @log10(@intToFloat(f32, n)));
var d: u32 = @intFromFloat(@log10(@as(f32, @floatFromInt(n))));
return while (d > 0) : (d -= 1) {
n = rotate(n);
if (n < n0 or !isprime(n))
if (n < n0 or !isPrime(n))
break false;
} else true;
}
@ -55,13 +58,13 @@ fn rotate(n: u32) u32 {
if (n == 0)
return 0
else {
const d = @floatToInt(u32, @log10(@intToFloat(f32, n))); // digit count - 1
const d: u32 = @intFromFloat(@log10(@as(f32, @floatFromInt(n)))); // digit count - 1
const m = math.pow(u32, 10, d);
return (n % m) * 10 + n / m;
}
}
fn isprime(n: u32) bool {
fn isPrime(n: u32) bool {
if (n < 2)
return false;

1
Task/Closures-Value-capture/Acornsoft-Lisp/closures-value-capture-1.lisp Normal file
View file

@ -0,0 +1 @@
(freeze '(a b) '(lambda (c) (list a b c)))

3
Task/Closures-Value-capture/Acornsoft-Lisp/closures-value-capture-2.lisp Normal file
View file

@ -0,0 +1,3 @@
(lambda (c)
((lambda ((a . 1) (b . 2))
(list a b c))))

2
Task/Closures-Value-capture/Acornsoft-Lisp/closures-value-capture-3.lisp Normal file
View file

@ -0,0 +1,2 @@
( (lambda ((a . 1) (b . 2))
(list a b c)) )

9
Task/Closures-Value-capture/Acornsoft-Lisp/closures-value-capture-4.lisp Normal file
View file

@ -0,0 +1,9 @@
(defun freeze (_fvars_ _lambda-expr_)
(freeze-vars
(mapc cons _fvars_ (mapc eval _fvars_))
(cadr _lambda-expr_)
(cddr _lambda-expr_)))
(defun freeze-vars (bindings lvars lbody)
(list 'lambda lvars
(list (cons 'lambda (cons bindings lbody)))))

9
Task/Closures-Value-capture/Acornsoft-Lisp/closures-value-capture-5.lisp Normal file
View file

@ -0,0 +1,9 @@
(defun range (from to)
(cond ((greaterp from to) '())
(t (cons from (range (add1 from) to)))))
(defun example ()
(mapc '(lambda (f) (f))
(mapc '(lambda (i)
(freeze '(i) '(lambda () (times i i))))
(range 1 10))))

38
Task/Combinations-with-repetitions/EasyLang/combinations-with-repetitions.easy
View file

@ -1,20 +1,36 @@
proc combine pos val . .
if pos > k
call output
else
for i = val to n
result[pos] = i
call combine pos + 1 i
.
.
items$[] = [ "iced" "jam" "plain" ]
n = len items$[]
k = 2
len result[] k
n_results = 0
#
proc output . .
n_results += 1
if len items$[] > 0
s$ = ""
for i = 1 to k
s$ &= items$[result[i]] & " "
.
print s$
.
.
call combine 1 1
proc combine pos val . .
if pos > k
output
else
for i = val to n
result[pos] = i
combine pos + 1 i
.
.
.
combine 1 1
#
n = 10
k = 3
len result[] k
items$[] = [ ]
n_results = 0
call combine 1 1
combine 1 1
print ""
print n_results & " results with 10 donuts"

4
Task/Combinations-with-repetitions/Phix/combinations-with-repetitions-3.phix Normal file
View file

@ -0,0 +1,4 @@
(phixonline)-->
<span style="color: #0000FF;">?</span><span style="color: #7060A8;">join</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">combinations_with_repetitions</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"ijp"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">),</span><span style="color: #008000;">','</span><span style="color: #0000FF;">)</span>
<span style="color: #0000FF;">?</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">combinations_with_repetitions</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">10</span><span style="color: #0000FF;">),</span><span style="color: #000000;">3</span><span style="color: #0000FF;">))</span>
<!--

13
Task/Combinations/Acornsoft-Lisp/combinations.lisp Normal file
View file

@ -0,0 +1,13 @@
(defun comb (m n (i . 0))
(cond ((zerop m) '(()))
((eq i n) '())
(t (append
(mapc '(lambda (rest) (cons i rest))
(comb (sub1 m) n (add1 i)))
(comb m n (add1 i))))))
(defun append (a b)
(cond ((null a) b)
(t (cons (car a) (append (cdr a) b)))))
(map print (comb 3 5))

18
Task/Combinations/EasyLang/combinations.easy
View file

@ -3,13 +3,13 @@ m = 3
len result[] m
#
proc combinations pos val . .
if pos <= m
for i = val to n - m
result[pos] = pos + i
call combinations pos + 1 i
.
else
print result[]
.
if pos <= m
for i = val to n - m
result[pos] = pos + i
combinations pos + 1 i
.
else
print result[]
.
.
call combinations 1 0
combinations 1 0

0
Task/Combinations/Phix/combinations.phix → Task/Combinations/Phix/combinations-1.phix
View file

3
Task/Combinations/Phix/combinations-2.phix Normal file
View file

@ -0,0 +1,3 @@
(phixonline)-->
<span style="color: #0000FF;">?</span><span style="color: #7060A8;">join</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">combinations</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"12345"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">),</span><span style="color: #008000;">','</span><span style="color: #0000FF;">)</span>
<!--

20
Task/Comma-quibbling/Acornsoft-Lisp/comma-quibbling.lisp Normal file
View file

@ -0,0 +1,20 @@
(defun examples ()
(map '(lambda (words) (printc (quibble words)))
'(() (ABC) (ABC DEF) (ABC DEF G H))))
(defun quibble (words)
(implode (list '{ (quibbles words) '})))
(defun quibbles (words)
(implode (conjunction words)))
(defun conjunction (words)
(cond ((null words)
'())
((null (cdr words))
words)
((null (cddr words))
(list (car words) '! and! (cadr words)))
(t
(cons (car words)
(cons ',! (conjunction (cdr words)))))))

30
Task/Compiler-AST-interpreter/Zig/compiler-ast-interpreter.zig
View file

@ -63,7 +63,7 @@ pub const ASTInterpreter = struct {
},
.prts => _ = try self.out("{s}", .{(try self.interp(t.left)).?.string}),
.prti => _ = try self.out("{d}", .{(try self.interp(t.left)).?.integer}),
.prtc => _ = try self.out("{c}", .{@intCast(u8, (try self.interp(t.left)).?.integer)}),
.prtc => _ = try self.out("{c}", .{@as(u8, @intCast((try self.interp(t.left)).?.integer))}),
.string => return t.value,
.integer => return t.value,
.unknown => {
@ -82,7 +82,7 @@ pub const ASTInterpreter = struct {
fn binOp(
self: *Self,
func: fn (a: i32, b: i32) i32,
comptime func: fn (a: i32, b: i32) i32,
a: ?*Tree,
b: ?*Tree,
) ASTInterpreterError!i32 {
@ -93,22 +93,22 @@ pub const ASTInterpreter = struct {
}
fn less(a: i32, b: i32) i32 {
return @boolToInt(a < b);
return @intFromBool(a < b);
}
fn less_equal(a: i32, b: i32) i32 {
return @boolToInt(a <= b);
return @intFromBool(a <= b);
}
fn greater(a: i32, b: i32) i32 {
return @boolToInt(a > b);
return @intFromBool(a > b);
}
fn greater_equal(a: i32, b: i32) i32 {
return @boolToInt(a >= b);
return @intFromBool(a >= b);
}
fn equal(a: i32, b: i32) i32 {
return @boolToInt(a == b);
return @intFromBool(a == b);
}
fn not_equal(a: i32, b: i32) i32 {
return @boolToInt(a != b);
return @intFromBool(a != b);
}
fn add(a: i32, b: i32) i32 {
return a + b;
@ -126,10 +126,10 @@ pub const ASTInterpreter = struct {
return @mod(a, b);
}
fn @"or"(a: i32, b: i32) i32 {
return @boolToInt((a != 0) or (b != 0));
return @intFromBool((a != 0) or (b != 0));
}
fn @"and"(a: i32, b: i32) i32 {
return @boolToInt((a != 0) and (b != 0));
return @intFromBool((a != 0) and (b != 0));
}
};
@ -138,13 +138,13 @@ pub fn main() !void {
defer arena.deinit();
const allocator = arena.allocator();
var arg_it = std.process.args();
_ = try arg_it.next(allocator) orelse unreachable; // program name
const file_name = arg_it.next(allocator);
var arg_it = try std.process.argsWithAllocator(allocator);
_ = arg_it.next() orelse unreachable; // program name
const file_name = arg_it.next();
// We accept both files and standard input.
var file_handle = blk: {
if (file_name) |file_name_delimited| {
const fname: []const u8 = try file_name_delimited;
const fname: []const u8 = file_name_delimited;
break :blk try std.fs.cwd().openFile(fname, .{});
} else {
break :blk std.io.getStdIn();
@ -260,7 +260,7 @@ fn loadAST(
fn loadASTHelper(
allocator: std.mem.Allocator,
line_it: *std.mem.SplitIterator(u8),
line_it: *std.mem.SplitIterator(u8, std.mem.DelimiterType.sequence),
string_pool: *std.ArrayList([]const u8),
) LoadASTError!?*Tree {
if (line_it.next()) |line| {

50
Task/Continued-fraction/EasyLang/continued-fraction.easy Normal file
View file

@ -0,0 +1,50 @@
numfmt 8 0
func calc_sqrt .
n = 100
sum = n
while n >= 1
a = 1
if n > 1
a = 2
.
b = 1
sum = a + b / sum
n -= 1
.
return sum
.
func calc_e .
n = 100
sum = n
while n >= 1
a = 2
if n > 1
a = n - 1
.
b = 1
if n > 1
b = n - 1
.
sum = a + b / sum
n -= 1
.
return sum
.
func calc_pi .
n = 100
sum = n
while n >= 1
a = 3
if n > 1
a = 6
.
b = 2 * n - 1
b *= b
sum = a + b / sum
n -= 1
.
return sum
.
print calc_sqrt
print calc_e
print calc_pi

43
Task/Convert-seconds-to-compound-duration/EasyLang/convert-seconds-to-compound-duration.easy
View file

@ -1,25 +1,22 @@
proc split sec . s$ .
divs[] = [ 60 60 24 7 ]
n$[] = [ "sec" "min" "hr" "d" "wk" ]
len r[] 5
for i = 1 to 4
r[i] = sec mod divs[i]
sec = sec div divs[i]
.
r[5] = sec
s$ = ""
for i = 5 downto 1
if r[i] <> 0
if s$ <> ""
s$ &= ", "
func$ split sec .
divs[] = [ 60 60 24 7 ]
n$[] = [ "sec" "min" "hr" "d" "wk" ]
len r[] 5
for i = 1 to 4
r[i] = sec mod divs[i]
sec = sec div divs[i]
.
r[5] = sec
for i = 5 downto 1
if r[i] <> 0
if s$ <> ""
s$ &= ", "
.
s$ &= r[i] & " " & n$[i]
.
s$ &= r[i] & " " & n$[i]
.
.
.
return s$
.
call split 7259 s$
print s$
call split 86400 s$
print s$
call split 6000000 s$
print s$
print split 7259
print split 86400
print split 6000000

4
Task/Conways-Game-of-Life/COBOL/conways-game-of-life.cobol
View file

@ -1,5 +1,6 @@
identification division.
program-id. game-of-life-program.
data division.
working-storage section.
01 grid.
@ -18,6 +19,7 @@ working-storage section.
05 neighbour-cell pic 9.
05 check-row pic s9.
05 check-cell pic s9.
procedure division.
control-paragraph.
perform blinker-paragraph varying current-cell from 2 by 1
@ -67,3 +69,5 @@ check-cell-paragraph.
if cell(neighbour-row,neighbour-cell) is equal to '#',
and check-cell is not equal to zero or check-row is not equal to zero,
then add 1 to living-neighbours.
end program game-of-life-program.

97
Task/Conways-Game-of-Life/EasyLang/conways-game-of-life.easy
View file

@ -1,63 +1,64 @@
# Game of life
#
n = 70
n += 1
time = 0.1
#
nx = n + 1
subr init
for r = 1 to n - 1
for c = 1 to n - 1
i = r * n + c + 1
if randomf < 0.3
f[i] = 1
for r = 1 to n
for c = 1 to n
i = r * nx + c
if randomf < 0.3
f[i] = 1
.
.
.
.
.
.
f = 100 / (n - 1)
f = 100 / n
subr show
clear
for r = 1 to n - 1
for c = 1 to n - 1
if f[r * n + c + 1] = 1
move (c - 1) * f (r - 1) * f
rect f * 0.9 f * 0.9
clear
for r = 1 to n
for c = 1 to n
if f[r * nx + c] = 1
move c * f - f r * f - f
rect f * 0.9 f * 0.9
.
.
.
.
.
.
subr update
swap f[] p[]
for r = 1 to n - 1
sm = 0
i = r * n + 1
sr = p[i - n + 1] + p[i + 1] + p[i + n + 1]
for c = 1 to n - 1
i += 1
sl = sm
sm = sr
sr = p[i - n + 1] + p[i + 1] + p[i + n + 1]
s = sl + sm + sr
if s = 3 or s = 4 and p[i] = 1
f[i] = 1
else
f[i] = 0
swap f[] p[]
for r = 1 to n
sm = 0
i = r * nx + 1
sr = p[i - nx] + p[i] + p[i + nx]
for c = 1 to n
sl = sm
sm = sr
in = i + 1
sr = p[in - nx] + p[in] + p[in + nx]
s = sl + sm + sr
if s = 3 or s = 4 and p[i] = 1
f[i] = 1
else
f[i] = 0
.
i = in
.
.
.
.
.
on timer
call update
call show
timer 0.2
update
show
timer time
.
on mouse_down
c = mouse_x div f
r = mouse_y div f
i = r * n + c + n + 2
f[i] = 1 - f[i]
call show
timer 3
c = mouse_x div f + 1
r = mouse_y div f + 1
i = r * nx + c
f[i] = 1 - f[i]
show
timer 3
.
len f[] n * n + n + 1
len p[] n * n + n + 1
call init
len f[] nx * nx + nx
len p[] nx * nx + nx
init
timer 0

128
Task/Conways-Game-of-Life/Elena/conways-game-of-life.elena
View file

@ -1,5 +1,6 @@
import extensions;
import system'threading;
import system'text;
import cellular;
const int maxX = 48;
@ -9,93 +10,86 @@ const int DELAY = 50;
sealed class Model
{
Space theSpace;
RuleSet theRuleSet;
bool started;
Space _space;
RuleSet _ruleSet;
bool _started;
event Func<Space, object> OnUpdate;
Func<Space, object> OnUpdate : event;
constructor newRandomset(RuleSet transformSet)
{
theSpace := new IntMatrixSpace.allocate(maxY, maxX, randomSet);
constructor newRandomset(RuleSet transformSet)
{
_space := IntMatrixSpace.allocate(maxY, maxX, randomSet);
theRuleSet := transformSet;
_ruleSet := transformSet;
started := false
}
_started := false
}
constructor newLoaded(RuleSet initSet, RuleSet transformSet)
{
theSpace := IntMatrixSpace.allocate(maxY, maxX, initSet);
private onUpdate()
{
OnUpdate.?(_space)
}
theRuleSet := transformSet;
run()
{
if (_started)
{
_space.update(_ruleSet)
}
else
{
_started := true
};
started := false
}
private onUpdate()
{
OnUpdate.?(theSpace)
}
run()
{
if (started)
{
theSpace.update(theRuleSet)
}
else
{
started := true
};
self.onUpdate()
}
self.onUpdate()
}
}
singleton gameOfLifeRuleSet : RuleSet
{
proceed(Space s, int x, int y, ref int retVal)
{
int cell := s.at(x, y);
int number := s.LiveCell(x, y, 1); // NOTE : number of living cells around the self includes the cell itself
int proceed(Space s, int x, int y)
{
int cell := s.at(x, y);
int number := s.LiveCell(x, y, 1); // NOTE : number of living cells around the self includes the cell itself
if (cell == 0 && number == 3)
{
retVal := 1
}
else if (cell == 1 && (number == 4 || number == 3))
{
retVal := 1
}
else
{
retVal := 0
}
}
if (cell == 0 && number == 3)
{
^ 1
}
else if (cell == 1 && (number == 4 || number == 3))
{
^ 1
}
else
{
^ 0
}
}
}
public extension presenterOp : Space
{
print()
{
console.setCursorPosition(0, 0);
print()
{
console.setCursorPosition(0, 0);
int columns := self.Columns;
int rows := self.Rows;
int columns := self.Columns;
int rows := self.Rows;
for(int i := 0, i < rows, i += 1)
{
for(int j := 0, j < columns, j += 1)
{
int cell := self.at(i, j);
auto line := new TextBuilder();
for(int i := 0, i < rows, i += 1)
{
line.clear();
for(int j := 0, j < columns, j += 1)
{
int cell := self.at(i, j);
console.write((cell == 0).iif(" ","o"));
};
line.write((cell == 0).iif(" ","o"));
};
console.writeLine()
}
}
console.writeLine(line.Value)
}
}
}
public program()

0
Task/Conways-Game-of-Life/Maxima/conways-game-of-life.maxima → Task/Conways-Game-of-Life/Maxima/conways-game-of-life-1.maxima
View file

2
Task/Conways-Game-of-Life/Maxima/conways-game-of-life-2.maxima Normal file
View file

@ -0,0 +1,2 @@
three_all_alive: matrix([0,1,0],[0,1,0],[0,1,0])$
with_slider_draw(n,makelist(j,j,0,2),image(gen(three_all_alive,n),0,0,30,30));

1
Task/Copy-a-string/EasyLang/copy-a-string.easy
View file

@ -1,2 +1,3 @@
a$ = "hello"
b$ = a$
print b$

2
Task/Count-in-factors/EasyLang/count-in-factors.easy
View file

@ -13,7 +13,7 @@ proc decompose num . primes[] .
.
for i = 1 to 30
write i & ": "
call decompose i primes[]
decompose i primes[]
for j = 1 to len primes[]
if j > 1
write " x "

10
Task/Count-in-octal/EasyLang/count-in-octal.easy
View file

@ -1,5 +1,4 @@
proc oct v . r$ .
r$ = ""
func$ oct v .
while v > 0
r$ = v mod 8 & r$
v = v div 8
@ -7,18 +6,17 @@ proc oct v . r$ .
if r$ = ""
r$ = 0
.
return r$
.
for i = 0 to 10
call oct i o$
print o$
print oct i
.
print "."
print "."
max = pow 2 53
i = max - 10
repeat
call oct i o$
print o$
print oct i
until i = max
i += 1
.

25
Task/Count-the-coins/EasyLang/count-the-coins.easy
View file

@ -1,29 +1,24 @@
len cache[] 100000 * 7 + 6
val[] = [ 1 5 10 25 50 100 ]
proc count sum kind . r .
func count sum kind .
if sum = 0
r = 1
break 1
return 1
.
if sum < 0 or kind = 0
r = 0
break 1
return 0
.
chind = sum * 7 + kind
if cache[chind] > 0
r = cache[chind]
break 1
return cache[chind]
.
call count sum - val[kind] kind r2
call count sum kind - 1 r1
r2 = count (sum - val[kind]) kind
r1 = count sum (kind - 1)
r = r1 + r2
cache[chind] = r
return r
.
call count 100 4 r
print r
call count 10000 6 r
print r
call count 100000 6 r
print count 100 4
print count 10000 6
print count 100000 6
# this is not exact, since numbers
# are doubles and r > 2^53
print r

12
Task/Create-a-file-on-magnetic-tape/COBOL/create-a-file-on-magnetic-tape.cobol
View file

@ -6,17 +6,21 @@ ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT TAPE-FILE
ASSIGN "./TAPE.FILE"
ORGANIZATION IS LINE SEQUENTIAL.
ASSIGN TO "./TAPE.FILE"
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD TAPE-FILE.
01 TAPE-FILE-RECORD PIC X(51).
FD TAPE-FILE.
01 TAPE-FILE-RECORD PICTURE IS X(51).
PROCEDURE DIVISION.
OPEN OUTPUT SHARING WITH ALL OTHER TAPE-FILE
WRITE TAPE-FILE-RECORD
FROM "COBOL treats tape files and text files identically."
END-WRITE
CLOSE TAPE-FILE
STOP RUN.
END PROGRAM MAKE-TAPE-FILE.

8
Task/Cullen-and-Woodall-numbers/EasyLang/cullen-and-woodall-numbers.easy Normal file
View file

@ -0,0 +1,8 @@
for n = 1 to 20
write n * pow 2 n + 1 & " "
.
print ""
for n = 1 to 20
write n * pow 2 n - 1 & " "
.
print ""

7
Task/Cullen-and-Woodall-numbers/Maxima/cullen-and-woodall-numbers.maxima Normal file
View file

@ -0,0 +1,7 @@
/* Functions */
cullen(n):=(n*2^n)+1$
woodall(n):=(n*2^n)-1$
/* Test cases */
makelist(cullen(i),i,20);
makelist(woodall(i),i,20);

Some files were not shown because too many files have changed in this diff Show more