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

September Morn Update

Browse source
This commit is contained in:
Ingy döt Net 2019-09-12 10:33:56 -07:00
parent 4e2d22a71d
commit aac6731f2c
6856 changed files with 141342 additions and 21127 deletions
Download patch file Download diff file Expand all files Collapse all files

1
Task/100-doors/00META.yaml Normal file
View file

@ -0,0 +1 @@
--- {}

154
Task/100-doors/ARM-Assembly/100-doors-1.arm Normal file
View file

@ -0,0 +1,154 @@
/* ARM assembly Raspberry PI */
/* program 100doors.s */
/************************************/
/* Constantes */
/************************************/
.equ STDOUT, 1 @ Linux output console
.equ EXIT, 1 @ Linux syscall
.equ WRITE, 4 @ Linux syscall
.equ NBDOORS, 100
/*********************************/
/* Initialized data */
/*********************************/
.data
sMessResult: .ascii "The door "
sMessValeur: .fill 11, 1, ' ' @ size => 11
.asciz "is open.\n"
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
stTableDoors: .skip 4 * NBDOORS
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
push {fp,lr} @ saves 2 registers
@ display first line
ldr r3,iAdrstTableDoors @ table address
mov r5,#1
1:
mov r4,r5
2: @ begin loop
ldr r2,[r3,r4,lsl #2] @ read doors index r4
cmp r2,#0
moveq r2,#1 @ if r2 = 0 1 -> r2
movne r2,#0 @ if r2 = 1 0 -> r2
str r2,[r3,r4,lsl #2] @ store value of doors
add r4,r5 @ increment r4 with r5 value
cmp r4,#NBDOORS @ number of doors ?
ble 2b @ no -> loop
add r5,#1 @ increment the increment !!
cmp r5,#NBDOORS @ number of doors ?
ble 1b @ no -> loop
@ loop display state doors
mov r4,#0
3:
ldr r2,[r3,r4,lsl #2] @ read state doors r4 index
cmp r2,#0
beq 4f
mov r0,r4 @ open -> display message
ldr r1,iAdrsMessValeur @ display value index
bl conversion10 @ call function
ldr r0,iAdrsMessResult
bl affichageMess @ display message
4:
add r4,#1
cmp r4,#NBDOORS
ble 3b @ loop
100: @ standard end of the program
mov r0, #0 @ return code
pop {fp,lr} @restaur 2 registers
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrsMessValeur: .int sMessValeur
iAdrstTableDoors: .int stTableDoors
iAdrsMessResult: .int sMessResult
/******************************************************************/
/* display text with size calculation */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
push {r0,r1,r2,r7,lr} @ save registres
mov r2,#0 @ counter length
1: @ loop length calculation
ldrb r1,[r0,r2] @ read octet start position + index
cmp r1,#0 @ if 0 its over
addne r2,r2,#1 @ else add 1 in the length
bne 1b @ and loop
@ so here r2 contains the length of the message
mov r1,r0 @ address message in r1
mov r0,#STDOUT @ code to write to the standard output Linux
mov r7, #WRITE @ code call system "write"
svc #0 @ call systeme
pop {r0,r1,r2,r7,lr} @ restaur des 2 registres */
bx lr @ return
/******************************************************************/
/* Converting a register to a decimal unsigned */
/******************************************************************/
/* r0 contains value and r1 address area */
/* r0 return size of result (no zero final in area) */
/* area size => 11 bytes */
.equ LGZONECAL, 10
conversion10:
push {r1-r4,lr} @ save registers
mov r3,r1
mov r2,#LGZONECAL
1: @ start loop
bl divisionpar10U @unsigned r0 <- dividende. quotient ->r0 reste -> r1
add r1,#48 @ digit
strb r1,[r3,r2] @ store digit on area
cmp r0,#0 @ stop if quotient = 0
subne r2,#1 @ else previous position
bne 1b @ and loop
// and move digit from left of area
mov r4,#0
2:
ldrb r1,[r3,r2]
strb r1,[r3,r4]
add r2,#1
add r4,#1
cmp r2,#LGZONECAL
ble 2b
// and move spaces in end on area
mov r0,r4 @ result length
mov r1,#' ' @ space
3:
strb r1,[r3,r4] @ store space in area
add r4,#1 @ next position
cmp r4,#LGZONECAL
ble 3b @ loop if r4 <= area size
100:
pop {r1-r4,lr} @ restaur registres
bx lr @return
/***************************************************/
/* division par 10 unsigned */
/***************************************************/
/* r0 dividende */
/* r0 quotient */
/* r1 remainder */
divisionpar10U:
push {r2,r3,r4, lr}
mov r4,r0 @ save value
//mov r3,#0xCCCD @ r3 <- magic_number lower @ for Raspberry pi 3
//movt r3,#0xCCCC @ r3 <- magic_number upper @ for Raspberry pi 3
ldr r3,iMagicNumber @ for Raspberry pi 1 2
umull r1, r2, r3, r0 @ r1<- Lower32Bits(r1*r0) r2<- Upper32Bits(r1*r0)
mov r0, r2, LSR #3 @ r2 <- r2 >> shift 3
add r2,r0,r0, lsl #2 @ r2 <- r0 * 5
sub r1,r4,r2, lsl #1 @ r1 <- r4 - (r2 * 2) = r4 - (r0 * 10)
pop {r2,r3,r4,lr}
bx lr @ leave function
iMagicNumber: .int 0xCCCCCCCD

136
Task/100-doors/ARM-Assembly/100-doors-2.arm Normal file
View file

@ -0,0 +1,136 @@
/*********************************************/
/* optimized version */
/*********************************************/
/* ARM assembly Raspberry PI */
/* program 100doors.s */
/************************************/
/* Constantes */
/************************************/
.equ STDOUT, 1 @ Linux output console
.equ EXIT, 1 @ Linux syscall
.equ WRITE, 4 @ Linux syscall
.equ NBDOORS, 100
/*********************************/
/* Initialized data */
/*********************************/
.data
sMessResult: .ascii "The door "
sMessValeur: .fill 11, 1, ' ' @ size => 11
.asciz "is open.\n"
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
push {fp,lr} @ saves 2 registers
@ display first line
mov r5,#3 @ start value of increment
mov r4,#1 @ start doors
@ loop display state doors
1:
mov r0,r4 @ open -> display message
ldr r1,iAdrsMessValeur @ display value index
bl conversion10 @ call function
ldr r0,iAdrsMessResult
bl affichageMess @ display message
add r4,r5 @ add increment
add r5,#2 @ new increment
cmp r4,#NBDOORS
ble 1b @ loop
100: @ standard end of the program
mov r0, #0 @ return code
pop {fp,lr} @ restaur 2 registers
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrsMessValeur: .int sMessValeur
iAdrsMessResult: .int sMessResult
/******************************************************************/
/* display text with size calculation */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
push {r0,r1,r2,r7,lr} @ save registres
mov r2,#0 @ counter length
1: @ loop length calculation
ldrb r1,[r0,r2] @ read octet start position + index
cmp r1,#0 @ if 0 its over
addne r2,r2,#1 @ else add 1 in the length
bne 1b @ and loop
@ so here r2 contains the length of the message
mov r1,r0 @ address message in r1
mov r0,#STDOUT @ code to write to the standard output Linux
mov r7, #WRITE @ code call system "write"
svc #0 @ call systeme
pop {r0,r1,r2,r7,lr} @ restaur des 2 registres */
bx lr @ return
/******************************************************************/
/* Converting a register to a decimal unsigned */
/******************************************************************/
/* r0 contains value and r1 address area */
/* r0 return size of result (no zero final in area) */
/* area size => 11 bytes */
.equ LGZONECAL, 10
conversion10:
push {r1-r4,lr} @ save registers
mov r3,r1
mov r2,#LGZONECAL
1: @ start loop
bl divisionpar10U @ unsigned r0 <- dividende. quotient ->r0 reste -> r1
add r1,#48 @ digit
strb r1,[r3,r2] @ store digit on area
cmp r0,#0 @ stop if quotient = 0
subne r2,#1 @ else previous position
bne 1b @ and loop
@ and move digit from left of area
mov r4,#0
2:
ldrb r1,[r3,r2]
strb r1,[r3,r4]
add r2,#1
add r4,#1
cmp r2,#LGZONECAL
ble 2b
@ and move spaces in end on area
mov r0,r4 @ result length
mov r1,#' ' @ space
3:
strb r1,[r3,r4] @ store space in area
add r4,#1 @ next position
cmp r4,#LGZONECAL
ble 3b @ loop if r4 <= area size
100:
pop {r1-r4,lr} @ restaur registres
bx lr @return
/***************************************************/
/* division par 10 unsigned */
/***************************************************/
/* r0 dividende */
/* r0 quotient */
/* r1 remainder */
divisionpar10U:
push {r2,r3,r4, lr}
mov r4,r0 @ save value
//mov r3,#0xCCCD @ r3 <- magic_number lower @ for raspberry 3
//movt r3,#0xCCCC @ r3 <- magic_number upper @ for raspberry 3
ldr r3,iMagicNumber @ for raspberry 1 2
umull r1, r2, r3, r0 @ r1<- Lower32Bits(r1*r0) r2<- Upper32Bits(r1*r0)
mov r0, r2, LSR #3 @ r2 <- r2 >> shift 3
add r2,r0,r0, lsl #2 @ r2 <- r0 * 5
sub r1,r4,r2, lsl #1 @ r1 <- r4 - (r2 * 2) = r4 - (r0 * 10)
pop {r2,r3,r4,lr}
bx lr @ leave function
iMagicNumber: .int 0xCCCCCCCD

29
Task/100-doors/B/100-doors.b Normal file
View file

@ -0,0 +1,29 @@
main()
{
auto doors[100]; /* != 0 means open */
auto pass, door;
door = 0;
while( door<100 ) doors[door++] = 0;
pass = 0;
while( pass<100 )
{
door = pass;
while( door<100 )
{
doors[door] = !doors[door];
door =+ pass+1;
}
++pass;
}
door = 0;
while( door<100 )
{
printf("door #%d is %s.*n", door+1, doors[door] ? "open" : "closed");
++door;
}
return(0);
}

9
Task/100-doors/BASIC/100-doors-10.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

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

@ -1,22 +1,13 @@
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 PROGRAM "100doors.bas"
110 NUMERIC D(1 TO 100)
120 FOR I=1 TO 100
130 LET D(I)=0
140 NEXT
150 FOR I=1 TO 100
160 FOR J=I TO 100 STEP I
170 LET D(J)=NOT D(J)
180 NEXT
190 NEXT
200 FOR I=1 TO 100
210 IF D(I) THEN PRINT I
220 NEXT

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

@ -1,16 +1,6 @@
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 PROGRAM "100doors.bas"
110 LET NR=1:LET D=3
120 DO
130 PRINT NR
140 LET NR=NR+D:LET D=D+2
150 LOOP WHILE NR<=100

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

@ -1,12 +1,22 @@
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
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

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

@ -1,10 +1,16 @@
'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
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

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

@ -1,9 +1,12 @@
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 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
Task/100-doors/BASIC/100-doors-9.basic Normal file
View file

@ -0,0 +1,10 @@
'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

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

@ -1,6 +1,6 @@
(defun doors (n)
(loop for a from 1 to n collect
(if (zerop (mod (sqrt a) 1)) t nil)))
(zerop (mod (sqrt a) 1))))
> (doors 100)
(T NIL NIL T NIL NIL NIL NIL T NIL NIL NIL NIL NIL NIL T NIL NIL NIL NIL NIL

2
Task/100-doors/Component-Pascal/100-doors.component
View file

@ -6,7 +6,7 @@ VAR
i,j: INTEGER;
closed: ARRAY 101 OF BOOLEAN;
BEGIN
(* initilization of close to true *)
(* initialization of closed to true *)
FOR i := 0 TO LEN(closed) - 1 DO closed[i] := TRUE END;
(* process *)
FOR i := 1 TO LEN(closed) DO;

26
Task/100-doors/Dart/100-doors-3.dart Normal file
View file

@ -0,0 +1,26 @@
import 'dart:io';
final numDoors = 100;
final List<bool> doorClosed = List(numDoors);
String stateToString(String message) {
var res = '';
for (var i = 0; i < numDoors; i++) {
res += (doorClosed[i] ? 'X' : '\u2610');
}
return res + " " + message;
}
main() {
for (var i = 0; i < numDoors; i++) {
doorClosed[i] = true;
}
stdout.writeln(stateToString("after initialization"));
for (var step = 1; step <= numDoors; step++) {
final start = step - 1;
for (var i = start; i < numDoors; i += step) {
doorClosed[i] = !doorClosed[i];
}
stdout.writeln(stateToString("after toggling with step = $step"));
}
}

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

@ -1,22 +1,21 @@
import system'routines.
import extensions.
import system'routines;
import extensions;
public program
[
var Doors := Array new:100; populate(:n)( false ).
public program()
{
var Doors := Array.allocate(100).populate:(n=>false);
for(int i := 0, i < 100, i := i + 1)
{
for(int j := i, j < 100, j := j + i + 1)
{
Doors[j] := Doors[j].Inverted
}
};
0 till:100 do(:i)
[
i till:100 by(i + 1) do(:j)
[
Doors[j] := Doors[j] not
]
].
for(int i := 0, i < 100, i := i + 1)
{
console.printLine("Door #",i + 1," :",Doors[i].iif("Open","Closed"))
};
0 till:100 do(:i)
[
console printLine("Door #",i + 1," :",Doors[i] iif("Open","Closed"))
].
console readChar.
]
console.readChar()
}

3
Task/100-doors/Elm/100-doors.elm
View file

@ -1,6 +1,7 @@
-- Unoptimized
import List exposing (indexedMap, foldl, repeat, range)
import Html exposing (text)
import Debug exposing (toString)
type Door = Open | Closed
@ -8,7 +9,7 @@ toggle d = if d == Open then Closed else Open
toggleEvery : Int -> List Door -> List Door
toggleEvery k doors = indexedMap
(\i door -> if i % k == 0 then toggle door else door)
(\i door -> if modBy k (i+1) == 0 then toggle door else door)
doors
n = 100

10
Task/100-doors/Fish/100-doors.fish Normal file
View file

@ -0,0 +1,10 @@
1001-p01.
>0101-p02.
>101-g001-g+:::aa*)?v101-p03.
>02-g?v1}02-p02. >05.
>0}02-p02.
>~~~0101-p001-g:1+001-paa*)?v02.
>07.
>0101-p08.
>101-g::02-g?v >1+:101-paa*=?;
>n" "o^

34
Task/100-doors/Free-Pascal/100-doors.free Normal file
View file

@ -0,0 +1,34 @@
program OneHundredIsOpen;
const
DoorCount = 100;
var
IsOpen: array[1..DoorCount] of boolean;
Door, Jump: integer;
begin
// Close all doors
for Door := 1 to DoorCount do
IsOpen[Door] := False;
// Iterations
for Jump := 1 to DoorCount do
begin
Door := Jump;
repeat
IsOpen[Door] := not IsOpen[Door];
Door := Door + Jump;
until Door > DoorCount;
end;
// Show final status
for Door := 1 to DoorCount do
begin
Write(Door, ' ');
if IsOpen[Door] then
WriteLn('open')
else
WriteLn('closed');
end;
// Wait for <enter>
Readln;
end.

12
Task/100-doors/Futhark/100-doors.futhark
View file

@ -1,11 +1,9 @@
fun main(n: int): [n]bool =
let is_open = replicate n False
loop (is_open) = for i < n do
let main(n: i32): [n]bool =
loop is_open = replicate n false for i < n do
let js = map (*i+1) (iota n)
let flips = map (fn j =>
let flips = map (\j ->
if j < n
then unsafe !is_open[j]
else True -- Doesn't matter.
else true -- Doesn't matter.
) js
in write js flips is_open
in is_open
in scatter is_open js flips

2
Task/100-doors/Go/100-doors-1.go
View file

@ -3,7 +3,7 @@ package main
import "fmt"
func main() {
doors := make([]bool, 100)
doors := [100]bool{}
// the 100 passes called for in the task description
for pass := 1; pass <= 100; pass++ {

52
Task/100-doors/Mercury/100-doors.mercury
View file

@ -1,33 +1,39 @@
:- module doors.
:- interface.
:- import_module array, io, int.
:- type door ---> open ; closed.
:- type doors == array(door).
:- func toggle(door) = door.
:- pred walk(int::in, doors::in, doors::out) is semidet.
:- pred walks(int::in, int::in, doors::in, doors::out) is det.
:- import_module io.
:- pred main(io::di, io::uo) is det.
:- implementation.
:- import_module bitmap, bool, list, string, int.
toggle(open) = closed.
toggle(closed) = open.
:- func doors = bitmap.
doors = bitmap.init(100, no).
walk(N, !D) :- walk(N, N, !D).
:- pred walk(int, bitmap, bitmap).
:- mode walk(in, bitmap_di, bitmap_uo) is det.
walk(Pass, !Doors) :-
walk(Pass, Pass, !Doors).
:- pred walk(int::in, int::in, doors::in, doors::out) is semidet.
walk(At, By, !D) :-
semidet_lookup(!.D, At - 1, Door),
slow_set(At - 1, toggle(Door), !D),
( walk(At + By, By, !D) -> true ; true ).
:- pred walk(int, int, bitmap, bitmap).
:- mode walk(in, in, bitmap_di, bitmap_uo) is det.
walk(At, By, !Doors) :-
( if bitmap.in_range(!.Doors, At - 1) then
bitmap.unsafe_flip(At - 1, !Doors),
walk(At + By, By, !Doors)
else
true
).
walks(N, End, !D) :-
( N =< End, walk(N, !D) -> walks(N + 1, End, !D) ; true ).
:- pred report(bitmap, int, io, io).
:- mode report(bitmap_di, in, di, uo) is det.
report(Doors, N, !IO) :-
( if is_set(Doors, N - 1) then
State = "open"
else
State = "closed"
),
io.format("door #%d is %s\n",
[i(N), s(State)], !IO).
main(!IO) :-
io.write(Doors1, !IO), io.nl(!IO),
array.init(100, closed, Doors0),
walks(1, 100, Doors0, Doors1).
list.foldl(walk, 1 .. 100, doors, Doors),
list.foldl(report(Doors), 1 .. 100, !IO).

13
Task/100-doors/Ol/100-doors.ol Normal file
View file

@ -0,0 +1,13 @@
(define (flip doors every)
(map (lambda (door num)
(mod (+ door (if (eq? (mod num every) 0) 1 0)) 2))
doors
(iota (length doors) 1)))
(define doors
(let loop ((doors (repeat 0 100)) (n 1))
(if (eq? n 100)
doors
(loop (flip doors n) (+ n 1)))))
(print "100th doors: " doors)

4
Task/100-doors/PARI-GP/100-doors-3.pari Normal file
View file

@ -0,0 +1,4 @@
doors =vector(100);
print("open doors are : ");
for(i=1,100,for(j=i,100,doors[j]=!doors[j];j +=i-1))
for(k=1,100,if(doors[k]==1,print1(" ",k)))

16
Task/100-doors/Picat/100-doors-1.picat Normal file
View file

@ -0,0 +1,16 @@
doors(N) =>
Doors = new_array(N),
foreach(I in 1..N) Doors[I] := 0 end,
foreach(I in 1..N)
foreach(J in I..I..N)
Doors[J] := 1^Doors[J]
end,
if N <= 10 then
print_open(Doors)
end
end,
println(Doors),
print_open(Doors),
nl.
print_open(Doors) => println([I : I in 1..Doors.length, Doors[I] == 1]).

6
Task/100-doors/Picat/100-doors-2.picat Normal file
View file

@ -0,0 +1,6 @@
doors_opt(N) =>
foreach(I in 1..N)
Root = sqrt(I),
println([I, cond(Root == 1.0*round(Root), open, closed)])
end,
nl.

2
Task/100-doors/Picat/100-doors-3.picat Normal file
View file

@ -0,0 +1,2 @@
doors_opt2(N) =>
println([I**2 : I in 1..N, I**2 <= N]).

114
Task/100-doors/Pony/100-doors.pony Normal file
View file

@ -0,0 +1,114 @@
actor Toggler
let doors:Array[Bool]
let env: Env
new create(count:USize,_env:Env) =>
var i:USize=0
doors=Array[Bool](count)
env=_env
while doors.size() < count do
doors.push(false)
end
be togglin(interval : USize)=>
var i:USize=0
try
while i < doors.size() do
doors.update(i,not doors(i)?)?
i=i+interval
end
else
env.out.print("Errored while togglin'!")
end
be printn(onlyOpen:Bool)=>
try
for i in doors.keys() do
if onlyOpen and not doors(i)? then
continue
end
env.out.print("Door " + i.string() + " is " +
if doors(i)? then
"Open"
else
"closed"
end)
end
else
env.out.print("Error!")
end
true
actor OptimizedToggler
let doors:Array[Bool]
let env:Env
new create(count:USize,_env:Env)=>
env=_env
doors=Array[Bool](count)
while doors.size()<count do
doors.push(false)
end
be togglin()=>
var i:USize=0
if alreadydone then
return
end
try
doors.update(0,true)?
doors.update(1,true)?
while i < doors.size() do
i=i+1
let z=i*i
let x=z*z
if z > doors.size() then
break
else
doors.update(z,true)?
end
if x < doors.size() then
doors.update(x,true)?
end
end
end
be printn(onlyOpen:Bool)=>
try
for i in doors.keys() do
if onlyOpen and not doors(i)? then
continue
end
env.out.print("Door " + i.string() + " is " +
if doors(i)? then
"Open"
else
"closed"
end)
end
else
env.out.print("Error!")
end
true
actor Main
new create(env:Env)=>
var count: USize =100
try
let index=env.args.find("-n",0,0,{(l,r)=>l==r})?
try
match env.args(index+1)?.read_int[USize]()?
| (let x:USize, _)=>count=x
end
else
env.out.print("You either neglected to provide an argument after -n or that argument was not an integer greater than zero.")
return
end
end
if env.args.contains("optimized",{(l,r)=>r==l}) then
let toggler=OptimizedToggler(count,env)
var i:USize = 1
toggler.togglin()
toggler.printn(env.args.contains("onlyopen", {(l,r)=>l==r}))
else
let toggler=Toggler(count,env)
var i:USize = 1
while i < count do
toggler.togglin(i)
i=i+1
end
toggler.printn(env.args.contains("onlyopen", {(l,r)=>l==r}))
end

78
Task/100-doors/Pure-Data/100-doors.pure Normal file
View file

@ -0,0 +1,78 @@
100Doors.pd
#N canvas 241 375 414 447 10;
#X obj 63 256 expr doors[$f1] = doors[$f1] ^ 1;
#X msg 83 118 \; doors const 0;
#X msg 44 66 bang;
#X obj 44 92 t b b b;
#X obj 43 28 table doors 101;
#X obj 44 360 sel 0;
#X obj 44 336 expr if (doors[$f1] == 1 \, $f1 \, 0);
#X obj 63 204 t b f f;
#X text 81 66 run;
#X obj 71 384 print -n;
#X text 132 310 print results (open doors);
#X obj 63 179 loop 1 100 1;
#X obj 63 231 loop 1 100 1;
#X obj 44 310 loop 1 100 1;
#X text 148 28 create array;
#X text 151 180 100 passes;
#X text 179 123 set values to 0;
#X connect 2 0 3 0;
#X connect 3 0 13 0;
#X connect 3 1 11 0;
#X connect 3 2 1 0;
#X connect 5 1 9 0;
#X connect 6 0 5 0;
#X connect 7 0 12 0;
#X connect 7 1 12 1;
#X connect 7 2 12 3;
#X connect 11 0 7 0;
#X connect 12 0 0 0;
#X connect 13 0 6 0;
loop.pd
#N canvas 656 375 427 447 10;
#X obj 62 179 until;
#X obj 102 200 f;
#X obj 62 89 inlet;
#X obj 303 158 f \$3;
#X obj 270 339 outlet;
#X obj 223 89 inlet;
#X obj 138 89 inlet;
#X obj 324 89 inlet;
#X obj 117 158 f \$1;
#X text 323 68 step;
#X obj 202 158 f \$2;
#X obj 62 118 t b b b b;
#X obj 270 315 spigot;
#X obj 89 314 sel 0;
#X obj 137 206 +;
#X obj 102 237 expr $f1 \; if ($f3 > 0 \, if ($f1 > $f2 \, 0 \, 1)
\, if ($f3 < 0 \, if ($f1 < $f2 \, 0 \, 1) \, 0)), f 34;
#X text 63 68 run;
#X text 136 68 start;
#X text 227 68 end;
#X text 58 31 loop (abstraction);
#X connect 0 0 1 0;
#X connect 1 0 14 0;
#X connect 1 0 15 0;
#X connect 2 0 11 0;
#X connect 3 0 14 1;
#X connect 3 0 15 2;
#X connect 5 0 10 1;
#X connect 6 0 8 1;
#X connect 7 0 3 1;
#X connect 8 0 1 1;
#X connect 10 0 15 1;
#X connect 11 0 0 0;
#X connect 11 1 8 0;
#X connect 11 2 10 0;
#X connect 11 3 3 0;
#X connect 12 0 4 0;
#X connect 13 0 0 1;
#X connect 14 0 1 1;
#X connect 15 0 12 0;
#X connect 15 1 12 1;
#X connect 15 1 13 0;

34
Task/100-doors/Spin/100-doors.spin Normal file
View file

@ -0,0 +1,34 @@
con
_clkmode = xtal1+pll16x
_clkfreq = 80_000_000
obj
ser : "FullDuplexSerial.spin"
pub init
ser.start(31, 30, 0, 115200)
doors
waitcnt(_clkfreq + cnt)
ser.stop
cogstop(0)
var
byte door[101] ' waste one byte by using only door[1..100]
pri doors | i,j
repeat i from 1 to 100
repeat j from i to 100 step i
not door[j]
ser.str(string("Open doors: "))
repeat i from 1 to 100
if door[i]
ser.dec(i)
ser.tx(32)
ser.str(string(13,10))

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

@ -3,7 +3,7 @@ set obs 100
gen doors=0
gen index=_n
forvalues i=1/100 {
quietly replace doors=1-doors if mod(_n,`i')==0
quietly replace doors=!doors if mod(_n,`i')==0
}
list index if doors, noobs noheader

7
Task/100-doors/Xojo/100-doors.xojo Normal file
View file

@ -0,0 +1,7 @@
// True=Open; False=Closed
Dim doors(100) As Boolean // Booleans default to false
For j As Integer = 1 To 100
For i As Integer = 1 to 100
If i Mod j = 0 Then doors(i) = Not doors(i)
Next
Next

1
Task/24-game-Solve/00META.yaml Normal file
View file

@ -0,0 +1 @@
--- {}

133
Task/24-game-Solve/Ceylon/24-game-solve.ceylon Normal file
View file

@ -0,0 +1,133 @@
import ceylon.random {
DefaultRandom
}
shared sealed class Rational(numerator, denominator = 1) satisfies Numeric<Rational> {
shared Integer numerator;
shared Integer denominator;
Integer gcd(Integer a, Integer b) => if (b == 0) then a else gcd(b, a % b);
shared Rational inverted => Rational(denominator, numerator);
shared Rational simplified =>
let (largestFactor = gcd(numerator, denominator))
Rational(numerator / largestFactor, denominator / largestFactor);
divided(Rational other) => (this * other.inverted).simplified;
negated => Rational(-numerator, denominator).simplified;
plus(Rational other) =>
let (top = numerator*other.denominator + other.numerator*denominator,
bottom = denominator * other.denominator)
Rational(top, bottom).simplified;
times(Rational other) =>
Rational(numerator * other.numerator, denominator * other.denominator).simplified;
shared Integer integer => numerator / denominator;
shared Float float => numerator.float / denominator.float;
string => denominator == 1 then numerator.string else "``numerator``/``denominator``";
shared actual Boolean equals(Object that) {
if (is Rational that) {
value simplifiedThis = this.simplified;
value simplifiedThat = that.simplified;
return simplifiedThis.numerator==simplifiedThat.numerator &&
simplifiedThis.denominator==simplifiedThat.denominator;
} else {
return false;
}
}
}
shared Rational? rational(Integer numerator, Integer denominator = 1) =>
if (denominator == 0)
then null
else Rational(numerator, denominator).simplified;
shared Rational numeratorOverOne(Integer numerator) => Rational(numerator);
shared abstract class Operation(String lexeme) of addition | subtraction | multiplication | division {
shared formal Rational perform(Rational left, Rational right);
string => lexeme;
}
shared object addition extends Operation("+") {
perform(Rational left, Rational right) => left + right;
}
shared object subtraction extends Operation("-") {
perform(Rational left, Rational right) => left - right;
}
shared object multiplication extends Operation("*") {
perform(Rational left, Rational right) => left * right;
}
shared object division extends Operation("/") {
perform(Rational left, Rational right) => left / right;
}
shared Operation[] operations = `Operation`.caseValues;
shared interface Expression of NumberExpression | OperationExpression {
shared formal Rational evaluate();
}
shared class NumberExpression(Rational number) satisfies Expression {
evaluate() => number;
string => number.string;
}
shared class OperationExpression(Expression left, Operation op, Expression right) satisfies Expression {
evaluate() => op.perform(left.evaluate(), right.evaluate());
string => "(``left`` ``op`` ``right``)";
}
shared void run() {
value twentyfour = numeratorOverOne(24);
value random = DefaultRandom();
function buildExpressions({Rational*} numbers, Operation* ops) {
assert (is NumberExpression[4] numTuple = numbers.collect(NumberExpression).tuple());
assert (is Operation[3] opTuple = ops.sequence().tuple());
value [a, b, c, d] = numTuple;
value [op1, op2, op3] = opTuple;
value opExp = OperationExpression; // this is just to give it a shorter name
return [
opExp(opExp(opExp(a, op1, b), op2, c), op3, d),
opExp(opExp(a, op1, opExp(b, op2, c)), op3, d),
opExp(a, op1, opExp(opExp(b, op2, c), op3, d)),
opExp(a, op1, opExp(b, op2, opExp(c, op3, d)))
];
}
print("Please enter your 4 numbers to see how they form 24 or enter the letter r for random numbers.");
if (exists line = process.readLine()) {
Rational[] chosenNumbers;
if (line.trimmed.uppercased == "R") {
chosenNumbers = random.elements(1..9).take(4).collect((Integer element) => numeratorOverOne(element));
print("The random numbers are ``chosenNumbers``");
} else {
chosenNumbers = line.split().map(Integer.parse).narrow<Integer>().collect(numeratorOverOne);
}
value expressions = {
for (numbers in chosenNumbers.permutations)
for (op1 in operations)
for (op2 in operations)
for (op3 in operations)
for (exp in buildExpressions(numbers, op1, op2, op3))
if (exp.evaluate() == twentyfour)
exp
};
print("The solutions are:");
expressions.each(print);
}
}

56
Task/24-game-Solve/Nim/24-game-solve.nim Normal file
View file

@ -0,0 +1,56 @@
import algorithm, sequtils, strformat
type
Operation = enum
opAdd = "+"
opSub = "-"
opMul = "*"
opDiv = "/"
const Ops = @[opAdd, opSub, opMul, opDiv]
func opr(o: Operation, a, b: float): float =
case o
of opAdd: a + b
of opSub: a - b
of opMul: a * b
of opDiv: a / b
func solve(nums: array[4, int]): string =
func `~=`(a, b: float): bool =
abs(a - b) <= 1e-5
result = "not found"
let sortedNums = nums.sorted.mapIt float it
for i in product Ops.repeat 3:
let (x, y, z) = (i[0], i[1], i[2])
var nums = sortedNums
while true:
let (a, b, c, d) = (nums[0], nums[1], nums[2], nums[3])
if x.opr(y.opr(a, b), z.opr(c, d)) ~= 24.0:
return fmt"({a:0} {y} {b:0}) {x} ({c:0} {z} {d:0})"
if x.opr(a, y.opr(b, z.opr(c, d))) ~= 24.0:
return fmt"{a:0} {x} ({b:0} {y} ({c:0} {z} {d:0}))"
if x.opr(y.opr(z.opr(c, d), b), a) ~= 24.0:
return fmt"(({c:0} {z} {d:0}) {y} {b:0}) {x} {a:0}"
if x.opr(y.opr(b, z.opr(c, d)), a) ~= 24.0:
return fmt"({b:0} {y} ({c:0} {z} {d:0})) {x} {a:0}"
if not nextPermutation(nums): break
proc main() =
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
]:
echo fmt"solve({nums}) -> {solve(nums)}"
when isMainModule: main()

2
Task/24-game-Solve/Perl-6/24-game-solve.pl6 → Task/24-game-Solve/Perl-6/24-game-solve-1.pl6
View file

@ -27,7 +27,7 @@ my @formats = (
);
# Brute force test the different permutations
for unique @digits.permutations -> @p {
(unique @digits.permutations).race.map: -> @p {
for @ops -> @o {
for @formats -> $format {
my $string = sprintf $format, flat roundrobin(|@p; |@o);

90
Task/24-game-Solve/Perl-6/24-game-solve-2.pl6 Normal file
View file

@ -0,0 +1,90 @@
my %*SUB-MAIN-OPTS = :named-anywhere;
sub MAIN (*@parameters, Int :$goal = 24) {
my @numbers;
if +@parameters == 1 {
@numbers = @parameters[0].comb(/\d/);
USAGE() and exit unless 2 < @numbers < 5;
} elsif +@parameters > 4 {
USAGE() and exit;
} elsif +@parameters == 3|4 {
@numbers = @parameters;
USAGE() and exit if @numbers.any ~~ /<-[-\d]>/;
} else {
USAGE();
exit if +@parameters == 2;
@numbers = 3,3,8,8;
say 'Running demonstration with: ', |@numbers, "\n";
}
solve @numbers, $goal
}
sub solve (@numbers, $goal = 24) {
my @operators = < + - * / >;
my @ops = [X] @operators xx (@numbers - 1);
my @perms = @numbers.permutations.unique( :with(&[eqv]) );
my @order = (^(@numbers - 1)).permutations;
my @sol;
@sol[250]; # preallocate some stack space
my $batch = ceiling +@perms/4;
my atomicint $i;
@perms.race(:batch($batch)).map: -> @p {
for @ops -> @o {
for @order -> @r {
my $result = evaluate(@p, @o, @r);
@sol[$i⚛++] = $result[1] if $result[0] and $result[0] == $goal;
}
}
}
@sol.=unique;
say @sol.join: "\n";
my $pl = +@sol == 1 ?? '' !! 's';
my $sg = $pl ?? '' !! 's';
say +@sol, " equation{$pl} evaluate{$sg} to $goal using: {@numbers}";
}
sub evaluate ( @digit, @ops, @orders ) {
my @result = @digit.map: { [ $_, $_ ] };
my @offset = 0 xx +@orders;
for ^@orders {
my $this = @orders[$_];
my $order = $this - @offset[$this];
my $op = @ops[$this];
my $result = op( $op, @result[$order;0], @result[$order+1;0] );
return [ NaN, Str ] unless defined $result;
my $string = "({@result[$order;1]} $op {@result[$order+1;1]})";
@result.splice: $order, 2, [ $[ $result, $string ] ];
@offset[$_]++ if $order < $_ for ^@offset;
}
@result[0];
}
multi op ( '+', $m, $n ) { $m + $n }
multi op ( '-', $m, $n ) { $m - $n }
multi op ( '/', $m, $n ) { $n == 0 ?? fail() !! $m / $n }
multi op ( '*', $m, $n ) { $m * $n }
my $txt = "\e[0;96m";
my $cmd = "\e[0;92m> {$*EXECUTABLE-NAME} {$*PROGRAM-NAME}";
sub USAGE {
say qq:to
'========================================================================'
{$txt}Supply 3 or 4 integers on the command line, and optionally a value
to equate to.
Integers may be all one group: {$cmd} 2233{$txt}
Or, separated by spaces: {$cmd} 2 4 6 7{$txt}
If you wish to supply multi-digit or negative numbers, you must
separate them with spaces: {$cmd} -2 6 12{$txt}
If you wish to use a different equate value,
supply a new --goal parameter: {$cmd} --goal=17 2 -3 1 9{$txt}
If you don't supply any parameters, will use 24 as the goal, will run a
demo and will show this message.\e[0m
========================================================================
}

44
Task/24-game-Solve/Picat/24-game-solve-1.picat Normal file
View file

@ -0,0 +1,44 @@
import util.
main =>
Target=24,
Nums = [5,6,7,8],
All=findall(Expr, solve_num(Nums,Target,Expr)),
foreach(Expr in All) println(Expr.flatten()) end,
println(len=All.length),
nl.
% A string based approach, inspired by - among others - the Perl6 solution.
solve_num(Nums, Target,Expr) =>
Patterns = [
"A X B Y C Z D",
"(A X B) Y C Z D",
"(A X B Y C) Z D",
"((A X B) Y C) Z D",
"(A X B) Y (C Z D)",
"A X (B Y C Z D)",
"A X (B Y (C Z D))"
],
permutation(Nums,[A,B,C,D]),
Syms = [+,-,*,/],
member(X ,Syms),
member(Y ,Syms),
member(Z ,Syms),
member(Pattern,Patterns),
Expr = replace_all(Pattern,
"ABCDXYZ",
[A,B,C,D,X,Y,Z]),
catch(Target =:= Expr.eval(), E, ignore(E)).
eval(Expr) = parse_term(Expr.flatten()).apply().
ignore(_E) => fail. % ignore zero_divisor errors
% Replace all occurrences in S with From -> To.
replace_all(S,From,To) = Res =>
R = S,
foreach({F,T} in zip(From,To))
R := replace(R, F,T.to_string())
end,
Res = R.

47
Task/24-game-Solve/Picat/24-game-solve-2.picat Normal file
View file

@ -0,0 +1,47 @@
import util.
main =>
Target=24,
Nums = [5,6,7,8],
_ = findall(Expr, solve_num2(Nums,Target)),
nl.
solve_num2(Nums, Target) =>
Syms = [+,-,*,/],
Perms = permutations([I.to_string() : I in Nums]),
Seen = new_map(), % weed out duplicates
foreach(X in Syms,Y in Syms, Z in Syms)
foreach(P in Perms)
[A,B,C,D] = P,
if catch(check(A,X,B,Y,C,Z,D,Target,Expr),E,ignore(E)),
not Seen.has_key(Expr) then
println(Expr.flatten()=Expr.eval().round()),
Seen.put(Expr,1)
end
end
end.
to_string2(Expr) = [E.to_string() : E in Expr].flatten().
ignore(_E) => fail. % ignore zero_divisor errors
check(A,X,B,Y,C,Z,D,Target,Expr) ?=>
Expr = ["(",A,Y,B,")",X,"(",C,Z,D,")"].to_string2(),
Target =:= Expr.eval().
check(A,X,B,Y,C,Z,D,Target,Expr) ?=>
Expr = [A,X,"(",B,Y,"(",C,Z,D,")",")"].to_string2(),
Target =:= Expr.eval().
check(A,X,B,Y,C,Z,D,Target,Expr) ?=>
Expr = ["(","(",C,Z,D,")",Y,B,")",X,A].to_string2(),
Target =:= Expr.eval().
check(A,X,B,Y,C,Z,D,Target,Expr) ?=>
Expr = ["(",B,Y,"(",C,Z,D,")",")",X,A].to_string2(),
Target =:= Expr.eval().
check(A,X,B,Y,C,Z,D,Target,Expr) =>
Expr = [A,X,"(","(",B,Y,C,")", Z,D,")"].to_string2(),
Target =:= Expr.eval().

342
Task/24-game-Solve/REXX/24-game-solve.rexx
View file

@ -1,99 +1,263 @@
/*REXX program to help the user find solutions to the game of 24. */
/* ┌──────────────────────────────────────────────────────────────────┐
│ Argument is either of two forms: ssss ==or== ssss-ffff │
│ │
│ where one or both strings must be exactly four numerals (digits) │
│ comprised soley of the numerals (digits) 1 ──► 9 (no zeroes). │
│ │
│ In SSSS-FFFF SSSS is the start, │
│ FFFF is the start. │
└──────────────────────────────────────────────────────────────────┘ */
parse arg orig /*get the guess from the argument. */
parse var orig start '-' finish /*get the start and finish (maybe). */
start=space(start,0) /*remove any blanks from the START. */
finish=space(finish,0) /*remove any blanks from the FINISH. */
finish=word(finish start,1) /*if no FINISH specified, use START.*/
digs=123456789 /*numerals (digits) that can be used. */
call validate start
call validate finish
opers='+-*/' /*define the legal arithmetic operators*/
ops=length(opers) /* ··· and the count of them (length). */
do j=1 for ops /*define a version for fast execution. */
o.j=substr(opers,j,1)
end /*j*/
finds=0 /*number of found solutions (so far). */
x.=0 /*a method to hold unique expressions. */
indent=left('',30) /*used to indent display of solutions. */
/*alternative: indent=copies(' ',30) */
Lpar='(' /*a string to make REXX code prettier. */
Rpar=')' /*ditto. */
/*REXX program helps the user find solutions to the game of 24. */
/* start-of-help
┌───────────────────────────────────────────────────────────────────────┐
│ Argument is either of three forms: (blank) │~
│ ssss │~
│ ssss,tot │~
│ ssss-ffff │~
│ ssss-ffff,tot │~
│ -ssss │~
│ +ssss │~
│ │~
│ where SSSS and/or FFFF must be exactly four numerals (digits) │~
│ comprised soley of the numerals (digits) 1 ──> 9 (no zeroes). │~
│ │~
│ SSSS is the start, │~
│ FFFF is the start. │~
│ │~
│ │~
│ If ssss has a leading plus (+) sign, it is used as the number, and │~
│ the user is prompted to find a solution. │~
│ │~
│ If ssss has a leading minus (-) sign, a solution is looked for and │~
│ the user is told there is a solution (but no solutions are shown). │~
│ │~
│ If no argument is specified, this program finds a four digits (no │~
│ zeroes) which has at least one solution, and shows the digits to │~
│ the user, requesting that they enter a solution. │~
│ │~
│ If tot is entered, it is the desired answer. The default is 24. │~
│ │~
│ A solution to be entered can be in the form of: │
│ │
│ digit1 operator digit2 operator digit3 operator digit4 │
│ │
│ where DIGITn is one of the digits shown (in any order), and │
│ OPERATOR can be any one of: + - * / │
│ │
│ Parentheses () may be used in the normal manner for grouping, as │
│ well as brackets [] or braces {}. Blanks can be used anywhere. │
│ │
│ I.E.: for the digits 3448 the following could be entered. │
│ │
│ 3*8 + (4-4) │
└───────────────────────────────────────────────────────────────────────┘
end-of-help */
numeric digits 12 /*where rational arithmetic is needed. */
parse arg orig /*get the guess from the command line*/
orig= space(orig, 0) /*remove all blanks from ORIG. */
negatory= left(orig,1)=='-' /*=1, suppresses showing. */
pository= left(orig,1)=='+' /*=1, force $24 to use specific number.*/
if pository | negatory then orig=substr(orig,2) /*now, just use the absolute vaue. */
parse var orig orig ',' ?? /*get ?? (if specified, def=24). */
parse var orig start '-' finish /*get start and finish (maybe). */
opers= '*' || "/+-" /*legal arith. opers;order is important*/
ops= length(opers) /*the number of arithmetic operators. */
groupsym= '()[]{}' /*allowed grouping symbols. */
indent= left('', 30) /*indents display of solutions. */
show= 1 /*=1, shows solutions (semifore). */
digs= 123456789 /*numerals/digs that can be used. */
abuttals = 0 /*=1, allows digit abutal: 12+12 */
if ??=='' then ??= 24 /*the name of the game. */
??= ?? / 1 /*normalize the answer. */
@abc= 'abcdefghijklmnopqrstuvwxyz' /*the Latin alphabet in order. */
@abcu= @abc; upper @abcu /*an uppercase version of @abc. */
x.= 0 /*method used to not re-interpret. */
do j=1 for ops; o.j=substr(opers, j, 1)
end /*j*/ /*used for fast execution. */
y= ??
if \datatype(??,'N') then do; call ger "isn't numeric"; exit 13; end
if start\=='' & \pository then do; call ranger start,finish; exit 13; end
show= 0 /*stop SOLVE blabbing solutions. */
do forever while \negatory /*keep truckin' until a solution. */
x.= 0 /*way to hold unique expressions. */
rrrr= random(1111, 9999) /*get a random set of digits. */
if pos(0, rrrr)\==0 then iterate /*but don't the use of zeroes. */
if solve(rrrr)\==0 then leave /*try to solve for these digits. */
end /*forever*/
do g=start to finish /*process a (possible) range of values.*/
if pos(0,g)\==0 then iterate /*ignore values with zero in them. */
if left(orig,1)=='+' then rrrr=start /*use what's specified. */
show= 1 /*enable SOLVE to show solutions. */
rrrr= sortc(rrrr) /*sort four elements. */
rd.= 0
do j=1 for 9 /*count for each digit in RRRR. */
_= substr(rrrr, j, 1); rd._= countchars(rrrr, _)
end
do guesses=1; say
say 'Using the digits' rrrr", enter an expression that equals" ?? ' (? or QUIT):'
pull y; y= space(y, 0)
if countchars(y, @abcu)>2 then exit /*the user must be desperate. */
helpstart= 0
if y=='?' then do j=1 for sourceline() /*use a lazy way to show help. */
_= sourceline(j)
if p(_)=='start-of-help' then do; helpstart=1; iterate; end
if p(_)=='end-of-help' then iterate guesses
if \helpstart then iterate
if right(_,1)=='~' then iterate
say ' ' _
end
do _=1 for 4 /*define versions for faster execution.*/
g._=substr(g,_,1)
end /*_*/
_v= verify(y, digs || opers || groupsym) /*any illegal characters? */
if _v\==0 then do; call ger 'invalid character:' substr(y, _v, 1); iterate; end
if y='' then do; call validate y; iterate; end
do i=1 for ops /*insert an operator after 1st number. */
do j=1 for ops /*insert an operator after 2nd number. */
do k=1 for ops /*insert an operator after 2nd number. */
do m=0 for 4; L.= /*assume no left parenthesis so far. */
do n=m+1 to 4 /*match left paren with a right paren. */
L.m=Lpar /*define a left paren, m=0 means ignore*/
R.= /*un-define all right parenthesis. */
if m==1 & n==2 then L.= /*special case: (n)+ ··· */
else if m\==0 then R.n=Rpar /*no (, no )*/
e= L.1 g.1 o.i L.2 g.2 o.j L.3 g.3 R.3 o.k g.4 R.4
e=space(e,0) /*remove all blanks from the expression*/
do j=1 for length(y)-1 while \abuttals /*check for two digits adjacent. */
if \datatype(substr(y,j,1), 'W') then iterate
if datatype(substr(y,j+1,1),'W') then do
call ger 'invalid use of digit abuttal' substr(y,j,2)
iterate guesses
end
end /*j*/
/*(below) change expression: */
/* /(yyy) ===> /div(yyy) */
/*Enables to check for division by zero*/
origE=e /*keep old version for the display. */
if pos('/(',e)\==0 then e=changestr('/(', e, "/div(")
/*The above could be replaced by: */
/* e=changestr('/(',e,"/div(") */
yd= countchars(y, digs) /*count of legal digits 123456789 */
if yd<4 then do; call ger 'not enough digits entered.'; iterate guesses; end
if yd>4 then do; call ger 'too many digits entered.' ; iterate guesses; end
/*INTERPRET stresses REXX's groin, so */
/* try to avoid repeated heavy lifting.*/
if x.e then iterate /*was the expression already used? */
x.e=1 /*mark this expression as unique. */
/*have REXX do the heavy lifting (ugh).*/
interpret 'x=' e /*··· strain··· */
x=x/1 /*remove trailing decimal points(maybe)*/
if x\==24 then iterate /*Not correct? Try again. */
finds=finds+1 /*bump number of found solutions. */
_=translate(origE, '][', ")(") /*show [], not (). */
say indent 'a solution:' _ /*display a solution. */
end /*n*/
do j=1 for length(groupsym) by 2
if countchars(y,substr(groupsym,j ,1))\==,
countchars(y,substr(groupsym,j+1,1)) then do
call ger 'mismatched' substr(groupsym,j,2)
iterate guesses
end
end /*j*/
do k=1 for 2 /*check for ** and // */
_= copies( substr( opers, k, 1), 2)
if pos(_, y)\==0 then do; call ger 'illegal operator:' _; iterate guesses; end
end /*k*/
do j=1 for 9; if rd.j==0 then iterate; _d= countchars(y, j)
if _d==rd.j then iterate
if _d<rd.j then call ger 'not enough' j "digits, must be" rd.j
else call ger 'too many' j "digits, must be" rd.j
iterate guesses
end /*j*/
y= translate(y, '()()', "[]{}")
interpret 'ans=(' y ") / 1"
if ans==?? then leave guesses
say right('incorrect, ' y'='ans, 50)
end /*guesses*/
say; say center('┌─────────────────────┐', 79)
say center('│ │', 79)
say center('│ congratulations ! │', 79)
say center('│ │', 79)
say center('└─────────────────────┘', 79)
say
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
countchars: procedure; arg x,c /*count of characters in X. */
return length(x) - length( space( translate(x, ,c ), 0) )
/*──────────────────────────────────────────────────────────────────────────────────────*/
ranger: parse arg ssss,ffff /*parse args passed to this sub. */
ffff= p(ffff ssss) /*create a FFFF if necessary. */
do g=ssss to ffff /*process possible range of values. */
if pos(0, g)\==0 then iterate /*ignore any G with zeroes. */
sols= solve(g); wols= sols
if sols==0 then wols= 'No' /*un-geek number of solutions (if any).*/
if negatory & sols\==0 then wols='A' /*found only the first solution? */
say
say wols 'solution's(sols) "found for" g
if ??\==24 then say 'for answers that equal' ??
end
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
solve: parse arg qqqq; finds= 0 /*parse args passed to this sub. */
if \validate(qqqq) then return -1
parse value '( (( )) )' with L LL RR R /*assign some static variables. */
nq.= 0
do jq=1 for 4; _= substr(qqqq,jq,1) /*count the number of each digit. */
nq._= nq._ + 1
end /*jq*/
do gggg=1111 to 9999
if pos(0, gggg)\==0 then iterate /*ignore values with zeroes. */
if verify(gggg, qqqq)\==0 then iterate
if verify(qqqq, gggg)\==0 then iterate
ng.= 0
do jg=1 for 4; _= substr(gggg, jg, 1) /*count the number of each digit. */
g.jg= _; ng._= ng._ + 1
end /*jg*/
do kg=1 for 9 /*verify each number has same # digits.*/
if nq.kg\==ng.kg then iterate gggg
end /*kg*/
do i =1 for ops /*insert operator after 1st numeral. */
do j =1 for ops /* " " " 2nd " */
do k=1 for ops /* " " " 3rd " */
do m=0 for 10; !.= /*nullify all grouping symbols (parens)*/
select
when m==1 then do; !.1=L; !.3=R; end
when m==2 then do; !.1=L; !.5=R; end
when m==3 then do; !.1=L; !.3=R; !.4=L; !.6=R; end
when m==4 then do; !.1=L; !.2=L; !.6=RR; end
when m==5 then do; !.1=LL; !.5=R; !.6=R; end
when m==6 then do; !.2=L; !.5=R; end
when m==7 then do; !.2=L; !.6=R; end
when m==8 then do; !.2=L; !.4=L; !.6=RR; end
when m==9 then do; !.2=LL; !.5=R; !.6=R; end
otherwise nop
end /*select*/
e= space(!.1 g.1 o.i !.2 g.2 !.3 o.j !.4 g.3 !.5 o.k g.4 !.6, 0)
if x.e then iterate /*was the expression already used? */
x.e= 1 /*mark this expression as being used. */
/*(below) change the expression: /(yyy) ===> /div(yyy) */
origE= e /*keep original version for the display*/
pd= pos('/(', e) /*find pos of /( in E. */
if pd\==0 then do /*Found? Might have possible ÷ by zero*/
eo= e
lr= lastpos(')', e) /*find last right ) */
lm= pos('-', e, pd+1) /*find - after ( */
if lm>pd & lm<lr then e= changestr('/(',e,"/div(") /*change*/
if eo\==e then if x.e then iterate /*expression already used?*/
x.e= 1 /*mark this expression as being used. */
end
interpret 'x=(' e ") / 1" /*have REXX do the heavy lifting here. */
if x\==?? then do /*Not correct? Then try again. */
numeric digits 9; x= x / 1 /*re-do evaluation.*/
numeric digits 12 /*re-instate digits*/
if x\==?? then iterate /*Not correct? Then try again. */
end
finds= finds + 1 /*bump number of found solutions. */
if \show | negatory then return finds
_= translate(origE, '][', ")(") /*show [], not (). */
if show then say indent 'a solution for' g':' ??"=" _ /*show solution.*/
end /*m*/
end /*k*/
end /*j*/
end /*i*/
end /*g*/
end /*gggg*/
return finds
/*──────────────────────────────────────────────────────────────────────────────────────*/
sortc: procedure; arg nnnn; L= length(nnnn) /*sorts the chars NNNN */
do i=1 for L /*build array of digs from NNNN, */
a.i= substr(nnnn, i, 1) /*enabling SORT to sort an array. */
end /*i*/
sols=finds
if sols==0 then sols='No' /*make the sentence not so geek-like. */
say; say sols 'unique solution's(finds) "found for" orig /*pluralize.*/
exit
/*───────────────────────────DIV subroutine─────────────────────────────*/
div: procedure; parse arg q /*tests if dividing by 0 (zero). */
if q=0 then q=1e9 /*if dividing by zero, change divisor. */
return q /*changing Q invalidates the expression*/
/*───────────────────────────GER subroutine─────────────────────────────*/
ger: say; say '*** error! ***'; if _\=='' then say 'guess=' _
say arg(1); say; exit 13
/*───────────────────────────S subroutine───────────────────────────────*/
s: if arg(1)==1 then return ''; return 's' /*simple pluralizer.*/
/*───────────────────────────validate subroutine────────────────────────*/
validate: parse arg y; errCode=0; _v=verify(y,digs)
select
when y=='' then call ger 'no digits entered.'
when length(y)<4 then call ger 'not enough digits entered, must be 4'
when length(y)>4 then call ger 'too many digits entered, must be 4'
when pos(0,y)\==0 then call ger "can't use the digit 0 (zero)"
when _v\==0 then call ger 'illegal character:' substr(y,_v,1)
otherwise nop
end /*select*/
return \errCode
do j=1 for L /*very simple sort, it's a small array*/
_= a.j
do k=j+1 to L
if a.k<_ then do; a.j= a.k; a.k= _; _= a.k; end
end /*k*/
end /*j*/
v= a.1
do m=2 to L; v= v || a.m /*build a string of digs from A.m */
end /*m*/
return v
/*──────────────────────────────────────────────────────────────────────────────────────*/
validate: parse arg y; errCode= 0; _v= verify(y, digs)
select
when y=='' then call ger 'no digits entered.'
when length(y)<4 then call ger 'not enough digits entered, must be 4'
when length(y)>4 then call ger 'too many digits entered, must be 4'
when pos(0,y)\==0 then call ger "can't use the digit 0 (zero)"
when _v\==0 then call ger 'illegal character:' substr(y,_v,1)
otherwise nop
end /*select*/
return \errCode
/*──────────────────────────────────────────────────────────────────────────────────────*/
div: procedure; parse arg q; if q=0 then q=1e9; return q /*tests if dividing by zero.*/
ger: say= '***error*** for argument:' y; say arg(1); errCode= 1; return 0
p: return word( arg(1), 1)
s: if arg(1)==1 then return arg(3); return word( arg(2) 's', 1)

4
Task/24-game/00META.yaml Normal file
View file

@ -0,0 +1,4 @@
---
category:
- Puzzles
- Games

250
Task/24-game/Ceylon/24-game.ceylon
View file

@ -1,36 +1,47 @@
import ceylon.random {
DefaultRandom
}
class Rational(shared Integer numerator, shared Integer denominator = 1) satisfies Numeric<Rational> {
assert(denominator != 0);
assert (denominator != 0);
Integer gcd(Integer a, Integer b) => if(b == 0) then a else gcd(b, a % b);
Integer gcd(Integer a, Integer b) => if (b == 0) then a else gcd(b, a % b);
shared Rational inverted => Rational(denominator, numerator);
shared Rational simplified =>
let(largestFactor = gcd(numerator, denominator))
Rational(numerator / largestFactor, denominator / largestFactor);
let (largestFactor = gcd(numerator, denominator))
Rational(numerator / largestFactor, denominator / largestFactor);
divided(Rational other) => (this * other.inverted).simplified;
negated => Rational(-numerator, denominator).simplified;
plus(Rational other) =>
let(top = numerator * other.denominator + other.numerator * denominator,
let (top = numerator*other.denominator + other.numerator*denominator,
bottom = denominator * other.denominator)
Rational(top, bottom).simplified;
times(Rational other) =>
Rational(numerator * other.numerator, denominator * other.denominator).simplified;
Rational(numerator * other.numerator, denominator * other.denominator).simplified;
shared Integer integer => numerator / denominator;
shared Float float => numerator.float / denominator.float;
string => denominator == 1 then numerator.string else "``numerator``/``denominator``";
shared actual Boolean equals(Object that) {
if (is Rational that) {
value simplifiedThis = this.simplified;
value simplifiedThat = that.simplified;
return simplifiedThis.numerator==simplifiedThat.numerator &&
simplifiedThis.denominator==simplifiedThat.denominator;
}
else {
return false;
}
}
}
interface Expression {
@ -44,17 +55,17 @@ class NumberExpression(Rational number) satisfies Expression {
class OperatorExpression(Expression left, Character operator, Expression right) satisfies Expression {
shared actual Rational evaluate() {
switch(operator)
case('*') {
switch (operator)
case ('*') {
return left.evaluate() * right.evaluate();
}
case('/') {
case ('/') {
return left.evaluate() / right.evaluate();
}
case('-') {
case ('-') {
return left.evaluate() - right.evaluate();
}
case('+') {
case ('+') {
return left.evaluate() + right.evaluate();
}
else {
@ -75,7 +86,7 @@ class PrattParser(String input) {
shared Expression expression(Integer precedence = 0) {
value token = advance();
variable value left = parseUnary(token);
while(precedence < getPrecedence(peek())) {
while (precedence < getPrecedence(peek())) {
value nextToken = advance();
left = parseBinary(left, nextToken);
}
@ -83,15 +94,15 @@ class PrattParser(String input) {
}
Integer getPrecedence(Character op) =>
switch(op)
case('*' | '/') 2
case('+' | '-') 1
switch (op)
case ('*' | '/') 2
case ('+' | '-') 1
else 0;
Character advance(Character? expected = null) {
index++;
value token = tokens[index] else ' ';
if(exists expected, token != expected) {
if (exists expected, token != expected) {
throw Exception("unknown character ``token``");
}
return token;
@ -100,122 +111,127 @@ class PrattParser(String input) {
Character peek() => tokens[index + 1] else ' ';
Expression parseBinary(Expression left, Character operator) =>
let(right = expression(getPrecedence(operator)))
OperatorExpression(left, operator, right);
let (right = expression(getPrecedence(operator)))
OperatorExpression(left, operator, right);
Expression parseUnary(Character token) {
if(token.digit) {
assert(exists int = parseInteger(token.string));
if (token.digit) {
assert (is Integer int = Integer.parse(token.string));
return NumberExpression(Rational(int));
} else if(token == '(') {
}
else if (token == '(') {
value exp = expression();
advance(')');
return exp;
} else {
}
else {
throw Exception("unknown character ``token``");
}
}
}
"Run the module `twentyfourgame`."
shared void run() {
value random = DefaultRandom();
function random4Numbers() =>
random.elements(1..9).take(4).sequence();
function isValidGuess(String input, {Integer*} allowedNumbers) {
value allowedOperators = set {*"()+-/*"};
value extractedNumbers = input
.split((Character ch) => ch in allowedOperators || ch.whitespace)
.map((String element) => parseInteger(element))
.coalesced;
if(extractedNumbers.any((Integer element) => element > 9)) {
print("number too big!");
return false;
}
if(extractedNumbers.any((Integer element) => element < 1)) {
print("number too small!");
return false;
}
if(extractedNumbers.sort(byIncreasing(Integer.magnitude)) != allowedNumbers.sort(byIncreasing(Integer.magnitude))) {
print("use all the numbers, please!");
return false;
}
if(!input.every((Character element) => element in allowedOperators || element.digit || element.whitespace)) {
print("only digits and mathematical operators, please");
return false;
}
variable value lefts = 0;
for(c in input) {
if(c == '(') {
lefts++;
} else if(c == ')') {
lefts--;
if(lefts < 0) {
break;
}
}
}
if(lefts != 0) {
print("unbalanced brackets!");
return false;
}
return true;
}
function evaluate(String input) =>
let(parser = PrattParser(input),
exp = parser.expression())
exp.evaluate();
print("Welcome to The 24 Game.
Create a mathematical equation with four random
numbers that evaluates to 24.
You must use all the numbers once and only once,
but in any order.
Also, only + - / * and parentheses are allowed.
For example: (1 + 2 + 3) * 4
Also: enter n for new numbers and q to quit.
-----------------------------------------------");
while(true) {
value random = DefaultRandom();
function random4Numbers() =>
random.elements(1..9).take(4).sequence();
function isValidGuess(String input, {Integer*} allowedNumbers) {
value allowedOperators = set { *"()+-/*" };
value extractedNumbers = input
.split((Character ch) => ch in allowedOperators || ch.whitespace)
.map((String element) => Integer.parse(element))
.narrow<Integer>();
if (extractedNumbers.any((Integer element) => element > 9)) {
print("number too big!");
return false;
}
if (extractedNumbers.any((Integer element) => element < 1)) {
print("number too small!");
return false;
}
if (extractedNumbers.sort(increasing) != allowedNumbers.sort(increasing)) {
print("use all the numbers, please!");
return false;
}
if (!input.every((Character element) => element in allowedOperators || element.digit || element.whitespace)) {
print("only digits and mathematical operators, please");
return false;
}
variable value leftParens = 0;
for (c in input) {
if (c == '(') {
leftParens++;
} else if (c == ')') {
leftParens--;
if (leftParens < 0) {
break;
}
}
}
if (leftParens != 0) {
print("unbalanced brackets!");
return false;
}
return true;
}
function evaluate(String input) =>
let (parser = PrattParser(input),
exp = parser.expression())
exp.evaluate();
print("Welcome to The 24 Game.
Create a mathematical equation with four random
numbers that evaluates to 24.
You must use all the numbers once and only once,
but in any order.
Also, only + - / * and parentheses are allowed.
For example: (1 + 2 + 3) * 4
Also: enter n for new numbers and q to quit.
-----------------------------------------------");
value twentyfour = Rational(24);
while (true) {
value chosenNumbers = random4Numbers();
void pleaseTryAgain() => print("Sorry, please try again. (Your numbers are ``chosenNumbers``)");
print("Your numbers are ``chosenNumbers``. Please turn them into 24.");
while(true) {
value line = process.readLine()?.trimmed;
if(exists line) {
if(line.uppercased == "Q") {
print("bye!");
return;
}
if(line.uppercased == "N") {
break;
}
if(isValidGuess(line, chosenNumbers)) {
try {
value result = evaluate(line);
print("= ``result``");
if(result.integer == 24) {
print("You did it!");
break;
} else {
pleaseTryAgain();
}
} catch(Exception e) {
print(e.message);
pleaseTryAgain();
}
} else {
pleaseTryAgain();
}
}
}
while (true) {
value line = process.readLine()?.trimmed;
if (exists line) {
if (line.uppercased == "Q") { // quit
print("bye!");
return;
}
if (line.uppercased == "N") { // new game
break;
}
if (isValidGuess(line, chosenNumbers)) {
try {
value result = evaluate(line);
print("= ``result``");
if (result == twentyfour) {
print("You did it!");
break;
}
else {
pleaseTryAgain();
}
}
catch (Exception e) {
print(e.message);
pleaseTryAgain();
}
}
else {
pleaseTryAgain();
}
}
}
}
}

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

@ -1,175 +1,203 @@
import system'routines.
import system'collections.
import system'dynamic.
import extensions.
import system'routines;
import system'collections;
import system'dynamic;
import extensions;
class ExpressionTree
{
object theTree.
object theTree;
constructor new : aLiteral
[
auto aLevel := Integer new:0.
constructor(s)
{
auto level := new Integer(0);
aLiteral forEach(:ch)
[
var node := DynamicStruct new.
s.forEach:(ch)
{
var node := new DynamicStruct();
ch =>
$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 leaf := ch literal; toReal.
node level := aLevel + 3.
].
$43 { node.Level := level + 1; node.Operation := __subj add } // +
$45 { node.Level := level + 1; node.Operation := __subj subtract } // -
$42 { node.Level := level + 2; node.Operation := __subj multiply } // *
$47 { node.Level := level + 2; node.Operation := __subj divide } // /
$40 { level.append(10); ^ self } // (
$41 { level.reduce(10); ^ self } // )
: {
node.Leaf := ch.toString().toReal();
node.Level := level + 3
};
if (nil == theTree)
[ theTree := node ];
[
if (theTree level >= node level)
[
node left := theTree.
node right := nilValue.
{
theTree := node
}
else
{
if (theTree.Level >= node.Level)
{
node.Left := theTree;
node.Right := nilValue;
theTree := node
];
[
var aTop := theTree.
while ((nilValue != aTop right)&&(aTop right; level < node level))
[ aTop := aTop right ].
theTree := node
}
else
{
var top := theTree;
while ((nilValue != top.Right)&&(top.Right.Level < node.Level))
{ top := top.Right };
node left := aTop right.
node right := nilValue.
node.Left := top.Right;
node.Right := nilValue;
aTop right := node
]
]
]
]
top.Right := node
}
}
}
}
eval : aNode
[
if (aNode containsProperty:%leaf)
[ ^ aNode leaf ];
[
var aLeft := self eval:(aNode left).
var aRight := self eval:(aNode right).
eval(node)
{
if (node.containsProperty(subjconst Leaf))
{
^ node.Leaf
}
else
{
var left := self.eval(node.Left);
var right := self.eval(node.Right);
^ aLeft~(aNode operation) eval:aRight
]
]
var op := node.Operation;
value
<= eval:theTree.
^ mixin op(left).eval:right
}
}
readLeaves : aList at:aNode
[
if (nil == aNode)
[ InvalidArgumentException new; raise ].
get Value()
<= eval(theTree);
if (aNode containsProperty:%leaf)
[ aList append(aNode leaf) ];
[
self readLeaves:aList at(aNode left).
self readLeaves:aList at(aNode right).
].
]
readLeaves(list, node)
{
if (nil == node)
{ InvalidArgumentException.raise() };
readLeaves : aList
<= readLeaves:aList at:theTree.
var s := subjconst Leaf;
if (node.containsProperty(subjconst Leaf))
{
list.append(node.Leaf)
}
else
{
self.readLeaves(list, node.Left);
self.readLeaves(list, node.Right)
}
}
readLeaves(list)
<= readLeaves(list,theTree);
}
class TwentyFourGame
{
object theNumbers.
object theNumbers;
constructor new
[
self newPuzzle.
]
constructor()
{
self.newPuzzle();
}
newPuzzle
[
theNumbers := (
1 + randomGenerator eval:9,
1 + randomGenerator eval:9,
1 + randomGenerator eval:9,
1 + randomGenerator eval:9).
]
newPuzzle()
{
theNumbers := new object[]
{
1 + randomGenerator.eval:9,
1 + randomGenerator.eval:9,
1 + randomGenerator.eval:9,
1 + randomGenerator.eval:9
}
}
help
[
help()
{
console
printLine:"------------------------------- Instructions ------------------------------";
printLine:"Four digits will be displayed.";
printLine:"Enter an equation using all of those four digits that evaluates to 24";
printLine:"Only * / + - operators and () are allowed";
printLine:"Digits can only be used once, but in any order you need.";
printLine:"Digits cannot be combined - i.e.: 12 + 12 when given 1,2,2,1 is not allowed";
printLine:"Submit a blank line to skip the current puzzle.";
printLine:"Type 'q' to quit";
writeLine;
printLine:"Example: given 2 3 8 2, answer should resemble 8*3-(2-2)";
printLine:"------------------------------- --------------------------------------------".
]
.printLine:"------------------------------- Instructions ------------------------------"
.printLine:"Four digits will be displayed."
.printLine:"Enter an equation using all of those four digits that evaluates to 24"
.printLine:"Only * / + - operators and () are allowed"
.printLine:"Digits can only be used once, but in any order you need."
.printLine:"Digits cannot be combined - i.e.: 12 + 12 when given 1,2,2,1 is not allowed"
.printLine:"Submit a blank line to skip the current puzzle."
.printLine:"Type 'q' to quit"
.writeLine()
.printLine:"Example: given 2 3 8 2, answer should resemble 8*3-(2-2)"
.printLine:"------------------------------- --------------------------------------------"
}
prompt
[
theNumbers forEach(:n) [ console print(n," ") ].
prompt()
{
theNumbers.forEach:(n){ console.print(n," ") };
console print:": "
]
console.print:": "
}
resolve : aLine
[
var exp := ExpressionTree new:aLine.
resolve(expr)
{
var tree := new ExpressionTree(expr);
var Leaves := ArrayList new.
exp readLeaves:Leaves.
var leaves := new ArrayList();
tree.readLeaves:leaves;
ifnot (Leaves ascendant; sequenceEqual(theNumbers ascendant))
[ console printLine:"Invalid input. Enter an equation using all of those four digits. Try again.". ^ self ].
ifnot (leaves.ascendant().sequenceEqual(theNumbers.ascendant()))
{ 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).
var result := tree.Value;
if (result == 24)
{
console.printLine("Good work. ",expr,"=",result);
self newPuzzle.
];
[ console printLine("Incorrect. ",aLine,"=",aResult) ]
]
self.newPuzzle()
}
else
{
console.printLine("Incorrect. ",expr,"=",result)
}
}
}
extension gameOp
{
playRound : aLine
[
if (aLine == "q")
[ ^ false ];
[
if (aLine == "")
[ console printLine:"Skipping this puzzle". self newPuzzle. ];
[
try(self resolve:aLine)
{
on(Exception e) [
console writeLine:"An error occurred. Check your input and try again."
]
}
].
^ true
].
]
playRound(expr)
{
if (expr == "q")
{
^ false
}
else
{
if (expr == "")
{
console.printLine:"Skipping this puzzle"; self.newPuzzle()
}
else
{
try
{
self.resolve(expr)
}
catch(Exception e)
{
console.printLine:"An error occurred. Check your input and try again."
}
};
^ true
}
}
}
public program
[
var aGame := TwentyFourGame new; help.
public program()
{
var game := new TwentyFourGame().help();
while (aGame prompt; playRound(console readLine)) [].
]
while (game.prompt().playRound(console.readLine())) {}
}

108
Task/24-game/FreeBASIC/24-game.freebasic Normal file
View file

@ -0,0 +1,108 @@
' The 24 game en FreeBASIC
Const operaciones = "*/+-"
Declare Sub Encabezado
Declare Function escoge4() As String
Declare Function quitaEspacios(cadena As String, subcadena1 As String, subcadena2 As String) As String
Declare Function evaluaEntrada(cadena As String) As Integer
Declare Function evaluador(oper1 As Byte, oper2 As Byte, operacion As String) As Integer
Dim Shared As String serie, entrada, cadena
Dim As Integer resultado
Sub Encabezado
Cls: Color 15
Print "The 24 Game"
Print "============" + Chr(13) + Chr(10)
Print "Dados cuatro dígitos en el rango de 1 a 9, que pueden repetirse, "
Print "usando solo los operadores aritméticos suma (+), resta (-), "
Print "multiplicación (*) y división (/) intentar obtener un resultado de 24." + Chr(13) + Chr(10)
Print "Use la notación polaca inversa (primero los operandos y luego los operadores)."
Print "Por ejemplo: en lugar de 2 + 4, escriba 2 4 +" + Chr(13) + Chr(10)
End Sub
Function escoge4() As String
Dim As Byte i
Dim As String a, b
Print "Los dígitos a utilizar son: ";
For i = 1 To 4
a = Str(Int(Rnd*9)+1)
Print a;" ";
b = b + a
Next i
escoge4 = b
End Function
Function evaluaEntrada(cadena As String) As Integer
Dim As Byte oper1, oper2, n(4), i
Dim As String op
oper1 = 0: oper2 = 0: i = 0
While cadena <> ""
op = Left(cadena, 1)
entrada = Mid(cadena, 2)
If Instr(serie, op) Then
i = i + 1
n(i) = Val(op)
Elseif Instr(operaciones, op) Then
oper2 = n(i)
n(i) = 0
i = i - 1
oper1 = n(i)
n(i) = evaluador(oper1, oper2, op)
Else
Print "Signo no v lido"
End If
Wend
evaluaEntrada = n(i)
End Function
Function evaluador(oper1 As Byte, oper2 As Byte, operacion As String) As Integer
Dim As Integer t
Select Case operacion
Case "+": t = oper1 + oper2
Case "-": t = oper1 - oper2
Case "*": t = oper1 * oper2
Case "/": t = oper1 / oper2
End Select
evaluador = t
End Function
Function quitaEspacios(cadena As String, subcadena1 As String, subcadena2 As String) As String
Dim As Byte len1 = Len(subcadena1), len2 = Len(subcadena2)
Dim As Byte i
i = Instr(cadena, subcadena1)
While i
cadena = Left(cadena, i - 1) & subcadena2 & Mid(cadena, i + len1)
i = Instr(i + len2, cadena, subcadena1)
Wend
quitaEspacios = cadena
End Function
'--- Programa Principal ---
Randomize Timer
Do
Encabezado
serie = escoge4
Print: Line Input "Introduzca su fórmula en notación polaca inversa: ", entrada
entrada = quitaEspacios(entrada, " ", "")
If (Len(entrada) <> 7) Then
Print "Error en la serie introducida."
Else
resultado = evaluaEntrada(entrada)
Print "El resultado es = "; resultado
If resultado = 24 Then
Print "¡Correcto!"
Else
Print "¡Error!"
End If
End If
Print "¿Otra ronda? (Pulsa S para salir, u otra tecla para continuar)"
Loop Until (Ucase(Input(1)) = "S")
End
'--------------------------

2
Task/24-game/Modula-2/24-game.mod2
View file

@ -131,7 +131,7 @@ BEGIN
div : num := num / VAL(REAL,operand[index]);
END;(*of CASE*)
END;(*of FOR*)
END;(*of WIHT*)
END;(*of WITH*)
END evaluateExpr;
(**************************************************************generateNumbers*)

339
Task/24-game/REXX/24-game-1.rexx
View file

@ -1,118 +1,235 @@
/*REXX program supports a human to play the game of 24 (twenty-four) with error checking*/
parse arg yyy; yyy=space(yyy, 0) /*get optional CL args; elide blanks. */
parse var yyy start '-' fin /*get the START and FINish (maybe). */
fin= word(fin start, 1) /*if no FINish specified, use START.*/
ops= '+-*/' ; Lops= length(0ps) /*define the legal arithmetic operators*/
groupSym= '()[]{}' /*legal grouping symbols for this game.*/
pad= left('', 30) /*used to indent display of solutions. */
Lpar= '(' ; Rpar= ')' /*strings to make the output prettier.*/
digs= 123456789 /*numerals (digits) that can be used. */
show= 1 /*flag used show solutions (0 = not). */
do j=1 for Lops; @.j=substr(ops,j,1); end /*for fast execution. */
signal on syntax /*enable program to trap syntax errors.*/
if yyy\=='' then do; sols=solve(start, fin) /*solve from START ───► FINish. */
if sols <0 then exit 13 /*Was there a problem with the input? */
if sols==0 then sols='No' /*Englishize the SOLS variable value*/
say; say sols 'unique solution's(sols) "found for" yyy
exit /*S [↑] does pluralizations. */
end
show=0 /*stop SOLVE from blabbing solutions.*/
do forever; rrrr=random(1111, 9999)
if pos(0, rrrr)\==0 then iterate /*if it contains a zero, then ignore it*/
if solve(rrrr) \==0 then leave /*if solved, then we can stop looking. */
/*REXX program helps the user find solutions to the game of 24.
start─of─help
╔═════════════════════════════════════════════════════════════════════════════╗
║ Argument is either of these forms: (blank) ║~
║ ssss ║~
║ ssss,total,limit ║~
║ ssss-ffff ║~
║ ssss-ffff,total,limit ║~
║ -ssss ║~
║ +ssss ║~
║ ║~
║ where SSSS and/or FFFF must be exactly four numerals (digits) ║~
║ comprised soley of the numerals (digits) 1 ──> 9 (no zeroes). ║~
║ ║~
║ SSSS is the start, and FFFF is the end (inclusive). ║~
║ ║~
║ If ssss has a leading plus (+) sign, it is used as the digits, and ║~
║ the user is prompted to enter a solution (using those decimal digits). ║~
║ ║~
║ If ssss has a leading minus (-) sign, a solution is looked for and ║~
║ the user is told there is a solution (or not), but no solutions are shown). ║~
║ ║~
║ If no argument is specified, this program generates four digits (no zeros) ║~
║ which has at least one solution, and shows the sorted digits to the user, ║~
║ requesting that they enter a solution (the digits used may be in any order).║~
║ ║~
║ If TOTAL is entered, it is the desired answer. The default is 24. ║~
║ If LIMIT is entered, it limits the number of solutions shown. ║~
║ ║~
║ A solution to be entered can be in the form of: ║
║ ║
║ digit1 operator digit2 operator digit3 operator digit4 ║
║ ║
║ where DIGITn is one of the digits shown (in any order), and ║
║ OPERATOR can be any one of: + - * / ║
║ ║
║ Parentheses () may be used in the normal manner for grouping, as well as ║
║ brackets [] or braces {}. Blanks can be used anywhere. ║
║ ║
║ I.E.: for the digits 3448 the following could be entered: 3*8 + (4-4) ║
╚═════════════════════════════════════════════════════════════════════════════╝
end─of─help */
numeric digits 12 /*where rational arithmetic is needed. */
parse arg orig; uargs= orig /*get the guess from the command line*/
orig= space(orig, 0) /*remove all blanks from ORIG. */
negatory= left(orig,1)=='-' /*=1, suppresses showing. */
pository= left(orig,1)=='+' /*=1, force $24 to use specific number.*/
if pository | negatory then orig=substr(orig,2) /*now, just use the absolute vaue. */
parse var orig orig ',' $ "," limit /*get optional total ($) and/or limit*/
parse var orig start '-' finish /*get start and finish (maybe). */
opers= '*' || "/+-" /*arithmetic opers; order is important.*/
ops= length(opers) /*the number of arithmetic operators. */
groupsym= space(' ( ) [ ] { } « » ', 0) /*the allowable grouping symbols. */
indent= left('', 30) /*indents the display of solutions. */
show= 1 /*=1, shows solutions (a semifore). */
digs= 123456789 /*numerals/digits that can be used. */
abuttals = 0 /*=1, allows digit abutal: 12+12 */
if $=='' then $= 24 /*the name of the game: (24) */
if limit=='' then limit= 1 /*=1, shows only one solution. */
do j=1 for ops; o.j=substr(opers, j, 1) /*these are used for fast execution. */
end /*j*/
if \datatype(limit, 'N') then do; call ger limit "isn't numeric"; exit 13; end
limit= limit / 1 /*normalize the number for limit. */
if \datatype($, 'N') then do; call ger $ "isn't numeric"; exit 13; end
$= $ / 1 /*normalize the number for total. */
if start\=='' & \pository then do; call ranger start,finish; exit 1; end
show= 0 /*stop blabbing solutions in SOLVE. */
do forever while \negatory /*keep truckin' until a solution. */
x.= 0 /*way to hold unique expressions. */
rrrr= random(1111, 9999) /*get a random set of digits. */
if pos(0, rrrr)\==0 then iterate /*but don't the use of zeroes. */
if solve(rrrr)\==0 then leave /*try to solve for these digits. */
end /*forever*/
show=1 /*enable SOLVE to display solutions. */
rrrr=sort(rrrr); Lrrrr=length(rrrr) /*sort four digits (for consistency). */
$.=0
do j=1 for Lrrrr; _=substr(rrrr,j,1) /*digit count for each digit in RRRR. */
$._= countDigs(rrrr, _) /*define the count for this digit. */
end /*j*/ /* [↑] counts duplicates twice, no harm*/
__ = copies('─', 9) /*used for output highlighting. */
prompt= 'Using the digits ' rrrr", enter an expression that equals 24 (or QUIT):"
/* [↓] ITERATE needs a variable name.*/
do prompter=0 by 0; say; say __ prompt /*display blank line and the prompt (P)*/
pull y; y=space(y, 0) /*get Y from CL, then remove all blanks*/
if abbrev('QUIT', y, 1) then exit 0 /*Does the user want to quit this game?*/
_v=verify(y, digs || ops || groupSym); a=substr(y, max(1,_v), 1)
if _v\==0 then do; call ger "invalid character:" a; iterate; end
if pos('**', y) then do; call ger "invalid ** operator"; iterate; end
if pos('//', y) then do; call ger "invalid // operator"; iterate; end
Ly=length(y)
if y=='' then do; call validate y; iterate; end
do j=1 for Ly-1; if \datatype(substr(y,j ,1), 'W') then iterate
if \datatype(substr(y,j+1,1), 'W') then iterate
call ger 'invalid use of "digit abuttal".'
iterate prompter
end /*j*/
yd=countDigs(y,digs) /*count of the digits 1──►9 (123456789)*/
if yd<4 then do; call ger 'not enough digits entered.'; iterate /*prompter*/; end
if yd>4 then do; call ger 'too many digits entered.' ; iterate /*prompter*/; end
do j=1 for 9; if $.j==0 then iterate
_d=countDigs(y, j); if $.j==_d then iterate
if _d<$.j then call ger 'not enough' j "digits, must be" $.j
else call ger 'too many' j "digits, must be" $.j
iterate prompter
end /*j*/
interpret 'ans=' translate(y, '()()', "[]{}"); ans=ans/1
if ans==24 then leave prompter; say 'incorrect, ' y"="ans
end /*prompter*/
show= 1 /*enable SOLVE to show solutions. */
if pository then rrrr=start /*use what's specified. */
rrrr= sortc(rrrr) /*sort four elements. */
rd.= 0
do j=1 for 9; _= substr(rrrr, j, 1); rd._= #chars(rrrr, _)
end /*j*/ /* [↑] count for each digit in RRRR. */
do guesses=1; say; @prompt= copies('─', 8) "Using the digits "
say @prompt rrrr", enter an expression that equals" $ ' (or ? or QUIT):'
pull y; uargs= y; y= space(y, 0) /*obtain the user's response. */
if abbrev('QUIT', y, 1) then exit 0 /*does the user want to quit this game?*/
helpstart= 0
if y=='?' then do j=1 for sourceline(); _= sourceline(j) /*get a line of program.*/
if p(_)=='start─of─help' then do; helpstart= 1; iterate; end
if p(_)=='end─of─help' then iterate guesses
if \helpstart | right(_, 1)=='~' then iterate
say ' ' _
end /*j*/ /* [↑] use an in─line way to show help*/
_v= verify(y, digs || opers || groupsym) /*any illegal characters? */
if _v\==0 then do; call ger 'invalid character:' substr(y, _v, 1); iterate; end
if y='' then do; call validate y; iterate; end
say; say center('┌─────────────────────┐', 79)
say center('│ │', 79)
say center('│ congratulations ! │', 79)
say center('│ │', 79)
say center('└─────────────────────┘', 79)
do j=1 for length(y)-1 while \abuttals /*check for two adjacent decimal digits*/
if datatype( substr(y, j, 1), 'W') & datatype( substr(y, j+1, 1), 'W') then
do; call ger 'invalid use of digit abuttal' substr(y,j,2)
iterate guesses
end
end /*j*/
yd= #chars(y, digs) /*count of legal digits 123456789 */
if yd<4 then do; call ger 'not enough digits entered.'; iterate guesses; end
if yd>4 then do; call ger 'too many digits entered.' ; iterate guesses; end
do j=1 for length(groupsym) by 2
if #chars(y,substr(groupsym,j ,1))\==,
#chars(y,substr(groupsym,j+1,1)) then do; @mis= 'mismatched'
call ger @mis substr(groupsym, j, 2)
iterate guesses
end
end /*j*/
do k=1 for 2 /*check for ** and // */
_= copies( substr( opers, k, 1), 2) /*only examine the first two operators.*/
if pos(_, y)\==0 then do; call ger 'illegal operator:' _; iterate guesses; end
end /*k*/
do j=1 for 9; if rd.j==0 then iterate; _d= #chars(y, j)
if _d==rd.j then iterate
if _d<rd.j then call ger 'not enough' j "digits, must be" rd.j
else call ger 'too many' j "digits, must be" rd.j
iterate guesses
end /*j*/
y= translate(y, '()()', "[]{}"); interpret 'ans=(' y ") / 1"
if ans==$ then leave guesses; say right('incorrect, ' y'='ans, 50)
end /*guesses*/
say; say center('┌─────────────────────┐', 79)
say center('│ │', 79)
say center('│ congratulations ! │', 79)
say center('│ │', 79)
say center('└─────────────────────┘', 79); say
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
countDigs: arg ?; return length(?) - length(space(translate(?, , arg(2)), 0))
div: if arg(1)=0 then return 7e9; return arg(1) /*÷ by 0? Fudge result*/
ger: say; say __ '***error*** for expression:' y; say __ arg(1); say; OK=0; return 0
s: if arg(1)==1 then return ''; return "s" /*a simple pluralizer.*/
syntax: call ger 'illegal syntax in' y; exit
#chars: procedure; parse arg x,c; return length(x) -length( space( translate(x, ,c ), 0) )
div: procedure; parse arg q; if q=0 then q=1e9; return q /*tests if dividing by zero.*/
ger: say '***error*** for argument: ' uargs; say ' ' arg(1); errCode= 1; return 0
p: return word( arg(1), 1)
s: if arg(1)==1 then return arg(3); return word( arg(2) 's', 1)
/*──────────────────────────────────────────────────────────────────────────────────────*/
solve: parse arg ssss, ffff /*parse the argument passed to SOLVE. */
if ffff=='' then ffff=ssss /*create a FFFF if necessary. */
if \validate(ssss) | \validate(ffff) then return -1 /*validate SSSS & FFFF*/
!.=0; #=0 /*holds unique expressions; # solutions*/
do g=ssss to ffff /*process a (possible) range of values.*/
if pos(0, g)\==0 then iterate /*ignore values with zero in them. */
do j=1 for 4; g.j=substr(g,j,1); end /*for fast execution.*/
do i =1 for Lops /*insert an operator after 1st number. */
do j =1 for Lops /* " " " " 2nd " */
do k =1 for Lops /* " " " " 3rd " */
do m=0 to 3; L.= /*assume no left parenthesis (so far).*/
do n=m+1 to 4; L.m=Lpar; R.= /*match left paren with a right paren. */
if m==1 & n==2 then L.= /*special case of : (n) + ··· */
else if m\==0 then R.n=Rpar /*no (, no )*/
e= L.1 g.1 @.i L.2 g.2 @.j L.3 g.3 R.3 @.k g.4 R.4
e=space(e, 0) /*remove all blanks from the expression*/
yyyE=e /*keep old the version for the display.*/
/* [↓] change /(yyy) ═══► /div(yyy) */
if pos('/(', e)\==0 then e=changestr( "/(", e, '/div(' )
if !.e then iterate /*was this expression already used? */
!.e=1 /*mark this expression as being used. */
interpret 'x=' e /*have REXX do all the heavy lifting */
if x\=24 then iterate /*Is the result incorrect? Try again. */
#=#+1 /*bump number of found solutions. */
if show then say pad 'a solution for' g": " translate(yyyE,'][',")(")
end /*n*/ /* [↑] display a (single) solution. */
end /*m*/
end /*k*/
end /*j*/
end /*i*/
end /*g*/
return #
ranger: parse arg ssss,ffff /*parse args passed to this sub. */
ffff= p(ffff ssss) /*create a FFFF if necessary. */
do g=ssss to ffff /*process possible range of values. */
if pos(0, g)\==0 then iterate /*ignore any G with zeroes. */
sols= solve(g); wols= sols
if sols==0 then wols= 'No' /*un─geek number of solutions (if any).*/
if negatory & sols\==0 then wols= 'A' /*found only the first solution? */
if sols==1 & limit==1 then wols= 'A'
say; say wols 'solution's(sols) "found for" g
if $\==24 then say 'for answers that equal' $
end /*g*/
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
sort: procedure; parse arg #; L=length(#); !.= /*this is a modified bin sort.*/
do d=1 for L; _=substr(#, d, 1); !.d=!.d || _; end /*d*/
return space(!.0 !.1 !.2 !.3 !.4 !.5 !.6 !.7 !.8 !.9, 0) /*reconstitute the #.*/
solve: parse arg qqqq; finds= 0; x.=0 /*parse args passed to this function. */
if \validate(qqqq) then return -1
parse value '( (( )) )' with L LL RR R /*assign some static variables. */
nq.= 0
do jq=1 for 4; _= substr(qqqq,jq,1) /*count the number of each digit. */
nq._= nq._ + 1
end /*jq*/
gLO= 1111; gHI= 9999
if $==24 then do; gLO= 1118; gHI= 9993; end /*24: lowest poss.# that has solutions*/
do gggg=gLO to gHI; if pos(0, gggg)\==0 then iterate /*ignore values with zeroes.*/
if verify(gggg, qqqq)\==0 then iterate
if verify(qqqq, gggg)\==0 then iterate
ng.= 0
do jg=1 for 4; _= substr(gggg, jg, 1); g.jg= _; ng._= ng._ + 1
end /*jg*/ /* [↑] count the number of each digit.*/
do kg=1 for 9; if nq.kg\==ng.kg then iterate gggg
end /*kg*/ /* [↑] verify number has same # digits*/
do i =1 for ops /*insert operator after 1st numeral. */
do j =1 for ops /* " " " 2nd " */
do k=1 for ops /* " " " 3rd " */
do m=0 for 10; !.= /*nullify all grouping symbols (parens)*/
select /*used to generate grouped expressions.*/
when m==1 then do; !.1=L; !.3=R; end
when m==2 then do; !.1=L; !.5=R; end
when m==3 then do; !.1=L; !.3=R; !.4=L; !.6=R; end
when m==4 then do; !.2=L; !.5=R; end
when m==5 then do; !.2=L; !.6=R; end
when m==6 then do; !.1=LL; !.5=R; !.6=R; end
when m==7 then do; !.2=LL; !.5=R; !.6=R; end
when m==8 then do; !.1=L; !.2=L; !.6=RR; end
when m==9 then do; !.2=L; !.4=L; !.6=RR; end
otherwise nop
end /*select*/
e= space(!.1 g.1 o.i !.2 g.2 !.3 o.j !.4 g.3 !.5 o.k g.4 !.6, 0)
if x.e then iterate /*was the expression already used? */
x.e= 1 /*mark this expression as being used. */
origE= e /*keep original version for the display*/
pd= pos('/(', e) /*find pos of /( in E. */
if pd\==0 then do /*Found? Might have possible ÷ by zero*/
eo= e
lr= lastpos(')', e) /*find last right ) */
lm= pos('-', e, pd+1) /*find a minus sign (-) after ( */
if lm>pd & lm<lr then e= changestr('/(',e,"/div(") /*change*/
if eo\==e then if x.e then iterate /*expression already used?*/
x.e= 1 /*mark this expression as being used. */
end
interpret 'x=(' e ") / 1" /*have REXX do the heavy lifting here. */
if x\==$ then do /*Not correct? Then try again. */
numeric digits 9; x= x / 1 /*re─do evaluation.*/
numeric digits 12 /*re─instate digits*/
if x\==$ then iterate /*Not correct? Then try again. */
end
finds= finds + 1 /*bump number of found solutions. */
if \show | negatory then return finds
_= translate(origE, '][', ")(") /*display [], not (). */
if show then say indent 'a solution for' gggg':' $"=" _ /*show solution.*/
if limit==1 & finds==limit then leave gggg /*leave big loop*/
end /*m*/
end /*k*/
end /*j*/
end /*i*/
end /*gggg*/
return finds
/*──────────────────────────────────────────────────────────────────────────────────────*/
validate: parse arg y; OK=1; _v=verify(y,digs); DE='digits entered, there must be four.'
select
when y=='' then call ger "no" DE
when length(y)<4 then call ger "not enough" DE
when length(y)>4 then call ger "too many" DE
when pos(0,y)\==0 then call ger "can't use the digit 0 (zero)."
when _v\==0 then call ger "illegal character: " substr(y, _v, 1)
otherwise nop
end /*select*/; return OK
sortc: procedure; arg nnnn; @.= /*sorts the digits of NNNN */
do i=1 for length(nnnn); _= substr(nnnn, i, 1); @._= @._||_; end /*i*/
return @.0 || @.1 || @.2 || @.3 || @.4 || @.5 || @.6 || @.7 || @.8 || @.9
/*──────────────────────────────────────────────────────────────────────────────────────*/
validate: parse arg y; errCode= 0; _v= verify(y, digs)
select
when y=='' then call ger 'no digits entered.'
when length(y)<4 then call ger 'not enough digits entered, must be 4'
when length(y)>4 then call ger 'too many digits entered, must be 4'
when pos(0,y)\==0 then call ger "can't use the digit 0 (zero)"
when _v\==0 then call ger 'illegal character:' substr(y, _v, 1)
otherwise nop
end /*select*/
return \errCode

34
Task/24-game/Red/24-game.red Normal file
View file

@ -0,0 +1,34 @@
Red []
print "Evaluation from left to right with no precedence, unless you use parenthesis." print ""
a: "123456789"
guess: ""
valid: ""
sucess: false
random/seed now/time
loop 4 [append valid last random a]
print ["The numbers are: " valid/1 ", " valid/2 ", " valid/3 " and " valid/4]
sort valid
insert valid " "
expr: [term ["+" | "-"] expr | term]
term: [primary ["*" | "/"] term | primary]
primary: [some digit | "(" expr ")"]
digit: charset valid
while [not sucess] [
guess: ask "Enter your expression: "
if guess = "q" [halt]
numbers: copy guess
sort numbers
numbers: take/last/part numbers 4
insert numbers " "
either (parse guess expr) and (valid = numbers) [
repeat i length? guess [insert at guess (i * 2) " "]
result: do guess
print ["The result of your expression is: " result]
if (result = 24) [sucess: true]
][
print "Something is wrong with the expression, try again."
]
]
print "You got it right!"

1
Task/9-billion-names-of-God-the-integer/00META.yaml Normal file
View file

@ -0,0 +1 @@
--- {}

8
Task/9-billion-names-of-God-the-integer/Crystal/9-billion-names-of-god-the-integer.crystal Normal file
View file

@ -0,0 +1,8 @@
def g(n,g)
return 1 unless 1 < g && g < n-1
(2..g).reduce(1){|res,q| res + (q > n-g ? 0 : g(n-g,q))}
end
(1..25).each {|n|
puts (1..n).map {|g| "%4s" % g(n,g)}.join
}

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

@ -1,24 +1,30 @@
package main
import (
f "fmt"
"math"
m "math/big"
"fmt"
"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))
intMin := func(a, b int) int {
if a < b {
return a
} else {
return b
}
}
var cache = [][]*big.Int{{big.NewInt(1)}}
cumu := func(n int) []*big.Int {
for y := len(cache); y <= n; y++ {
row := []*big.Int{big.NewInt(0)}
for x := 1; x <= y; x++ {
cacheValue := cache[y-x][intMin(x, y-x)]
row = append(row, big.NewInt(0).Add(row[len(row)-1], cacheValue))
}
cache = append(cache, r)
cache = append(cache, row)
}
return cache[n]
}
@ -26,20 +32,20 @@ func main() {
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))
fmt.Printf(" %v ", (big.NewInt(0).Sub(e[i+1], e[i])).Text(10))
}
f.Print("\n")
fmt.Println()
}
f.Print("rows:\n")
fmt.Println("rows:")
for x := 1; x < 11; x++ {
row(x)
}
f.Print("\n sums:\n")
nums := []int{23, 123, 1234,12345}
for _, num := range nums {
fmt.Println()
fmt.Println("sums:")
for _, num := range [...]int{23, 123, 1234, 12345} {
r := cumu(num)
f.Printf("%d %v \n", num, r[len(r)-1].Text(10))
fmt.Printf("%d %v\n", num, r[len(r)-1].Text(10))
}
}

38
Task/9-billion-names-of-God-the-integer/Julia/9-billion-names-of-god-the-integer.julia Normal file
View file

@ -0,0 +1,38 @@
using Combinatorics, StatsBase
namesofline(n) = counts([x[1] for x in integer_partitions(n)])
function centerjustpyramid(n)
maxwidth = length(string(namesofline(n)))
for i in 1:n
s = string(namesofline(i))
println(" " ^ div(maxwidth - length(s), 2), s)
end
end
centerjustpyramid(25)
const cachecountpartitions = Dict{BigInt,BigInt}()
function countpartitions(n::BigInt)
if n < 0
0
elseif n < 2
1
elseif (np = get(cachecountpartitions, n, 0)) > 0
np
else
np = 0
sgn = 1
for k = 1:n
np += sgn * (countpartitions(n - (k*(3k-1)) >> 1) + countpartitions(n - (k*(3k+1)) >> 1))
sgn = -sgn
end
cachecountpartitions[n] = np
end
end
G(n) = countpartitions(BigInt(n))
for g in [23, 123, 1234, 12345]
@time println("\nG($g) is $(G(g))")
end

7
Task/9-billion-names-of-God-the-integer/Maple/9-billion-names-of-god-the-integer.maple Normal file
View file

@ -0,0 +1,7 @@
TriangleLine(n) := map(rhs, Statistics :- Tally(map(x -> x[-1], combinat:-partition(n)))):
Triangle := proc(m)
local i;
for i from 1 to m do
print(op(TriangleLine(i)));
end do
end proc:

32
Task/9-billion-names-of-God-the-integer/Phix/9-billion-names-of-god-the-integer-1.phix Normal file
View file

@ -0,0 +1,32 @@
-- demo\rosetta\9billionnames.exw
sequence cache = {{1}}
function cumu(integer n)
sequence r
for l=length(cache) to n do
r = {0}
for x=1 to l do
r = append(r,r[-1]+cache[l-x+1][min(x,l-x)+1])
end for
cache = append(cache,r)
end for
return cache[n]
end function
function row(integer n)
sequence r = cumu(n+1)
sequence res = repeat(0,n)
for i=1 to n do
res[i] = r[i+1]-r[i]
end for
return res
end function
for i=1 to 25 do
puts(1,repeat(' ',50-2*i))
sequence r = row(i)
for j=1 to i do
printf(1,"%4d",r[j])
end for
puts(1,"\n")
end for

30
Task/9-billion-names-of-God-the-integer/Phix/9-billion-names-of-god-the-integer-2.phix Normal file
View file

@ -0,0 +1,30 @@
include mpfr.e
sequence p
procedure calc(integer n)
n += 1
for k=1 to n-1 do
integer d = n - k * (3 * k - 1) / 2;
if d<1 then exit end if
if and_bits(k,1) then mpz_add(p[n],p[n],p[d])
else mpz_sub(p[n],p[n],p[d]) end if
d -= k;
if d<1 then exit end if
if and_bits(k,1) then mpz_add(p[n],p[n],p[d])
else mpz_sub(p[n],p[n],p[d]) end if
end for
end procedure
constant cx = {23, 123, 1234, 12345}
puts(1,"sums:\n")
integer at = 1
p = mpz_inits(cx[$]+1)
mpz_set_si(p[1],1)
for i=1 to cx[$] do
calc(i)
if i=cx[at] then
printf(1,"%2d:%s\n",{i,mpz_get_str(p[i+1])})
at += 1
end if
end for

30
Task/9-billion-names-of-God-the-integer/Phix/9-billion-names-of-god-the-integer-3.phix Normal file
View file

@ -0,0 +1,30 @@
include pGUI.e
IupOpen()
IupControlsOpen()
Ihandle plot = IupPlot("MENUITEMPROPERTIES=Yes, SIZE=640x320")
IupSetAttribute(plot, "TITLE", "9 Billion Names");
IupSetAttribute(plot, "TITLEFONTSIZE", "10");
IupSetAttribute(plot, "TITLEFONTSTYLE", "ITALIC");
IupSetAttribute(plot, "GRIDLINESTYLE", "DOTTED");
IupSetAttribute(plot, "GRID", "YES");
IupSetAttribute(plot, "AXS_XLABEL", "x");
IupSetAttribute(plot, "AXS_YLABEL", "G(x)");
IupSetAttribute(plot, "AXS_XFONTSTYLE", "ITALIC");
IupSetAttribute(plot, "AXS_YFONTSTYLE", "ITALIC");
IupSetAttribute(plot, "AXS_XSCALE", "LOG10");
IupSetAttribute(plot, "AXS_YSCALE", "LOG10");
IupSetAttribute(plot, "AXS_YTICKSIZEAUTO", "NO");
IupSetAttribute(plot, "AXS_YTICKMAJORSIZE", "8");
IupSetAttribute(plot, "AXS_YTICKMINORSIZE", "0");
IupPlotBegin(plot)
for x=1 to 999 do
IupPlotAdd(plot, x, sum(row(x))) -- (row() from part 1)
end for
{} = IupPlotEnd(plot)
Ihandle dlg = IupDialog(plot)
IupCloseOnEscape(dlg)
IupSetAttribute(dlg, "TITLE", "9 Billion Names")
IupMap(dlg)
IupShowXY(dlg,IUP_CENTER,IUP_CENTER)
IupMainLoop()
IupClose()

52
Task/9-billion-names-of-God-the-integer/Phix/9-billion-names-of-god-the-integer.phix
View file

@ -1,52 +0,0 @@
--
-- Phix does not have a bignum library, and I have not attempted any formatting.
-- sum(1234) shows 1.5697879723e+35, not 156978797223733228787865722354959930,
-- and I did not wait to see if sum(12345) would finish. [for sum read cumu[$]]
-- If you want to try plotting things, then demo\arwendemo\demo_curve_fit.exw
-- might get you started.
function min(atom a, atom b)
if a<=b then return a end if
return b
end function
sequence cache = {{1}}
function cumu(integer n)
sequence r
for l=length(cache) to n do
r = {0}
for x=1 to l do
r = append(r,r[-1]+cache[l-x+1][min(x,l-x)+1])
end for
cache = append(cache,r)
end for
return cache[n]
end function
function row(integer n)
sequence r = cumu(n+1)
sequence res = repeat(0,n)
for i=1 to n do
res[i] = r[i+1]-r[i]
end for
return res
end function
constant cx = {23, 123, 1234} --, 12345}
procedure nine_billion_names()
puts(1,"rows:\n")
for x=1 to 25 do
printf(1,"%2d:",x)
?row(x)
end for
puts(1,"sums:\n")
for i=1 to length(cx) do
printf(1,"%2d:",cx[i])
?cumu(cx[i]+1)[$]
end for
if getc(0) then end if
end procedure
nine_billion_names()

16
Task/9-billion-names-of-God-the-integer/VBA/9-billion-names-of-god-the-integer.vba Normal file
View file

@ -0,0 +1,16 @@
Public Sub nine_billion_names()
Dim p(25, 25) As Long
p(1, 1) = 1
For i = 2 To 25
For j = 1 To i
p(i, j) = p(i - 1, j - 1) + p(i - j, j)
Next j
Next i
For i = 1 To 25
Debug.Print String$(50 - 2 * i, " ");
For j = 1 To i
Debug.Print String$(4 - Len(CStr(p(i, j))), " ") & p(i, j);
Next j
Debug.Print
Next i
End Sub

1
Task/99-Bottles-of-Beer/00META.yaml Normal file
View file

@ -0,0 +1 @@
--- {}

32
Task/99-Bottles-of-Beer/ALGOL-M/99-bottles-of-beer.algol-m Normal file
View file

@ -0,0 +1,32 @@
BEGIN
COMMENT PRINT LYRICS TO "99 BOTTLES OF BEER ON THE WALL";
STRING FUNCTION BOTTLE(N); % GIVE CORRECT GRAMMATICAL FORM %
INTEGER N;
BEGIN
IF N = 1 THEN
BOTTLE := " BOTTLE"
ELSE
BOTTLE := " BOTTLES";
END;
INTEGER N;
N := 99;
WHILE N > 0 DO
BEGIN
WRITE(N, BOTTLE(N), " OF BEER ON THE WALL,");
WRITEON(N, BOTTLE(N), " OF BEER");
WRITE("TAKE ONE DOWN AND PASS IT AROUND, ");
N := N - 1;
IF N = 0 THEN
WRITEON("NO MORE")
ELSE
WRITEON(N);
WRITEON(BOTTLE(N), " OF BEER ON THE WALL");
WRITE(" "); % BLANK LINE BETWEEN STANZAS %
END;
WRITE("THANKS FOR SINGING ALONG!");
END

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

@ -1,12 +1,12 @@
fun bottles(n):
| 0 => "No more bottles"
| 1 => "1 bottle"
| _ => "$n bottles"
fun bottles(n): match __args__:
(0) => "No more bottles"
(1) => "1 bottle"
(_) => "$n bottles"
for n in 99..-1..1:
print """
${bottles n} of beer on the wall
${bottles n} of beer
print @format"""
{bottles n} of beer on the wall
{bottles n} of beer
Take one down, pass it around
${bottles n-1} of beer on the wall\n
{bottles n-1} of beer on the wall\n
"""

2
Task/99-Bottles-of-Beer/Bc/99-bottles-of-beer.bc
View file

@ -1,5 +1,5 @@
i = 99;
while (i > -1) {
while ( 1 ) {
print i , " bottles of beer on the wall\n";
print i , " bottles of beer\nTake one down, pass it around\n";
if (i == 2) {

23
Task/99-Bottles-of-Beer/Clojure/99-bottles-of-beer-1.clj
View file

@ -1,12 +1,13 @@
(defn sing
[start]
(doseq [n (range start 0 -1)]
(printf "%d bottles of beer on the wall,
%d bottles of beer,
Take one down, pass it around,
%d bottles of beer on the wall.\n\n"
n
n
(dec n))))
(defn paragraph [num]
(str num " bottles of beer on the wall\n"
num " bottles of beer\n"
"Take one down, pass it around\n"
(dec num) " bottles of beer on the wall.\n"))
(sing 99)
(defn lyrics []
(let [numbers (range 99 0 -1)
paragraphs (map paragraph numbers)]
(clojure.string/join "\n" paragraphs)))
(print (lyrics))

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

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

19
Task/99-Bottles-of-Beer/Go/99-bottles-of-beer-1.go
View file

@ -3,16 +3,21 @@ package main
import "fmt"
func main() {
cardinality := func (i int) string {
if i!=1 {
return "s"
bottles := func(i int) string {
switch i {
case 0:
return "No more bottles"
case 1:
return "1 bottle"
default:
return fmt.Sprintf("%d bottles", i)
}
return ""
}
for i := 99; i > 0; i-- {
fmt.Printf("%d bottle%s of beer on the wall\n", i, cardinality(i))
fmt.Printf("%d bottle%s of beer\n", i, cardinality(i))
fmt.Printf("%s of beer on the wall\n", bottles(i))
fmt.Printf("%s of beer\n", bottles(i))
fmt.Printf("Take one down, pass it around\n")
fmt.Printf("%d bottle%s of beer on the wall\n", i-1, cardinality(i-1))
fmt.Printf("%s of beer on the wall\n", bottles(i-1))
}
}

19
Task/99-Bottles-of-Beer/Golo/99-bottles-of-beer.golo Normal file
View file

@ -0,0 +1,19 @@
module Bottles
augment java.lang.Integer {
function bottles = |self| -> match {
when self == 0 then "No bottles"
when self == 1 then "One bottle"
otherwise self + " bottles"
}
}
function main = |args| {
99: downTo(1, |i| {
println(i: bottles() + " of beer on the wall,")
println(i: bottles() + " of beer!")
println("Take one down, pass it around,")
println((i - 1): bottles() + " of beer on the wall!")
println("--------------------------------------")
})
}

38
Task/99-Bottles-of-Beer/Haskell/99-bottles-of-beer-4.hs
View file

@ -1,27 +1,23 @@
incant :: Int -> String
incant n =
let inventory = unwords . (: [locate]) . asset
in case n of
0 -> solve
_ -> unlines [inventory n, asset n, distribute, inventory (n - 1)]
asset :: Int -> String
asset n =
unwords
[ show n
, (reverse . concat) $
(case n of
1 -> []
_ -> ['s']) :
[drink]
]
[locate, distribute, solve, drink] =
location, distribution, solution :: String
[location, distribution, solution] =
[ "on the wall"
, "Take one down, pass it around"
, "Better go to the store to buy some more"
, "elttob"
]
asset :: Int -> String
asset n =
let suffix n
| 1 == n = []
| otherwise = ['s']
in unwords [show n, (reverse . concat) $ suffix n : ["elttob"]]
incantation :: Int -> String
incantation n =
let inventory = unwords . (: [location]) . asset
in case n of
0 -> solution
_ -> unlines [inventory n, asset n, distribution, inventory $ pred n]
main :: IO ()
main = putStrLn $ unlines (incant <$> [99,98 .. 0])
main = putStrLn $ unlines (incantation <$> [99,98 .. 0])

29
Task/99-Bottles-of-Beer/HolyC/99-bottles-of-beer.holyc Normal file
View file

@ -0,0 +1,29 @@
U0 BottlesOfBeer (I64 initial=99) {
// This is made I64 rather than U64
// Because, a U64 would overflow
// At the end of the loop, thus it would loop forever (i-- would be 0-1 so it overflows and is always greater than or equal to 0)
I64 i = initial;
for (; i >= 0; i--) {
if (i == 1) {
// Just a string on it's own will pass it to an inbuilt HolyC function that puts it to terminal
"1 Bottle of Beer on the wall, 1 bottle of beer.\n";
"Take one down and pass it around, no more bottles of beer on the wall.\n";
} else if (i == 0) {
"No more bottles of beer on the wall, no more bottles of beer.\n";
"Go to the store and buy some more, 99 bottles of beer on the wall.\n";
} else {
"%d bottles of beer on the wall, %d bottles of beer.\n",i,i;
"Take one down and pass it around, %d bottle",(i-1);
// Only add the s if it's not 1
if ((i-1) != 1) {
"s";
}
" of beer on the wall.\n";
}
}
}
// Calls the function, which goes to the default parameters
BottlesOfBeer;

31
Task/99-Bottles-of-Beer/Neko/99-bottles-of-beer.neko Normal file
View file

@ -0,0 +1,31 @@
/**
<doc>
<h3>Rosetta Code, 99 bottles of beer on the wall, in Neko</h3>
<pre>
Tectonics:
nekoc 99bottles.neko
neko 99bottles
</pre>
</doc>
**/
var message = " of beer on the wall\n";
var beers = 99;
var plural = function(n) {
return if (n == 1) " bottle" else " bottles";
}
var nonesome = function(n) {
return if (n > 0) n else "No more";
}
while (beers > 0) {
$print(nonesome(beers), plural(beers), message);
$print(nonesome(beers), plural(beers), " of beer\n");
$print("Take one down, pass it around\n");
beers -= 1;
$print(nonesome(beers), plural(beers), message);
if (beers > 0) $print("\n");
}

15
Task/99-Bottles-of-Beer/PHP/99-bottles-of-beer-6.php Normal file
View file

@ -0,0 +1,15 @@
<?php
$lyrics = <<<ENDVERSE
%2\$d bottle%1\$s of beer on the wall
%2\$d bottle%1\$s of beer
Take one down, pass it around
%4\$s bottle%3\$s of beer on the wall
ENDVERSE;
$x = 99;
while ( $x > 0 ) {
printf( $lyrics, $x != 1 ? 's' : '', $x--, $x != 1 ? 's' : '', $x > 0 ? $x : 'No more' );
}

25
Task/99-Bottles-of-Beer/Picat/99-bottles-of-beer.picat Normal file
View file

@ -0,0 +1,25 @@
beer1(N) =>
Beer = N,
while (Beer > 0)
printf("%d bottles of beer on the wall,\n", Beer),
printf("%d bottles of beer.\n", Beer),
printf("Take one down, pass it around.\n"),
printf("%d bottles of beer.\n", Beer-1),
Beer := Beer -1
end,
print("0 more bottles of beer on the wall.\n"),
nl.
% With plurals.
beer2(B) = S =>
BS = B.to_string(),
BB = " bottle",
BT = BB,
if B > 1 then BB := BB ++ "s" end,
OB = " of beer",
NL = "\n",
BW = OB ++ " on the wall." ++ NL,
T = "Take one down, pass it around." ++ NL,
S1 = BS ++ BT ++ BW ++ BS ++ BT ++ OB ++ T ++
cond(B > 0, (B-1).to_string() ++ BT ++ BW ++ NL, ""),
S = S1.

111
Task/99-Bottles-of-Beer/Python/99-bottles-of-beer-3.py Normal file
View file

@ -0,0 +1,111 @@
'''99 Units of Disposable Asset'''
from itertools import chain
# main :: IO ()
def main():
'''Modalised asset dispersal procedure.'''
# localisation :: (String, String, String)
localisation = (
'on the wall',
'Take one down, pass it around',
'Better go to the store to buy some more'
)
print(unlines(map(
incantation(localisation),
enumFromThenTo(99)(98)(0)
)))
# incantation :: (String, String, String) -> Int -> String
def incantation(localisation):
'''Versification of asset disposal
and inventory update.'''
location, distribution, solution = localisation
def inventory(n):
return unwords([asset(n), location])
return lambda n: solution if 0 == n else (
unlines([
inventory(n),
asset(n),
distribution,
inventory(pred(n))
])
)
# asset :: Int -> String
def asset(n):
'''Quantified asset.'''
def suffix(n):
return [] if 1 == n else 's'
return unwords([
str(n),
concat(reversed(concat(cons(suffix(n))(["elttob"]))))
])
# GENERIC -------------------------------------------------
# concat :: [[a]] -> [a]
# concat :: [String] -> String
def concat(xxs):
'''The concatenation of all the elements in a list.'''
xs = list(chain.from_iterable(xxs))
unit = '' if isinstance(xs, str) else []
return unit if not xs else (
''.join(xs) if isinstance(xs[0], str) else xs
)
# cons :: a -> [a] -> [a]
def cons(x):
'''Construction of a list from x as head,
and xs as tail.'''
return lambda xs: [x] + xs if (
isinstance(xs, list)
) else chain([x], xs)
# enumFromThenTo :: Int -> Int -> Int -> [Int]
def enumFromThenTo(m):
'''Integer values enumerated from m to n
with a step defined by nxt-m.'''
def go(nxt, n):
d = nxt - m
return list(range(m, d + n, d))
return lambda nxt: lambda n: (
go(nxt, n)
)
# pred :: Enum a => a -> a
def pred(x):
'''The predecessor of a value. For numeric types, (- 1).'''
return x - 1 if isinstance(x, int) else (
chr(ord(x) - 1)
)
# unlines :: [String] -> String
def unlines(xs):
'''A single string derived by the intercalation
of a list of strings with the newline character.'''
return '\n'.join(xs)
# unwords :: [String] -> String
def unwords(xs):
'''A space-separated string derived from
a list of words.'''
return ' '.join(xs)
if __name__ == '__main__':
main()

93
Task/99-Bottles-of-Beer/Python/99-bottles-of-beer-4.py Normal file
View file

@ -0,0 +1,93 @@
"""99 Bottles of Beer on the Wall made functional"""
from functools import partial
from typing import Callable
def regular_plural(noun: str) -> str:
"""Regular rule to get the plural form of a word"""
return noun + "s"
def beer_song(*,
location: str = 'on the wall',
distribution: str = 'Take one down, pass it around',
solution: str = 'Better go to the store to buy some more!',
container: str = 'bottle',
plurifier: Callable[[str], str] = regular_plural,
liquid: str = "beer",
initial_count: int = 99) -> None:
"""
Displays the lyrics of the beer song
:param location: initial location of the drink
:param distribution: specifies the process of its distribution
:param solution: what happens when we run out of drinks
:param container: bottle/barrel/flask or other containers
:param plurifier: function converting a word to its plural form
:param liquid: the name of the drink in the given container
:param initial_count: how many containers available initially
"""
verse = partial(get_verse,
location=location,
distribution=distribution,
solution=solution,
container=container,
plurifier=plurifier,
liquid=liquid)
verses = map(verse, range(initial_count, -1, -1))
print(*verses, sep='\n\n')
def get_verse(count: int,
*,
location: str,
distribution: str,
solution: str,
container: str,
plurifier: Callable[[str], str],
liquid: str) -> str:
"""Returns the verse for the given initial amount of drinks"""
inventory = partial(get_inventory,
location=location)
asset = partial(get_asset,
container=container,
plurifier=plurifier,
liquid=liquid)
initial_asset = asset(count)
final_asset = asset(count - 1)
standard_verse = '\n'.join([inventory(initial_asset),
initial_asset,
distribution,
inventory(final_asset)])
return solution if count == 0 else standard_verse
def get_inventory(asset: str,
*,
location: str) -> str:
"""
Used to return the first or the fourth line of the verse
>>> get_inventory("10 bottles of beer", location="on the wall")
"10 bottles of beer on the wall"
"""
return ' '.join([asset, location])
def get_asset(count: int,
*,
container: str,
plurifier: Callable[[str], str],
liquid: str) -> str:
"""
Quantified asset
>>> get_asset(0, container="jar", plurifier=regular_plural, liquid='milk')
"No more jars of milk"
"""
containers = container if count == 1 else plurifier(container)
spelled_out_quantity = "No more" if count == 0 else str(count)
return ' '.join([spelled_out_quantity, containers, "of", liquid])
if __name__ == '__main__':
beer_song()

2
Task/99-Bottles-of-Beer/Q/99-bottles-of-beer.q Normal file
View file

@ -0,0 +1,2 @@
bobw:{[n] {x," bottles of beer on the wall\n",x," bottles of beer\nTake one down, pass it around\n",y," bottles of beer on the wall\n\n"} . string (n;n-1)}
-1 bobw each reverse 1 + til 99

90
Task/99-Bottles-of-Beer/RPG/99-bottles-of-beer.rpg Normal file
View file

@ -0,0 +1,90 @@
H/TITLE 99 Bottles of Beer on the Wall - RPGIII (IBM System/38)
F********************************************************************
F*
F* Lines with an asterisk in column 7 (such as this one) are comments.
F*
F* The character in column 6 specifies the form type. Before the first
F* use of each form type is a comment with the template for the form.
F*
F********************************************************************
F* File Description Specifications
F*
F* Specify a default printer file for output, program described,
F* 132 columns wide, and an overflow indicator OV. The overflow
F* indicator is turned on when data is output to the last usable
F* line (line 60, for the default printer file QSYSPRT).
F*
F*ilenameIPEAF....RlenLK1AIOvKlocEDevice+......KExit++Entry+A....U1
FQSYSPRT O F 132 OV PRINTER
F*
C********************************************************************
C* If there were an input file, the RPG cycle would automatically
C* execute the output lines; since there is no input file, output
C* lines are produced as "exception" output with the EXCPT opcode.
C*
C* Calculation Specifications
C* vvvvvvvvv-- conditionally executes lines if indicators are on/off
C*0N01N02N03Factor1+++OpcdeFactor2+++ResultLenDHHiLoEqComments+++++++
C*
C* Zero, then add 99 to a variable named #BOTLS, which is defined
C* as packed decimal, 3 positions, 0 decimal places.
C Z-ADD99 #BOTLS 30
C*
C* Do until #BOTLS = 0. Each loop produces one complete verse.
C #BOTLS DOUEQ0
C*
C* When the overflow indicator is turned on, start a new page.
C* The indicator is automatically turned on when the overflow
C* line is printed on, and it is automatically turned off
C* when the heading is printed.
C OV EXCPTNEWPAG
C*
C* Print exception lines with names "LYRIC1" and "LYRIC2".
C EXCPTLYRIC1
C EXCPTLYRIC2
C*
C* Subtract 1 from #BOTLS, and turn on indicator LR (Last Record)
C* if the result is equal to zero (Eq); if LR is on, the program
C* will terminate at the end of the current cycle.
C SUB 1 #BOTLS LR
C*
C* Compare #BOTLS to 1, and turn on indicator 01 if equal.
C #BOTLS COMP 1 01
C*
C* Print exception lines with name "LYRIC1".
C EXCPTLYRIC1
C*
C* If LR is not on, print exception lines with name "SKIPLN"
C* (which, in this case, will produce a blank line between verses).
C NLR EXCPTSKIPLN
C*
C END end do
C*
O********************************************************************
O* Output Specifications
O* .-- E means "Exception" ("H" Header, "D" Detail, "T" Total)
O* v vv-- before printing, skip to line # 1 (of the next page)
O*ame++++DFBASbSaN01N02N03Excnam...........................................
OQSYSPRT E 1 NEWPAG
O* v-- space 1 line after printing
O E 1 LYRIC1
O*
O* .........-- conditionally print lines if indicators on/off
O* vvvvvvvvv v-- edit code Z (suppress leading Zeroes)
O*...............N01N02N03Field+YBEnd+PConstant/editword+++++++++
O #BOTLSZ 3
O N01NLR 11 'bottles'
O N01NLR 31 'of beer on the wall'
O 01NLR 10 'bottle'
O 01NLR 30 'of beer on the wall'
O LR 16 'No more bottles'
O LR 36 'of beer on the wall'
O E 1 LYRIC2
O #BOTLSZ 3
O N01 19 'bottles of beer'
O 01 18 'bottle of beer'
O E 1 LYRIC2
O 14 'Take one down'
O E 1 LYRIC2
O 15 'Pass it around'
O E 1 SKIPLN

40
Task/99-Bottles-of-Beer/Retro/99-bottles-of-beer.retro
View file

@ -1,16 +1,28 @@
[ dup "%d bottles" puts ]
[ "1 bottle" puts ]
[ "no more bottles" puts ]
create bottles , , ,
# 99 Bottles
: .bottles dup 2 ^math'min bottles + @ do ;
: .beer .bottles " of beer" puts ;
: .wall .beer " on the wall" puts ;
: .take "Take one down, pass it around" puts ;
: .verse .wall cr .beer cr
1- .take cr .wall cr ;
: ?dup dup 0; ;
: verses [ cr .verse dup 0 <> ] while drop ;
Display the text for the *99 Bottles of Beer* song.
99 verses
bye
~~~
{ 'bottle 'bottles 'of 'beer 'on 'the 'wall 'no 'more
'Take 'one 'down, 'pass 'it 'around }
[ dup ':%s_'%s_s:put_sp_; s:format s:evaluate ] a:for-each
{ [ no more bottles ]
[ #1 n:put sp bottle ]
[ dup n:put sp bottles ]
} 'BOTTLES const
:number-bottles
dup #2 n:min BOTTLES swap a:fetch call ;
:display-verse
number-bottles of beer on the wall nl
number-bottles of beer nl
n:dec Take one down, pass it around nl
number-bottles of beer on the wall nl ;
:verses (n-)
repeat 0; nl display-verse again ;
#99 verses
~~~

18
Task/99-Bottles-of-Beer/Rust/99-bottles-of-beer-1.rust Normal file
View file

@ -0,0 +1,18 @@
fn main() {
for n in (0..100).rev() {
match n {
0 => {
println!("No more bottles of beer on the wall, no more bottles of beer.");
println!("Go to the store and buy some more, 99 bottles of beer on the wall.");
},
1 => {
println!("1 bottle of beer on the wall, 1 bottle of beer.");
println!("Take one down and pass it around, no more bottles of beer on the wall.\n");
},
_ => {
println!("{0:?} bottles of beer on the wall, {0:?} bottles of beer.", n);
println!("Take one down and pass it around, {} bottles of beer on the wall.\n", n-1);
},
}
}
}

0
Task/99-Bottles-of-Beer/Rust/99-bottles-of-beer.rust → Task/99-Bottles-of-Beer/Rust/99-bottles-of-beer-2.rust
View file

49
Task/99-Bottles-of-Beer/SmileBASIC/99-bottles-of-beer.smilebasic Normal file
View file

@ -0,0 +1,49 @@
DEF NUM(N)
IF N==-1 THEN
RETURN "99"
ELSEIF N==0 THEN
RETURN "No more"
ELSE
RETURN STR$(N)
ENDIF
END
DEF BTL(N)
IF N==1 THEN
RETURN " bottle"
ELSE
RETURN " bottles"
ENDIF
END
DEF ACT(N)
IF N==0 THEN
RETURN "Go to the store, buy some more,"
ELSEIF N==1 THEN
RETURN "Take it down, pass it around,"
ELSE
RETURN "Take one down, pass it around,"
ENDIF
END
DEF WAITPLAY TUNE
BGMPLAY TUNE
WHILE BGMCHK(0):WEND
END
BGMSET 128,"T180@6E-8E-8E-8>B-8B-8B-8<E-8E-8E-8E-4R8"
BGMSET 129,"T180@6F8F8F8C8C8C8F4R4."
BGMSET 130,"T180@6D4D8D8R4D8D8D8D4R8"
BGMSET 131,"T180@6>A+8A+8A+8<C8C8D8D+8D+8D+8D+4R8"
FOR I=99 TO 0 STEP -1
CLS
PRINT NUM(I);BTL(I);" of beer on the wall,"
WAITPLAY 128
PRINT NUM(I);BTL(I);" of beer."
WAITPLAY 129
PRINT ACT(I)
WAITPLAY 130
PRINT NUM(I-1);BTL(I-1);" of beer on the wall."
WAITPLAY 131
NEXT

8
Task/99-Bottles-of-Beer/Swift/99-bottles-of-beer.swift
View file

@ -1,5 +1,5 @@
for i in (1...99).reversed() {
print("\(i) bottles of beer on the wall, \(i) bottles of beer.")
let next = i == 1 ? "no" : i.description
print("Take one down and pass it around, \(next) bottles of beer on the wall.")
}
print("\(i) bottles of beer on the wall, \(i) bottles of beer.")
let next = i == 1 ? "no" : (i-1).description
print("Take one down and pass it around, \(next) bottles of beer on the wall.")
}

18
Task/99-Bottles-of-Beer/TypeScript/99-bottles-of-beer.type Normal file
View file

@ -0,0 +1,18 @@
function beerSong(){
function nbottles(howMany:number){
return `${howMany?howMany:'no'} bottle${howMany!=1?'s':''}`;
}
let song=[];
let beer = 99;
while (beer > 0) {
song.push(`
${nbottles(beer)} of beer on the wall,
${nbottles(beer)} of beer!
Take one down, pass it around
${nbottles(--beer)} of beer on the wall
`);
}
return song.join('');
}
console.log(beerSong());

2
Task/99-Bottles-of-Beer/V/99-bottles-of-beer.v
View file

@ -1,5 +1,5 @@
[bottles
[newline <nowiki>''</nowiki> puts].
[newline '' puts].
[beer
[0 =] ['No more bottles of beer' put] if
[1 =] ['One bottle of beer' put] if

0
Task/99-Bottles-of-Beer/XSLT/99-bottles-of-beer.xslt → Task/99-Bottles-of-Beer/XSLT/99-bottles-of-beer-1.xslt
View file

20
Task/99-Bottles-of-Beer/XSLT/99-bottles-of-beer-2.xslt Normal file
View file

@ -0,0 +1,20 @@
<?xml version="1.0" ?>
<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
xmlns:xs="http://www.w3.org/2001/XMLSchema" exclude-result-prefixes="xs" version="3.0">
<xsl:output method="text"/>
<xsl:variable name="startingNumberOfBottles" select="99"/>
<!-- Main procedure. -->
<xsl:template match="/" expand-text="true">
<xsl:iterate select="reverse(1 to $startingNumberOfBottles)">
<xsl:variable name="currentBottles" select="." as="xs:integer"/>
<xsl:variable name="newBottles" select=". - 1" as="xs:integer"/>
<xsl:text>{$currentBottles} bottle{if ($currentBottles ne 1) then 's' else ()} of beer on the wall&#10;</xsl:text>
<xsl:text>{$currentBottles} bottle{if ($currentBottles ne 1) then 's' else ()} of beer&#10;</xsl:text>
<xsl:text>Take one down, pass it around&#10;</xsl:text>
<xsl:text>{$newBottles} bottle{if ($newBottles ne 1) then 's' else ()} of beer on the wall&#10;&#10;</xsl:text>
</xsl:iterate>
</xsl:template>
</xsl:stylesheet>

2
Task/A+B/00DESCRIPTION
View file

@ -2,7 +2,7 @@
;Task:
Given two integer, &nbsp; '''A''' and '''B'''.
Given two integers, &nbsp; '''A''' and '''B'''.
Their sum needs to be calculated.

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

@ -1,2 +1,9 @@
input, n$
print eval(word$(n$,1);" + ";word$(n$,2))
100 DO
110 INPUT PROMPT "Ener two integers separated by a comma: ":A,B
120 IF ABS(A)>1000 OR ABS(B)>1000 OR IP(A)<>A OR IP(B)<>B THEN
130 PRINT "Both integers must be in the interval [-1000..1000] - try again.":PRINT
140 ELSE
150 PRINT "Their sum is";A+B
160 EXIT DO
170 END IF
180 LOOP

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

@ -1,6 +1,2 @@
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 )
input, n$
print eval(word$(n$,1);" + ";word$(n$,2))

6
Task/A+B/BASIC/a+b-12.basic Normal file
View file

@ -0,0 +1,6 @@
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 )

2
Task/A+B/BASIC/a+b-4.basic
View file

@ -1,4 +1,4 @@
dim a(2)
input "Enter two numbers seperated by a space?", t$
input "Enter two numbers separated by a space?", t$
a = explode(t$," ")
print t$ + " " + (a[0] + a[1])

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

@ -1,9 +1,9 @@
import extensions.
import extensions;
public program
[
var A := Integer new.
var B := Integer new.
public program()
{
var A := new Integer();
var B := new Integer();
console readLine(A,B); writeLine(A + B)
]
console.loadLine(A,B).printLine(A + B)
}

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

@ -1,10 +1,10 @@
import system'routines.
import extensions.
import system'routines;
import extensions;
public program
[
console writeLine(console readLine;
split;
selectBy(%"convertorOp.toInt[0]");
summarize)
]
public program()
{
console.printLine(console.readLine()
.split()
.selectBy(__mssg toInt<convertorOp>[0])
.summarize())
}

27
Task/A+B/Golo/a+b.golo Normal file
View file

@ -0,0 +1,27 @@
#!/usr/bin/env golosh
----
This module asks for two numbers, adds them, and prints the result.
----
module Aplusb
import gololang.IO
function main = |args| {
let line = readln("Please enter two numbers (just leave a space in between them) ")
let numbers = line: split("[ ]+"): asList()
require(numbers: size() == 2, "we need two numbers")
try {
let a, b = numbers: map(|i| -> i: toInt())
require(a >= -1000 and a <= 1000 and b >= -1000 and b <= 1000, "both numbers need to be between -1000 and 1000")
println(a + b)
} catch (e) {
println("they both need to be numbers for this to work")
}
}

8
Task/A+B/Julia/a+b-1.julia
View file

@ -1,6 +1,2 @@
#A+B
function AB()
input = sum(map(int,split(readline(STDIN)," ")))
println(input)
end
AB()
input = parse.(Int, split(readline(stdin)))
println(stdout, sum(input))

2
Task/A+B/Julia/a+b-2.julia
View file

@ -1,3 +1,3 @@
julia> int(readuntil(STDIN, ' ')) + int(readuntil(STDIN, '\n'))
julia> println(parse(Int, readuntil(stdin, ' ')) + parse(Int, readuntil(stdin, '\n')))
1 2
3

65
Task/A+B/Neko/a+b.neko Normal file
View file

@ -0,0 +1,65 @@
/**
A+B, Rosetta Code, in Neko
Tectonics:
nekoc a+b.neko
echo '4 5' | neko a+b.n
*/
/* load some primitives */
var regexp_new = $loader.loadprim("regexp@regexp_new", 1)
var regexp_match = $loader.loadprim("regexp@regexp_match", 4)
var regexp_matched = $loader.loadprim("regexp@regexp_matched", 2)
var stdin = $loader.loadprim("std@file_stdin", 0)()
var file_read_char = $loader.loadprim("std@file_read_char", 1)
/* Read a line from file f into string s returning length without any newline */
var NEWLINE = 10
var readline = function(f, s) {
var len = 0
var ch
while true {
try ch = file_read_char(f) catch a break;
if ch == NEWLINE break;
if $sset(s, len, ch) == null break; else len += 1
}
return len
}
/* Trim a string of trailing NUL and spaces, returning substring */
var SPACE = 32
var trim = function(s) {
var len = $ssize(s)
var ch
while len > 0 {
ch = $sget(s, len - 1)
if ch != 0 && ch != SPACE break; else len -= 1
}
return $ssub(s, 0, len)
}
/* The A+B task */
var RECL = 132
try {
/* whitespace(s), digit(s), whitespace(s), digit(s) */
var twonums = regexp_new("^\\s*(\\d+)\\s+(\\d+)\\b")
var s = $smake(RECL)
var len = readline(stdin, s)
s = trim(s)
var valid = regexp_match(twonums, s, 0, $ssize(s))
if valid {
var first = regexp_matched(twonums, 1)
var second = regexp_matched(twonums, 2)
first = $int(first)
second = $int(second)
if first < -1000 || first > 1000 $throw("First value out of range -1000,1000")
if second < -1000 || second > 1000 $throw("Second value out of range -1000,1000")
$print($int(first) + $int(second), "\n")
} else $print("Need two numbers, separated by whitespace\n")
} catch with $print("Exception: ", with, "\n")

18
Task/A+B/Pascal/a+b-3.pascal Normal file
View file

@ -0,0 +1,18 @@
{ Task: A + B
Sum of A + B while A, B >= -1000 and A,B <= 1000
Author: Sinuhe Masan (2019) }
program APlusB;
var
A, B : integer;
begin
repeat
write('Enter two numbers betwen -1000 and 1000 separated by space: ');
readln(A, B);
until ((abs(A) < 1000) and (abs(B) < 1000));
writeln('The sum is: ', A + B);
end.

74
Task/A+B/Phix/a+b.phix
View file

@ -1,65 +1,9 @@
-- longhand version, input is echoed, full error handling
string text
integer idx = 0
integer ch
procedure nextch()
idx += 1
if idx>length(text) then
idx = 0
ch = 0
else
ch = text[idx]
end if
end procedure
function getNumber()
integer sign = 0
integer res = 0
while find(ch," \t\r\n") do
nextch()
end while
if idx=0 then
puts(1,"\nenter another number\n")
text = gets(0)
idx = 0
nextch()
end if
if ch='-' then
sign = 1
nextch()
end if
if idx=0 or ch<'0' or ch>'9' then
idx = 0
else
while 1 do
res = res*10+ch-'0'
nextch()
if idx=0 or ch<'0' or ch>'9' then exit end if
end while
if sign then
res = -res
end if
end if
return res
end function
procedure twoNumbers()
integer a, b
text = gets(0)
idx = 0
nextch()
if idx!=0 then
a = getNumber()
if idx!=0 and a>=-1000 and a<=1000 then
b = getNumber()
if idx!=0 and b>=-1000 and b<=1000 then
printf(1," %d\n",{a+b})
return
end if
end if
end if
puts(1," some error\n")
end procedure
twoNumbers()
-- demo\rosetta\AplusB.exw
string s = prompt_string("Enter two numbers separated by a space : ")
sequence r = scanf(s,"%d %d")
if length(r)=1 then
integer {a,b} = r[1], c = a+b
printf(1,"%d + %d = %d\n",{a,b,c})
else
printf(1,"invalid input\n")
end if

24
Task/A+B/Pony/a+b.pony Normal file
View file

@ -0,0 +1,24 @@
actor Main
let _env:Env
new create(env:Env)=>
_env=env
env.input(object iso is InputNotify
let _e:Main=this
fun ref apply(data:Array[U8] iso)=>
_e(consume data)
fun ref dispose()=>
None
end,
512)
be apply(s:Array[U8] iso)=>
let c=String.from_iso_array(consume s)
let parts:Array[String]=c.split(" ",0)
var sum:I32=0
try
for v in parts.values() do
sum=sum+match v.read_int[I32](0)?
|(let x:I32,_)=>x
end
end
end
_env.out.print(sum.string())

9
Task/A+B/REXX/a+b-4.rexx
View file

@ -2,11 +2,10 @@
numeric digits 1000 /*just in case the user gets ka-razy. */
say 'enter some numbers to be summed:' /*display a prompt message to terminal.*/
parse pull y /*obtain all numbers from input stream.*/
many=words(y) /*obtain the number of numbers entered.*/
$=0 /*initialize the sum to zero. */
many= words(y) /*obtain the number of numbers entered.*/
$= 0 /*initialize the sum to zero. */
do j=1 for many /*process each of the numbers. */
$=$ + word(y, j) /*add one number to the sum. */
$= $ + word(y, j) /*add one number to the sum. */
end /*j*/
say 'sum of ' many " numbers = " $/1 /*display normalized sum $ to terminal.*/
/*stick a fork in it, we're all done. */
say 'sum of ' many " numbers = " $/1 /*display normalized sum $ to terminal.*/

8
Task/A+B/REXX/a+b-5.rexx Normal file
View file

@ -0,0 +1,8 @@
/*REXX program obtains some numbers from the input stream (the console), shows their sum*/
numeric digits 1000 /*just in case the user gets ka-razy. */
say 'enter some numbers to be summed:' /*display a prompt message to terminal.*/
parse pull y /*obtain all numbers from input stream.*/
y=space(y)
y=translate(y,'+',' ')
Interpret 's='y
say 'sum of ' many " numbers = " s/1 /*display normalized sum s to terminal.*/

2
Task/A+B/Retro/a+b-1.retro
View file

@ -1 +1 @@
: try ( "-n ) getToken toNumber getToken toNumber + putn ;
:try ("-n) s:get s:to-number s:get s:to-number + n:put ;

4
Task/A+B/Retro/a+b-2.retro
View file

@ -1 +1,3 @@
try 1 2
try
1
2

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