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

June 2018 Update

Browse source
This commit is contained in:
Ingy döt Net 2018-06-22 20:57:24 +00:00
parent ba8067c3b7
commit 22f33d4004
5278 changed files with 84726 additions and 14379 deletions
Download patch file Download diff file Expand all files Collapse all files

9
Task/100-doors/Astro/100-doors.astro
View file

@ -1,4 +1,5 @@
var doors = falses 100
for a in [:101]:
for b in [a:a:101]: doors[b] = !doors[b]
print "Door $a is $('open.' if doors[a] else 'closed.')"
var doors = falses(100)
for a in 1..100: for b in a..a..100:
doors[b] = not doors[b]
for a in 1..100:
print "Door $a is $((doors[a]) ? 'open.': 'closed.')"

33
Task/100-doors/BASIC/100-doors-1.basic
View file

@ -1,22 +1,11 @@
REM "100 Doors" program for QB64 BASIC (http://www.qb64.net/), a QuickBASIC-like compiler.
REM Author: G. A. Tippery
REM Date: 12-Feb-2014
REM
REM Unoptimized (naive) version, per specifications at http://rosettacode.org/wiki/100_doors
DEFINT A-Z
CONST N = 100
DIM door(N)
FOR stride = 1 TO N
FOR index = stride TO N STEP stride
LET door(index) = NOT (door(index))
NEXT index
NEXT stride
PRINT "Open doors:"
FOR index = 1 TO N
IF door(index) THEN PRINT index
NEXT index
END
100 :
110 REM 100 DOORS PROBLEM
120 :
130 DIM D(100)
140 FOR P = 1 TO 100
150 FOR T = P TO 100 STEP P
160 D(T) = NOT D(T): NEXT T
170 NEXT P
180 FOR I = 1 TO 100
190 IF D(I) THEN PRINT I;" ";
200 NEXT I

50
Task/100-doors/BASIC/100-doors-2.basic
View file

@ -1,16 +1,34 @@
DIM doors(0 TO 99)
FOR pass = 0 TO 99
FOR door = pass TO 99 STEP pass + 1
PRINT doors(door)
PRINT NOT doors(door)
doors(door) = NOT doors(door)
NEXT door
NEXT pass
FOR i = 0 TO 99
PRINT "Door #"; i + 1; " is ";
IF NOT doors(i) THEN
PRINT "closed"
ELSE
PRINT "open"
END IF
NEXT i
# 100 doors problem
dim d(100)
# simple solution
print "simple solution"
gosub initialize
for t = 1 to 100
for j = t to 100 step t
d[j-1] = not d[j-1]
next j
next t
gosub showopen
# more optimized solution
print "more optimized solution"
gosub initialize
for t = 1 to 10
d[t^2-1] = true
next t
gosub showopen
end
initialize:
for t = 1 to d[?]
d[t-1] = false # closed
next t
return
showopen:
for t = 1 to d[?]
print d[t-1]+ " ";
if t%10 = 0 then print
next t
return

21
Task/100-doors/BASIC/100-doors-3.basic
View file

@ -1,12 +1,9 @@
DIM doors(0 TO 99)
FOR door = 0 TO 99
IF INT(SQR(door)) = SQR(door) THEN doors(door) = -1
NEXT door
FOR i = 0 TO 99
PRINT "Door #"; i + 1; " is ";
IF NOT doors(i) THEN
PRINT "closed"
ELSE
PRINT "open"
END IF
NEXT i
10 DIM D(100)
20 FOR I=1 TO 100
30 FOR J=I TO 100 STEP I
40 D(J) = NOT D(J)
50 NEXT J
60 NEXT I
70 FOR I=1 TO 100
80 IF D(I) THEN PRINT I,
90 NEXT I

32
Task/100-doors/BASIC/100-doors-4.basic
View file

@ -1,10 +1,22 @@
'lrcvs 04.11.12
cls
x = 1 : y = 3 : z = 0
print x + " Open"
do
z = x + y
print z + " Open"
x = z : y = y + 2
until z >= 100
end
REM "100 Doors" program for QB64 BASIC (http://www.qb64.net/), a QuickBASIC-like compiler.
REM Author: G. A. Tippery
REM Date: 12-Feb-2014
REM
REM Unoptimized (naive) version, per specifications at http://rosettacode.org/wiki/100_doors
DEFINT A-Z
CONST N = 100
DIM door(N)
FOR stride = 1 TO N
FOR index = stride TO N STEP stride
LET door(index) = NOT (door(index))
NEXT index
NEXT stride
PRINT "Open doors:"
FOR index = 1 TO N
IF door(index) THEN PRINT index
NEXT index
END

25
Task/100-doors/BASIC/100-doors-5.basic
View file

@ -1,9 +1,16 @@
10 DIM D(100)
20 FOR I=1 TO 100
30 FOR J=I TO 100 STEP I
40 LET D(J)=NOT D(J)
50 NEXT J
60 NEXT I
70 FOR I=1 TO 100
80 IF D(I) THEN PRINT I,
90 NEXT I
DIM doors(0 TO 99)
FOR pass = 0 TO 99
FOR door = pass TO 99 STEP pass + 1
PRINT doors(door)
PRINT NOT doors(door)
doors(door) = NOT doors(door)
NEXT door
NEXT pass
FOR i = 0 TO 99
PRINT "Door #"; i + 1; " is ";
IF NOT doors(i) THEN
PRINT "closed"
ELSE
PRINT "open"
END IF
NEXT i

46
Task/100-doors/BASIC/100-doors-6.basic
View file

@ -1,34 +1,12 @@
# 100 doors problem
dim d(100)
# simple solution
print "simple solution"
gosub initialize
for t = 1 to 100
for j = t to 100 step t
d[j-1] = not d[j-1]
next j
next t
gosub showopen
# more optimized solution
print "more optimized solution"
gosub initialize
for t = 1 to 10
d[t^2-1] = true
next t
gosub showopen
end
initialize:
for t = 1 to d[?]
d[t-1] = false # closed
next t
return
showopen:
for t = 1 to d[?]
print d[t-1]+ " ";
if t%10 = 0 then print
next t
return
DIM doors(0 TO 99)
FOR door = 0 TO 99
IF INT(SQR(door)) = SQR(door) THEN doors(door) = -1
NEXT door
FOR i = 0 TO 99
PRINT "Door #"; i + 1; " is ";
IF NOT doors(i) THEN
PRINT "closed"
ELSE
PRINT "open"
END IF
NEXT i

19
Task/100-doors/BASIC/100-doors-7.basic
View file

@ -1,9 +1,10 @@
10 DIM D(100)
20 FOR I=1 TO 100
30 FOR J=I TO 100 STEP I
40 D(J) = NOT D(J)
50 NEXT J
60 NEXT I
70 FOR I=1 TO 100
80 IF D(I) THEN PRINT I,
90 NEXT I
'lrcvs 04.11.12
cls
x = 1 : y = 3 : z = 0
print x + " Open"
do
z = x + y
print z + " Open"
x = z : y = y + 2
until z >= 100
end

9
Task/100-doors/BASIC/100-doors-8.basic Normal file
View file

@ -0,0 +1,9 @@
10 DIM D(100)
20 FOR I=1 TO 100
30 FOR J=I TO 100 STEP I
40 LET D(J)=NOT D(J)
50 NEXT J
60 NEXT I
70 FOR I=1 TO 100
80 IF D(I) THEN PRINT I,
90 NEXT I

12
Task/100-doors/C-sharp/100-doors-2.cs
View file

@ -7,9 +7,10 @@ namespace ConsoleApplication1
{
//The o variable stores the number of the next OPEN door.
int o = 1;
//The n variable is used to help calculate the next value of the o variable.
int n = 0;
int f = 1;
int l = 5;
Random r = new Random();
o = r.Next(f, l);
//The d variable determines the door to be output next.
for (int d = 1; d <= 100; d++)
@ -18,8 +19,9 @@ namespace ConsoleApplication1
if (d == o)
{
Console.WriteLine("Open");
n++;
o += 2 * n + 1;
f = f + 5;
l = l + 5;
o = r.Next(f, l);
}
else
Console.WriteLine("Closed");

6
Task/100-doors/Common-Lisp/100-doors-3.lisp
View file

@ -1,10 +1,10 @@
(defun doors (z &optional (w (make-list z)) (n 1))
(if (> n z) w (doors z (toggle w n z) (1+ n))))
(defun toggle (w m z)
(loop for a in w for n from 1 to z
collect (if (zerop (mod n m)) (not a) a)))
(defun doors (z &optional (w (make-list z)) (n 1))
(if (> n z) w (doors z (toggle w n z) (1+ n))))
> (doors 100)
(T NIL NIL T NIL NIL NIL NIL T NIL NIL NIL NIL NIL NIL T NIL NIL NIL NIL NIL
NIL NIL NIL T NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL T NIL NIL NIL NIL NIL

16
Task/100-doors/Common-Lisp/100-doors-4.lisp
View file

@ -1,6 +1,10 @@
(defun 100-doors ()
(let ((doors (make-array 100)))
(dotimes (i 10)
(setf (svref doors (* i i)) t))
(dotimes (i 100)
(format t "door ~a: ~:[closed~;open~]~%" (1+ i) (svref doors i)))))
(defun doors (n)
(loop for a from 1 to n collect
(if (zerop (mod (sqrt a) 1)) t nil)))
> (doors 100)
(T NIL NIL T NIL NIL NIL NIL T NIL NIL NIL NIL NIL NIL T NIL NIL NIL NIL NIL
NIL NIL NIL T NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL T NIL NIL NIL NIL NIL
NIL NIL NIL NIL NIL NIL NIL T NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
NIL NIL T NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL T
NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL T)

29
Task/100-doors/Common-Lisp/100-doors-5.lisp
View file

@ -1,23 +1,6 @@
(defun perfect-square-list (n)
"Generates a list of perfect squares from 0 up to n"
(loop for i from 1 to (isqrt n) collect (expt i 2)))
(defun print-doors (doors)
"Pretty prints the doors list"
(format T "~{~A ~A ~A ~A ~A ~A ~A ~A ~A ~A~%~}~%" doors))
(defun open-door (doors num open)
"Sets door at num to open"
(setf (nth (- num 1) doors) open))
(defun visit-all (doors vlist open)
"Visits and opens all the doors indicated in vlist"
(dolist (dn vlist doors)
(open-door doors dn open)))
(defun start2 (&optional (size 100))
"Start the program"
(print-doors
(visit-all (make-list size :initial-element '\#)
(perfect-square-list size)
'_)))
(defun 100-doors ()
(let ((doors (make-array 100)))
(dotimes (i 10)
(setf (svref doors (* i i)) t))
(dotimes (i 100)
(format t "door ~a: ~:[closed~;open~]~%" (1+ i) (svref doors i)))))

28
Task/100-doors/Common-Lisp/100-doors-6.lisp
View file

@ -1,5 +1,23 @@
(let ((i 0))
(mapcar (lambda (x)
(if (zerop (mod (sqrt (incf i)) 1))
"_" "#"))
(make-list 100)))
(defun perfect-square-list (n)
"Generates a list of perfect squares from 0 up to n"
(loop for i from 1 to (isqrt n) collect (expt i 2)))
(defun print-doors (doors)
"Pretty prints the doors list"
(format T "~{~A ~A ~A ~A ~A ~A ~A ~A ~A ~A~%~}~%" doors))
(defun open-door (doors num open)
"Sets door at num to open"
(setf (nth (- num 1) doors) open))
(defun visit-all (doors vlist open)
"Visits and opens all the doors indicated in vlist"
(dolist (dn vlist doors)
(open-door doors dn open)))
(defun start2 (&optional (size 100))
"Start the program"
(print-doors
(visit-all (make-list size :initial-element '\#)
(perfect-square-list size)
'_)))

5
Task/100-doors/Common-Lisp/100-doors-7.lisp Normal file
View file

@ -0,0 +1,5 @@
(let ((i 0))
(mapcar (lambda (x)
(if (zerop (mod (sqrt (incf i)) 1))
"_" "#"))
(make-list 100)))

2
Task/100-doors/Elena/100-doors.elena
View file

@ -1,7 +1,7 @@
import system'routines.
import extensions.
program =
public program =
[
var Doors := Array new:100; populate(:n)( false ).

1
Task/100-doors/Excel/100-doors-1.excel Normal file
View file

@ -0,0 +1 @@
=IF($A2/C$1=INT($A2/C$1),IF(B2=0,1,IF(B2=1,0)),B2)

1
Task/100-doors/Excel/100-doors-2.excel Normal file
View file

@ -0,0 +1 @@
=IF($A3/C$1=INT($A3/C$1),IF(B3=0,1,IF(B3=1,0)),B3)

1
Task/100-doors/Excel/100-doors-3.excel Normal file
View file

@ -0,0 +1 @@
=IF($A2/D$1=INT($A2/D$1),IF(C2=0,1,IF(C2=1,0)),C2)

14
Task/100-doors/HolyC/100-doors.holyc Normal file
View file

@ -0,0 +1,14 @@
U8 is_open[100];
U8 pass = 0, door = 0;
/* do the 100 passes */
for (pass = 0; pass < 100; ++pass)
for (door = pass; door < 100; door += pass + 1)
is_open[door] = !is_open[door];
/* output the result */
for (door = 0; door < 100; ++door)
if (is_open[door])
Print("Door #%d is open.\n", door + 1);
else
Print("Door #%d is closed.\n", door + 1);

2
Task/100-doors/Julia/100-doors-1.julia
View file

@ -1,5 +1,5 @@
doors = falses(100)
for a = 1:100, b in a:a:100
for a in 1:100, b in a:a:100
doors[b] = !doors[b]
end
for a = 1:100

2
Task/100-doors/Julia/100-doors-2.julia
View file

@ -1 +1 @@
for i = 1:10 println("Door $(i^2) is open.") end
for i in 1:10 println("Door $(i^2) is open.") end

2
Task/100-doors/Klong/100-doors-1.klong Normal file
View file

@ -0,0 +1,2 @@
flip::{,/{(1-*x),1_x}'x:#y}
i::0;(100{i::i+1;flip(i;x)}:*100:^0)?1

1
Task/100-doors/Klong/100-doors-2.klong Normal file
View file

@ -0,0 +1 @@
(1+!9)^2

4
Task/100-doors/Nial/100-doors-1.nial Normal file
View file

@ -0,0 +1,4 @@
n:=100;reduce xor (count n eachright mod count n eachall<1)
looloooolooooooloooooooolooooooooooloooooooooooolooooooooooooooloooooooooooooooo
looooooooooooooooool

2
Task/100-doors/Nial/100-doors-2.nial Normal file
View file

@ -0,0 +1,2 @@
true findall (n:=100;reduce xor (count n eachright mod count n eachall<1))+1
1 4 9 16 25 36 49 64 81 100

2
Task/100-doors/Nial/100-doors-3.nial Normal file
View file

@ -0,0 +1,2 @@
count 10 power 2
1 4 9 16 25 36 49 64 81 100

4
Task/100-doors/Oforth/100-doors.oforth
View file

@ -1,7 +1,7 @@
: doors
| i j l |
ListBuffer initValue(100, false) ->l
100 #[ false ] Array init dup ->l
100 loop: i [
i 100 i step: j [ l put(j, l at(j) not) ]
]
l println ;
l . ;

3
Task/100-doors/R/100-doors-4.r Normal file
View file

@ -0,0 +1,3 @@
H=100
f=rep(F,H)
which(Reduce(function(d,n) xor(replace(f,seq(n,H,n),T),d), 1:H, f))

5
Task/100-doors/Rust/100-doors-1.rust
View file

@ -1,8 +1,6 @@
#![feature(inclusive_range_syntax)]
fn main() {
let mut door_open = [false; 100];
for pass in 1...100 {
for pass in 1..100 {
let mut door = pass;
while door <= 100 {
door_open[door - 1] = !door_open[door - 1];
@ -13,3 +11,4 @@ fn main() {
println!("Door {} is {}.", i + 1, if is_open {"open"} else {"closed"});
}
}
}

4
Task/100-doors/Rust/100-doors-2.rust
View file

@ -1,8 +1,6 @@
#![feature(inclusive_range_syntax)]
fn main() {
let doors = vec![false; 100].iter_mut().enumerate()
.map(|(door, door_state)| (1...100).into_iter()
.map(|(door, door_state)| (1..100).into_iter()
.filter(|pass| door % pass == 0)
.map(|_| { *door_state = !*door_state; *door_state })
.last().unwrap()).collect::<Vec<_>>();

6
Task/100-doors/Rust/100-doors-3.rust
View file

@ -1,10 +1,8 @@
#![feature(inclusive_range_syntax)]
fn main() {
let squares: Vec<_> = (1...10).map(|n| n*n).collect();
let squares: Vec<_> = (1..10).map(|n| n*n).collect();
let is_square = |num| squares.binary_search(&num).is_ok();
for i in 1...100 {
for i in 1..100 {
let state = if is_square(i) {"open"} else {"closed"};
println!("Door {} is {}", i, state);
}

4
Task/100-doors/Rust/100-doors-4.rust
View file

@ -1,7 +1,5 @@
#![feature(inclusive_range_syntax)]
fn main() {
for i in 1u32...10u32{
for i in 1u32..10u32{
println!("Door {} is open", i.pow(2));
}
}

43
Task/100-doors/SheerPower-4GL/100-doors.4gl Normal file
View file

@ -0,0 +1,43 @@
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! I n i t i a l i z a t i o n
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
doors% = 100
dim doorArray?(doors%)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! M a i n L o g i c A r e a
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
// Initialize Array
for index% = 1 to doors%
doorArray?(index%) = false
next index%
// Execute routine
toggle_doors
// Print results
for index% = 1 to doors%
if doorArray?(index%) = true then print index%, ' is open'
next index%
stop
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! R o u t i n e s
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
routine toggle_doors
for index_outer% = 1 to doors%
for index_inner% = 1 to doors%
if mod(index_inner%, index_outer%) = 0 then
doorArray?(index_inner%) = not doorArray?(index_inner%)
end if
next index_inner%
next index_outer%
end routine
end

24
Task/100-doors/Simula/100-doors.simula
View file

@ -1,16 +1,16 @@
BEGIN
INTEGER I, PASS;
BOOLEAN ARRAY DOORS(1:100);
INTEGER LIMIT = 100, door, stride;
BOOLEAN ARRAY DOORS(1:LIMIT);
TEXT intro;
FOR I := 1 STEP 1 UNTIL 100 DO
DOORS(I) := FALSE;
FOR PASS := 1 STEP 1 UNTIL 100 DO
FOR I := PASS STEP PASS UNTIL 100 DO
DOORS(I) := NOT DOORS(I);
FOR I := 1 STEP 1 UNTIL 100 DO
IF DOORS(I)
THEN BEGIN OUTTEXT("DOOR "); OUTINT(I,0); OUTTEXT(" IS OPEN"); OUTIMAGE END
FOR stride := 1 STEP 1 UNTIL LIMIT DO
FOR door := stride STEP stride UNTIL LIMIT DO
DOORS(door) := NOT DOORS(door);
intro :- "All doors closed but ";
FOR door := 1 STEP 1 UNTIL LIMIT DO
IF DOORS(door) THEN BEGIN
OUTTEXT(intro); OUTINT(door, 0); intro :- ", "
END;
OUTIMAGE
END.

32
Task/100-doors/Stata/100-doors.stata
View file

@ -1,24 +1,22 @@
clear all
clear
set obs 100
gen doors=0
gen index=_n
forvalues i=1/100 {
quietly replace doors=1-doors if mod(_n,`i')==0
}
list index if doors
list index if doors, noobs noheader
+-------+
| index |
|-------|
1. | 1 |
4. | 4 |
9. | 9 |
16. | 16 |
25. | 25 |
|-------|
36. | 36 |
49. | 49 |
64. | 64 |
81. | 81 |
100. | 100 |
+-------+
+-------+
| 1 |
| 4 |
| 9 |
| 16 |
| 25 |
|-------|
| 36 |
| 49 |
| 64 |
| 81 |
| 100 |
+-------+

17
Task/100-doors/Visual-Basic/100-doors.vb Normal file
View file

@ -0,0 +1,17 @@
Public Sub Doors100()
' the state of a door is represented by the data type boolean (false = door closed, true = door opened)
Dim doorstate(1 To 100) As Boolean ' the doorstate()-array is initialized by VB with value 'false'
Dim i As Long, j As Long
For i = 1 To 100
For j = i To 100 Step i
doorstate(j) = Not doorstate(j)
Next j
Next i
Debug.Print "The following doors are open:"
For i = 1 To 100
' print number if door is openend
If doorstate(i) Then Debug.Print CStr(i)
Next i
End Sub

18
Task/24-game-Solve/Factor/24-game-solve.factor Normal file
View file

@ -0,0 +1,18 @@
USING: continuations grouping io kernel math math.combinatorics
prettyprint quotations random sequences sequences.deep ;
IN: rosetta-code.24-game
: 4digits ( -- seq ) 4 9 random-integers [ 1 + ] map ;
: expressions ( digits -- exprs )
all-permutations [ [ + - * / ] 3 selections
[ append ] with map ] map flatten 7 group ;
: 24= ( exprs -- )
>quotation dup call( -- x ) 24 = [ . ] [ drop ] if ;
: 24-game ( -- )
4digits dup "The numbers: " write . "The solutions: "
print expressions [ [ 24= ] [ 2drop ] recover ] each ;
24-game

35
Task/24-game-Solve/Mathematica/24-game-solve-3.math Normal file
View file

@ -0,0 +1,35 @@
evaluate[HoldForm[op_[l_, r_]]] := op[evaluate[l], evaluate[r]];
evaluate[x_] := x;
combine[l_, r_ /; evaluate[r] != 0] := {HoldForm[Plus[l, r]],
HoldForm[Subtract[l, r]], HoldForm[Times[l, r]],
HoldForm[Divide[l, r]] };
combine[l_, r_] := {HoldForm[Plus[l, r]], HoldForm[Subtract[l, r]],
HoldForm[Times[l, r]]};
split[items_] :=
Table[{items[[1 ;; i]], items[[i + 1 ;; Length[items]]]}, {i, 1,
Length[items] - 1}];
expressions[{x_}] := {x};
expressions[items_] :=
Flatten[Table[
Flatten[Table[
combine[l, r], {l, expressions[sp[[1]]]}, {r,
expressions[sp[[2]]]}], 2], {sp, split[items]}]];
(* Must use all atoms in given order. *)
solveMaintainOrder[goal_, items_] :=
Select[expressions[items], (evaluate[#] == goal) &];
(* Must use all atoms, but can permute them. *)
solveCanPermute[goal_, items_] :=
Flatten[Table[
solveMaintainOrder[goal, pitems], {pitems,
Permutations[items]}]];
(* Can use any subset of atoms. *)
solveSubsets[goal_, items_] :=
Flatten[Table[
solveCanPermute[goal, is], {is,
Subsets[items, {1, Length[items]}]}], 2];
(* Demonstration to find all the ways to create 1/5 from {2, 3, 4, 5}. *)
solveMaintainOrder[1/5, Range[2, 5]]
solveCanPermute[1/5, Range[2, 5]]
solveSubsets[1/5, Range[2, 5]]

0
Task/24-game-Solve/Python/24-game-solve.py → Task/24-game-Solve/Python/24-game-solve-1.py
View file

39
Task/24-game-Solve/Python/24-game-solve-2.py Normal file
View file

@ -0,0 +1,39 @@
# -*- coding: utf-8 -*-
import operator
from itertools import product, permutations
def mydiv(n, d):
return n / d if d != 0 else 9999999
syms = [operator.add, operator.sub, operator.mul, mydiv]
op = {sym: ch for sym, ch in zip(syms, '+-*/')}
def solve24(nums):
for x, y, z in product(syms, repeat=3):
for a, b, c, d in permutations(nums):
if round(x(y(a,b),z(c,d)),5) == 24:
return f"({a} {op[y]} {b}) {op[x]} ({c} {op[z]} {d})"
elif round(x(a,y(b,z(c,d))),5) == 24:
return f"{a} {op[x]} ({b} {op[y]} ({c} {op[z]} {d}))"
elif round(x(y(z(c,d),b),a),5) == 24:
return f"(({c} {op[z]} {d}) {op[y]} {b}) {op[x]} {a}"
elif round(x(y(b,z(c,d)),a),5) == 24:
return f"({b} {op[y]} ({c} {op[z]} {d})) {op[x]} {a}"
return '--Not Found--'
if __name__ == '__main__':
#nums = eval(input('Four integers in the range 1:9 inclusive, separated by commas: '))
for nums in [
[9,4,4,5],
[1,7,2,7],
[5,7,5,4],
[1,4,6,6],
[2,3,7,3],
[8,7,9,7],
[1,6,2,6],
[7,9,4,1],
[6,4,2,2],
[5,7,9,7],
[3,3,8,8], # Difficult case requiring precise division
]:
print(f"solve24({nums}) -> {solve24(nums)}")

44
Task/24-game-Solve/Python/24-game-solve-3.py Normal file
View file

@ -0,0 +1,44 @@
# -*- coding: utf-8 -*-
# Python 3
from operator import mul, sub, add
def div(a, b):
if b == 0:
return 999999.0
return a / b
ops = {mul: '*', div: '/', sub: '-', add: '+'}
def solve24(num, how, target):
if len(num) == 1:
if round(num[0], 5) == round(target, 5):
yield str(how[0]).replace(',', '').replace("'", '')
else:
for i, n1 in enumerate(num):
for j, n2 in enumerate(num):
if i != j:
for op in ops:
new_num = [n for k, n in enumerate(num) if k != i and k != j] + [op(n1, n2)]
new_how = [h for k, h in enumerate(how) if k != i and k != j] + [(how[i], ops[op], how[j])]
yield from solve24(new_num, new_how, target)
tests = [
[1, 7, 2, 7],
[5, 7, 5, 4],
[1, 4, 6, 6],
[2, 3, 7, 3],
[1, 6, 2, 6],
[7, 9, 4, 1],
[6, 4, 2, 2],
[5, 7, 9, 7],
[3, 3, 8, 8], # Difficult case requiring precise division
[8, 7, 9, 7], # No solution
[9, 4, 4, 5], # No solution
]
for nums in tests:
print(nums, end=' : ')
try:
print(next(solve24(nums, nums, 24)))
except StopIteration:
print("No solution found")

46
Task/24-game-Solve/Scheme/24-game-solve-1.ss Normal file
View file

@ -0,0 +1,46 @@
#!r6rs
(import (rnrs)
(rnrs eval)
(only (srfi :1 lists) append-map delete-duplicates iota))
(define (map* fn . lis)
(if (null? lis)
(list (fn))
(append-map (lambda (x)
(apply map*
(lambda xs (apply fn x xs))
(cdr lis)))
(car lis))))
(define (insert x li n)
(if (= n 0)
(cons x li)
(cons (car li) (insert x (cdr li) (- n 1)))))
(define (permutations li)
(if (null? li)
(list ())
(map* insert (list (car li)) (permutations (cdr li)) (iota (length li)))))
(define (evaluates-to-24 expr)
(guard (e ((assertion-violation? e) #f))
(= 24 (eval expr (environment '(rnrs base))))))
(define (tree n o0 o1 o2 xs)
(list-ref
(list
`(,o0 (,o1 (,o2 ,(car xs) ,(cadr xs)) ,(caddr xs)) ,(cadddr xs))
`(,o0 (,o1 (,o2 ,(car xs) ,(cadr xs)) ,(caddr xs)) ,(cadddr xs))
`(,o0 (,o1 ,(car xs) (,o2 ,(cadr xs) ,(caddr xs))) ,(cadddr xs))
`(,o0 (,o1 ,(car xs) ,(cadr xs)) (,o2 ,(caddr xs) ,(cadddr xs)))
`(,o0 ,(car xs) (,o1 (,o2 ,(cadr xs) ,(caddr xs)) ,(cadddr xs)))
`(,o0 ,(car xs) (,o1 ,(cadr xs) (,o2 ,(caddr xs) ,(cadddr xs)))))
n))
(define (solve a b c d)
(define ops '(+ - * /))
(define perms (delete-duplicates (permutations (list a b c d))))
(delete-duplicates
(filter evaluates-to-24
(map* tree (iota 6) ops ops ops perms))))

13
Task/24-game-Solve/Scheme/24-game-solve-2.ss Normal file
View file

@ -0,0 +1,13 @@
> (solve 1 3 5 7)
((* (+ 1 5) (- 7 3))
(* (+ 5 1) (- 7 3))
(* (+ 5 7) (- 3 1))
(* (+ 7 5) (- 3 1))
(* (- 3 1) (+ 5 7))
(* (- 3 1) (+ 7 5))
(* (- 7 3) (+ 1 5))
(* (- 7 3) (+ 5 1)))
> (solve 3 3 8 8)
((/ 8 (- 3 (/ 8 3))))
> (solve 3 4 9 10)
()

25
Task/24-game/Befunge/24-game.bf Normal file
View file

@ -0,0 +1,25 @@
v > > >> v
2 2 1234
4 ^1?3^4
>8*00p10p> >? ?5> 68*+00g10gpv
v9?7v6 0
8 0
> > >> ^ g
^p00 _v# `\*49:+1 <
_>"rorrE",,,,,$ >~:67*-!#v_:167*+-!#v_:95*-!#v_:295*+-!#v_:586*+\`#v_:97*2--!#v
$ $ $ $ : $
* + - / 1 :
^ < < < < 8 .
6 6
* 4
+ *
\ -
` > v_v
"
^ < _v e
^ _^#+*28:p2\*84\-*86g2:-+*441< s
o
L
> 1 |-*49"#<
| -*84gg01g00<p00*84<v <
>00g:1+00p66*`#^_ "niW">:#,_@

48
Task/24-game/Elena/24-game.elena
View file

@ -9,40 +9,43 @@ class ExpressionTree
constructor new : aLiteral
[
var aLevel := Integer new:0.
auto aLevel := Integer new:0.
aLiteral forEach(:ch)
[
var node := DynamicStruct new.
ch =>
$43 [ node set level(aLevel + 1); set operation:%add ]; // +
$45 [ node set level(aLevel + 1); set operation:%subtract ]; // -
$42 [ node set level(aLevel + 2); set operation:%multiply ]; // *
$47 [ node set level(aLevel + 2); set operation:%divide ]; // /
$40 [ aLevel append int:10. ^ $self ]; // (
$41 [ aLevel reduce int:10. ^ $self ]; // )
$43 [ node level := aLevel + 1. node operation := %add ]; // +
$45 [ node level := aLevel + 1. node operation := %subtract ]; // -
$42 [ node level := aLevel + 2. node operation := %multiply ]; // *
$47 [ node level := aLevel + 2. node operation := %divide ]; // /
$40 [ aLevel append(10). ^ self ]; // (
$41 [ aLevel reduce(10). ^ self ]; // )
! [
node set leaf(ch literal; toReal); set level(aLevel + 3).
node leaf := ch literal; toReal.
node level := aLevel + 3.
].
if ($nil == theTree)
if (nil == theTree)
[ theTree := node ];
[
if (theTree level >= node level)
[
node set left:theTree; set right:$nil.
node left := theTree.
node right := nilValue.
theTree := node
];
[
var aTop := theTree.
while (($nil != aTop right)and:$(aTop right; level < node level))
while ((nilValue != aTop right)&&(aTop right; level < node level))
[ aTop := aTop right ].
node set left(aTop right); set right:$nil.
node left := aTop right.
node right := nilValue.
aTop set right:node
aTop right := node
]
]
]
@ -53,8 +56,8 @@ class ExpressionTree
if (aNode containsProperty:%leaf)
[ ^ aNode leaf ];
[
var aLeft := $self eval:(aNode left).
var aRight := $self eval:(aNode right).
var aLeft := self eval:(aNode left).
var aRight := self eval:(aNode right).
^ aLeft~(aNode operation) eval:aRight
]
@ -65,14 +68,14 @@ class ExpressionTree
readLeaves : aList at:aNode
[
if ($nil == aNode)
if (nil == aNode)
[ InvalidArgumentException new; raise ].
if (aNode containsProperty:%leaf)
[ aList append(aNode leaf) ];
[
$self readLeaves:aList at(aNode left).
$self readLeaves:aList at(aNode right).
self readLeaves:aList at(aNode left).
self readLeaves:aList at(aNode right).
].
]
@ -86,7 +89,7 @@ class TwentyFourGame
constructor new
[
$self newPuzzle.
self newPuzzle.
]
newPuzzle
@ -129,14 +132,14 @@ class TwentyFourGame
exp readLeaves:Leaves.
ifnot (Leaves ascendant; sequenceEqual(theNumbers ascendant))
[ console printLine:"Invalid input. Enter an equation using all of those four digits. Try again.". ^ $self ].
[ console printLine:"Invalid input. Enter an equation using all of those four digits. Try again.". ^ self ].
var aResult := exp value.
if (aResult == 24)
[
console printLine("Good work. ",aLine,"=",aResult).
$self newPuzzle.
self newPuzzle.
];
[ console printLine("Incorrect. ",aLine,"=",aResult) ]
]
@ -159,13 +162,12 @@ extension gameOp
]
}
].
^ true
].
]
}
program =
public program =
[
var aGame := TwentyFourGame new; help.

19
Task/24-game/Oforth/24-game.oforth
View file

@ -1,19 +1,22 @@
: 24game
import: mapping
: game
| l expr w n i |
ListBuffer init(4, #[ 9 rand ]) ->l
4 #[ 9 rand ] Array init ->l
System.Out "Digits : " << l << " --> RPN Expression for 24 : " << drop
System.Console askln ->expr
System.Console accept ->expr
expr words forEach: w [
w "+" == ifTrue: [ + continue ]
w "-" == ifTrue: [ - continue ]
w "*" == ifTrue: [ * continue ]
w "/" == ifTrue: [ asFloat / continue ]
w "/" == ifTrue: [ >float / continue ]
w asInteger dup ->n ifNull: [ System.Out "Word " << w << " not allowed " << cr break ]
l indexOf(n) dup ->i ifNull: [ System.Out "Integer " << n << " is wrong " << cr break ]
w >integer dup ->n ifNull: [ System.Out "Word " << w << " not allowed " << cr break ]
n l indexOf dup ->i ifNull: [ System.Out "Integer " << n << " is wrong " << cr break ]
n l put(i, null)
]
l conform(#isNull) ifFalse: [ "Sorry, all numbers must be used..." println return ]
24 == ifTrue: [ "You won !" ] else: [ "You loose..." ] println ;
#null? l conform? ifFalse: [ "Sorry, all numbers must be used..." . return ]
24 if=: [ "You won !" ] else: [ "You loose..." ] .
;

63
Task/24-game/Ring/24-game.ring Normal file
View file

@ -0,0 +1,63 @@
# Project : 24 game
# Date : 2018/02/21
# Author : Gal Zsolt (~ CalmoSoft ~)
# Email : <calmosoft@gmail.com>
load "stdlib.ring"
digits = list(4)
check = list(4)
for choice = 1 to 4
digits[choice] = random(9)
next
see "enter an equation (using all of, and only, the single digits " + nl
for index = 1 to 4
see digits[index]
if index != 4
see " "
ok
next
see ")"
see " which evaluates to exactly 24. only multiplication (*), division (/)," + nl
see "addition (+) & subtraction (-) operations and parentheses are allowed:" + nl
see "24 = "
give equation
see "equation = " + equation + nl
while true
for char = 1 to len(equation)
digit = substr("0123456789", equation[char]) - 1
if digit >= 0
for index = 1 to 4
if digit = digits[index]
if not check[index]
check[index] = 1
exit
ok
ok
next
if index > 4
see "sorry, you used the illegal digit " + digit + nl
exit 2
ok
ok
next
for index = 1 to 4
if check[index] = 0
see "sorry, you failed to use the digit " + digits[index] + nl
exit 2
ok
next
for pair = 11 to 99
if substr(equation, string(pair))
see "sorry, you may not use a pair of digits " + pair + nl
ok
next
eval("result = " + equation)
if result = 24
see "congratulations, you succeeded in the task!" + nl
exit
else
see "sorry, your equation evaluated to " + result + " rather than 24!" + nl
ok
end

45
Task/9-billion-names-of-God-the-integer/Go/9-billion-names-of-god-the-integer.go Normal file
View file

@ -0,0 +1,45 @@
package main
import (
f "fmt"
"math"
m "math/big"
)
func main() {
var cache = make([][]m.Int, 0)
cache = append(cache, append([]m.Int{}, *m.NewInt(1)))
cumu := func(n int) []m.Int {
for l := len(cache); l <= n; l++ {
r := make([]m.Int, 0)
r = append(r, *m.NewInt(0))
for x := 1; x <= l; x++ {
cacheValue := &cache[l-x][int(math.Min(float64(x), float64(l-x)))]
r = append(r, *m.NewInt(0).Add(&r[len(r)-1], cacheValue))
}
cache = append(cache, r)
}
return cache[n]
}
row := func(n int) {
e := cumu(n)
for i := 0; i < n; i++ {
f.Printf(" %v ", (*m.NewInt(0).Sub(&e[i+1], &e[i])).Text(10))
}
f.Print("\n")
}
f.Print("rows:\n")
for x := 1; x < 11; x++ {
row(x)
}
f.Print("\n sums:\n")
nums := []int{23, 123, 1234,12345}
for _, num := range nums {
r := cumu(num)
f.Printf("%d %v \n", num, r[len(r)-1].Text(10))
}
}

10
Task/9-billion-names-of-God-the-integer/Stata/9-billion-names-of-god-the-integer.stata Normal file
View file

@ -0,0 +1,10 @@
mata
function part(n) {
a = J(n,n,.)
for (i=1;i<=n;i++) a[i,1] = a[i,i] = 1
for (i=3;i<=n;i++) {
for (j=2;j<i;j++) a[i,j] = sum(a[i-j,1..min((j,i-j))])
}
return(a)
}
end

19
Task/99-Bottles-of-Beer/00DESCRIPTION
View file

@ -1,8 +1,8 @@
;Task:
Display the complete lyrics for the song: &nbsp; &nbsp; '''99 bottles of beer on the wall'''.
Display the complete lyrics for the song: &nbsp; &nbsp; '''99 Bottles of Beer on the Wall'''.
;The beersong:
;The beer song:
The lyrics follow this form:
<blockquote>
@ -24,9 +24,16 @@ Grammatical support for "1 bottle of beer" is optional.
As with any puzzle, try to do it in as creative/concise/comical a way
as possible (simple, obvious solutions allowed, too).
;Related tasks:
* &nbsp; [[The Twelve Days of Christmas]]
* &nbsp; [[Old_lady_swallowed_a_fly]]
* &nbsp; [[Mad Libs]]
;See also:
* http://99-bottles-of-beer.net/
* [[:Category:99_Bottles_of_Beer]]
* [[:Category:Programming language families]]
* [https://en.wikipedia.org/wiki/99_Bottles_of_Beer Wikipedia 99 bottles of beer]
* &nbsp; http://99-bottles-of-beer.net/
* &nbsp; [[:Category:99_Bottles_of_Beer]]
* &nbsp; [[:Category:Programming language families]]
* &nbsp; [https://en.wikipedia.org/wiki/99_Bottles_of_Beer Wikipedia 99 bottles of beer]
<br><br>

8
Task/99-Bottles-of-Beer/Astro/99-bottles-of-beer.astro
View file

@ -1,9 +1,9 @@
fun bottles(n):
| 0 -> "No more bottles"
| 1 -> "1 bottle"
| _ -> "$n bottles"
| 0 => "No more bottles"
| 1 => "1 bottle"
| _ => "$n bottles"
for n in [100:1]:
for n in !99..1:
print """
$(bottles n) of beer on the wall
$(bottles n) of beer

7
Task/99-Bottles-of-Beer/Crystal/99-bottles-of-beer.crystal Normal file
View file

@ -0,0 +1,7 @@
99.downto(1) do |n|
puts "#{n} bottle#{n > 1 ? "s" : ""} of beer on the wall"
puts "#{n} bottle#{n > 1 ? "s" : ""} of beer"
puts "Take one down, pass it around"
puts "#{n-1} bottle#{n > 2 ? "s" : ""} of beer on the wall\n\n" if n > 1
end
puts "No more bottles of beer on the wall"

17
Task/99-Bottles-of-Beer/Elena/99-bottles-of-beer.elena
View file

@ -1,4 +1,3 @@
import system'dynamic.
import system'routines.
import extensions.
import extensions'routines.
@ -9,22 +8,26 @@ extension bottleOp
bottleDescription
= self literal + (self != 1) iif(" bottles"," bottle").
bottleEnumerator = Variable new:self; doWith(:target)
bottleEnumerator = Variable new:self; doWith(:n)
[
^ Enumerator::
{
next = target > 0.
bool next = n > 0.
get = StringWriter new;
printLine(target bottleDescription," of beer on the wall");
printLine(target bottleDescription," of beer");
printLine(n bottleDescription," of beer on the wall");
printLine(n bottleDescription," of beer");
printLine("Take one down, pass it around");
printLine((target reduce:1) bottleDescription," of beer on the wall").
printLine((n reduce:1) bottleDescription," of beer on the wall").
reset []
enumerable = target.
}
].
}
program =
public program =
[
var bottles := 99.

32
Task/99-Bottles-of-Beer/Kitten/99-bottles-of-beer.kitten Normal file
View file

@ -0,0 +1,32 @@
99 bottles_of_beer_on_the_wall
define bottles_of_beer_on_the_wall (Int32 -> +IO):
-> n;
n th_verse
if (n > 1): (n - 1) bottles_of_beer_on_the_wall
define th_verse (Int32 -> +IO):
-> n;
n bottles_of_beer on_the_wall say
n bottles_of_beer say
take_one_down_pass_it_around say
(n - 1) bottles_of_beer on_the_wall say
newline
define bottles_of_beer (Int32 -> List<Char>):
bottles " of beer" cat
define on_the_wall (List<Char> -> List<Char>):
" on the wall" cat
define take_one_down_pass_it_around (-> List<Char>):
"take one down, pass it around"
define bottles (Int32 -> List<Char>):
-> n;
if (n = 0):
"no more bottles"
elif (n = 1):
"one bottle"
else:
n show " bottles" cat

26
Task/99-Bottles-of-Beer/Limbo/99-bottles-of-beer.limbo Normal file
View file

@ -0,0 +1,26 @@
implement Beer;
include "sys.m";
include "draw.m";
sys: Sys;
Beer : module
{
init : fn(ctxt : ref Draw->Context, args : list of string);
};
init (ctxt: ref Draw->Context, args: list of string)
{
sys = load Sys Sys->PATH;
beers := 99;
for (; beers > 1; --beers) {
sys->print("%d bottles of beer on the wall\n", beers);
sys->print("%d bottles of beer\n", beers);
sys->print("Take one down, pass it around,\n");
sys->print("%d bottles of beer on the wall\n\n", beers-1);
};
sys->print("1 bottle of beer on the wall\n1 bottle of beer\n");
sys->print("Take it down, pass it around\nand nothing is left!\n\n");
}

18
Task/99-Bottles-of-Beer/Lingo/99-bottles-of-beer.lingo Normal file
View file

@ -0,0 +1,18 @@
repeat with i = 99 down to 2
put i & " bottles of beer on the wall"
put i & " bottles of beer"
put "Take one down, pass it around"
put (i-1) & " bottles of beer on the wall"
put
end repeat
put "1 bottle of beer on the wall"
put "1 bottle of beer"
put "Take one down, pass it around"
put "No more bottles of beer on the wall"
put
put "No more bottles of beer on the wall"
put "No more bottles of beer"
put "Go to the store and buy some more"
put "99 bottles of beer on the wall"

11
Task/99-Bottles-of-Beer/Lua/99-bottles-of-beer-3.lua Normal file
View file

@ -0,0 +1,11 @@
function bottles(i)
local s = i == 1 and "1 bottle of beer" or
i == 0 and "no more bottles of beer" or
tostring(i) .. " bottles of beer"
return s, s
end
for i = 99, 1, -1 do
print( string.format("%s on the wall,\n%s,\ntake one down, pass it around,", bottles(i)),
string.format("\n%s on the wall.\n", bottles(i-1)) )
end

18
Task/99-Bottles-of-Beer/N-t-roff/99-bottles-of-beer-1.n Normal file
View file

@ -0,0 +1,18 @@
.nr BS 99 1
.de L1
.ie \\n(BS>1 \{ \
\\n(BS bottles of beer on the wall,
\\n(BS bottles of beer.\c
\}
.el \{ \
\\n(BS bottle of beer on the wall,
\\n(BS bottle of beer.\c
\}
Take one down, pass it around,
\\n-(BS bottles of beer on the wall.
.if \\n(BS>0 .L1
..
.nf
.L1
.fi

15
Task/99-Bottles-of-Beer/N-t-roff/99-bottles-of-beer-2.n Normal file
View file

@ -0,0 +1,15 @@
.nr beers 99 1
.nf
.while \n[beers]>0 \{ \
.ie \n[beers]>1 \{ \
\n[beers] bottles of beer on the wall,
\n[beers] bottles of beer.\c
\} \" ie \n[beers]>1
.el \{ \
\n[beers] bottle of beer on the wall,
\n[beers] bottle of beer.\c
\} \" el
Take one down, pass it around,
\n-[beers] bottles of beer on the wall.
\} \" while \n[beers]>0
.fi

2
Task/99-Bottles-of-Beer/Oforth/99-bottles-of-beer.oforth
View file

@ -1,4 +1,4 @@
"bottles of beer on the wall\n" const: B
"bottles of beer\nTake one down, pass it around\n" const: T
: beer #[ dup . B print dup . T print 1- . B .cr ] 100 seq applyr ;
#[ 100 swap - dup . B print dup . T print 1- . B .cr ] 99 each

38
Task/99-Bottles-of-Beer/REXX/99-bottles-of-beer.rexx
View file

@ -1,20 +1,20 @@
/*REXX program displays lyrics to the song "99 Bottles of Beer on the Wall". */
parse arg N .; if N=='' | N=="," then N=99 /*let number of bottles be given. */
do j=N by -1 to 1 /*start the countdown and singdown*/
say j 'bottle's(j) "of beer on the wall," /*sing the number bottles of beer.*/
say j 'bottle's(j) "of beer." /* ··· and the song's refrain.*/
say 'Take one down, pass it around,' /*take a beer bottle and share it.*/
m=j-1 /*M: number of bottles we have now*/
if m==0 then m='no' /*use "no" instead of numeric 0.*/
say m 'bottle's(m) "of beer on the wall." /*sing the beer bottle inventory. */
say /*a blank line between the verses.*/
end /*j*/
/*Not quite tanked? Then sing it.*/
say 'No more bottles of beer on the wall,' /*Finally! The last verse. */
say 'no more bottles of beer.' /*this is so forlorn ··· */
say 'Go to the store and buy some more,' /*obtain replenishment of the beer*/
say N 'bottles of beer on the wall.' /*all is well in the ole tavern. */
exit /*we're all done and also sloshed.*/
/*REXX program displays lyrics to the infamous song "99 Bottles of Beer on the Wall". */
parse arg N .; if N=='' | N=="," then N=99 /*allow number of bottles be specified.*/
/* [↓] downward count of beer bottles.*/
do #=N by -1 for N /*start the countdown and singdown. */
say # 'bottle's(#) "of beer on the wall," /*sing the number bottles of beer. */
say # 'bottle's(#) "of beer." /* ··· and also the song's refrain.*/
say 'Take one down, pass it around,' /*take a beer bottle ─── and share it.*/
m= # - 1 /*M: the number of bottles we have now*/
if m==0 then m= 'no' /*use word "no" instead of numeric 0.*/
say m 'bottle's(m) "of beer on the wall." /*sing the beer bottle inventory. */
say /*show a blank line between the verses.*/
end /*#*/ /*PSA: Please drink responsibly. */
/*Not quite tanked? Then sing it. */
say 'No more bottles of beer on the wall,' /*Finally! The last verse. */
say 'no more bottles of beer.' /*this is sooooooo sad and forlorn ··· */
say 'Go to the store and buy some more,' /*obtain replenishment of the beer. */
say N 'bottles of beer on the wall.' /*all is well in the ole town tavern. */
exit /*we're all done, and also sloshed !. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
s: if arg(1)=1 then return ''; return 's' /*a simple pluralizer function. */
s: if arg(1)=1 then return ''; return 's' /*simple pluralizer for gooder English.*/

2
Task/99-Bottles-of-Beer/Xojo/99-bottles-of-beer.xojo
View file

@ -1,6 +1,6 @@
Dim bottles As Integer = 99
While bottles > 0
Print(bottles.ToText) + " bottles of beer on the wall,")
Print(bottles.ToText + " bottles of beer on the wall,")
Print(bottles.ToText + " bottles of beer.")
Print("Take one down, pass it around.")
bottles = bottles - 1

14
Task/A+B/BASIC/a+b-11.basic
View file

@ -1,8 +1,6 @@
! RosettaCode: A+B
! True BASIC v6.007
PROGRAM APLUSB
INPUT PROMPT "Enter A:":A
INPUT PROMPT "Enter B:":B
PRINT "A + B =";(A+B)
GET KEY done
END
10 INPUT A$
20 LET I=1
30 IF A$(I)=" " THEN GOTO 60
40 LET I=I+1
50 GOTO 30
60 PRINT VAL A$( TO I-1)+VAL A$(I+1 TO )

44
Task/A+B/Ceylon/a+b.ceylon
View file

@ -1,23 +1,25 @@
shared void run() {
while(true) {
print("please enter two numbers for me to add");
value input = process.readLine();
if(exists input) {
value tokens = input.split();
value numbers = tokens.map(parseInteger);
if(numbers.any((Integer? element) => element is Null)) {
print("numbers only, please");
} else if(numbers.size != 2) {
print("two numbers, please");
} else if(!numbers.coalesced.every((Integer element) => -1k <= element <= 1k)) {
print("only numbers between -1000 and 1000, please");
} else if(exists a = numbers.first, exists b = numbers.last) {
print(a + b);
} else {
print("something went wrong");
}
} else {
break;
}
}
print("please enter two numbers for me to add");
value input = process.readLine();
if (exists input) {
value tokens = input.split().map(Integer.parse);
if (tokens.any((element) => element is ParseException)) {
print("numbers only, please");
return;
}
value numbers = tokens.narrow<Integer>();
if (numbers.size != 2) {
print("two numbers, please");
}
else if (!numbers.every((Integer element) => -1k <= element <= 1k)) {
print("only numbers between -1000 and 1000, please");
}
else if (exists a = numbers.first, exists b = numbers.last) {
print(a + b);
}
else {
print("something went wrong");
}
}
}

2
Task/A+B/Elena/a+b-1.elena
View file

@ -1,6 +1,6 @@
import extensions.
program =
public program =
[
var A := Integer new.
var B := Integer new.

2
Task/A+B/Elena/a+b-2.elena
View file

@ -1,7 +1,7 @@
import system'routines.
import extensions.
program =
public program =
[
console writeLine(console readLine;
split;

4
Task/A+B/Oforth/a+b.oforth
View file

@ -1 +1,3 @@
System.Console askln words map(#asInteger) sum .
import: mapping
System.Console accept words map( #>integer) reduce( #+ ) printcr .

18
Task/ABC-Problem/Astro/abc-problem.astro
View file

@ -1,12 +1,12 @@
fun abc(s, list):
return true if s.empty
for i in [:list.size]:
return any([abc(s[:!1], delete(val list, i))]) ...
if s[!0] in list[i] else true
fun abc(str, list):
if list.isEmpty: return true
for i in indices(list) where s[!1] in list[i]:
return abc(str[:!2], remove(val list, i))
false
let test = ["A", "BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE"]
let list = ["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS","JW",
"HU","VI","AN","OB","ER","FS","LY","PC","ZM"]
for s in test:
print "$:.-8(s) | $(abc(s, list))"
let list = ["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS",
"JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"]
for str in test:
print "$:>8(s) | $(abc(s, list))"

6
Task/ABC-Problem/Elena/abc-problem.elena
View file

@ -9,19 +9,19 @@ extension op
[
var list := ArrayList new:blocks.
^ $nil == self literal; upperCase; seekEach(:ch)
^ nil == self literal; upperCase; seekEach(:ch)
[
var index := list indexOfElement
((:word)(word indexOf:ch at:0 != -1) asComparator).
if (index>=0)
[ list remove at:index. ^ false ];
[ list removeAt:index. ^ false ];
[ ^ true ]
]
]
}
program =
public program =
[
var blocks := ("BO", "XK", "DQ", "CP", "NA",
"GT", "RE", "TG", "QD", "FS",

24
Task/ABC-Problem/Julia/abc-problem.julia
View file

@ -1,9 +1,17 @@
function abc (str, list)
isempty(str) && return true
for i = eachindex(list)
str[end] in list[i] &&
any([abc(str[1:end-1], deleteat!(copy(list), i))]) &&
return true
end
false
function abc(str::AbstractString, list)
isempty(str) && return true
for i in eachindex(list)
str[end] in list[i] &&
any([abc(str[1:end-1], deleteat!(copy(list), i))]) &&
return true
end
return false
end
let test = ["A", "BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE"],
list = ["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS",
"JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"]
for str in test
@printf("%-8s | %s\n", str, abc(str, list))
end
end

13
Task/ABC-Problem/Maple/abc-problem.maple
View file

@ -1,14 +1,15 @@
canSpell := proc(w)
local blocks, i, j, word, letterFound;
blocks := [["B", "O"], ["X", "K"], ["D", "Q"], ["C", "P"], ["N", "A"], ["G", "T"], ["R", "E"], ["T", "G"], ["Q", "D"], ["F", "S"],
["J", "W"], ["H", "U"], ["V", "I"], ["A", "N"], ["O", "B"], ["E", "R"], ["F", "S"], ["L", "Y"], ["P", "C"], ["Z", "M"]];
blocks := Array([["B", "O"], ["X", "K"], ["D", "Q"], ["C", "P"], ["N", "A"], ["G", "T"], ["R", "E"], ["T", "G"],
["Q", "D"], ["F", "S"], ["J", "W"], ["H", "U"], ["V", "I"], ["A", "N"], ["O", "B"], ["E", "R"],
["F", "S"], ["L", "Y"], ["P", "C"], ["Z", "M"]]);
word := StringTools[UpperCase](convert(w, string));
for i to length(word) do
letterFound := false;
for j to numelems(blocks) do
if not letterFound and (substring(word, i) = blocks[j][1] or substring(word, i) = blocks[j][2]) then
blocks[j][1] := undefined;
blocks[j][2] := undefined;
for j to numelems(blocks)/2 do
if not letterFound and (substring(word, i) = blocks[j,1] or substring(word, i) = blocks[j,2]) then
blocks[j,1] := undefined;
blocks[j,2] := undefined;
letterFound := true;
end if;
end do;

14
Task/ABC-Problem/Oforth/abc-problem.oforth
View file

@ -1,10 +1,14 @@
["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS","JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"] const: ABCBlocks
import: mapping
["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS","JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"]
const: ABCBlocks
: canMakeWord(w, blocks)
| i |
w isEmpty ifTrue: [ true return ]
w empty? ifTrue: [ true return ]
blocks size loop: i [
blocks at(i) include(w first toUpper) ifFalse: [ continue ]
canMakeWord(w right(w size 1 -), blocks del(i, i)) ifTrue: [ true return ]
w first >upper blocks at(i) include? ifFalse: [ continue ]
canMakeWord( w right( w size 1- ), blocks del(i, i) ) ifTrue: [ true return ]
]
false ;
false
;

16
Task/ABC-Problem/Red/abc-problem.red Normal file
View file

@ -0,0 +1,16 @@
Red []
test: func [ s][
p: copy "BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"
forever [
if 0 = length? s [ return 'true ] ;; if string cleared, all chars found/removed
if tail? p [ return 'false ] ;; if at end of search block - not found
rule: reduce [ first p '| second p] ;; construct parse rule from string
either parse s [ to rule remove rule to end ] [ ;; remove found char from string
remove/part p 2 ;;character found , remove block
p: head p ;;start from remaining string at beginning aka head
] [ p: skip p 2 ] ;; else move to next block
]
]
foreach word split {A bark book TrEAT COmMoN SQUAD conFUsE} space [
print reduce [ pad copy word 8 ":" test word]
]

34
Task/ABC-Problem/VBA/abc-problem.vba Normal file
View file

@ -0,0 +1,34 @@
Option Explicit
Sub Main_ABC()
Dim Arr, i As Long
Arr = Array("A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE")
For i = 0 To 6
Debug.Print ">>> can_make_word " & Arr(i) & " => " & ABC(CStr(Arr(i)))
Next i
End Sub
Function ABC(myWord As String) As Boolean
Dim myColl As New Collection
Dim NbLoop As Long, NbInit As Long
Dim b As Byte, i As Byte
Const BLOCKS As String = "B,O;X,K;D,Q;C,P;N,A;G,T;R,E;T,G;Q,D;F,S;J,W;H,U;V,I;A,N;O,B;E,R;F,S;L,Y;P,C;Z,M"
For b = 0 To 19
myColl.Add Split(BLOCKS, ";")(b), Split(BLOCKS, ";")(b) & b
Next b
NbInit = myColl.Count
NbLoop = NbInit
For b = 1 To Len(myWord)
For i = 1 To NbLoop
If i > NbLoop Then Exit For
If InStr(myColl(i), Mid(myWord, b, 1)) <> 0 Then
myColl.Remove (i)
NbLoop = NbLoop - 1
Exit For
End If
Next
Next b
ABC = (NbInit = (myColl.Count + Len(myWord)))
End Function

56
Task/AKS-test-for-primes/8th/aks-test-for-primes.8th Normal file
View file

@ -0,0 +1,56 @@
with: a
: nextrow \ a -- a
len
[ ( drop [1] ),
( drop [1,1] ),
( ' n:+ y 1 slide 1 push ) ]
swap 2 min caseof ;
;with
with: n
: .x \ n --
dup
[ ( drop ),
( drop "x" . ),
( "x^" . . ) ]
swap 2 min caseof space ;
: .term \ coef exp -- ; omit coef for 1x^n when n > 0
over 1 = over 0 > and if nip .x else swap . .x then ;
: .sgn \ +/-1 --
[ "-", null, "+" ]
swap 1+ caseof . space ;
: .lhs \ n --
"(x-1)^" . . ;
: .rhs \ a -- a
a:len 1- >r
1 swap ( third .sgn r@ rot - .term -1 * ) a:each
nip rdrop ;
: .eqn \ a -- a
a:len 1- .lhs " = " . .rhs ;
: .binomials \ --
[] ( nextrow .eqn cr ) 8 times drop ;
: primerow? \ a -- a ?
a:len 3 < if false ;then
1 a:@ >r \ 2nd position is the number to check for primality
true swap ( nip dup 1 = swap r@ mod 0 = or and ) a:each swap
rdrop ;
: .primes-via-aks \ --
[] ( nextrow primerow? if 1 a:@ . space then ) 50 times drop ;
;with
.binomials cr
"The primes upto 50 are (via AKS): " . .primes-via-aks cr
bye

82
Task/AKS-test-for-primes/Elena/aks-test-for-primes.elena Normal file
View file

@ -0,0 +1,82 @@
import extensions.
singleton AksTest
{
static Array<long> c := V<long>(100).
coef(int n)
[
int i := 0.
int j := 0.
if ((n < 0) || (n > 63)) [ AbortException new; raise ]. // gracefully deal with range issue
c[i] := 1l.
while(i < n)
[
j := i.
c[1 + j] := 1l.
while (j > 0)
[
c[j] := c[j - 1] - c[j].
j -= 1
].
c[0] := c[0] negative.
i += 1
].
var t := c.
]
bool is_prime(int n)
[
int i := n.
self coef(n).
(c[0]) += 1.
(c[i]) -= 1.
i -= 1.
while ((i + 1 != 0) && (c[i+1] mod(n) == 0))
[
i -= 1
].
^ i < 0
]
show(int n)
[
int i := n.
i += 1.
while(i != 0)
[
i -= 1.
console print("+",c[i],"x^",i).
]
]
}
public program =
[
0 till:10 do(:n)<int>
[
AksTest coef(n).
console print("(x-1)^",n," = ").
AksTest show(n).
console printLine.
].
console print("Primes:").
1 to(63) do(:n)<int>
[
if (AksTest is_prime(n))
[
console print(n," ").
]
].
console printLine; readLine
].

25
Task/AKS-test-for-primes/Oforth/aks-test-for-primes.oforth
View file

@ -1,13 +1,20 @@
: nextCoef(prev)
| i |
ListBuffer new dup add(0)
prev size 1- loop: i [ dup add(prev at(i) prev at(i 1+) - ) ]
dup add(0) ;
import: mapping
: coefs(n) [ 0, 1, 0 ] #nextCoef times(n) extract(2, n 2 + ) ;
: isPrime(n) coefs(n) extract(2, n) conform(#[n mod 0 == ]) ;
: nextCoef( prev -- [] )
| i |
Array new 0 over dup
prev size 1- loop: i [ prev at(i) prev at(i 1+) - over add ]
0 over add
;
: coefs( n -- [] )
[ 0, 1, 0 ] #nextCoef times(n) extract(2, n 2 + ) ;
: prime?( n -- b)
coefs( n ) extract(2, n) conform?( #[n mod 0 == ] ) ;
: aks
| i |
0 10 for: i [ System.Out "(x-1)^" << i << " = " << coefs(i) << cr ]
50 seq filter(#isPrime) apply(#[ print " " print ]) printcr ;
0 10 for: i [ System.Out "(x-1)^" << i << " = " << coefs( i ) << cr ]
50 seq filter( #prime? ) apply(#.) printcr
;

31
Task/AKS-test-for-primes/Perl-6/aks-test-for-primes.pl6 Normal file
View file

@ -0,0 +1,31 @@
constant expansions = [1], [1,-1], -> @prior { [|@prior,0 Z- 0,|@prior] } ... *;
sub polyprime($p where 2..*) { so expansions[$p].[1 ..^ */2].all %% $p }
# Showing the expansions:
say ' p: (x-1)ᵖ';
say '-----------';
sub super ($n) {
$n.trans: '0123456789'
=> '⁰¹²³⁴⁵⁶⁷⁸⁹';
}
for ^13 -> $d {
say $d.fmt('%2i: '), (
expansions[$d].kv.map: -> $i, $n {
my $p = $d - $i;
[~] gather {
take < + - >[$n < 0] ~ ' ' unless $p == $d;
take $n.abs unless $p == $d > 0;
take 'x' if $p > 0;
take super $p - $i if $p > 1;
}
}
)
}
# And testing the function:
print "\nPrimes up to 100:\n { grep &polyprime, 2..100 }\n";

9
Task/AKS-test-for-primes/R/aks-test-for-primes.r Normal file
View file

@ -0,0 +1,9 @@
AKS<-function(p){
i<-2:p-1
l<-unique(factorial(p) / (factorial(p-i) * factorial(i)))
if(all(l%%p==0)){
print(noquote("It is prime."))
}else{
print(noquote("It isn't prime."))
}
}

81
Task/AKS-test-for-primes/REXX/aks-test-for-primes-2.rexx
View file

@ -1,41 +1,42 @@
/*REXX program calculates primes via the Agrawal─Kayal─Saxena (AKS) primality test.*/
parse arg Z .; if Z=='' then Z=200 /*Z not specified? Then use default.*/
OZ=Z; tell= Z<0; Z=abs(Z) /*Is Z negative? Then show expression.*/
numeric digits max(9, Z%3) /*define a dynamic # of decimal digits.*/
$.0='-'; $.1="+"; @.=1 /*$.x: sign char; default coefficients.*/
#= /*define list of prime numbers (so far)*/
do p=3 for Z; pm=p-1; pp=p+1 /*PM & PP: used as a coding convenience*/
do m=2 for pp%2-1; mm=m-1 /*calculate coefficients for a power. */
@.p.m=@.pm.mm + @.pm.m; h=pp-m /*calculate left side of coefficients*/
@.p.h=@.p.m /* " right " " " */
end /*m*/ /* [↑] The M DO loop creates both */
end /*p*/ /* sides in the same loop, saving */
/* a bunch of execution time. */
if tell then say '(x-1)^0: 1' /*possibly display the first expression*/
/* [↓] test for primality by division.*/
do n=2 for Z; nh=n%2; d=n-1 /*create expressions; find the primes.*/
do k=3 to nh while @.n.k//d==0 /*are coefficients divisible by N-1 ? */
end /*k*/ /* [↑] skip the 1st & 2nd coefficients*/
/* [↓] multiple THEN─IF faster than &s*/
if k>nh then if d\==1 then if d\==4 then #=# d /*add a number to prime list.*/
if \tell then iterate /*Don't tell? Don't show expressions.*/
y='(x-1)^'d": " /*define the 1st part of the expression*/
s=1 /*S: is the sign indicator (-1│+1).*/
do j=n for n-1 by -1; jm=j-1 /*create the higher powers first. */
if j==2 then xp='x' /*if power=1, then don't show the power*/
else xp='x^'jm /* ··· else show power with ^ */
if j==n then y=y xp /*no sign (+│-) for the 1st expression.*/
else y=y $.s || @.n.j'∙'xp /*build the expression with sign (+|-).*/
s=\s /*flip the sign for the next expression*/
end /*j*/ /* [↑] the sign (now) is either 0 │ 1,*/
/* and is displayed either - │ + */
say y $.s || 1 /*just show the first N expressions, */
end /*n*/ /* [↑] ··· but only for negative Z. */
say /* [↓] Has Z a leading + ? Then show.*/
if Z==word(. #, words(#)+1) then is= 'is' /*the number is a prime. */
else is= "isn't" /* " " isn't " " */
if left(OZ, 1)=='+' then say Z is 'prime.' /*display if OZ has a + (plus sign).*/
else say 'primes:' # /*display the prime number list. */
say /* [↓] the digit length of a big coef.*/
say 'Found ' words(#) " primes and the largest coefficient has " length(@.pm.h),
" decimal digits." /*stick a fork in it, we're all done. */
parse arg Z .; if Z=='' | Z=="," then Z=200 /*Z not specified? Then use default.*/
OZ=Z; tell= Z<0; Z=abs(Z) /*Is Z negative? Then show expression.*/
numeric digits max(9, Z % 3) /*define a dynamic # of decimal digits.*/
call AKS /*invoke the AKS funtion for coef. bld.*/
if left(OZ,1)=='+' then do; say Z isAksp(); exit /*display if Z is or isn't a prime.*/
end /* [↑] call isAKSp if Z has leading +.*/
say; say "primes found:" # /*display the prime number list. */
say; if \datatype(#, 'W') then exit /* [↓] the digit length of a big coef.*/
say 'Found ' words(#) " primes and the largest coefficient has " length(@.pm.h) @dd
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isAKSp: if z==word(#,words(#)) then return ' is a prime.'; else return " isn't a prime."
/*──────────────────────────────────────────────────────────────────────────────────────*/
AKS: $.0= '-'; $.1= "+"; @.=1 /*$.x: sign char; default coefficients.*/
q.=1; q.1=0; q.4=0 /*sparse array for faster comparisons. */
#=; L= length(Z) /*define list of prime numbers (so far)*/
do p=3 for Z; pm=p - 1; pp=p + 1 /*PM & PP: used as a coding convenience*/
do m=2 for pp % 2 - 1; mm=m - 1 /*calculate coefficients for a power. */
@.p.m= @.pm.mm + @.pm.m; h=pp - m /*calculate left side of coefficients*/
@.p.h= @.p.m /* " right " " " */
end /*m*/ /* [↑] The M DO loop creates both */
end /*p*/ /* sides in the same loop. */
if tell then say '(x-1)^'right(0, L)": 1" /*possibly display the first expression*/
@dd= 'decimal digits.' /* [↓] test for primality by division.*/
do n=2 for Z; nh=n % 2; d=n - 1 /*create expressions; find the primes.*/
do k=3 to nh while @.n.k//d==0 /*are coefficients divisible by N-1 ? */
end /*k*/ /* [↑] skip the 1st & 2nd coefficients*/
if k>nh then if q.d then #=# d /*add a number to the prime list. */
if \tell then iterate /*Don't tell? Don't show expressions.*/
y='(x-1)^'right(d, L)": " /*define the 1st part of the expression*/
s=1 /*S: is the sign indicator (-1│+1).*/
do j=n for n-1 by -1 /*create the higher powers first. */
if j==2 then xp= 'x' /*if power=1, then don't show the power*/
else xp= 'x^' || (j-1) /* ··· else show power with ^ */
if j==n then y=y xp /*no sign (+│-) for the 1st expression.*/
else y=y $.s || @.n.j'∙'xp /*build the expression with sign (+|-).*/
s= \s /*flip the sign for the next expression*/
end /*j*/ /* [↑] the sign (now) is either 0 │ 1,*/
say y $.s'1' /*just show the first N expressions, */
end /*n*/ /* [↑] ··· but only for negative Z. */
if #=='' then #='none'; return # /*if null, return "none"; else return #*/

4
Task/Abstract-type/Julia/abstract-type-1.julia
View file

@ -1,2 +1,2 @@
abstract «name»
abstract «name» <: «supertype»
abstract type «name» end
abstract type «name» <: «supertype» end

12
Task/Abstract-type/Julia/abstract-type-2.julia
View file

@ -1,6 +1,6 @@
abstract Number
abstract Real <: Number
abstract FloatingPoint <: Real
abstract Integer <: Real
abstract Signed <: Integer
abstract Unsigned <: Integer
abstract type Number end
abstract type Real <: Number end
abstract type FloatingPoint <: Real end
abstract type Integer <: Real end
abstract type Signed <: Integer end
abstract type Unsigned <: Integer end

4
Task/Abstract-type/Oforth/abstract-type-1.oforth
View file

@ -1,8 +1,8 @@
Property new: Spherical(r)
Spherical method: radius @r ;
Spherical method: setRadius := r ;
Spherical method: perimeter @r 2 * Pi * ;
Spherical method: surface @r sq Pi * 4 * ;
Spherical method: perimeter @r 2 * PI * ;
Spherical method: surface @r sq PI * 4 * ;
Object Class new: Ballon(color)
Ballon is: Spherical

3
Task/Abstract-type/Oforth/abstract-type-2.oforth
View file

@ -8,4 +8,5 @@
Planete new("Earth", 6371000.0) ->p
System.Out "Earth radius is : " << p radius << cr
System.Out "Earth perimeter is : " << p perimeter << cr
System.Out "Earth surface is : " << p surface << cr ;
System.Out "Earth surface is : " << p surface << cr
;

41
Task/Abundant,-deficient-and-perfect-number-classifications/Elena/abundant,-deficient-and-perfect-number-classifications.elena Normal file
View file

@ -0,0 +1,41 @@
import extensions.
classifyNumbers =
{
eval(int bound, ref<int> abundant, ref<int> deficient, ref<int> perfect)
[
int a := 0.
int d := 0.
int p := 0.
Array<int> sum := V<int>(bound + 1).
1 to(bound / 2) do(:divisor)<int>
[
(divisor + divisor) to:bound by:divisor do(:i)<int>
[
(sum[i]) += divisor
].
].
1 to:bound do(:i)<int>
[
int t := sum[i].
if (sum[i]<i) [ d += 1 ];
if (sum[i]>i) [ a += 1 ];
[ p += 1 ]
].
abundant value := a.
deficient value := d.
perfect value := p
]
}.
public program =
[
int abundant := 0.
int deficient := 0.
int perfect := 0.
classifyNumbers eval(20000, &abundant, &deficient, &perfect).
console printLine("Abundant: ",abundant,", Deficient: ",deficient,", Perfect: ",perfect).
].

0
Task/Abundant,-deficient-and-perfect-number-classifications/Erlang/abundant,-deficient-and-perfect-number-classifications.erl → Task/Abundant,-deficient-and-perfect-number-classifications/Erlang/abundant,-deficient-and-perfect-number-classifications-1.erl
View file

29
Task/Abundant,-deficient-and-perfect-number-classifications/Erlang/abundant,-deficient-and-perfect-number-classifications-2.erl Normal file
View file

@ -0,0 +1,29 @@
-module(proper_divisors).
-export([classify_range/2]).
classify_range(Start, Stop) ->
lists:foldl(fun (X, A) ->
Class = classify(X),
A#{Class => maps:get(Class, A, 0)+1} end,
#{},
lists:seq(Start, Stop)).
classify(N) ->
SumPD = lists:sum(proper_divisors(N)),
if
SumPD < N -> deficient;
SumPD =:= N -> perfect;
SumPD > N -> abundant
end.
proper_divisors(1) -> [];
proper_divisors(N) when N > 1, is_integer(N) ->
proper_divisors(2, math:sqrt(N), N, [1]).
proper_divisors(I, L, _, A) when I > L -> lists:sort(A);
proper_divisors(I, L, N, A) when N rem I =/= 0 ->
proper_divisors(I+1, L, N, A);
proper_divisors(I, L, N, A) when I * I =:= N ->
proper_divisors(I+1, L, N, [I|A]);
proper_divisors(I, L, N, A) ->
proper_divisors(I+1, L, N, [N div I, I|A]).

8
Task/Abundant,-deficient-and-perfect-number-classifications/Factor/abundant,-deficient-and-perfect-number-classifications.factor Normal file
View file

@ -0,0 +1,8 @@
USING: fry math.primes.factors math.ranges ;
: psum ( n -- m ) divisors but-last sum ;
: pcompare ( n -- <=> ) dup psum swap <=> ;
: classify ( -- seq ) 20,000 [1,b] [ pcompare ] map ;
: pcount ( <=> -- n ) '[ _ = ] count ;
classify [ +lt+ pcount "Deficient: " write . ]
[ +eq+ pcount "Perfect: " write . ]
[ +gt+ pcount "Abundant: " write . ] tri

47
Task/Abundant,-deficient-and-perfect-number-classifications/Modula-2/abundant,-deficient-and-perfect-number-classifications.mod2 Normal file
View file

@ -0,0 +1,47 @@
MODULE ADP;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;
PROCEDURE ProperDivisorSum(n : INTEGER) : INTEGER;
VAR i,sum : INTEGER;
BEGIN
sum := 0;
IF n<2 THEN
RETURN 0
END;
FOR i:=1 TO (n DIV 2) DO
IF n MOD i = 0 THEN
INC(sum,i)
END
END;
RETURN sum
END ProperDivisorSum;
VAR
buf : ARRAY[0..63] OF CHAR;
n : INTEGER;
d,p,a : INTEGER = 0;
sum : INTEGER;
BEGIN
FOR n:=1 TO 20000 DO
sum := ProperDivisorSum(n);
IF sum<n THEN
INC(d)
ELSIF sum=n THEN
INC(p)
ELSIF sum>n THEN
INC(a)
END
END;
WriteString("The classification of the numbers from 1 to 20,000 is as follows:");
WriteLn;
FormatString("Deficient = %i\n", buf, d);
WriteString(buf);
FormatString("Perfect = %i\n", buf, p);
WriteString(buf);
FormatString("Abundant = %i\n", buf, a);
WriteString(buf);
ReadChar
END ADP.

14
Task/Abundant,-deficient-and-perfect-number-classifications/Oforth/abundant,-deficient-and-perfect-number-classifications.oforth
View file

@ -1,14 +1,18 @@
Integer method: properDivs self 2 / seq filter(#[ self swap mod 0 == ]) ;
import: mapping
Integer method: properDivs -- []
self 2 / seq filter( #[ self swap mod 0 == ] ) ;
: numberClasses
| i deficient perfect s |
0 0 ->deficient ->perfect
0 20000 loop: i [
i properDivs sum ->s
0 #+ i properDivs apply ->s
s i < ifTrue: [ deficient 1+ ->deficient continue ]
s i == ifTrue: [ perfect 1+ ->perfect continue ]
1+
]
"Deficients : " print deficient println
"Perfects : " print perfect println
"Abundant : " print println ;
"Deficients :" . deficient .cr
"Perfects :" . perfect .cr
"Abundant :" . .cr
;

2
Task/Abundant,-deficient-and-perfect-number-classifications/Ruby/abundant,-deficient-and-perfect-number-classifications.rb
View file

@ -1,3 +1,3 @@
res = Hash.new(0)
(1 .. 20_000).each{|n| res[n.proper_divisors.inject(0, :+) <=> n] += 1}
(1 .. 20_000).each{|n| res[n.proper_divisors.sum <=> n] += 1}
puts "Deficient: #{res[-1]} Perfect: #{res[0]} Abundant: #{res[1]}"

32
Task/Abundant,-deficient-and-perfect-number-classifications/VBA/abundant,-deficient-and-perfect-number-classifications.vba Normal file
View file

@ -0,0 +1,32 @@
Option Explicit
Public Sub Nb_Classifications()
Dim A As New Collection, D As New Collection, P As New Collection
Dim n As Long, l As Long, s As String, t As Single
t = Timer
'Start
For n = 1 To 20000
l = SumPropers(n): s = CStr(n)
Select Case n
Case Is > l: D.Add s, s
Case Is < l: A.Add s, s
Case l: P.Add s, s
End Select
Next
'End. Return :
Debug.Print "Execution Time : " & Timer - t & " seconds."
Debug.Print "-------------------------------------------"
Debug.Print "Deficient := " & D.Count
Debug.Print "Perfect := " & P.Count
Debug.Print "Abundant := " & A.Count
End Sub
Private Function SumPropers(n As Long) As Long
'returns the sum of the proper divisors of n
Dim j As Long
For j = 1 To n \ 2
If n Mod j = 0 Then SumPropers = j + SumPropers
Next
End Function

8
Task/Accumulator-factory/Astro/accumulator-factory.astro
View file

@ -1,5 +1,5 @@
fun accumulator(sum): |n| -> sum += n
let f = accumulator(5)
print f(5) # 10
print f(10) # 20
fun accumulator(sum) = |n| => sum += n
let f = accumulator(5.)
print f(5) # 10.0
print f(10) # 20.0
print f(2.4) # 22.4

23
Task/Accumulator-factory/Elena/accumulator-factory.elena
View file

@ -1,21 +1,16 @@
import system'dynamic.
function =
(:acc)((:n)(acc append:n)).
Function =
(:x)(closure append:x).
accumulator =
(:n)(function(Variable new(n))).
extension op
{
accumulatorOf:func
= Variable new(self); mixInto(func).
}
program =
public program =
[
var x := 1 accumulatorOf(Function).
var x := accumulator(1).
x eval(5).
x(5).
var y := 3 accumulatorOf(Function).
var y := accumulator(3).
console write(x eval(2.3r)).
console write(x(2.3r)).
].

1
Task/Accumulator-factory/Factor/accumulator-factory.factor
View file

@ -1,3 +1,4 @@
USE: locals
:: accumulator ( n! -- quot ) [ n + dup n! ] ;
1 accumulator

33
Task/Accumulator-factory/Java/accumulator-factory-1.java
View file

@ -1,16 +1,29 @@
public class Accumulator {
private double sum;
public Accumulator(double sum0) {
sum = sum0;
public class Accumulator
//implements java.util.function.UnaryOperator<Number> // Java 8
{
private Number sum;
public Accumulator(Number sum0) {
sum = sum0;
}
public double call(double n) {
return sum += n;
public Number apply(Number n) {
// Acts like sum += n, but chooses long or double.
// Converts weird types (like BigInteger) to double.
return (longable(sum) && longable(n)) ?
(sum = sum.longValue() + n.longValue()) :
(sum = sum.doubleValue() + n.doubleValue());
}
private static boolean longable(Number n) {
return n instanceof Byte || n instanceof Short ||
n instanceof Integer || n instanceof Long;
}
public static void main(String[] args) {
Accumulator x = new Accumulator(1);
x.call(5);
System.out.println(new Accumulator(3));
System.out.println(x.call(2.3));
Accumulator x = new Accumulator(1);
x.apply(5);
new Accumulator(3);
System.out.println(x.apply(2.3));
}
}

31
Task/Accumulator-factory/Java/accumulator-factory-2.java
View file

@ -1,16 +1,27 @@
public class Accumulator {
private double sum;
public Accumulator(double sum0) {
sum = sum0;
import java.util.function.UnaryOperator;
public class AccumulatorFactory {
public static UnaryOperator<Number> accumulator(Number sum0) {
// Allows sum[0] = ... inside lambda.
Number[] sum = { sum0 };
// Acts like n -> sum[0] += n, but chooses long or double.
// Converts weird types (like BigInteger) to double.
return n -> (longable(sum[0]) && longable(n)) ?
(sum[0] = sum[0].longValue() + n.longValue()) :
(sum[0] = sum[0].doubleValue() + n.doubleValue());
}
public double call(double n) {
return sum += n;
private static boolean longable(Number n) {
return n instanceof Byte || n instanceof Short ||
n instanceof Integer || n instanceof Long;
}
public static void main(String[] args) {
Accumulator x = new Accumulator(1);
x.call(5);
System.out.println(new Accumulator(3));
System.out.println(x.call(2.3));
UnaryOperator<Number> x = accumulator(1);
x.apply(5);
accumulator(3);
System.out.println(x.apply(2.3));
}
}

7
Task/Accumulator-factory/Julia/accumulator-factory.julia
View file

@ -1,7 +1,10 @@
function accumulator(i)
f(n) = i += n
return f
end
x = accumulator(1)
x(5)
@show x(5)
accumulator(3)
x(2.3)
@show x(2.3)

6
Task/Accumulator-factory/Oforth/accumulator-factory-1.oforth
View file

@ -1,4 +1,2 @@
: foo(n)
| ch |
Channel new dup ->ch send(n) drop
#[ ch receive swap + dup ch send drop ] ;
: foo( n -- bl )
#[ n swap + dup ->n ] ;

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