Another update from ingydotnet^djgoku

This commit is contained in:
Ingy döt Net 2015-11-18 06:14:39 +00:00
parent 91df62d461
commit 948b86eafa
7604 changed files with 108452 additions and 22726 deletions

View file

@ -3,8 +3,9 @@ You make 100 [[task feature::Rosetta Code:multiple passes|passes]] by the doors.
The first time through, you visit every door and toggle the door (if the door is closed, you open it; if it is open, you close it). The second time you only visit every 2nd door (door #2, #4, #6, ...).
The third time, every 3rd door (door #3, #6, #9, ...), etc, until you only visit the 100th door.
Question: What state are the doors in after the last pass? Which are open, which are closed? [http://www.techinterview.org/Puzzles/fog0000000079.html]
Question: What state are the doors in after the last pass? Which are open, which are closed?
'''[[task feature::Rosetta Code:extra credit|Alternate]]:'''
As noted in this page's [[Talk:100 doors|discussion page]], the only doors that remain open are whose numbers are perfect squares of integers.
Opening only those doors is an [[task feature::Rosetta Code:optimization|optimization]] that may also be expressed.
Opening only those doors is an [[task feature::Rosetta Code:optimization|optimization]] that may also be expressed;
however, as should be obvious, this defeats the intent of comparing implementations across programming languages.

View file

@ -0,0 +1,38 @@
* 100 doors 13/08/2015
HUNDOOR CSECT
USING HUNDOOR,R12
LR R12,R15
LA R6,0
LA R8,1 step 1
LA R9,100
LOOPI BXH R6,R8,ELOOPI do ipass=1 to 100 (R6)
LR R7,R6
SR R7,R6
LR R10,R6 step ipass
LA R11,100
LOOPJ BXH R7,R10,ELOOPJ do idoor=ipass to 100 by ipass (R7)
LA R5,DOORS-1
AR R5,R7
XI 0(R5),X'01' doors(idoor)=not(doors(idoor))
NEXTJ B LOOPJ
ELOOPJ B LOOPI
ELOOPI LA R10,BUFFER R10 address of the buffer
LA R5,DOORS R5 address of doors item
LA R6,1 idoor=1 (R6)
LA R9,100 loop counter
LOOPN CLI 0(R5),X'01' if doors(idoor)=1
BNE NEXTN
XDECO R6,XDEC idoor to decimal
MVC 0(4,R10),XDEC+8 move decimal to buffer
LA R10,4(R10)
NEXTN LA R6,1(R6) idoor=idoor+1
LA R5,1(R5)
BCT R9,LOOPN loop
ELOOPN XPRNT BUFFER,80
RETURN XR R15,R15
BR R14
DOORS DC 100X'00'
BUFFER DC CL80' '
XDEC DS CL12
YREGS
END HUNDOOR

View file

@ -0,0 +1,32 @@
begin
% find the first few squares via the unoptimised door flipping method %
integer doorMax;
doorMax := 100;
begin
% need to start a new block so the array can have variable bounds %
% array of doors - door( i ) is true if open, false if closed %
logical array door( 1 :: doorMax );
% set all doors to closed %
for i := 1 until doorMax do door( i ) := false;
% repeatedly flip the doors %
for i := 1 until doorMax
do begin
for j := i step j until doorMax
do begin
door( j ) := not door( j )
end
end;
% display the results %
i_w := 1; % set integer field width %
s_w := 1; % and separator width %
for i := 1 until doorMax do if door( i ) then writeon( i )
end
end.

View file

@ -0,0 +1,2 @@
doors{100((-1)0),1}
doors¨ 100

View file

@ -0,0 +1,3 @@
>"d">:00p1-:>:::9%\9/9+g2%!\:9v
$.v_^#!$::$_^#`"c":+g00p+9/9\%<
::<_@#`$:\*:+55:+1p27g1g+9/9\%9

View file

@ -0,0 +1 @@
1+:::*.9`#@_

View file

@ -0,0 +1,12 @@
for i=1:1:100 {
set doors(i) = 0
}
for i=1:1:100 {
for door=i:i:100 {
Set doors(door)='doors(door)
}
}
for i = 1:1:100
{
if doors(i)=1 write i_": open",!
}

View file

@ -0,0 +1,10 @@
1: open
4: open
9: open
16: open
25: open
36: open
49: open
64: open
81: open
100: open

View file

@ -1,9 +1,9 @@
(defn doors []
(reduce (fn [doors idx] (assoc doors idx true))
(into [] (repeat 100 false))
(map #(dec (* % %)) (range 1 11))))
(defn open-doors [] (for [[d n] (map vector (doors) (iterate inc 1)) :when d] n))
(defn open-doors []
(->> (for [step (range 1 101), occ (range step 101 step)] occ)
frequencies
(filter (comp odd? val))
(map first)
sort))
(defn print-open-doors []
(println

View file

@ -0,0 +1,11 @@
(defn doors []
(reduce (fn [doors idx] (assoc doors idx true))
(into [] (repeat 100 false))
(map #(dec (* % %)) (range 1 11))))
(defn open-doors [] (for [[d n] (map vector (doors) (iterate inc 1)) :when d] n))
(defn print-open-doors []
(println
"Open doors after 100 passes:"
(apply str (interpose ", " (open-doors)))))

View file

@ -0,0 +1,6 @@
(defn open-doors [] (->> (iterate inc 1) (map #(* % %)) (take-while #(<= % 100))))
(defn print-open-doors []
(println
"Open doors after 100 passes:"
(apply str (interpose ", " (open-doors)))))

View file

@ -1,7 +1,7 @@
(define-modify-macro toggle () not)
(defun 100-doors ()
(let ((doors (make-array 100 :initial-element nil)))
(let ((doors (make-array 100)))
(dotimes (i 100)
(loop for j from i below 100 by (1+ i)
do (toggle (svref doors j))))

View file

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

View file

@ -1,5 +1,6 @@
(let ((i 0))
(mapcar (lambda (x)
(if (zerop (mod (sqrt (incf i)) 1))
"_" "#"))
(make-list 100)))
(defun 100-doors ()
(let ((doors (make-array 100)))
(dotimes (i 10)
(setf (svref doors (* i i)) t))
(dotimes (i 100)
(format t "door ~a: ~:[closed~;open~]~%" (1+ i) (svref doors i)))))

View file

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

View file

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

View file

@ -1,7 +1,7 @@
note
description: "100 Doors problem"
date: "07-AUG-2011"
revision: "1.0"
date: "08-JUL-2015"
revision: "1.1"
class
APPLICATION
@ -11,54 +11,82 @@ create
feature {NONE} -- Initialization
doors: LINKED_LIST [DOOR]
-- A set of doors
once
create Result.make
make
-- Main application routine.
do
initialize_closed_doors
toggle_doors
output_door_states
end
make
-- Run application.
local
count, i: INTEGER
feature -- Access
doors: ARRAYED_LIST [DOOR]
-- A set of doors (self-initialized to capacity of `max_door_count').
attribute
create Result.make (max_door_count)
end
feature -- Basic Operations
initialize_closed_doors
-- Initialize all `doors'.
do
--initialize doors
count := 100
from
i := 1
until
i > count
loop
doors.extend (create {DOOR}.make (i, false))
i := i + 1
across min_door_count |..| max_door_count as ic_address_list loop
doors.extend (create {DOOR}.make_closed (ic_address_list.item))
end
ensure
has_all_closed_doors: across doors as ic_doors_list all not ic_doors_list.item.is_open end
end
-- toggle doors
from
i := 1
until
i > count
loop
across
doors as this
loop
if this.item.address \\ i = 0 then
this.item.open := not this.item.open
toggle_doors
-- Toggle all `doors'.
do
across min_door_count |..| max_door_count as ic_addresses_list loop
across doors as ic_doors_list loop
if is_door_to_toggle (ic_doors_list.item.address, ic_addresses_list.item) then
ic_doors_list.item.toggle_door
end
end -- across doors
i := i + 1
end -- for i
end
end
end
-- print results
doors.do_all (agent (door: DOOR)
do
if door.open then
io.put_string ("Door " + door.address.out + " is open.")
elseif not door.open then
io.put_string ("Door " + door.address.out + " is closed.")
end
io.put_new_line
end)
end -- make
output_door_states
-- Output the state of all `doors'.
do
doors.do_all (agent door_state_out)
end
end -- APPLICATION
feature -- Status Report
is_door_to_toggle (a_door_address, a_index_address: like {DOOR}.address): BOOLEAN
-- Is the door at `a_door_address' needing to be toggled, when compared to `a_index_address'?
do
Result := a_door_address \\ a_index_address = 0
ensure
only_modulus_zero: Result = (a_door_address \\ a_index_address = 0)
end
feature -- Outputs
door_state_out (a_door: DOOR)
-- Output the state of `a_door'.
do
print ("Door " + a_door.address.out + " is ")
if a_door.is_open then
print ("open.")
else
print ("closed.")
end
io.new_line
end
feature {DOOR} -- Constants
min_door_count: INTEGER = 1
-- Minimum number of doors.
max_door_count: INTEGER = 100
-- Maximum number of doors.
end

View file

@ -1,44 +1,77 @@
note
description: "A door with an address and an open or closed state."
date: "07-AUG-2011"
revision: "1.0"
date: "08-JUL-2015"
revision: "1.1"
class
DOOR
create
make_closed,
make
feature -- initialization
feature {NONE} -- initialization
make (addr: INTEGER; status: BOOLEAN)
-- create door with address and status
make_closed (a_address: INTEGER)
-- Initialize Current {DOOR} at `a_address' and state of `Is_closed'.
require
valid_address: addr /= '%U'
valid_status: status /= '%U'
positive: a_address >= {APPLICATION}.min_door_count and a_address >= Min_door_count
do
address := addr
open := status
make (a_address, Is_closed)
ensure
address_set: address = addr
status_set: open = status
closed: is_open = Is_closed
end
make (a_address: INTEGER; a_status: BOOLEAN)
-- Initialize Current {DOOR} with `a_address' and `a_status', denoting position and `is_open' or `Is_closed'.
require
positive: a_address >= {APPLICATION}.min_door_count and a_address >= Min_door_count
do
address := a_address
is_open := a_status
ensure
address_set: address = a_address
status_set: is_open = a_status
end
feature -- access
address: INTEGER
-- `address' of Current {DOOR}.
open: BOOLEAN assign set_open
is_open: BOOLEAN assign set_open
-- `is_open' (or not) status of Current {DOOR}.
feature -- mutators
feature -- Setters
set_open (status: BOOLEAN)
require
valid_status: status /= '%U'
set_open (a_status: BOOLEAN)
-- Set `status' with `a_status'
do
open := status
is_open := a_status
ensure
open_updated: open = status
open_updated: is_open = a_status
end
feature {APPLICATION} -- Basic Operations
toggle_door
-- Toggle Current {DOOR} from `is_open' to not `is_open'.
do
is_open := not is_open
ensure
toggled: is_open /= old is_open
end
feature {NONE} -- Implementation: Constants
Is_closed: BOOLEAN = False
-- State of being not `is_open'.
Min_door_count: INTEGER = 1
-- Minimum door count.
invariant
one_or_more: address >= 1
consistency: is_open implies not Is_closed
end

View file

@ -0,0 +1,21 @@
#define system.
#define system'routines.
#define extensions.
#symbol program=
[
#var Doors := Array new:100 set &every: (&index:n) [ false ].
0 till:100 &doEach: i
[
i till:100 &by:(i + 1) &doEach: j
[
Doors@j := Doors@j not.
].
].
0 till:100 &doEach: i
[
console writeLine:"Door #":(i + 1):" :":(Doors@i iif:"Open":"Closed").
].
].

View file

@ -1,26 +1,30 @@
defmodule HundredDoors do
def doors() do
Enum.to_list(Stream.take(Stream.cycle([false]), 100))
def doors(n \\ 100) do
List.duplicate(false, n)
end
def toggle(doors, n) do
Enum.take(doors, n) ++ [not Enum.at(doors,n)] ++ Enum.drop(doors,n+1)
List.update_at(doors, n, &(!&1))
end
def toggle_every(doors, n) do
Enum.reduce( Enum.take_every((n-1)..99, n), doors, fn(n, acc) -> toggle(acc, n) end )
end
end
# unoptimized
final_state = Enum.reduce(1..100, HundredDoors.doors, fn(n, acc) -> HundredDoors.toggle_every(acc, n) end)
open_doors = Enum.with_index(final_state)
|> Enum.filter_map(fn {door,_} -> door end, fn {_,index} -> index+1 end)
IO.puts "All doors are closed except these: #{inspect open_doors}"
# optimized
final_state = Enum.reduce(1..10, HundredDoors.doors, fn(n, acc) -> HundredDoors.toggle(acc, n*n-1) end)
open_doors = Enum.map(Enum.filter( Enum.with_index(final_state), fn({door,_}) -> door end ),
fn({_,index}) -> index+1 end)
open_doors = Enum.with_index(final_state)
|> Enum.filter_map(fn {door,_} -> door end, fn {_,index} -> index+1 end)
IO.puts "All doors are closed except these: #{inspect open_doors}"

View file

@ -0,0 +1,10 @@
10 DIM A(100)
20 FOR OFFSET = 1 TO 100
30 FOR I = 0 TO 100 STEP OFFSET
40 A(I) = A(I) + 1
50 NEXT I
60 NEXT OFFSET
70 ' Print "opened" doors
80 FOR I = 1 TO 100
90 IF A(I) MOD 2 = 1 THEN PRINT I
100 NEXT I

View file

@ -0,0 +1,14 @@
(function () {
return rng(1, Math.sqrt(100)).map(function (x) {
return x * x;
});
// rng(1, 20) --> [1..20]
function rng(m, n) {
return Array.apply(null, Array(n - m + 1)).map(function (x, i) {
return m + i;
});
}
})();

View file

@ -0,0 +1 @@
[1, 4, 9, 16, 25, 36, 49, 64, 81, 100]

View file

@ -0,0 +1,9 @@
Array.apply(null, { length: 100 })
.map((v, i) => i + 1)
.forEach(door => {
var sqrt = Math.sqrt(door);
if (sqrt === (sqrt | 0)) {
console.log("Door %d is open", door);
}
});

View file

@ -0,0 +1,9 @@
// Array comprehension style
[ for (i of Array.apply(null, { length: 100 })) i ].forEach((_, i) => {
var door = i + 1
var sqrt = Math.sqrt(door);
if (sqrt === (sqrt | 0)) {
console.log("Door %d is open", door);
}
});

View file

@ -1,6 +1,41 @@
for (var door = 1; door <= 100; door++) {
var sqrt = Math.sqrt(door);
if (sqrt === (sqrt | 0)) {
console.log("Door %d is open", door);
(function () {
return chain(
// 100 passes ...
rng(0, 99).reduce(function (a, _, i) {
return a.slice(0, i).concat(
a.slice(i).map(function (v, j) {
return (i + j + 1) % (i + 1) ? v : {
door: v.door,
open: !v.open
};
})
)
},
// 100 closed doors at start
Array.apply(null, Array(100)).map(function (x, i) {
return {
open: false,
door: i + 1
};
})),
// Filtering by chained function
function (door) {
return door.open ? [door] : [];
}
)
// Monadic bind (chain) for lists
function chain(xs, f) {
return [].concat.apply([], xs.map(f));
}
}
// range(1, 20) --> [1..20]
function rng(m, n) {
return Array.apply(null, Array(n - m + 1)).map(function (x, i) {
return m + i;
});
}
})();

View file

@ -1,9 +1 @@
Array.apply(null, { length: 100 })
.map(function(v, i) { return i + 1; })
.forEach(function(door) {
var sqrt = Math.sqrt(door);
if (sqrt === (sqrt | 0)) {
console.log("Door %d is open", door);
}
});
[{"door":1, "open":true}, {"door":4, "open":true}, {"door":9, "open":true}, {"door":16, "open":true}, {"door":25, "open":true}, {"door":36, "open":true}, {"door":49, "open":true}, {"door":64, "open":true}, {"door":81, "open":true}, {"door":100, "open":true}]

View file

@ -1,3 +1,6 @@
for(var door=1;i<10/*Math.sqrt(100)*/;i++){
console.log("Door %d is open",i*i);
for (var door = 1; door <= 100; door++) {
var sqrt = Math.sqrt(door);
if (sqrt === (sqrt | 0)) {
console.log("Door %d is open", door);
}
}

View file

@ -1,9 +1,3 @@
Array.apply(null, { length: 100 })
.map((v, i) => i + 1)
.forEach(door => {
var sqrt = Math.sqrt(door);
if (sqrt === (sqrt | 0)) {
console.log("Door %d is open", door);
}
});
for(var door=1;i<10/*Math.sqrt(100)*/;i++){
console.log("Door %d is open",i*i);
}

View file

@ -1,9 +1,9 @@
// Array comprehension style
[ for (i of Array.apply(null, { length: 100 })) i ].forEach((_, i) => {
var door = i + 1
var sqrt = Math.sqrt(door);
Array.apply(null, { length: 100 })
.map(function(v, i) { return i + 1; })
.forEach(function(door) {
var sqrt = Math.sqrt(door);
if (sqrt === (sqrt | 0)) {
console.log("Door %d is open", door);
}
});
if (sqrt === (sqrt | 0)) {
console.log("Door %d is open", door);
}
});

View file

@ -0,0 +1,34 @@
(function () {
return chain(
rng(1, 100),
function (x) {
var root = Math.sqrt(x);
return root === Math.floor(root) ? inject(x) : fail();
}
);
/*************************************************************/
// monadic Bind/chain for lists
function chain(xs, f) {
return [].concat.apply([], xs.map(f));
}
// monadic Return/inject for lists
function inject(x) { return [x]; }
// monadic Fail for lists
function fail() { return []; }
// rng(1, 20) --> [1..20]
function rng(m, n) {
return Array.apply(null, Array(n - m + 1)).map(function (x, i) {
return m + i;
});
}
})();

View file

@ -0,0 +1 @@
[1, 4, 9, 16, 25, 36, 49, 64, 81, 100]

View file

@ -0,0 +1,18 @@
(function () {
return rng(1, 100).filter(
function (x) {
var root = Math.sqrt(x);
return root === Math.floor(root);
}
);
// rng(1, 20) --> [1..20]
function rng(m, n) {
return Array.apply(null, Array(n - m + 1)).map(function (x, i) {
return m + i;
});
}
})();

View file

@ -3,5 +3,5 @@ for a = 1:100, b in a:a:100
doors[b] = !doors[b]
end
for a = 1:100
println("Door $a is " * (doors[a] ? "open" : "close"))
println("Door $a is " * (doors[a] ? "open." : "closed."))
end

View file

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

View file

@ -1,5 +1,5 @@
/* NetRexx */
options replace format comments java crossref savelog symbols binary
options replace format comments java crossref symbols binary
True = Rexx(1 == 1)
False = Rexx(\True)

View file

@ -1,5 +1,5 @@
/* NetRexx */
options replace format comments java crossref savelog symbols binary
options replace format comments java crossref symbols binary
True = (1 == 1)
False = \True

View file

@ -1,5 +1,5 @@
my @doors = False xx 101;
($_ = !$_ for @doors[0, * + $_ ...^ * > 100]) for 1..100;
(.=not for @doors[0, $_ ... 100]) for 1..100;
say "Door $_ is ", <closed open>[ @doors[$_] ] for 1..100;

View file

@ -1,14 +1,13 @@
// rust 1.0.0-alpha
#![feature(core)]
use std::iter::{range_step_inclusive};
fn main() {
let mut door_open = [false; 100];
for pass in (1us..101) {
for door in range_step_inclusive(pass, 100, pass) {
door_open[door - 1] = !door_open[door - 1];
let mut door_open = [false; 100];
for pass in (1..101) {
let mut door = pass;
while door <= 100 {
door_open[door - 1] = !door_open[door - 1];
door += pass;
}
}
for (i, &is_open) in door_open.iter().enumerate() {
println!("Door {} is {}.", i + 1, if is_open {"open"} else {"closed"});
}
}
for (i, state) in door_open.iter().enumerate() {
println!("Door {} is {}.", i + 1, if *state {"open"} else {"closed"});
}
}

View file

@ -1,9 +1,9 @@
// rust 0.8
fn main() {
for i in std::iter::range_inclusive(1,100) {
let x = (i as f64).pow(&0.5);
let state = if x == x.round() {"open"} else {"closed"};
println!("Door {} is {}", i, state);
}
let squares: Vec<_> = (1..10+1).map(|n| n*n).collect();
let is_square = |num| squares.binary_search(&num).is_ok();
for i in 1..100+1 {
let state = if is_square(i) {"open"} else {"closed"};
println!("Door {} is {}", i, state);
}
}

View file

@ -1,9 +1,10 @@
@(do (defun hyaku-mai-tobira ()
(let ((doors (vector 100)))
(each ((i (range 0 99)))
(each ((j (range i 99 (+ i 1))))
(flip [doors j])))
doors))
(each ((counter (range 1))
(door (hyaku-mai-tobira)))
(put-line `door @counter is @(if door "open" "closed")`)))
(defun hyaku-mai-tobira ()
(let ((doors (vector 100)))
(each ((i (range 0 99)))
(each ((j (range i 99 (+ i 1))))
(flip [doors j])))
doors))
(each ((counter (range 1))
(door (hyaku-mai-tobira)))
(put-line `door @counter is @(if door "open" "closed")`))

View file

@ -31,7 +31,7 @@ for unique permutations @digits -> @p {
for @formats -> $format {
my $string = sprintf $format, @p[0], @o[0],
@p[1], @o[1], @p[2], @o[2], @p[3];
my $result = try { eval($string) };
my $result = try { EVAL($string) };
say "$string = 24" and last if $result and $result == 24;
}
}

View file

@ -1,83 +1,150 @@
@echo off
@set @dummy=0 /*
::24.bat
::
::Batch file implemetnation of the 24 Game where a player is given four random
::digits n, where 1 <= n <= 9, and needs to provide a simple arithmetic
::operation that does evaluate to 24.
::
::Note: [1]This implementation does not evaluate brackets
:: [2]This implementation does not keep remainders since batch language
:: has no support for floating point calculations
::Please open the Batch File Directly to play...
@echo off
setlocal enabledelayedexpansion
title The 24 Game Batch File
cls
echo.
echo The 24 Game
echo.
echo Given four digits, provide a simple arithmetic expression
echo that evaluates to 24 using +,-,*,/.
echo.
echo Enter 'SHOW' to show the digits or 'EXIT' to end the game.
echo Reminders (Please read):
echo.
echo 1. Type 'new' (NO quotes) - Fresh digits
echo 2. Type 'show' (NO quotes) - Show digits
echo 3. Type 'exit' (NO quotes) - Quit game
echo 4. Combining two digits as one number is NOT allowed.
echo 5. Use each digit only ONCE in expressions.
echo 6. Use ONLY the Parentheses as the groupting symbols.
echo 7. Do not make any digit Negative.
echo.
echo Why do someone wants to not follow the reminders? To trick me, right? ;)
echo.
pause
:NEW
set TRY=0
::Get four random digits
set /a "DIGIT_1=%RANDOM% %%9 + 1"
set /a "DIGIT_2=%RANDOM% %%9 + 1"
set /a "DIGIT_3=%RANDOM% %%9 + 1"
set /a "DIGIT_4=%RANDOM% %%9 + 1"
set /a "DIGIT_1=%RANDOM%%%9+1"
set /a "DIGIT_2=%RANDOM%%%9+1"
set /a "DIGIT_3=%RANDOM%%%9+1"
set /a "DIGIT_4=%RANDOM%%%9+1"
cls
echo.
echo The 24 Game
echo.
goto SHOW
::Main Program Loop
:MAIN
set /a TRY+=1
set ANSWER=
set "TMP_DIGIT_1=%DIGIT_1%"
set "TMP_DIGIT_2=%DIGIT_2%"
set "TMP_DIGIT_3=%DIGIT_3%"
set "TMP_DIGIT_4=%DIGIT_4%"
::Promt for an answer and trim answer string
::Prompt for an answer
echo.
set /p ANSWER="Try %TRY%: "
set "ANSWER=%ANSWER: =%"
::Determine if the player inputs a "good" try (input validation...)
if /i "!ANSWER!"=="NEW" goto NEW
if /i "!ANSWER!"=="SHOW" goto SHOW
if /i "!ANSWER!"=="EXIT" goto ABORT
if /i "%ANSWER%"=="SHOW" goto SHOW
if /i "%ANSWER%"=="EXIT" goto ABORT
if "%ANSWER:~6,1%"=="" goto ERROR_MISSING_CHARS:
set ANSWER=!ANSWER: =!
set DIGITS_USED=0&set COUNTER=0
::Determine if each digits has ben used once in the input equation
set DIGITS_USED=0
set COUNTER=0
:LOOP
call set CURR_DIGIT=%%ANSWER:~%COUNTER%,1%%
if %CURR_DIGIT%==%TMP_DIGIT_1% (set "TMP_DIGIT_1=" & set /a "DIGITS_USED+=1")
if %CURR_DIGIT%==%TMP_DIGIT_2% (set "TMP_DIGIT_2=" & set /a "DIGITS_USED+=2")
if %CURR_DIGIT%==%TMP_DIGIT_3% (set "TMP_DIGIT_3=" & set /a "DIGITS_USED+=4")
if %CURR_DIGIT%==%TMP_DIGIT_4% (set "TMP_DIGIT_4=" & set /a "DIGITS_USED+=8")
set /a "COUNTER+=2"
if not "%COUNTER%"=="8" goto LOOP
if not "%DIGITS_USED%"=="15" goto ERROR_INCORRECT_INPUT
set CURR_DIGIT=!ANSWER:~%COUNTER%,1!
if "!CURR_DIGIT!"=="%TMP_DIGIT_1%" (set "TMP_DIGIT_1=X"&goto NEXTCHARSCAN1)
if "!CURR_DIGIT!"=="%TMP_DIGIT_2%" (set "TMP_DIGIT_2=X"&goto NEXTCHARSCAN1)
if "!CURR_DIGIT!"=="%TMP_DIGIT_3%" (set "TMP_DIGIT_3=X"&goto NEXTCHARSCAN1)
if "!CURR_DIGIT!"=="%TMP_DIGIT_4%" (set "TMP_DIGIT_4=X"&goto NEXTCHARSCAN1)
if "!CURR_DIGIT!"=="" goto ALMOST
if "!CURR_DIGIT!"==")" goto SCANMORE
if "!CURR_DIGIT!"=="(" goto SCANMORE
if "!CURR_DIGIT!"=="+" goto NEXTCHARSCAN2
if "!CURR_DIGIT!"=="-" goto DONTALLOWNEGATIVES
if "!CURR_DIGIT!"=="*" goto NEXTCHARSCAN2
if "!CURR_DIGIT!"=="/" goto NEXTCHARSCAN2
goto ERROR_ICHAR_FOUND
::Calculate and evaluate result
set /a "RESULT=%ANSWER%"
:NEXTCHARSCAN1
set /a NEXT=%COUNTER%+1
set NEXT_CHAR=!ANSWER:~%NEXT%,1!
for /l %%w in (1,1,9) do (
if "!NEXT_CHAR!"=="%%w" goto ERROR_POSITION
)
goto :SCANMORE
:DONTALLOWNEGATIVES
set /a NEXT=%COUNTER%-1
if "%NEXT%"=="-1" goto ERROR_NEGA
set NEXT_CHAR=!ANSWER:~%NEXT%,1!
for /l %%z in (1,1,9) do (
if "!NEXT_CHAR!"=="%%z" goto NEXTCHARSCAN2
)
if "!NEXT_CHAR!"=="(" goto ERROR_NEGA
if "!NEXT_CHAR!"==")" goto NEXTCHARSCAN2
goto ERROR_NEGA
:NEXTCHARSCAN2
set /a NEXT=%COUNTER%+1
set NEXT_CHAR=!ANSWER:~%NEXT%,1!
for %%y in (+,-,/) do (
if "!NEXT_CHAR!"=="%%y" goto ERROR_TRICK
)
:SCANMORE
set /a "COUNTER+=1"&goto LOOP
:ALMOST
if not "%TMP_DIGIT_1%%TMP_DIGIT_2%%TMP_DIGIT_3%%TMP_DIGIT_4%"=="XXXX" goto ERROR_CHARS
::(SIGH) Input passed... Now, calculate and evaluate result
set "RESULT="
for /f "usebackq delims=" %%x in (`cscript //nologo //e:jscript "%~f0" "%ANSWER%" 2^>nul`) do set RESULT=%%x
::Wait... Input is STILL erroneous???
if "%RESULT%"=="" goto ERROR_SYNTAX
::YES!!! Correct Expression???
if "%RESULT%"=="24" goto END
echo Invalid input [Bad result: Expected 24, Received %RESULT%]
goto MAIN
:ERROR_MISSING_CHARS
echo Invalid input [insufficient number of characters]
goto MAIN
:ERROR_INCORRECT_INPUT
echo Invalid input [incorrect digits]
goto MAIN
::The Outputs
echo Wrong Answer [%RESULT% is not equal to 24.]&goto MAIN
:ERROR_CHARS
echo Invalid input [Please use all the digits above ONCE.]&goto MAIN
:ERROR_ICHAR_FOUND
echo Invalid input [An invalid character is found... C'mon...]&goto MAIN
:ERROR_SYNTAX
echo Invalid input [Syntax Error... Please answer seriously... I'm begging you...]&goto MAIN
:ERROR_POSITION
echo Invalid input [Sorry, digit concatenation is not allowed.]&goto MAIN
:ERROR_TRICK
echo Invalid input [Are you Playing the Game Seriously?]&goto MAIN
:ERROR_NEGA
echo Invalid input [Do not Make any Digit Negative.]&goto MAIN
:SHOW
echo Given digits: %DIGIT_1% %DIGIT_2% %DIGIT_3% %DIGIT_4%
goto MAIN
echo Given digits: %DIGIT_1% %DIGIT_2% %DIGIT_3% %DIGIT_4%&goto MAIN
:END
echo Correct input [Congratulations!]
echo Correct Input [Congratulations^^!]
echo.
echo Press any char key for a new game, or close this window to exit...
pause>nul
goto NEW
:ABORT
echo.
exit
::*/
WScript.echo(eval(WScript.arguments(0)));

View file

@ -0,0 +1,173 @@
#define system.
#define system'routines.
#define system'collections.
#define system'dynamic.
#define extensions.
#class ExpressionTree
{
#field theTree.
#constructor new : aLiteral
[
#var aLevel := Integer new:0.
aLiteral run &each: ch
[
#var node := Dynamic new.
ch =>
#43 ? [ node set &level:(aLevel + 1) set &operation:%add. ] // +
#45 ? [ node set &level:(aLevel + 1) set &operation:%subtract. ] // -
#42 ? [ node set &level:(aLevel + 2) set &operation:%multiply. ] // *
#47 ? [ node set &level:(aLevel + 2) set &operation:%divide. ] // /
#40 ? [ aLevel += 10. ^ $self. ] // (
#41 ? [ aLevel -= 10. ^ $self. ] // )
! [
node set &leaf:(ch literal toReal) set &level:((aLevel + 3)).
].
($nil == theTree)
? [ theTree := node. ]
! [
(theTree level >= node level)
? [
node set &left:theTree set &right:$nil.
theTree := node.
]
! [
#var aTop := theTree.
#loop (($nil != aTop right)and:[aTop right level < node level] )
? [ aTop := aTop right. ].
node set &left:(aTop right) set &right:$nil.
aTop set &right:node.
].
].
].
]
#method eval : aNode
[
(aNode if &leaf)
? [ ^ aNode leaf. ]
! [
#var aLeft := $self eval:(aNode left).
#var aRight := $self eval:(aNode right).
^ aLeft::(aNode operation) eval:aRight.
]
]
#method value
<= eval:theTree.
#method readLeaves : aList &at:aNode
[
($nil == aNode)
? [ #throw InvalidArgumentException new. ].
(aNode if &leaf)
? [ aList += aNode leaf. ]
! [
$self readLeaves:aList &at:(aNode left).
$self readLeaves:aList &at:(aNode right).
].
]
#method readLeaves : aList
<= readLeaves:aList &at:theTree.
}
#class TwentyFourGame
{
#field theNumbers.
#constructor new
[
$self newPuzzle.
]
#method newPuzzle
[
theNumbers := (
1 + randomGenerator eval:9,
1 + randomGenerator eval:9,
1 + randomGenerator eval:9,
1 + randomGenerator eval:9).
]
#method help
[
console
writeLine:"------------------------------- Instructions ------------------------------"
writeLine:"Four digits will be displayed."
writeLine:"Enter an equation using all of those four digits that evaluates to 24"
writeLine:"Only * / + - operators and () are allowed"
writeLine:"Digits can only be used once, but in any order you need."
writeLine:"Digits cannot be combined - i.e.: 12 + 12 when given 1,2,2,1 is not allowed"
writeLine:"Submit a blank line to skip the current puzzle."
writeLine:"Type 'q' to quit"
writeLine
writeLine:"Example: given 2 3 8 2, answer should resemble 8*3-(2-2)"
writeLine:"------------------------------- --------------------------------------------".
]
#method prompt
[
theNumbers run &each: n [ console writeLiteral:n:" ". ].
console write:": ".
]
#method resolve : aLine
[
#var exp := ExpressionTree new:aLine.
#var Leaves := ArrayList new.
exp readLeaves:Leaves.
(Leaves ascendant equal &indexable:(theNumbers ascendant))
! [ console writeLine:"Invalid input. Enter an equation using all of those four digits. Try again.". ^ $self. ].
#var aResult := exp value.
(aResult == 24)
? [
console writeLine:"Good work. ":aLine:"=":aResult.
$self newPuzzle.
]
! [ console writeLine:"Incorrect. ":aLine:"=":aResult. ].
]
}
#class(extension) gameOp
{
#method playRound : aLine
[
(aLine == "q")
? [ ^ false. ]
! [
(aLine == "")
? [ console writeLine:"Skipping this puzzle". self newPuzzle. ]
! [
self resolve:aLine
| if &Error: e
[
console writeLine:"An error occurred. Check your input and try again.".
].
].
^ true.
].
]
}
#symbol program =
[
#var aGame := TwentyFourGame new help.
#loop (aGame prompt playRound:(console readLine)) ? [].
].

View file

@ -1,4 +1,3 @@
# Solution in '''RPN'''
Play24 := function()
local input, digits, line, c, chars, stack, stackptr, cur, p, q, ok, a, b, run;
input := InputTextUser();

View file

@ -1,6 +1,7 @@
import java.util.*;
public class Game24 {
static Random r = new Random();
public static void main(String[] args) {
@ -53,7 +54,6 @@ public class Game24 {
}
static int[] randomDigits() {
Random r = new Random();
int[] result = new int[4];
for (int i = 0; i < 4; i++)
result[i] = r.nextInt(9) + 1;

View file

@ -0,0 +1,50 @@
package game24
import java.util.*
internal object Game24 {
fun run() {
val r = Random()
val digits = IntArray(4).map { r.nextInt(9) + 1 }
println("Make 24 using these digits: $digits")
print("> ")
val s = Stack<Float>()
var total: Long = 0
val cin = Scanner(System.`in`)
for (c in cin.nextLine())
when (c) {
in '0'..'9' -> {
val d = c - '0'
total += (1 shl (d * 5)).toLong()
s += d.toFloat()
}
else ->
if ("+/-*".indexOf(c) != -1)
s += c.applyOperator(s.pop(), s.pop())
}
when {
tally(digits) != total ->
print("Not the same digits. ")
s.peek().compareTo(target) == 0 ->
println("Correct!")
else ->
print("Not correct.")
}
}
fun Char.applyOperator(a: Float, b: Float) = when (this) {
'+' -> a + b
'-' -> b - a
'*' -> a * b
'/' -> b / a
else -> Float.NaN
}
fun tally(a: List<Int>): Long = a.reduce({ t, i -> t + (1 shl (i * 5)) }).toLong()
private val target = 24
}
fun main(args: Array<String>) = Game24.run()

View file

@ -1,22 +1,158 @@
Argument for the "24" program is either of three forms: (blank)
ssss
ssss-ffff
where one or both strings must be exactly four numerals (digits)
comprised soley of the numerals (digits) 1 9 (with no zeroes).
SSSS is the start,
FFFF is the finish.
If no argument is specified, this program finds a four digit number with
no zeroes) which has at least one solution, and shows the number to
the user, requesting that they enter a solution in the form of:
w operator x operator y operator z
where w x y and z are single digit numbers (no zeroes).
and operator can be any one of: + - * /
Parentheses ( ), brackets [ ], and/or braces { } may be used in the
normal manner for grouping expressions. Leading signs are permitted.
/*REXX program which allows a user to play the game of 24 (twenty-four). */
numeric digits 15 /*allow more leeway when computing #s. */
parse arg yyy /*get the optional arguments from C.L. */
yyy = space(yyy,0) /*remove extraneous blanks from YYY. */
parse var yyy start '-' fin /*get the START and FINish (maybe). */
fin = word(fin start,1) /*if no FINish specified, use START.*/
opers = '+-*/' /*define the legal arithmetic operators*/
ops = length(opers) /* ··· and the count of them (length). */
groupSymbols = '()[]{}' /*legal grouping symbols for this game.*/
indent = left('',30) /*used to indent display of solutions. */
Lpar = '(' /*a string to make the output prettier.*/
Rpar = ')' /*Ditto. [You can say that again.] */
digs = 123456789 /*numerals (digits) that can be used. */
show = 1 /*flag used show solutions (0 = not). */
do j=1 for ops /*define a version for fast execution. */
@.j=substr(opers,j,1) /*assign each operation to an array. */
end /*j*/
signal on syntax /*enable program to trap syntax errors.*/
if yyy\=='' then do /*if START (or FINish), then solve 'em.*/
sols=solve(start,fin) /*solve START ───► FINish. */
if sols <0 then exit 13 /*Was there a problem with input? */
if sols==0 then sols='No' /*Englishize the SOLS variable.*/
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 contains a zero, ignore it*/
if solve(rrrr)\==0 then leave /*if solved, then stop looking.*/
end /*forever*/
show=1 /*enable SOLVE to display solutions. */
rrrr=sort(rrrr) /*sort four digits (for consistency). */
$.=0
do j=1 for length(rrrr) /*digit count for each digit in RRRR. */
_=substr(rrrr, j, 1) /*pick off one of the digits in RRRR. */
$._=countDigs(rrrr, _) /*define the count for this digit. */
end /*j*/ /* [↑] counts duplicates twice, no harm*/
prompt= 'Using the digits' rrrr", enter an expression that equals 24 (or QUIT):"
/* [↓] ITERATE needs a variable name.*/
do prompter=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 /*Does the user want to quit this game?*/
_v=verify(y, digs || opers || groupSymbols); 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
yL=length(y)
if y=='' then do; call validate y; iterate; end
do j=1 for yL-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*/
y=translate(y, '()()', "[]{}")
interpret 'ans=' y; ans=ans/1; if ans==24 then leave prompter
say 'incorrect, ' y'='ans
end /*prompter*/
say; say center('', 79)
say center(' ', 79)
say center(' congratulations ! ', 79)
say center(' ', 79)
say center('', 79)
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────one─liner subroutines─────────────────────*/
countDigs: arg ?; return length(?) - length(space(translate(?, , arg(2)), 0))
div: if arg(1)=0 then return 7e9; return arg(1) /*if ÷ by 0, fudge result*/
ger: say; say '***error!*** for argument:' y; say arg(1); say;errCode=1;return 0
s: if arg(1)==1 then return ''; return 's' /*simple pluralizer.*/
syntax: call ger 'illegal syntax in' y; exit
/*──────────────────────────────────SOLVE subroutine──────────────────────────*/
solve: parse arg ssss, ffff /*parse the argument passed to SOLVE. */
if ffff=='' then ffff=ssss /*create a FFFF if necessary. */
if \validate(ssss) then return -1 /*validate the SSSS field. */
if \validate(ffff) then return -1 /* " " FFFF " */
#=0 /*number of found solutions (so far). */
!.=0 /*a method to hold unique expressions. */
/*alternative: indent=copies(' ',30) */
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 /*define a version for fast execution. */
g.j=substr(g, j, 1) /*extract each digit of G into array.*/
end /*j*/
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 to 3; 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 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*/
/* [↓] change expression: */
/* /(yyy) ═══► /div(yyy) */
/*Enables to check for division by zero*/
yyyE=e /*keep old the version for the display.*/
if pos('/(', e)\==0 then e=changestr( '/(', e, "/div(" )
/* [↓] INTERPRET stresses REXX's groin,*/
/* so try to avoid repeated lifting.*/
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 */
x=x/1 /*remove any trailing decimal point. */
if x\==24 then iterate /*Is the result incorrect? Try again. */
#=#+1 /*bump number of found solutions. */
_=translate(yyyE, '][', ")(") /*display [], not (). */
if show then say indent 'a solution:' _
end /*n*/ /* [↑] show a solution.*/
end /*m*/
end /*k*/
end /*j*/
end /*i*/
end /*g*/
return #
/*──────────────────────────────────SORT subroutine───────────────────────────*/
sort: procedure; arg nnnn; L=length(nnnn)
do i=1 for L /*build an array of digits from NNNN. */
s.i=substr(nnnn, i, 1) /*this enables SORT to sort an array. */
end /*i*/
do j=1 for L; _=s.j
do k=j+1 to L
if s.k<_ then parse value s.j s.k with s.k s.j
end /*k*/
end /*j*/
return s.1 || s.2 || s.3 || s.4
/*──────────────────────────────────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 four.'
when length(y)>4 then call ger 'too many digits entered, must be four.'
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

View file

@ -1,158 +1,25 @@
/*REXX program which allows a user to play the game of 24 (twenty-four). */
numeric digits 15 /*allow more leeway when computing #s. */
parse arg yyy /*get the optional arguments from C.L. */
yyy = space(yyy,0) /*remove extraneous blanks from YYY. */
parse var yyy start '-' fin /*get the START and FINish (maybe). */
fin = word(fin start,1) /*if no FINish specified, use START.*/
opers = '+-*/' /*define the legal arithmetic operators*/
ops = length(opers) /* ··· and the count of them (length). */
groupSymbols = '()[]{}' /*legal grouping symbols for this game.*/
indent = left('',30) /*used to indent display of solutions. */
Lpar = '(' /*a string to make the output prettier.*/
Rpar = ')' /*Ditto. [You can say that again.] */
digs = 123456789 /*numerals (digits) that can be used. */
show = 1 /*flag used show solutions (0 = not). */
do j=1 for ops /*define a version for fast execution. */
@.j=substr(opers,j,1) /*assign each operation to an array. */
end /*j*/
signal on syntax /*enable program to trap syntax errors.*/
if yyy\=='' then do /*if START (or FINish), then solve 'em.*/
sols=solve(start,fin) /*solve START ───► FINish. */
if sols <0 then exit 13 /*Was there a problem with input? */
if sols==0 then sols='No' /*Englishize the SOLS variable.*/
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 contains a zero, ignore it*/
if solve(rrrr)\==0 then leave /*if solved, then stop looking.*/
end /*forever*/
show=1 /*enable SOLVE to display solutions. */
rrrr=sort(rrrr) /*sort four digits (for consistancy). */
$.=0
do j=1 for length(rrrr) /*digit count for each digit in RRRR. */
_=substr(rrrr, j, 1) /*pick off one of the digits in RRRR. */
$._=countDigs(rrrr, _) /*define the count for this digit. */
end /*j*/ /* [↑] counts duplicates twice, no harm*/
prompt= 'Using the digits' rrrr", enter an expression that equals 24 (or QUIT):"
/* [↓] ITERATE needs a variable name.*/
do prompter=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 /*Does the user want to quit this game?*/
_v=verify(y, digs || opers || groupSymbols); 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
yL=length(y)
if y=='' then do; call validate y; iterate; end
do j=1 for yL-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*/
y=translate(y, '()()', "[]{}")
interpret 'ans=' y; ans=ans/1; if ans==24 then leave prompter
say 'incorrect, ' y'='ans
end /*prompter*/
say; say center('', 79)
say center(' ', 79)
say center(' congratulations ! ', 79)
say center(' ', 79)
say center('', 79)
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────one─liner subroutines─────────────────────*/
countDigs: arg ?; return length(?) - length(space(translate(?, , arg(2)), 0))
div: if arg(1)=0 then return 7e9; return arg(1) /*if ÷ by 0, fudge result*/
ger: say; say '***error!*** for argument:' y; say arg(1); say;errCode=1;return 0
s: if arg(1)==1 then return ''; return 's' /*simple pluralizer.*/
syntax: call ger 'illegal syntax in' y; exit
/*──────────────────────────────────SOLVE subroutine──────────────────────────*/
solve: parse arg ssss, ffff /*parse the argument passed to SOLVE. */
if ffff=='' then ffff=ssss /*create a FFFF if necessary. */
if \validate(ssss) then return -1 /*validate the SSSS field. */
if \validate(ffff) then return -1 /* " " FFFF " */
#=0 /*number of found solutions (so far). */
!.=0 /*a method to hold unique expressions. */
/*alternative: indent=copies(' ',30) */
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 /*define a version for fast execution. */
g.j=substr(g, j, 1) /*extract each digit of G into array.*/
end /*j*/
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 to 3; 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 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*/
/* [↓] change expression: */
/* /(yyy) ═══► /div(yyy) */
/*Enables to check for division by zero*/
yyyE=e /*keep old the version for the display.*/
if pos('/(', e)\==0 then e=changestr( '/(', e, "/div(" )
/* [↓] INTERPRET stresses REXX's groin,*/
/* so try to avoid repeated lifting.*/
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 */
x=x/1 /*remove any trailing decimal point. */
if x\==24 then iterate /*Is the result incorrect? Try again. */
#=#+1 /*bump number of found solutions. */
_=translate(yyyE, '][', ")(") /*display [], not (). */
if show then say indent 'a solution:' _
end /*n*/ /* [↑] show a solution.*/
end /*m*/
end /*k*/
end /*j*/
end /*i*/
end /*g*/
return #
/*──────────────────────────────────SORT subroutine───────────────────────────*/
sort: procedure; arg nnnn; L=length(nnnn)
do i=1 for L /*build an array of digits from NNNN. */
s.i=substr(nnnn, i, 1) /*this enables SORT to sort an array. */
end /*i*/
do j=1 for L; _=s.j
do k=j+1 to L
if s.k<_ then parse value s.j s.k with s.k s.j
end /*k*/
end /*j*/
return s.1 || s.2 || s.3 || s.4
/*──────────────────────────────────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 four.'
when length(y)>4 then call ger 'too many digits entered, must be four.'
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
changestr: Procedure
/* change needle to newneedle in haystack (as often as specified */
/* or all of them if count is omitted */
Parse Arg needle,haystack,newneedle,count
If count>'' Then Do
If count=0 Then Do
Say 'chstr count must be > 0'
Signal Syntax
End
End
res=""
changes=0
px=1
do Until py=0
py=pos(needle,haystack,px)
if py>0 then Do
res=res||substr(haystack,px,py-px)||newneedle
px=py+length(needle)
changes=changes+1
If count>'' Then
If changes=count Then Leave
End
end
res=res||substr(haystack,px)
Return res

View file

@ -1,55 +1,42 @@
require "rational" # for Ruby versions before 2.0
def validate(guess, nums)
name, error =
{
invalid_character: ->(str){ !str.scan(%r{[^\d\s()+*/-]}).empty? },
wrong_number: ->(str){ str.scan(/\d/).map(&:to_i).sort != nums.sort },
multi_digit_number: ->(str){ str.match(/\d\d/) }
}
.find {|name, validator| validator[guess] }
error ? puts("Invalid input of a(n) #{name.to_s.tr('_',' ')}!") : true
end
class Guess < String
def self.get(nums)
loop do
print "\nEnter a guess using #{nums}: "
input = gets.chomp
return new(input) if validate(input, nums)
end
end
def evaluate!
as_rat = gsub(/(\d)/, 'Rational(\1,1)')
begin
eval "(#{as_rat}).to_f"
rescue SyntaxError
"[syntax error]"
end
end
end
def play
digits = Array.new(4){rand(1..9)}
nums = Array.new(4){rand(1..9)}
loop do
guess = get_guess(digits)
result = evaluate(guess)
if result == 24.0
puts "yes!"
break
else
puts "nope: #{guess} = #{result}"
puts "try again"
end
end
end
def get_guess(digits)
loop do
print "\nEnter your guess using #{digits}: "
guess = gets.chomp
# ensure input is safe to eval
invalid_chars = guess.scan(%r{[^\d\s()+*/-]})
unless invalid_chars.empty?
puts "invalid characters in input: #{invalid_chars}"
next
end
guess_digits = guess.scan(/\d/).map {|ch| ch.to_i}
if guess_digits.sort != digits.sort
puts "you didn't use the right digits"
next
end
if guess.match(/\d\d/)
puts "no multi-digit numbers allowed"
next
end
return guess
end
end
# convert expression to use rational numbers, evaluate, then return as float
def evaluate(guess)
as_rat = guess.gsub(/(\d)/, 'Rational(\1,1)')
begin
eval "(#{as_rat}).to_f"
rescue SyntaxError
"[syntax error]"
result = Guess.get(nums).evaluate!
break if result == 24.0
puts "Try again! That gives #{result}!"
end
puts "You win!"
end
play

View file

@ -0,0 +1,19 @@
(defn nine-billion-names [row column]
(cond (<= row 0) 0
(<= column 0) 0
(< row column) 0
(= row 1) 1
:else (let [addend (nine-billion-names (dec row) (dec column))
augend (nine-billion-names (- row column) column)]
(+ addend augend))))
(defn print-row [row]
(doseq [x (range 1 (inc row))]
(print (nine-billion-names row x) \space))
(println))
(defn print-triangle [rows]
(doseq [x (range 1 (inc rows))]
(print-row x)))
(print-triangle 25)

View file

@ -0,0 +1,68 @@
Define.i nMax=25, n, k
Dim pfx.s(1)
Procedure.s Sigma(sx.s, sums.s)
Define.i i, v1, v2, r
Define.s s, sa
sums=ReverseString(sums) : s=ReverseString(sx)
For i=1 To Len(s)*Bool(Len(s)>Len(sums))+Len(sums)*Bool(Len(sums)>=Len(s))
v1=Val(Mid(s,i,1))
v2=Val(Mid(sums,i,1))
r+v1+v2
sa+Str(r%10)
r/10
Next i
If r : sa+Str(r%10) : EndIf
ProcedureReturn ReverseString(sa)
EndProcedure
Procedure.i Adr(row.i,col.i)
ProcedureReturn ((row-1)*row/2+col)*Bool(row>0 And col>0)
EndProcedure
Procedure Triangle(row.i,Array pfx.s(1))
Define.i n,k
Define.s zs
nMax=row
ReDim pfx(Adr(nMax,nMax))
For n=1 To nMax
For k=1 To n
If k>n : pfx(Adr(n,k))="0" : Continue : EndIf
If n=k : pfx(Adr(n,k))="1" : Continue : EndIf
If k<=n/2
zs=""
zs=Sigma(pfx(Adr(n-k,k)),zs)
zs=Sigma(pfx(Adr(n-1,k-1)),zs)
pfx(Adr(n,k))=zs
Else
pfx(Adr(n,k))=pfx(Adr(n-1,k-1))
EndIf
Next k
Next n
EndProcedure
Procedure.s sum(row.i, Array pfx.s(1))
Define.s s
Triangle(row, pfx())
For n=1 To row
s=Sigma(pfx(Adr(row,n)),s)
Next n
ProcedureReturn RSet(Str(row),5,Chr(32))+" : "+s
EndProcedure
OpenConsole()
Triangle(nMax, pfx())
For n=1 To nMax
Print(Space(((nMax*4-1)-(n*4-1))/2))
For k=1 To n
Print(RSet(pfx(Adr(n,k)),3,Chr(32))+Space(1))
Next k
PrintN("")
Next n
PrintN("")
PrintN(sum(23,pfx()))
PrintN(sum(123,pfx()))
PrintN(sum(1234,pfx()))
PrintN(sum(12345,pfx()))
Input()

View file

@ -1,52 +1,52 @@
/*REXX program generates a number triangle for partitions of a number.*/
numeric digits 400 /*be able to handle large numbers*/
parse arg N .; if N=='' then N=25 /*No input? Then use the default*/
/*REXX program generates & shows a number triangle for partitions of a number.*/
numeric digits 400 /*be able to handle larger numbers. */
parse arg N .; if N=='' then N=25 /*N specified? Then use the default. */
@.=0; @.0=1; aN=abs(N)
if N==N+0 then say ' G('aN"):" G(N) /*just for well formed #s*/
say 'partitions('aN"):" partitions(aN) /*the easy way*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────G subroutine────────────────────────*/
if N==N+0 then say ' G('aN"):" G(N) /*just for well formed numbers.*/
say 'partitions('aN"):" partitions(aN) /*do it the easy way*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────G subroutine──────────────────────────────*/
G: procedure; parse arg nn; !.=0; mx=1; aN=abs(nn); build=nn>0
!.4.2=2; do j=1 for aN%2; !.j.j=1; end /*j*/ /*shortcuts.*/
!.4.2=2; do j=1 for aN%2; !.j.j=1; end /*j*/ /*gen shortcuts.*/
do t=1 for 1+build; #.=1 /*gen triangle once or twice ∙∙∙*/
do r=1 for aN; #.2=r%2 /*#.2 is a shortcut calc.*/
do c=3 to r-2; #.c=gen#(r,c); end /*c*/
L=length(mx); p=0; aLine=
do cc=1 for r /*only sum last row of numbers. */
p=p+#.cc /*add last row of the triangle. */
if \build then iterate /*skip building the triangle? */
mx=max(mx,#.cc) /*used to build symmetric numbers*/
aLine=aLine right(#.cc,L) /*build a row of the triangle. */
end /*cc*/
if t==1 then iterate /*Is first time through? No show*/
L=length(mx); say centre(strip(aLine,'L'), 2+(aN-1)*(L+1))
end /*r*/ /* [↑] centre the row (triangle).*/
end /*t*/
return p /*return with generated number. */
/*──────────────────────────────────GEN# subroutine─────────────────────*/
gen#: procedure expose !.; parse arg x,y /*obtain X and Y arguments.*/
if !.x.y\==0 then return !.x.y /*was this # generated before? */
if y>x%2 then do; nx=x+1-2*(y-x%2)-(x//2==0); ny=nx%2; !.x.y=!.nx.ny
return !.x.y /*return with the calculated num.*/
end /*[↑] right half of the triangle.*/
$=1 /*[↓] left half of the triangle.*/
do q=2 to y; xy=x-y; if q>xy then iterate
if q==2 then $=$+xy%2
else if q==xy-1 then $=$+1
else $=$+gen#(xy,q)
end /*q*/
!.x.y=$; return $ /*remember #, return with number.*/
/*──────────────────────────────────PARTITIONS subroutine───────────────*/
partitions: procedure expose @.; parse arg n
if @.n\==0 then return @.n /*Already computed? Return it. */
$=0 /*[↓] Euler's recursive function.*/
do k=1 for n; _=n-(k*3-1)*k%2; if _<0 then leave
if @._==0 then x=partitions(_); else x=@._
_=_-k; if _<0 then y=0
else if @._==0 then y=partitions(_)
else y=@._
if k//2 then $=$+x+y /*sum this way if K is odd ···*/
else $=$-x-y /* " " " " " " even ···*/
end /*k*/
@.n=$; return $
do t=1 for 1+build; #.=1 /*gen triangle once or twice ···*/
do r=1 for aN; #.2=r%2 /*#.2 is a shortcut calculation.*/
do c=3 to r-2; #.c=gen#(r,c); end /*c*/
L=length(mx); p=0; __= /*__ will be a row (line) of triangle.*/
do cc=1 for r /*only sum the last row of numbers. */
p=p+#.cc /*add the last row of the triangle. */
if \build then iterate /*should we skip building the triangle?*/
mx=max(mx,#.cc) /*used to build the symmetric numbers. */
__=__ right(#.cc,L) /*construct a row (or line) of triangle*/
end /*cc*/
if t==1 then iterate /*Is this the 1st time through? No show*/
say center(strip(__), 2+(aN-1)*(length(mx)+1))
end /*r*/ /* [↑] center the row of the triangle.*/
end /*t*/
return p /*return with the generated number. */
/*──────────────────────────────────GEN# subroutine───────────────────────────*/
gen#: procedure expose !.; parse arg x,y /*obtain X and Y arguments. */
if !.x.y\==0 then return !.x.y /*was number generated before?*/
if y>x%2 then do; nx=x+1-2*(y-x%2)-(x//2==0); ny=nx%2; !.x.y=!.nx.ny
return !.x.y /*return the calculated number*/
end /* [↑] right half of triangle*/
$=1 /* [↓] left " " " */
do q=2 for y-1; xy=x-y; if q>xy then iterate
if q==2 then $=$+xy%2
else if q==xy-1 then $=$+1
else $=$+gen#(xy,q) /*recurse.*/
end /*q*/
!.x.y=$; return $ /*use memoization; return with number.*/
/*──────────────────────────────────PARTITIONS subroutine─────────────────────*/
partitions: procedure expose @.; parse arg n; if @.n\==0 then return @.n /*◄─┐*/
$=0 /*Already known? Then return value►───┘*/
do k=1 for n; _=n-(k*3-1)*k%2; if _<0 then leave
if @._==0 then x=partitions(_) /* [◄] recursive call.*/
else x=@._ /*value already known. */
_=_-k; if _<0 then y=0 /*recursive call ►────┐*/
else if @._==0 then y=partitions(_) /*◄──┘*/
else y=@._
if k//2 then $=$+x+y /*utilize this method if K is odd. */
else $=$2x-y /* " " " " " " even. */
end /*k*/ /* [↑] Euler's recursive function. */
@.n=$; return $ /*use memoization; return with number.*/

View file

@ -1,17 +1,18 @@
main: { 99 bottles }
-- beer.sp
bottles!:
{ x set
{ bw
bx cr <<
"Take one down, pass it around\n" <<
1 x -=
bw "\n" << }
x times }
{b " bottles of beer" <
bi { itoa << } <
bb { bi ! b << w << "\n" << } <
w " on the wall" <
beer
{<-
{ iter 1 + dup
<- bb ! ->
bi ! b << "\n" <<
"Take one down, pass it around\n" <<
iter bb ! "\n" << }
->
times}
< }
b : " bottles of beer"
bx!: { x %d << b }
w : " on the wall"
bw!: { bx w . cr << }
x: [0]
-- At the prompt, type 'N beer !' (no quotes), where N is the number of stanzas you desire

View file

@ -0,0 +1,21 @@
module bottles;
template BeerSong(int Bottles)
{
static if (Bottles == 1)
{
enum BeerSong = "1 bottle of beer on the wall\n" ~
"1 bottle of beer\ntake it down, pass it around\n" ~ "
no more bottles of beer on the wall\n";
}
else
{
enum BeerSong = Bottles.stringof ~ " bottles of beer on the wall\n" ~
Bottles.stringof ~ " bottles of beer\ntake it down, pass it around\n" ~
BeerSong!(Bottles-1);
}
}
pragma(msg,BeerSong!99);
void main(){}

View file

@ -0,0 +1,22 @@
output_lyrics
-- Output the lyrics to 99-bottles-of-beer.
local
l_bottles: LINKED_LIST [INTEGER]
do
create l_bottles.make
across (1 |..| 99) as ic loop l_bottles.force (ic.item) end
across l_bottles.new_cursor.reversed as ic_bottles loop
print (ic_bottles.item)
print (" bottles of beer on the wall, ")
print (ic_bottles.item)
print (" bottles of beer.%N")
print ("Take one down, pass it around, ")
if ic_bottles.item > 1 then
print (ic_bottles.item)
print (" bottles of beer on the wall.%N%N")
end
end
print ("1 bottle of beer on the wall.%N")
print ("No more bottles of beer on the wall, no more bottles of beer.%N")
print ("Go to the store and buy some more, 99 bottles of beer on the wall.%N")
end

View file

@ -1,16 +1,16 @@
\suffix=(\n eq n 1 "" "s")
\sing_count=(\n put n put " " put "bottle" put (suffix n) put " of beer")
\sing_line1=(\n sing_count n put " on the wall" nl)
\sing_count=(\n put [n " bottle" (suffix n) " of beer"])
\sing_line1=(\n sing_count n say " on the wall")
\sing_line2=(\n sing_count n nl)
\sing=
(@\loop\n
le n 0 ();
sing_line1 n
sing_line2 n
say "Take one down, pass it around"
\n=(- n 1)
sing_line1 n
nl
loop n
)
\sing==
(\n
le n 0 ();
sing_line1 n
sing_line2 n
say "Take one down, pass it around"
\n=(- n 1)
sing_line1 n
nl
sing n
)
sing 3

View file

@ -0,0 +1,36 @@
: bottles ( n -- ) \ select the right grammar based on 'n'
dup
case
1 of ." One more bottle " drop endof
0 of ." No more bottles " drop endof
. ." bottles " \ default case
endcase ;
\ create punctuation with delay for artistic effect
: , [char] , emit 100 ms ;
: . [char] . emit 300 ms ;
\ create the words to write the program
: of ." of " ;
: beer ." beer " ;
: on ." on " ;
: the ." the " ;
: wall ." wall" ;
: take ." take " ;
: one ." one " ;
: down ." down" ;
: pass ." pass " ;
: it ." it " ;
: around ." around" ;
\ who said Forth is write only?
: beers ( n -- ) \ USAGE: 99 beers
1 swap
cr
do
I bottles of beer on the wall , cr
I bottles of beer , cr
take one down , pass it around , cr
I 1- bottles of beer on the wall . cr
cr
-1 +loop ;

View file

@ -0,0 +1,12 @@
2 beers
2 bottles of beer on the wall,
2 bottles of beer ,
take one down, pass it around,
One more bottle of beer on the wall.
One more bottle of beer on the wall,
One more bottle of beer ,
take one down, pass it around,
No more bottles of beer on the wall.
ok

View file

@ -0,0 +1,132 @@
module song_typedefs
implicit none
private ! all
public :: TBottles
type, abstract :: TContainer
integer :: quantity
contains
! deferred method i.e. abstract method = must be overridden in extended type
procedure(take_one), deferred, pass :: take_one
procedure(show_quantity), deferred, pass :: show_quantity
end type TContainer
abstract interface
subroutine take_one(this)
import TContainer
implicit none
class(TContainer) :: this
end subroutine take_one
subroutine show_quantity(this)
import TContainer
implicit none
class(TContainer) :: this
end subroutine show_quantity
end interface
! extended derived type
type, extends(TContainer) :: TBottles
contains
procedure, pass :: take_one => take_one_bottle
procedure, pass :: show_quantity => show_bottles
final :: finalize_bottles
end type TBottles
contains
subroutine show_bottles(this)
implicit none
class(TBottles) :: this
! integer :: show_bottles
character(len=*), parameter :: bw0 = "No more bottles of beer on the wall,"
character(len=*), parameter :: bwx = "bottles of beer on the wall,"
character(len=*), parameter :: bw1 = "bottle of beer on the wall,"
character(len=*), parameter :: bb0 = "no more bottles of beer."
character(len=*), parameter :: bbx = "bottles of beer."
character(len=*), parameter :: bb1 = "bottle of beer."
character(len=*), parameter :: fmtxdd = "(I2,1X,A28,1X,I2,1X,A16)"
character(len=*), parameter :: fmtxd = "(I1,1X,A28,1X,I1,1X,A16)"
character(len=*), parameter :: fmt1 = "(I1,1X,A27,1X,I1,1X,A15)"
character(len=*), parameter :: fmt0 = "(A36,1X,A24)"
select case (this % quantity)
case (10:)
write(*,fmtxdd) this % quantity, bwx, this % quantity, bbx
case (2:9)
write(*,fmtxd) this % quantity, bwx, this % quantity, bbx
case (1)
write(*,fmt1) this % quantity, bw1, this % quantity, bb1
case (0)
write(*,*)
write(*,fmt0) bw0, bb0
case default
write(*,*)"Warning! Number of bottles exception, error 42. STOP"
stop
end select
! show_bottles = this % quantity
end subroutine show_bottles
subroutine take_one_bottle(this) ! bind(c, name='take_one_bottle')
implicit none
class(TBottles) :: this
! integer :: take_one_bottle
character(len=*), parameter :: t1 = "Take one down and pass it around,"
character(len=*), parameter :: remx = "bottles of beer on the wall."
character(len=*), parameter :: rem1 = "bottle of beer on the wall."
character(len=*), parameter :: rem0 = "no more bottles of beer on the wall."
character(len=*), parameter :: fmtx = "(A33,1X,I2,1X,A28)"
character(len=*), parameter :: fmt1 = "(A33,1X,I2,1X,A27)"
character(len=*), parameter :: fmt0 = "(A33,1X,A36)"
this % quantity = this % quantity -1
select case (this%quantity)
case (2:)
write(*,fmtx) t1, this%quantity, remx
case (1)
write(*,fmt1) t1, this%quantity, rem1
case (0)
write(*,fmt0) t1, rem0
case (-1)
write(*,'(A66)') "Go to the store and buy some more, 99 bottles of beer on the wall."
case default
write(*,*)"Warning! Number of bottles exception, error 42. STOP"
stop
end select
end subroutine take_one_bottle
subroutine finalize_bottles(bottles)
implicit none
type(TBottles) :: bottles
! here can be more code
end subroutine finalize_bottles
end module song_typedefs
!-----------------------------------------------------------------------
!Main program
!-----------------------------------------------------------------------
program bottles_song
use song_typedefs
implicit none
integer, parameter :: MAGIC_NUMBER = 99
type(TBottles), target :: BTLS
BTLS = TBottles(MAGIC_NUMBER)
call make_song(BTLS)
contains
subroutine make_song(bottles)
type(TBottles) :: bottles
do while(bottles%quantity >= 0)
call bottles%show_quantity()
call bottles%take_one()
enddo
end subroutine make_song
end program bottles_song

View file

@ -0,0 +1,6 @@
10 FOR BOTTLES = 99 TO 1 STEP -1
20 PRINT BOTTLES " bottles of beer on the wall"
30 PRINT BOTTLES " bottles of beer"
40 PRINT "Take one down, pass it around"
50 PRINT BOTTLES-1 " bottles of beer on the wall"
60 NEXT BOTTLES

View file

@ -1,11 +1,8 @@
fun main(args : Array<String>) {
var i = 99
while (i > 0) {
System.out?.println("${i} bottles of beer on the wall")
System.out?.println("${i} bottles of beer")
System.out?.println("Take one down, pass it around")
i--;
}
System.out?.println("0 bottles of beer on the wall")
fun main(args: Array<String>) {
for (i in 99.downTo(1)) {
println("${i} bottles of beer on the wall")
println("${i} bottles of beer")
println("Take one down, pass it around")
}
println("No more bottles of beer on the wall!")
}

View file

@ -0,0 +1,5 @@
seq( printf( "%d %s of beer on the wall,\n%d %s of beer.\nTake one down, pass it around,\n%d %s of beer on the wall.\n\n",
i, `if`( i<>1, "bottles", "bottle" ),
i, `if`( i<>1, "bottles", "bottle" ),
i-1, `if`( i-1<>1, "bottles", "bottle") ),
i = 99..1, -1 );

View file

@ -0,0 +1,26 @@
(* A basic "Writer" monoid with emit *)
module Writer = struct
type 'a t = 'a * string
let ( >>= ) (x,s) f = let (y,s') = f x in (y, s ^ s')
let return x = (x,"")
let emit (x,s) = print_string s; x
end
(* Utility functions for handling strings and grammar *)
let line s = (String.capitalize s) ^ ".\n"
let count = function 0 -> "no more" | n -> string_of_int n
let plural = function 1 -> "" | _ -> "s"
let specify = function 1 -> "it" | _ -> "one"
let bottles n = count n ^ " bottle" ^ plural n ^ " of beer"
(* Actions, expressed as an int * string, for Writer *)
let report n = (n, line (bottles n ^ " on the wall, " ^ bottles n))
let take n = (n-1, "Take " ^ specify n ^ " down and pass it around")
let summary n = (n, ", " ^ bottles n ^ " on the wall.\n\n")
let shop = (99, "Go to the store and buy some more")
let rec verse state =
Writer.(state >>= report >>= function 0 -> shop >>= summary (* ends here *)
| n -> take n >>= summary |> verse)
let sing start =
Writer.(emit (verse (return start)))

View file

@ -0,0 +1,11 @@
# sing 2;;
2 bottles of beer on the wall, 2 bottles of beer.
Take one down and pass it around, 1 bottle of beer on the wall.
1 bottle of beer on the wall, 1 bottle of beer.
Take it down and pass it around, no more bottles of beer on the wall.
No more bottles of beer on the wall, no more bottles of beer.
Go to the store and buy some more, 99 bottles of beer on the wall.
- : int = 99

View file

@ -1,13 +1,13 @@
my $b = 99;
sub b($b) {
"$b bottle{'s'.substr($b == 1)} of beer";
repeat while --$b {
say "{b $b} on the wall";
say "{b $b}";
say "Take one down, pass it around";
say "{b $b-1} on the wall";
say "";
}
repeat while --$b {
.say for "&b($b) on the wall",
b($b),
'Take one down, pass it around',
"&b($b-1) on the wall",
'';
sub b($b) {
"$b bottle{'s' if $b != 1} of beer";
}

View file

@ -1,19 +1,18 @@
#= Sings a verse about a certian number of beers, possibly on a wall.
sub sing(
Int $number, #= Number of bottles of beer.
Bool $has_wall = False #= Mention that the beers are on a wall?
) {
my $quantity = $number == 0 ?? "No more" !! $number;
my $plural = $number == 1 ?? "" !! "s";
my $wall = $has_wall ?? " on the wall" !! "";
return "{$quantity} bottle{$plural} of beer{$wall}"
for 99...1 -> $bottles {
sing $bottles, :wall;
sing $bottles;
say "Take one down, pass it around";
sing $bottles - 1, :wall;
say "";
}
for 99...1 -> $bottles {
.say for
sing($bottles, True),
sing($bottles),
"Take one down, pass it around",
sing($bottles-1, True),
"";
#| Prints a verse about a certain number of beers, possibly on a wall.
sub sing(
Int $number, #= Number of bottles of beer.
Bool :$wall, #= Mention that the beers are on a wall?
) {
my $quantity = $number == 0 ?? "No more" !! $number;
my $plural = $number == 1 ?? "" !! "s";
my $location = $wall ?? " on the wall" !! "";
say "$quantity bottle$plural of beer$location"
}

View file

@ -1,11 +1,11 @@
my @quantities = (99 ... 1), 'No more', 99;
my @bottles = 'bottles' xx 98, 'bottle', 'bottles' xx 2;
my @actions = 'Take one down, pass it around' xx 99,
my @quantities = flat (99 ... 1), 'No more', 99;
my @bottles = flat 'bottles' xx 98, 'bottle', 'bottles' xx 2;
my @actions = flat 'Take one down, pass it around' xx 99,
'Go to the store, buy some more';
for @quantities Z @bottles Z @actions Z
@quantities[1 .. *] Z @bottles[1 .. *]
-> $a, $b, $c, $d, $e {
-> ($a, $b, $c, $d, $e) {
say "$a $b of beer on the wall";
say "$a $b of beer";
say $c;

View file

@ -1,16 +1,13 @@
use std::iter::range_step_inclusive;
trait Bottles {
fn bottles_of_beer(&self) -> Self;
fn on_the_wall(&self);
}
impl Bottles for isize {
fn bottles_of_beer(&self) -> isize {
impl Bottles for u32 {
fn bottles_of_beer(&self) -> u32 {
match *self {
1 => print!("{} bottle of beer", self),
0 => print!("No bottles of beer"),
1 => print!("{} bottle of beer", self),
_ => print!("{} bottles of beer", self)
}
*self // return a number for chaining
@ -22,7 +19,7 @@ impl Bottles for isize {
}
fn main() {
for i in range_step_inclusive(99is, 1, -1) {
for i in (1..100).rev() {
i.bottles_of_beer().on_the_wall();
i.bottles_of_beer();
println!("\nTake one down, pass it around...");

View file

@ -1,9 +1,9 @@
select
( 100 - level ) || ' bottle' || case 100 - level when 1 then '' else 's' end || ' of beer on the wall'
( 100 - level ) || ' bottle' || case when level != 99 then 's' end || ' of beer on the wall'
|| chr(10)
|| ( 100 - level ) || ' bottle' || case 100 - level when 1 then '' else 's' end || ' of beer'
|| ( 100 - level ) || ' bottle' || case when level != 99 then 's' end || ' of beer'
|| chr(10)
|| 'Take one down, pass it around'
|| chr(10)
|| ( 99 - level ) || ' bottle' || case 99 - level when 1 then '' else 's' end || ' of beer on the wall'
|| ( 99 - level ) || ' bottle' || case when level != 98 then 's' end || ' of beer on the wall'
from dual connect by level <= 99;

View file

@ -0,0 +1,32 @@
/*These statements work in PostgreSQL (tested in 9.3)*/
SELECT generate_series || ' bottles of beer on the wall' || chr(10) ||
generate_series || ' bottles of beer' || chr(10) ||
'Take one down, pass it around' || chr(10) ||
coalesce(lead(generate_series) OVER (ORDER BY generate_series DESC),0) || ' bottles of beer on the wall'
FROM generate_series(1,100)
ORDER BY generate_series DESC;
/*The next statement takes also into account the grammaticalt support for "1 bottle of beer".*/
SELECT generate_series || ' bottle' || CASE WHEN generate_series>1 THEN 's' ELSE '' END || ' of beer on the wall' || chr(10) ||
generate_series || ' bottle' || CASE WHEN generate_series>1 THEN 's' ELSE '' END || ' of beer' || chr(10) ||
'Take one down, pass it around' || chr(10) ||
coalesce(lead(generate_series) OVER (ORDER BY generate_series DESC),0) || ' bottle' || CASE WHEN coalesce(lead(generate_series) OVER (ORDER BY generate_series DESC),0) <>1 THEN 's' ELSE '' END || ' of beer on the wall'
FROM generate_series(1,100)
ORDER BY generate_series DESC;
/*The next statement uses recursive query.*/
WITH RECURSIVE t(n) AS (
VALUES (1)
UNION ALL
SELECT n+1 FROM t WHERE n < 100
)
SELECT n || ' bottle' || CASE WHEN n>1 THEN 's' ELSE '' END || ' of beer on the wall' || chr(10) ||
n || ' bottle' || CASE WHEN n>1 THEN 's' ELSE '' END || ' of beer' || chr(10) ||
'Take one down, pass it around' || chr(10) ||
coalesce(lead(n) OVER (ORDER BY n DESC),0) || ' bottle' ||
CASE WHEN coalesce(lead(n) OVER (ORDER BY n DESC),0) <>1 THEN 's' ELSE '' END || ' of beer on the wall'
FROM t
ORDER BY n DESC;

View file

@ -1,7 +1,12 @@
(define (bottles x)
(format #t "~a bottles of beer on the wall~%" x)
(format #t "~a bottles of beer~%" x)
(format #t "Take one down, pass it around~%")
(format #t "~a bottles of beer on the wall~%" (- x 1))
(if (> (- x 1) 0)
(bottles (- x 1))))
(define (sing)
(define (sing-to-x n)
(if (> n -1)
(begin
(display n)
(display "bottles of beer on the wall")
(newline)
(display "Take one down, pass it around")
(newline)
(sing-to-x (- n 1)))
(display "would you wanna me to sing it again?")))
(sing-to-x 99))

View file

@ -0,0 +1,74 @@
<?xml version="1.0" ?>
<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="1.0">
<xsl:output method="text" encoding="utf-8"/>
<!-- Main procedure -->
<xsl:template match="/">
<!-- Default parameters are used -->
<xsl:call-template name="sing-all-verses-in-range"/>
</xsl:template>
<!-- Calls sing-verse-starting-with-number over each value in a range. -->
<xsl:template name="sing-all-verses-in-range">
<!-- Default parameters: From 99 through 1 -->
<xsl:param name="first" select="99"/>
<xsl:param name="final" select="1"/>
<!-- Simulate a loop with tail recursion. -->
<xsl:if test="$first &gt;= $final">
<!-- Process $first -->
<xsl:call-template name="sing-verse-starting-with-number">
<xsl:with-param name="n" select="$first"/>
</xsl:call-template>
<!-- Process $first - 1 through $final -->
<xsl:call-template name="sing-all-verses-in-range">
<xsl:with-param name="first" select="$first - 1"/>
<xsl:with-param name="final" select="$final"/>
</xsl:call-template>
</xsl:if>
</xsl:template>
<!-- Outputs a single verse. Each verse starts with $n bottles and ends with $n - 1 bottles. -->
<xsl:template name="sing-verse-starting-with-number">
<xsl:param name="n"/>
<!-- "$n bottles of beer on the wall" -->
<xsl:call-template name="sing-line-containing-number">
<xsl:with-param name="n" select="$n"/>
</xsl:call-template>
<!-- "$n bottles of beer" -->
<xsl:call-template name="sing-line-containing-number">
<xsl:with-param name="n" select="$n"/>
<!-- For the second line, specify blank suffix -->
<xsl:with-param name="suffix"/>
</xsl:call-template>
<xsl:text>Take one down, pass it around&#10;</xsl:text>
<!-- "($n - 1) bottles of beer on the wall" -->
<xsl:call-template name="sing-line-containing-number">
<!-- End verse with one less bottle -->
<xsl:with-param name="n" select="$n - 1"/>
</xsl:call-template>
<xsl:text>&#10;</xsl:text>
</xsl:template>
<!-- Outputs "[number] bottle[s] of beer[ on the wall]" -->
<xsl:template name="sing-line-containing-number">
<xsl:param name="n"/>
<!-- If no suffix is specified, use " on the wall" -->
<xsl:param name="suffix"> on the wall</xsl:param>
<xsl:value-of select="$n"/>
<xsl:text> bottle</xsl:text>
<!-- Add "s" iff appropriate -->
<xsl:if test="$n != 1">s</xsl:if>
<xsl:text> of beer</xsl:text>
<xsl:value-of select="$suffix"/>
<xsl:text>&#10;</xsl:text>
</xsl:template>
</xsl:stylesheet>

View file

@ -0,0 +1,21 @@
* A+B 29/08/2015
APLUSB CSECT
USING APLUSB,R12
LR R12,R15
OPEN (MYDATA,INPUT)
LOOP GET MYDATA,PG read a single record
XDECI R4,PG input A
XDECI R5,PG+12 input B
AR R4,R5 A+B
XDECO R4,PG+24 edit A+B
XPRNT PG,36 print A+B
B LOOP repeat
ATEND CLOSE MYDATA
RETURN XR R15,R15
BR R14
LTORG
MYDATA DCB LRECL=24,RECFM=FT,EODAD=ATEND,DDNAME=MYFILE
PG DS CL24 record
DC CL12' '
YREGS
END APLUSB

5
Task/A+B/ALGOL-W/a+b.alg Normal file
View file

@ -0,0 +1,5 @@
begin
integer a, b;
read( a, b );
write( a + b )
end.

26
Task/A+B/ATS/a+b.ats Normal file
View file

@ -0,0 +1,26 @@
(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
staload UN = $UNSAFE
//
(* ****** ****** *)
staload "libc/SATS/stdio.sats"
(* ****** ****** *)
implement
main0() = let
var A: int
var B: int
val () =
$extfcall
(void, "scanf", "%d%d", addr@A, addr@B)
// end of [val]
in
println! ($UN.cast2int(A) + $UN.cast2int(B))
end // end of [main0]
(* ****** ****** *)

View file

@ -0,0 +1,7 @@
on run argv
try
return ((first item of argv) as integer) + (second item of argv) as integer
on error
return "Usage with -1000 <= a,b <= 1000: " & tab & " A+B.scpt a b"
end try
end run

View file

@ -1,7 +1,7 @@
// Standard input-output streams
#include <iostream>
using namespace std;
void main()
int main()
{
int a, b;
cin >> a >> b;

View file

@ -0,0 +1,3 @@
(println (+ (read) (read)))
3 4
7

View file

@ -0,0 +1,4 @@
(let [ints (map #(Integer/parseInt %) (clojure.string/split (read-line) #"\s") )]
(println (reduce + ints)))
3 4
=>7

View file

@ -0,0 +1,4 @@
(println (reduce + (map #(Integer/parseInt %) (clojure.string/split (read-line) #"\s") )))
3 4
=>7

4
Task/A+B/DCL/a+b.dcl Normal file
View file

@ -0,0 +1,4 @@
$ read sys$command line
$ a = f$element( 0, " ", line )
$ b = f$element( 1, " ", line )
$ write sys$output a + b

20
Task/A+B/Eiffel/a+b-2.e Normal file
View file

@ -0,0 +1,20 @@
make
-- Run application.
note
synopsis: "[
The specification implies command line input stream and also
implies a range for both `A' and `B' (e.g. (-1000 <= A,B <= +1000)).
To test in Eiffel Studio workbench, one can set Execution Parameters
of "2 2", where the expected output is 4. One may also create other
test Execution Parameters where the inputs are out-of-bounds and
confirm the failure.
]"
do
if attached {INTEGER} argument (1).to_integer as a and then
attached {INTEGER} argument (2).to_integer as b and then
(a >= -1000 and b >= -1000 and a <= 1000 and b <= 1000) then
print (a + b)
else
print ("Either argument 1 or 2 is out-of-bounds. Ensure: (-1000 <= A,B <= +1000)")
end
end

View file

@ -1,3 +1,7 @@
open console list string read
open monad io string list
readn() |> string.split " " |> map readStr |> sum
a'b() = do
str <- readStr
putStrLn <| show <| sum <| map gread <| string.split " " <| str
a'b() ::: IO

View file

@ -6,6 +6,5 @@
#var A := Integer new.
#var B := Integer new.
consoleEx readLine:A:B.
consoleEx writeLine:(A + B).
console readLine:A:B writeLine:(A + B).
].

View file

@ -0,0 +1,5 @@
IO.gets("Enter two numbers seperated by a space: ")
|> String.split
|> Enum.map(&String.to_integer(&1))
|> Enum.sum
|> IO.puts

View file

@ -1 +1 @@
main = getLine >>= print . sum . map read . words
main = print . sum . map read . words =<< getLine

14
Task/A+B/Java/a+b-4.java Normal file
View file

@ -0,0 +1,14 @@
grammar aplusb ;
options {
language = Java;
}
aplusb : (WS* e1=Num WS+ e2=Num NEWLINE {System.out.println($e1.text + " + " + $e2.text + " = " + (Integer.parseInt($e1.text) + Integer.parseInt($e2.text)));})+
;
Num : '-'?('0'..'9')+
;
WS : (' ' | '\t')
;
NEWLINE : WS* '\r'? '\n'
;

View file

@ -1,6 +1,6 @@
/* NetRexx */
options replace format comments java crossref savelog symbols binary
options replace format comments java symbols binary
parse ask a b .
say a '+' b '=' a + b

View file

@ -0,0 +1 @@
say [+] get.words

View file

@ -0,0 +1 @@
$*IN.get.words.reduce(* + *).say

View file

@ -0,0 +1,2 @@
my ($a,$b) = $*IN.get.split(" ");
say $a + $b;

View file

@ -1 +0,0 @@
say [+] .words for lines

1
Task/A+B/Ruby/a+b.rb Normal file
View file

@ -0,0 +1 @@
puts gets.split.map(&:to_i).inject(:+)

View file

@ -1,15 +1,18 @@
// -*- rust v0.9 -*-
use std::os;
use std::io::{self, Write};
fn main() {
let args : ~[~str] = os::args();
let mut values = 0;
for i in args.iter(){
match from_str::<int>(i.to_str()) {
Some(valid_int) => values += valid_int,
None => ()
}
}
println(values.to_str());
let mut buf = String::new();
loop { // Loop until user gives a string of valid numbers
print!("Give me a number: ");
io::stdout().flush().expect("Could not flush stdout");
io::stdin().read_line(&mut buf).expect("Could not read stdin");
let res: Result<Vec<_>, _> = buf.split_whitespace().map(|num| num.parse()).collect();
println!("{}", match res {
Ok(vec) => vec.iter().fold(0, |sum, x| sum + x),
Err(e) => {
writeln!(&mut io::stderr(), "Error: {}", e).expect("Could not write to stdout");
continue;
}
});
break;
}
}

2
Task/A+B/SETL/a+b.setl Normal file
View file

@ -0,0 +1,2 @@
read(A, B);
print(A + B);

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