Just another update

This commit is contained in:
Ingy döt Net 2015-02-20 00:35:01 -05:00
parent a25938f123
commit 00a190b0a6
6591 changed files with 94363 additions and 23227 deletions

View file

@ -1,5 +1,10 @@
Problem: You have 100 doors in a row that are all initially closed. 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.
Problem: You have 100 doors in a row that are all initially closed.
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]
'''[[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.
'''[[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.

View file

@ -1,11 +1,11 @@
outdoors num
⍝ Simulates the 100 doors problem for any number of doors
⍝ Returns a boolean vector with 1 being open
out?doors num
? Simulates the 100 doors problem for any number of doors
? Returns a boolean vector with 1 being open
outnum ⍝ num steps
out¨out ⍝ Count out the spacing for each step
out1=out ⍝ Make that into a boolean vector
out¨out ⍝ Flip each vector around
out(num)¨out ⍝ Copy each out to the right size
out/out ⍝ XOR each vector, toggling each marked door
outout ⍝ Disclose the results to get a vector
out??num ? num steps
out??¨out ? Count out the spacing for each step
out?1=out ? Make that into a boolean vector
out??¨out ? Flip each vector around
out?(num°?)¨out ? Copy each out to the right size
out??/out ? XOR each vector, toggling each marked door
out??out ? Disclose the results to get a vector

View file

@ -1,7 +1,7 @@
outdoorsOptimized num;marks
⍝ Returns a boolean vector of the doors that would be left open
out?doorsOptimized num;marks
? Returns a boolean vector of the doors that would be left open
marksnum*0.5 ⍝ Take the square root of the size, floored
marks(marks)*2 ⍝ Get each door to be opened
outnum0 ⍝ Make a vector of 0s
out[marks]1 ⍝ Set the marked doors to 1
marks??num*0.5 ? Take the square root of the size, floored
marks?(?marks)*2 ? Get each door to be opened
out?num?0 ? Make a vector of 0s
out[marks]?1 ? Set the marked doors to 1

View file

@ -0,0 +1,41 @@
#include "share/atspre_staload.hats"
implement
main0((*void*)) = let
//
var A = @[bool][100](false)
val A = $UNSAFE.cast{arrayref(bool,100)}(addr@A)
//
fnx
loop
(
pass: intGte(0)
) : void =
if pass < 100
then loop2 (pass, pass)
// end of [if]
and
loop2
(
pass: natLt(100), door: intGte(0)
) : void =
if door < 100
then (A[door] := ~A[door]; loop2(pass, door+pass+1))
else loop(pass+1)
// end of [if]
//
fun
loop3
(
door: intGte(0)
) : void =
if door < 100
then (
println!("door #", door+1, " is ", (if A[door] then "open" else "closed"): string, ".");
loop3(door+1)
) (* end of [then] *)
// end of [if]
//
in
loop(0); loop3 (0)
end // end of [main0]

View file

@ -1,14 +1,42 @@
using System;
class Program
namespace ConsoleApplication1
{
static void Main()
using System;
class Program
{
//To simplify door numbers, uses indexes 1 to 100 (rather than 0 to 99)
bool[] doors = new bool[101];
for (int pass = 1; pass <= 100; pass++)
for (int current = pass; current <= 100; current += pass)
doors[current] = !doors[current];
for (int i = 1; i <= 100; i++)
Console.WriteLine("Door #{0} " + (doors[i] ? "Open" : "Closed"), i);
static void Main(string[] args)
{
bool[] doors = new bool[100];
//Close all doors to start.
for (int d = 0; d < 100; d++) doors[d] = false;
//For each pass...
for (int p = 0; p < 100; p++)//number of passes
{
//For each door to toggle...
for (int d = 0; d < 100; d++)//door number
{
if ((d + 1) % (p + 1) == 0)
{
doors[d] = !doors[d];
}
}
}
//Output the results.
Console.WriteLine("Passes Completed!!! Here are the results: \r\n");
for (int d = 0; d < 100; d++)
{
if (doors[d])
{
Console.WriteLine(String.Format("Door #{0}: Open", d + 1));
}
else
{
Console.WriteLine(String.Format("Door #{0}: Closed", d + 1));
}
}
Console.ReadKey(true);
}
}
}

View file

@ -1,20 +1,30 @@
using System;
class Program
namespace ConsoleApplication1
{
static void Main()
using System;
class Program
{
int door = 1, inrementer = 0;
for (int current = 1; current <= 100; current++)
static void Main()
{
Console.Write("Door #{0} ", current);
if (current == door)
//The o variable stores the number of the next OPEN door.
int o = 1;
//The n variable is used to help calculate the next value of the o variable.
int n = 0;
//The d variable determines the door to be output next.
for (int d = 1; d <= 100; d++)
{
Console.WriteLine("Open");
inrementer++;
door += 2 * inrementer + 1;
Console.Write("Door #{0}: ", d);
if (d == o)
{
Console.WriteLine("Open");
n++;
o += 2 * n + 1;
}
else
Console.WriteLine("Closed");
}
else
Console.WriteLine("Closed");
Console.ReadKey(true);
}
}
}

View file

@ -1,10 +1,21 @@
using System;
class Program
namespace ConsoleApplication1
{
static void Main()
using System;
class Program
{
double n;
for (int t = 1; t <= 100; ++t)
Console.WriteLine(t + ": " + (((n = Math.Sqrt(t)) == (int)n) ? "Open" : "Closed"));
static void Main(string[] args)
{
//Perform the operation.
bool[] doors = new bool[100];
int n = 0;
int d;
while ((d = (++n * n)) <= 100)
doors[d - 1] = true;
//Perform the presentation.
for (d = 0; d < doors.Length; d++)
Console.WriteLine("Door #{0}: {1}", d + 1, doors[d] ? "Open" : "Closed");
Console.ReadKey(true);
}
}
}

View file

@ -1,41 +1,19 @@
using System;
class Program
namespace ConsoleApplication1
{
static void Main(string[] args)
using System;
class Program
{
static void Main()
{
bool[] Doors = new bool[101];
bool[] doors = new bool[100];
//Close all doors to start
for (int g=1;g<101;g++) Doors[g] = false;
for (int i = 1; i < 101; i++)//number of passes
{
for (int d = 1; d < 101; d++)//door number
{
if ((d % i) == 0)
{
if (Doors[d]) Doors[d] = false;
else Doors[d] = true;
}
}
}
Console.WriteLine("Passes Completed!!! Here are the results: \r\n");
for (int p = 1; p < 101; p++)
{
if (Doors[p])
{
string doorStatus = String.Format("Door #{0} is \'OPENED\'.", p.ToString());
Console.WriteLine(doorStatus);
}
else
{
string doorStatus = String.Format("Door #{0} is \'CLOSED\'.", p.ToString());
Console.WriteLine(doorStatus);
}
}
//The number of passes can be 1-based, but the number of doors must be 0-based.
for (int p = 1; p <= 100; p++)
for (int d = p - 1; d < 100; d += p)
doors[d] = !doors[d];
for (int d = 0; d < 100; d++)
Console.WriteLine("Door #{0}: {1}", d + 1, doors[d] ? "Open" : "Closed");
Console.ReadKey(true);
}
}
}

View file

@ -1,14 +1,16 @@
namespace ConsoleApplication1
{
using System;
class Program
{
static void Main(string[] args)
static void Main()
{
bool[] doorStates = new bool[100];
int n = 0;
int d;
while ((d = (++n * n)) <= 100)
doorStates[d - 1] = true;
for (int i = 0; i < doorStates.Length; i++)
Console.WriteLine("Door {0}: {1}", i + 1, doorStates[i] ? "Open" : "Closed");
double n;
//If the current door number is the perfect square of an integer, say it is open, else say it is closed.
for (int d = 1; d <= 100; d++)
Console.WriteLine("Door #{0}: {1}", d, (n = Math.Sqrt(d)) == (int)n ? "Open" : "Closed");
Console.ReadKey(true);
}
}
}

View file

@ -0,0 +1,14 @@
<Cfparam name="doorlist" default="">
<cfloop from="1" to="100" index="i">
<Cfset doorlist = doorlist & 'c,'>
</cfloop>
<cfloop from="1" to="100" index="i">
<Cfloop from="1" to="100" index="door" step="#i#">
<Cfif listgetat(doorlist, door) eq 'c'>
<Cfset doorlist = listsetat(doorlist, door, 'O')>
<Cfelse>
<Cfset doorlist = listsetat(doorlist, door, 'c')>
</Cfif>
</Cfloop>
</cfloop>
<Cfoutput>#doorlist#</Cfoutput>

View file

@ -1,21 +1,23 @@
(defun perfect-square-list (n)
"Generates a list of perfect squares from 0 up to n"
(loop for i from 1 to (sqrt n) collect (expt i 2)))
"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)
doors)
"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"
(if (null vlist)
doors
(visit-all (open-door doors (car vlist) open)
(cdr 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) "_")))
"Start the program"
(print-doors
(visit-all (make-list size :initial-element '\#)
(perfect-square-list size)
'_)))

View file

@ -23,4 +23,4 @@ Fixpoint flipwhile l n :=
| S n' => flipwhile (flipeach l (S n')) n'
end.
Definition prison cells := flipwhile (rep false (S cells)) cells.
Definition prison cells := flipwhile (rep false cells) cells.

View file

@ -10,4 +10,4 @@ Fixpoint prisoo' nd n k accu :=
prisoo' nd' (snd (fst ra)) (snd ra) ((fst (fst ra))::accu)
end.
Definition prisoo n := prisoo' (S n) 1 0 nil.
Definition prisoo cells := prisoo' cells 1 0 nil.

View file

@ -7,4 +7,4 @@ toggleEvery :: [Door] -> Int -> [Door]
toggleEvery xs k = zipWith ($) fs xs
where fs = cycle $ (replicate (k-1) id) ++ [toggle]
run n = foldl toggleEvery (replicate n Closed) [0..n]
run n = foldl toggleEvery (replicate n Closed) [1..n]

View file

@ -1,6 +1,12 @@
gate :: Eq a => [a] -> [a] -> [Door]
gate (x:xs) (y:ys) | x == y = Open : gate xs ys
gate (x:xs) ys = Closed : gate xs ys
gate [] _ = []
data Door = Open | Closed deriving Show
run n = gate [1..n] [k*k | k <- [1..]]
toggle Open = Closed
toggle Closed = Open
toggleEvery :: Int -> [Door] -> [Door]
toggleEvery k = zipWith toggleK [1..]
where
toggleK n door | n `mod` k == 0 = toggle door
| otherwise = door
run n = foldr toggleEvery (replicate n Closed) [1..n]

View file

@ -1 +1,6 @@
run n = takeWhile (< n) [k*k | k <- [1..]]
gate :: Eq a => [a] -> [a] -> [Door]
gate (x:xs) (y:ys) | x == y = Open : gate xs ys
gate (x:xs) ys = Closed : gate xs ys
gate [] _ = []
run n = gate [1..n] [k*k | k <- [1..]]

View file

@ -0,0 +1 @@
run n = takeWhile (< n) [k*k | k <- [1..]]

View file

@ -1,4 +1,4 @@
'these doors are open' ; >: I. (>:i.100) e. *: i.11
┌────────────────────┬───────────────────────────┐
│these doors are open│1 4 9 16 25 36 49 64 81 100│
└────────────────────┴───────────────────────────┘
+------------------------------------------------+
¦these doors are open¦1 4 9 16 25 36 49 64 81 100¦
+------------------------------------------------+

View file

@ -1,6 +1,8 @@
for (var door = 1; door <= 100; i++) {
var sqrt = Math.sqrt(door);
if (sqrt === (sqrt | 0)) {
console.log("Door %d is open", door);
}
}
var doors=[];
for(var i=0;i<100;i++)
doors[i]=false; //create doors
for(var i=1;i<=100;i++)
for(var i2=i-1,g;i2<100;i2+=i)
doors[i2]=!doors[i2]; //toggle doors
for(var i=1;i<=100;i++) //read doors
console.log("Door %d is %s",i,doors[i-1]?"open":"closed")

View file

@ -1,9 +1,6 @@
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);
}
});
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,6 +1,6 @@
Array.apply(null, { length: 100 })
.map((v, i) => i + 1)
.forEach(door => {
.map(function(v, i) { return i + 1; })
.forEach(function(door) {
var sqrt = Math.sqrt(door);
if (sqrt === (sqrt | 0)) {

View file

@ -1,9 +1,3 @@
// 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);
}
});
for(var door=1;i<10/*Math.sqrt(100)*/;i++){
console.log("Door %d is open",i*i);
}

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,5 +1,7 @@
doors = falses(100)
for a = 1:100, b in a:a:100
doors[b] = !doors[b]
doors[b] = !doors[b]
end
for a = 1:100
println("Door $a is " * (doors[a] ? "open" : "close"))
end
for a = 1:100 println("Door $a is " * (doors[a] ? "open" : "close") ) end

View file

@ -1,9 +1,9 @@
NDoors := proc( N :: posint )
# Initialise, using 0 to represent "closed"
local doors := Array( 1 .. N, 'datatype' = 'integer'[ 1 ] );
local pass, door, doors := Array( 1 .. N, 'datatype' = 'integer'[ 1 ] );
# Now do N passes
for local pass from 1 to N do
for local door from pass by pass while door <= N do
for pass from 1 to N do
for door from pass by pass while door <= N do
doors[ door ] := 1 - doors[ door ]
end do
end do;

View file

@ -1 +1,5 @@
Do[Print["door ",i," is ",If[IntegerQ[Sqrt[i]],"open","closed"]],{i,100}]
Fold[
ReplacePart[#1, (i_ /; Mod[i, #2] == 0) :> (-#1[[i]])] &,
ConstantArray[-1, {100}],
Range[100]
] /. {1 -> "Open", -1 -> "Closed"}

View file

@ -1,3 +1 @@
n=100;
a=Range[1,Sqrt[n]]^2
Do[Print["door ",i," is ",If[MemberQ[a,i],"open","closed"]],{i,100}]
Do[Print["door ",i," is ",If[IntegerQ[Sqrt[i]],"open","closed"]],{i,100}]

View file

@ -1,12 +1,3 @@
n=100
nn=1
a=0
For[i=1,i<=n,i++,
If[i==nn,
Print["door ",i," is open"];
a++;
nn+=2a+1;
,
Print["door ",i," is closed"];
];
]
n=100;
a=Range[1,Sqrt[n]]^2
Do[Print["door ",i," is ",If[MemberQ[a,i],"open","closed"]],{i,100}]

View file

@ -1 +1,12 @@
Pick[Range[100], Xor@@@Array[Divisible[#1,#2]&, {100,100}]]
n=100
nn=1
a=0
For[i=1,i<=n,i++,
If[i==nn,
Print["door ",i," is open"];
a++;
nn+=2a+1;
,
Print["door ",i," is closed"];
];
]

View file

@ -1 +1 @@
Range[Sqrt[100]]^2
Pick[Range[100], Xor@@@Array[Divisible[#1,#2]&, {100,100}]]

View file

@ -0,0 +1 @@
Range[Sqrt[100]]^2

View file

@ -21,7 +21,7 @@ walk(N, !D) :- walk(N, N, !D).
:- pred walk(int::in, int::in, doors::in, doors::out) is semidet.
walk(At, By, !D) :-
semidet_lookup(!.D, At - 1, Door),
slow_set(!.D, At - 1, toggle(Door), !:D),
slow_set(At - 1, toggle(Door), !D),
( walk(At + By, By, !D) -> true ; true ).
walks(N, End, !D) :-

View file

@ -0,0 +1,28 @@
@import Foundation;
int main(int argc, const char * argv[]) {
@autoreleasepool {
// Create a mutable array
NSMutableArray *doorArray = [@[] mutableCopy];
// Fill the doorArray with 100 closed doors
for (NSInteger i = 0; i < 100; ++i) {
doorArray[i] = @NO;
}
// Do the 100 passes
for (NSInteger pass = 0; pass < 100; ++pass) {
for (NSInteger door = pass; door < 100; door += pass+1) {
doorArray[door] = [doorArray[door] isEqual: @YES] ? @NO : @YES;
}
}
// Print the results
[doorArray enumerateObjectsUsingBlock:^(id obj, NSUInteger idx, BOOL *stop) {
if ([obj isEqual: @YES]) {
NSLog(@"Door number %lu is open", idx + 1);
}
}];
}
}

View file

@ -0,0 +1,68 @@
@import Foundation;
#pragma mark - Classes
////////////////////////////////////////////////////
// Model class header - A we are using a category to add a method to MSMutableArray
@interface NSMutableArray (DoorModelExtension)
- (void)setNumberOfDoors:(NSUInteger)doors;
@end
// Model class implementation
@implementation NSMutableArray (DoorModelExtension)
- (void)setNumberOfDoors:(NSUInteger)doors {
// Fill the doorArray with 100 closed doors
for (NSInteger i = 0; i < doors; ++i) {
self[i] = @NO;
}
}
@end
////////////////////////////////////////////////////
// View class header - A simple class to handle printing our values
@interface DoorViewClass : NSObject
- (void)printResultsOfDoorTask:(NSMutableArray *)doors;
@end
// View class implementation
@implementation DoorViewClass
- (void)printResultsOfDoorTask:(NSMutableArray *)doors {
// Print the results, using an enumeration block for easy index tracking
[doors enumerateObjectsUsingBlock:^(id obj, NSUInteger idx, BOOL *stop) {
if ([obj isEqual: @YES]) {
NSLog(@"Door number %lu is open", idx + 1);
}
}];
}
@end
////////////////////////////////////////////////////
#pragma mark - main
// With our classes set we can use them from our controller, in this case main
int main(int argc, const char * argv[]) {
// Init our classes
NSMutableArray *doorArray = [NSMutableArray array];
DoorViewClass *doorView = [DoorViewClass new];
// Use our class category to add the doors
[doorArray setNumberOfDoors:100];
// Do the 100 passes
for (NSUInteger pass = 0; pass < 100; ++pass) {
for (NSUInteger door = pass; door < 100; door += pass+1) {
doorArray[door] = [doorArray[door] isEqual: @YES] ? @NO : @YES;
}
}
// Print the results
[doorView printResultsOfDoorTask:doorArray];
}

View file

@ -1 +1,10 @@
print "Door $_ is open\n" for map $_**2, 1 .. 10;
#!/usr/bin/perl
use strict;
use warnings;
my @doors = (1) x 100;
for my $N (1 .. 100) {
$doors[$_]=1-$doors[$_] for map { $_*$N - 1 } 1 .. int(100/$N);
}
print join("\n", map { "Door $_ is Open" } grep { ! $doors[$_-1] } 1 .. 100), "\n";
print "The rest are closed\n";

View file

@ -1 +1 @@
print "Door $_ is ", qw"closed open"[int sqrt == sqrt], "\n" for 1..100;
print "Door $_ is open\n" for map $_**2, 1 .. 10;

View file

@ -1,12 +1 @@
while( ++$i <= 100 )
{
$root = sqrt($i);
if ( int( $root ) == $root )
{
print "Door $i is open\n";
}
else
{
print "Door $i is closed\n";
}
}
print "Door $_ is ", qw"closed open"[int sqrt == sqrt], "\n" for 1..100;

View file

@ -0,0 +1,12 @@
while( ++$i <= 100 )
{
$root = sqrt($i);
if ( int( $root ) == $root )
{
print "Door $i is open\n";
}
else
{
print "Door $i is closed\n";
}
}

View file

@ -0,0 +1,6 @@
Workflow Calc-Doors {
Foreach parallel ($number in 1..100) {
"Door " + $number.ToString("0000") + ": " + @{$true="Closed";$false="Open"}[([Math]::pow($number, 0.5)%1) -ne 0]
}
}
Calc-Doors | sort

View file

@ -0,0 +1 @@
1..10|%{"Door "+ $_*$_ + " is open"}

View file

@ -1,4 +1,31 @@
doors_optimized(N) :-
Max is floor(sqrt(N)),
forall(between(1, Max, I),
( J is I*I,format('Door ~w is open.~n',[J]))).
doors(Num, Passes) :-
forall(( everyNth(1,Passes,1,Pass)
, forall((everyNth(Pass,Num,Pass,Door), toggle(Door)))
))
, show(Num)
.
toggle(Door) :-
Opened = opened(Door)
, ( clause(Opened,_) -> retract(Opened)
; asserta(Opened)
).
show(Num) :-
forall(( between(1,Num,Door)
, (opened(Door) -> State = opened ; State = closed)
, write(Door), write(' '), write(State), nl
)).
% utils
forall(X) :- findall(_, X, _).
everyNth(From,To,Step,X) :-
From =< To
, ( X = From ; From1 is From + Step, everyNth(From1,To,Step,X) )
.
main :- doors(100,100), halt.

View file

@ -0,0 +1,4 @@
doors_optimized(N) :-
Max is floor(sqrt(N)),
forall(between(1, Max, I),
( J is I*I,format('Door ~w is open.~n',[J]))).

View file

@ -0,0 +1 @@
for i in range(1,11): print("Door %s is open" % i**2)

View file

@ -0,0 +1,20 @@
dim x as integer, y as integer
dim door(1 to 100) as byte
'initialize array
for x = 1 to 100 : door(x) = 0 : next
'set door values
for y = 1 to 100
for x = y to 100 step y
door(x) = not door(x)
next x
next y
'print result
for x = 1 to 100
if door(x) then print "Door " + str$(x) + " = open"
next
while inkey$="":wend
end

View file

@ -1,17 +1,14 @@
// rust 0.8
// rust 1.0.0-alpha
#![feature(core)]
use std::iter::{range_step_inclusive};
fn main() {
let mut door_open = [false, ..100];
for pass in std::iter::range_inclusive(1, 100) {
for door in std::iter::range_inclusive(1, 100) {
if door % pass == 0 {
door_open[door - 1] = !door_open[door - 1];
}
}
}
for (i, state) in door_open.iter().enumerate() {
println!("Door {} is {}.", i + 1,
if *state {"open"} else {"closed"});
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];
}
}
for (i, state) in door_open.iter().enumerate() {
println!("Door {} is {}.", i + 1, if *state {"open"} else {"closed"});
}
}

View file

@ -0,0 +1,23 @@
DECLARE @sqr int,
@i int,
@door int;
SELECT @sqr =1,
@i = 3,
@door = 1;
WHILE(@door <=100)
BEGIN
IF(@door = @sqr)
BEGIN
PRINT 'Door ' + RTRIM(CAST(@door as char)) + ' is open.';
SET @sqr= @sqr+@i;
SET @i=@i+2;
END
ELSE
BEGIN
PRINT 'Door ' + RTRIM(CONVERT(char,@door)) + ' is closed.';
END
SET @door = @door + 1
END

View file

@ -0,0 +1,17 @@
(define (N_doors N)
(define (init)
(define (str n)
(if (> n N) '() (cons 0 (str (+ 1 n)))))
(str 1))
(define (toggle x str)
(define (s n lis)
(define (revert x)
(if (eq? x 0) 1 0))
(cond ((null? lis) '())
((zero? (remainder n x)) (cons (revert (car lis)) (s (+ n 1) (cdr lis))))
(else (cons (car lis) (s (+ n 1) (cdr lis))))))
(s 1 str))
(define (iterate x lis)
(if (> x N) lis (iterate (+ x 1) (toggle x lis))))
(iterate 1 (init)))
(N_doors 100)

View file

@ -3,14 +3,14 @@ PROGRAM:DOORS100
:Disp "SETTING UP LIST"
:Disp "PLEASE WAIT..."
:For(I,1,100,1)
:0L1(I)
:0?L1(I)
:End
:ClrHome
:Disp "Pass"
:For(I,1,100,1)
:For(J,I,100,I)
:Output(2,1,I)
:not(L1(J))L1(J)
:not(L1(J))?L1(J)
:End
:End
:ClrHome

View file

@ -1,4 +1,4 @@
PROGRAM:DOORSOPT
:For(I,1,100,1)
:not(fPart(√(I)))→L1(I)
:not(fPart(v(I)))?L1(I)
:End

View file

@ -1,14 +1,14 @@
Define doors(fast) = Func
Local doors,i,j
seq(false,x,1,100) doors
seq(false,x,1,100) ? doors
If fast Then
For i,1,10,1
true doors[i^2]
true ? doors[i^2]
EndFor
Else
For i,1,100,1
For j,i,100,i
not doors[j] doors[j]
not doors[j] ? doors[j]
EndFor
EndFor
EndIf

View file

@ -1,9 +1,9 @@
@(do (defun hyaku-mai-to ()
@(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 (list-vector (hyaku-mai-to))))
(format t "door ~a is ~a\n" counter (if door "open" "closed"))))
(door (hyaku-mai-tobira)))
(put-line `door @counter is @(if door "open" "closed")`)))

View file

@ -1,6 +1,5 @@
Write a function that given four digits subject to the rules of the [[24 game]], computes an expression to solve the game if possible.
Show examples of solutions generated by the function
Write a program that takes four digits, either from user input or by random generation, and computes arithmetic expressions following the rules of the [[24 game]].
Show examples of solutions generated by the program.
C.F: [[Arithmetic Evaluator]]

View file

@ -0,0 +1,90 @@
#include <iostream>
#include <ratio>
#include <array>
#include <algorithm>
#include <random>
typedef short int Digit; // Typedef for the digits data type.
constexpr Digit nDigits{4}; // Amount of digits that are taken into the game.
constexpr Digit maximumDigit{9}; // Maximum digit that may be taken into the game.
constexpr short int gameGoal{24}; // Desired result.
typedef std::array<Digit, nDigits> digitSet; // Typedef for the set of digits in the game.
digitSet d;
void printTrivialOperation(std::string operation) { // Prints a commutative operation taking all the digits.
bool printOperation(false);
for(const Digit& number : d) {
if(printOperation)
std::cout << operation;
else
printOperation = true;
std::cout << number;
}
std::cout << std::endl;
}
void printOperation(std::string prefix, std::string operation1, std::string operation2, std::string operation3, std::string suffix = "") {
std::cout << prefix << d[0] << operation1 << d[1] << operation2 << d[2] << operation3 << d[3] << suffix << std::endl;
}
int main() {
std::mt19937_64 randomGenerator;
std::uniform_int_distribution<Digit> digitDistro{1, maximumDigit};
// Let us set up a number of trials:
for(int trial{10}; trial; --trial) {
for(Digit& digit : d) {
digit = digitDistro(randomGenerator);
std::cout << digit << " ";
}
std::cout << std::endl;
std::sort(d.begin(), d.end());
// We start with the most trivial, commutative operations:
if(std::accumulate(d.cbegin(), d.cend(), 0) == gameGoal)
printTrivialOperation(" + ");
if(std::accumulate(d.cbegin(), d.cend(), 1, std::multiplies<Digit>{}) == gameGoal)
printTrivialOperation(" * ");
// Now let's start working on every permutation of the digits.
do {
// Operations with 2 symbols + and one symbol -:
if(d[0] + d[1] + d[2] - d[3] == gameGoal) printOperation("", " + ", " + ", " - "); // If gameGoal is ever changed to a smaller value, consider adding more operations in this category.
// Operations with 2 symbols + and one symbol *:
if(d[0] * d[1] + d[2] + d[3] == gameGoal) printOperation("", " * ", " + ", " + ");
if(d[0] * (d[1] + d[2]) + d[3] == gameGoal) printOperation("", " * ( ", " + ", " ) + ");
if(d[0] * (d[1] + d[2] + d[3]) == gameGoal) printOperation("", " * ( ", " + ", " + ", " )");
// Operations with one symbol + and 2 symbols *:
if((d[0] * d[1] * d[2]) + d[3] == gameGoal) printOperation("( ", " * ", " * ", " ) + ");
if(d[0] * d[1] * (d[2] + d[3]) == gameGoal) printOperation("( ", " * ", " * ( ", " + ", " )");
if((d[0] * d[1]) + (d[2] * d[3]) == gameGoal) printOperation("( ", " * ", " ) + ( ", " * ", " )");
// Operations with one symbol - and 2 symbols *:
if((d[0] * d[1] * d[2]) - d[3] == gameGoal) printOperation("( ", " * ", " * ", " ) - ");
if(d[0] * d[1] * (d[2] - d[3]) == gameGoal) printOperation("( ", " * ", " * ( ", " - ", " )");
if((d[0] * d[1]) - (d[2] * d[3]) == gameGoal) printOperation("( ", " * ", " ) - ( ", " * ", " )");
// Operations with one symbol +, one symbol *, and one symbol -:
if(d[0] * d[1] + d[2] - d[3] == gameGoal) printOperation("", " * ", " + ", " - ");
if(d[0] * (d[1] + d[2]) - d[3] == gameGoal) printOperation("", " * ( ", " + ", " ) - ");
if(d[0] * (d[1] - d[2]) + d[3] == gameGoal) printOperation("", " * ( ", " - ", " ) + ");
if(d[0] * (d[1] + d[2] - d[3]) == gameGoal) printOperation("", " * ( ", " + ", " - ", " )");
if(d[0] * d[1] - (d[2] + d[3]) == gameGoal) printOperation("", " * ", " - ( ", " + ", " )");
// Operations with one symbol *, one symbol /, one symbol +:
if(d[0] * d[1] == (gameGoal - d[3]) * d[2]) printOperation("( ", " * ", " / ", " ) + ");
if(((d[0] * d[1]) + d[2]) == gameGoal * d[3]) printOperation("(( ", " * ", " ) + ", " ) / ");
if((d[0] + d[1]) * d[2] == gameGoal * d[3]) printOperation("(( ", " + ", " ) * ", " ) / ");
if(d[0] * d[1] == gameGoal * (d[2] + d[3])) printOperation("( ", " * ", " ) / ( ", " + ", " )");
// Operations with one symbol *, one symbol /, one symbol -:
if(d[0] * d[1] == (gameGoal + d[3]) * d[2]) printOperation("( ", " * ", " / ", " ) - ");
if(((d[0] * d[1]) - d[2]) == gameGoal * d[3]) printOperation("(( ", " * ", " ) - ", " ) / ");
if((d[0] - d[1]) * d[2] == gameGoal * d[3]) printOperation("(( ", " - ", " ) * ", " ) / ");
if(d[0] * d[1] == gameGoal * (d[2] - d[3])) printOperation("( ", " * ", " ) / ( ", " - ", " )");
// Operations with 2 symbols *, one symbol /:
if(d[0] * d[1] * d[2] == gameGoal * d[3]) printOperation("", " * ", " * ", " / ");
if(d[0] * d[1] == gameGoal * d[2] * d[3]) printOperation("", " * ", " / ( ", " * ", " )");
// Operations with 2 symbols /, one symbol -:
if(d[0] * d[3] == gameGoal * (d[1] * d[3] - d[2])) printOperation("", " / ( ", " - ", " / ", " )");
// Operations with 2 symbols /, one symbol *:
if(d[0] * d[1] == gameGoal * d[2] * d[3]) printOperation("( ", " * ", " / ", " ) / ", "");
} while(std::next_permutation(d.begin(), d.end())); // All operations are repeated for all possible permutations of the numbers.
}
return 0;
}

View file

@ -1,30 +1,25 @@
(use 'clojure.contrib.combinatorics)
(ns rosettacode.24game.solve
(:require [clojure.math.combinatorics :as c]
[clojure.walk :as w]))
(defn nested-replace [l m]
(cond
(= l '()) '()
(m (first l)) (concat (list (m (first l))) (nested-replace (rest l) m))
(seq? (first l)) (concat (list (nested-replace (first l) m)) (nested-replace (rest l) m))
true (concat (list (first l)) (nested-replace (rest l) m))))
(def ^:private op-maps
(map #(zipmap [:o1 :o2 :o3] %) (c/selections '(* + - /) 3)))
(defn format-solution [sol]
(cond
(number? sol) sol
(seq? sol)
(list (format-solution (second sol)) (first sol) (format-solution (nth sol 2)))))
(def ^:private patterns '(
(:o1 (:o2 :n1 :n2) (:o3 :n3 :n4))
(:o1 :n1 (:o2 :n2 (:o3 :n3 :n4)))
(:o1 (:o2 (:o3 :n1 :n2) :n3) :n4)))
(defn play24 [& digits] (count (map #(-> % format-solution println)
(let [operator-map-list (map (fn [a] {:op1 (nth a 0) :op2 (nth a 1) :op3 (nth a 2)})
(selections '(* + - /) 3))
digits-map-list
(map (fn [a] {:num1 (nth a 0) :num2 (nth a 1) :num3 (nth a 2) :num4 (nth a 3)})
(permutations digits))
patterns-list (list
'(:op1 (:op2 :num1 :num2) (:op3 :num3 :num4))
'(:op1 :num1 (:op2 :num2 (:op3 :num3 :num4))))
;other patterns can be added here, e.g. '(:op1 (:op2 (:op3 :num1 :num2) :num3) :num4)
op-subbed (reduce concat '()
(map (fn [a] (map #(nested-replace a % ) operator-map-list)) patterns-list))
full-subbed (reduce concat '()
(map (fn [a] (map #(nested-replace % a) op-subbed)) digits-map-list))]
(filter #(= (try (eval %) (catch Exception e nil)) 24) full-subbed)))))
(defn play24 [& digits]
{:pre (and (every? #(not= 0 %) digits)
(= (count digits) 4))}
(->> (for [:let [digit-maps
(->> digits sort c/permutations
(map #(zipmap [:n1 :n2 :n3 :n4] %)))]
om op-maps, dm digit-maps]
(w/prewalk-replace dm
(w/prewalk-replace om patterns)))
(filter #(= (eval %) 24))
(map println)
doall
count))

View file

@ -0,0 +1,87 @@
# This program tries to find some way to turn four digits into an arithmetic
# expression that adds up to 24.
#
# Example solution for 5, 7, 8, 8:
# (((8 + 7) * 8) / 5)
solve_24_game = (digits...) ->
# Create an array of objects for our helper functions
arr = for digit in digits
{
val: digit
expr: digit
}
combo4 arr...
combo4 = (a, b, c, d) ->
arr = [a, b, c, d]
# Reduce this to a three-node problem by combining two
# nodes from the array.
permutations = [
[0, 1, 2, 3]
[0, 2, 1, 3]
[0, 3, 1, 2]
[1, 2, 0, 3]
[1, 3, 0, 2]
[2, 3, 0, 1]
]
for permutation in permutations
[i, j, k, m] = permutation
for combo in combos arr[i], arr[j]
answer = combo3 combo, arr[k], arr[m]
return answer if answer
null
combo3 = (a, b, c) ->
arr = [a, b, c]
permutations = [
[0, 1, 2]
[0, 2, 1]
[1, 2, 0]
]
for permutation in permutations
[i, j, k] = permutation
for combo in combos arr[i], arr[j]
answer = combo2 combo, arr[k]
return answer if answer
null
combo2 = (a, b) ->
for combo in combos a, b
return combo.expr if combo.val == 24
null
combos = (a, b) ->
[
val: a.val + b.val
expr: "(#{a.expr} + #{b.expr})"
,
val: a.val * b.val
expr: "(#{a.expr} * #{b.expr})"
,
val: a.val - b.val
expr: "(#{a.expr} - #{b.expr})"
,
val: b.val - a.val
expr: "(#{b.expr} - #{a.expr})"
,
val: a.val / b.val
expr: "(#{a.expr} / #{b.expr})"
,
val: b.val / a.val
expr: "(#{b.expr} / #{a.expr})"
,
]
# test
do ->
rand_digit = -> 1 + Math.floor (9 * Math.random())
for i in [1..15]
a = rand_digit()
b = rand_digit()
c = rand_digit()
d = rand_digit()
solution = solve_24_game a, b, c, d
console.log "Solution for #{[a,b,c,d]}: #{solution ? 'no solution'}"

View file

@ -1,47 +1,36 @@
import std.stdio, std.algorithm, std.range, std.typecons, std.conv,
std.string, permutations2, arithmetic_rational;
import std.stdio, std.algorithm, std.range, std.conv, std.string,
std.concurrency, permutations2, arithmetic_rational;
string solve(in int target, in int[] problem) {
static struct ComputeAllOperations {
//static struct T { Rational r; string e; }
alias T = Tuple!(Rational,"r", string,"e");
Rational[] L;
static struct T { Rational r; string e; }
int opApply(in int delegate(ref T) dg) {
int result;
if (!L.empty) {
auto x = L[0];
auto xs = L[1 .. $];
if (L.length == 1) {
T aux = T(x, text(x));
result = dg(aux);
} else {
OUTER: foreach (o; ComputeAllOperations(xs)) {
auto y = o.r;
auto sub = [T(x * y, "*"), T(x + y, "+"), T(x - y, "-")];
if (y) sub ~= [T(x/y, "/")];
foreach (e; sub) {
auto aux = T(e.r, format("(%s%s%s)", x, e.e, o.e));
result = dg(aux); if (result) break OUTER;
Generator!T computeAllOperations(in Rational[] L) {
return new typeof(return)({
if (!L.empty) {
immutable x = L[0];
if (L.length == 1) {
yield(T(x, x.text));
} else {
foreach (const o; computeAllOperations(L.dropOne)) {
immutable y = o.r;
auto sub = [T(x * y, "*"), T(x + y, "+"), T(x - y, "-")];
if (y) sub ~= [T(x / y, "/")];
foreach (const e; sub)
yield(T(e.r, format("(%s%s%s)", x, e.e, o.e)));
}
}
}
}
}
}
return result;
});
}
}
foreach (p; problem.map!Rational.array.permutations)
foreach (sol; ComputeAllOperations(p))
if (sol.r == target)
return sol.e;
return "No solution";
foreach (const p; problem.map!Rational.array.permutations!false)
foreach (const sol; computeAllOperations(p))
if (sol.r == target)
return sol.e;
return "No solution";
}
void main() {
foreach (prob; [[6, 7, 9, 5], [3, 3, 8, 8], [1, 1, 1, 1]])
writeln(prob, ": ", solve(24, prob));
foreach (const prob; [[6, 7, 9, 5], [3, 3, 8, 8], [1, 1, 1, 1]])
writeln(prob, ": ", solve(24, prob));
}

View file

@ -73,23 +73,23 @@ func expr_eval(x *Expr) (f frac) {
l, r := expr_eval(x.left), expr_eval(x.right)
switch {
case x.op == op_add:
switch x.op {
case op_add:
f.num = l.num*r.denom + l.denom*r.num
f.denom = l.denom * r.denom
return
case x.op == op_sub:
case op_sub:
f.num = l.num*r.denom - l.denom*r.num
f.denom = l.denom * r.denom
return
case x.op == op_mul:
case op_mul:
f.num = l.num * r.num
f.denom = l.denom * r.denom
return
case x.op == op_div:
case op_div:
f.num = l.num * r.denom
f.denom = l.denom * r.num
return

View file

@ -1,76 +1,42 @@
invocable all
link strings # for csort, deletec, permutes
import Control.Applicative
import Data.List
import Text.PrettyPrint
procedure main()
static eL
initial {
eoP := [] # set-up expression and operator permutation patterns
every ( e := !["a@b#c$d", "a@(b#c)$d", "a@b#(c$d)", "a@(b#c$d)", "a@(b#(c$d))"] ) &
( o := !(opers := "+-*/") || !opers || !opers ) do
put( eoP, map(e,"@#$",o) ) # expr+oper perms
eL := [] # all cases
every ( e := !eoP ) & ( p := permutes("wxyz") ) do
put(eL, map(e,"abcd",p))
data Expr = C Int | Op String Expr Expr
}
toDoc (C x ) = int x
toDoc (Op op x y) = parens $ toDoc x <+> text op <+> toDoc y
write("This will attempt to find solutions to 24 for sets of numbers by\n",
"combining 4 single digits between 1 and 9 to make 24 using only + - * / and ( ).\n",
"All operations have equal precedence and are evaluated left to right.\n",
"Enter 'use n1 n2 n3 n4' or just hit enter (to use a random set),",
"'first'/'all' shows the first or all solutions, 'quit' to end.\n\n")
ops :: [(String, Int -> Int -> Int)]
ops = [("+",(+)), ("-",(-)), ("*",(*)), ("/",div)]
repeat {
e := trim(read()) | fail
e ? case tab(find(" ")|0) of {
"q"|"quit" : break
"u"|"use" : e := tab(0)
"f"|"first": first := 1 & next
"a"|"all" : first := &null & next
"" : e := " " ||(1+?8) || " " || (1+?8) ||" " || (1+?8) || " " || (1+?8)
}
writes("Attempting to solve 24 for",e)
solve :: Int -> [Int] -> [Expr]
solve res = filter ((Just res ==) . eval) . genAst
where
genAst [x] = [C x]
genAst xs = do
(ys,zs) <- split xs
let f (Op op _ _) = op `notElem` ["+","*"] || ys <= zs
filter f $ Op <$> map fst ops <*> genAst ys <*> genAst zs
e := deletec(e,' \t') # no whitespace
if e ? ( tab(many('123456789')), pos(5), pos(0) ) then
write(":")
else write(" - invalid, only the digits '1..9' are allowed.") & next
eval (C x ) = Just x
eval (Op "/" _ y) | Just 0 <- eval y = Nothing
eval (Op op x y) = lookup op ops <*> eval x <*> eval y
eS := set()
every ex := map(!eL,"wxyz",e) do {
if member(eS,ex) then next # skip duplicates of final expression
insert(eS,ex)
if ex ? (ans := eval(E()), pos(0)) then # parse and evaluate
if ans = 24 then {
write("Success ",image(ex)," evaluates to 24.")
if \first then break
}
}
}
write("Quiting.")
end
procedure eval(X) #: return the evaluated AST
if type(X) == "list" then {
x := eval(get(X))
while o := get(X) do
if y := get(X) then
x := o( real(x), (o ~== "/" | fail, eval(y) ))
else write("Malformed expression.") & fail
}
return \x | X
end
select :: Int -> [Int] -> [[Int]]
select 0 _ = [[]]
select n xs = [x:zs | k <- [0..length xs - n]
, let (x:ys) = drop k xs
, zs <- select (n - 1) ys
]
procedure E() #: expression
put(lex := [],T())
while put(lex,tab(any('+-*/'))) do
put(lex,T())
suspend if *lex = 1 then lex[1] else lex # strip useless []
end
split :: [Int] -> [([Int],[Int])]
split xs = [(ys, xs \\ ys) | n <- [1..length xs - 1]
, ys <- nub . sort $ select n xs
]
procedure T() #: Term
suspend 2(="(", E(), =")") | # parenthesized subexpression, or ...
tab(any(&digits)) # just a value
end
main = mapM_ (putStrLn . render . toDoc) $ solve 24 [2,3,8,9]

View file

@ -0,0 +1,76 @@
invocable all
link strings # for csort, deletec, permutes
procedure main()
static eL
initial {
eoP := [] # set-up expression and operator permutation patterns
every ( e := !["a@b#c$d", "a@(b#c)$d", "a@b#(c$d)", "a@(b#c$d)", "a@(b#(c$d))"] ) &
( o := !(opers := "+-*/") || !opers || !opers ) do
put( eoP, map(e,"@#$",o) ) # expr+oper perms
eL := [] # all cases
every ( e := !eoP ) & ( p := permutes("wxyz") ) do
put(eL, map(e,"abcd",p))
}
write("This will attempt to find solutions to 24 for sets of numbers by\n",
"combining 4 single digits between 1 and 9 to make 24 using only + - * / and ( ).\n",
"All operations have equal precedence and are evaluated left to right.\n",
"Enter 'use n1 n2 n3 n4' or just hit enter (to use a random set),",
"'first'/'all' shows the first or all solutions, 'quit' to end.\n\n")
repeat {
e := trim(read()) | fail
e ? case tab(find(" ")|0) of {
"q"|"quit" : break
"u"|"use" : e := tab(0)
"f"|"first": first := 1 & next
"a"|"all" : first := &null & next
"" : e := " " ||(1+?8) || " " || (1+?8) ||" " || (1+?8) || " " || (1+?8)
}
writes("Attempting to solve 24 for",e)
e := deletec(e,' \t') # no whitespace
if e ? ( tab(many('123456789')), pos(5), pos(0) ) then
write(":")
else write(" - invalid, only the digits '1..9' are allowed.") & next
eS := set()
every ex := map(!eL,"wxyz",e) do {
if member(eS,ex) then next # skip duplicates of final expression
insert(eS,ex)
if ex ? (ans := eval(E()), pos(0)) then # parse and evaluate
if ans = 24 then {
write("Success ",image(ex)," evaluates to 24.")
if \first then break
}
}
}
write("Quiting.")
end
procedure eval(X) #: return the evaluated AST
if type(X) == "list" then {
x := eval(get(X))
while o := get(X) do
if y := get(X) then
x := o( real(x), (o ~== "/" | fail, eval(y) ))
else write("Malformed expression.") & fail
}
return \x | X
end
procedure E() #: expression
put(lex := [],T())
while put(lex,tab(any('+-*/'))) do
put(lex,T())
suspend if *lex = 1 then lex[1] else lex # strip useless []
end
procedure T() #: Term
suspend 2(="(", E(), =")") | # parenthesized subexpression, or ...
tab(any(&digits)) # just a value
end

View file

@ -0,0 +1,264 @@
import java.util.*;
public class Game24Player {
final String[] patterns = {"nnonnoo", "nnonono", "nnnoono", "nnnonoo",
"nnnnooo"};
final String ops = "+-*/^";
String solution;
List<Integer> digits;
public static void main(String[] args) {
new Game24Player().play();
}
void play() {
digits = getSolvableDigits();
Scanner in = new Scanner(System.in);
while (true) {
System.out.print("Make 24 using these digits: ");
System.out.println(digits);
System.out.println("(Enter 'q' to quit, 's' for a solution)");
System.out.print("> ");
String line = in.nextLine();
if (line.equalsIgnoreCase("q")) {
System.out.println("\nThanks for playing");
return;
}
if (line.equalsIgnoreCase("s")) {
System.out.println(solution);
digits = getSolvableDigits();
continue;
}
char[] entry = line.replaceAll("[^*+-/)(\\d]", "").toCharArray();
try {
validate(entry);
if (evaluate(infixToPostfix(entry))) {
System.out.println("\nCorrect! Want to try another? ");
digits = getSolvableDigits();
} else {
System.out.println("\nNot correct.");
}
} catch (Exception e) {
System.out.printf("%n%s Try again.%n", e.getMessage());
}
}
}
void validate(char[] input) throws Exception {
int total1 = 0, parens = 0, opsCount = 0;
for (char c : input) {
if (Character.isDigit(c))
total1 += 1 << (c - '0') * 4;
else if (c == '(')
parens++;
else if (c == ')')
parens--;
else if (ops.indexOf(c) != -1)
opsCount++;
if (parens < 0)
throw new Exception("Parentheses mismatch.");
}
if (parens != 0)
throw new Exception("Parentheses mismatch.");
if (opsCount != 3)
throw new Exception("Wrong number of operators.");
int total2 = 0;
for (int d : digits)
total2 += 1 << d * 4;
if (total1 != total2)
throw new Exception("Not the same digits.");
}
boolean evaluate(char[] line) throws Exception {
Stack<Float> s = new Stack<>();
try {
for (char c : line) {
if ('0' <= c && c <= '9')
s.push((float) c - '0');
else
s.push(applyOperator(s.pop(), s.pop(), c));
}
} catch (EmptyStackException e) {
throw new Exception("Invalid entry.");
}
return (Math.abs(24 - s.peek()) < 0.001F);
}
float applyOperator(float a, float b, char c) {
switch (c) {
case '+':
return a + b;
case '-':
return b - a;
case '*':
return a * b;
case '/':
return b / a;
default:
return Float.NaN;
}
}
List<Integer> randomDigits() {
Random r = new Random();
List<Integer> result = new ArrayList<>(4);
for (int i = 0; i < 4; i++)
result.add(r.nextInt(9) + 1);
return result;
}
List<Integer> getSolvableDigits() {
List<Integer> result;
do {
result = randomDigits();
} while (!isSolvable(result));
return result;
}
boolean isSolvable(List<Integer> digits) {
Set<List<Integer>> dPerms = new HashSet<>(4 * 3 * 2);
permute(digits, dPerms, 0);
int total = 4 * 4 * 4;
List<List<Integer>> oPerms = new ArrayList<>(total);
permuteOperators(oPerms, 4, total);
StringBuilder sb = new StringBuilder(4 + 3);
for (String pattern : patterns) {
char[] patternChars = pattern.toCharArray();
for (List<Integer> dig : dPerms) {
for (List<Integer> opr : oPerms) {
int i = 0, j = 0;
for (char c : patternChars) {
if (c == 'n')
sb.append(dig.get(i++));
else
sb.append(ops.charAt(opr.get(j++)));
}
String candidate = sb.toString();
try {
if (evaluate(candidate.toCharArray())) {
solution = postfixToInfix(candidate);
return true;
}
} catch (Exception ignored) {
}
sb.setLength(0);
}
}
}
return false;
}
String postfixToInfix(String postfix) {
class Expression {
String op, ex;
int prec = 3;
Expression(String e) {
ex = e;
}
Expression(String e1, String e2, String o) {
ex = String.format("%s %s %s", e1, o, e2);
op = o;
prec = ops.indexOf(o) / 2;
}
}
Stack<Expression> expr = new Stack<>();
for (char c : postfix.toCharArray()) {
int idx = ops.indexOf(c);
if (idx != -1) {
Expression r = expr.pop();
Expression l = expr.pop();
int opPrec = idx / 2;
if (l.prec < opPrec)
l.ex = '(' + l.ex + ')';
if (r.prec <= opPrec)
r.ex = '(' + r.ex + ')';
expr.push(new Expression(l.ex, r.ex, "" + c));
} else {
expr.push(new Expression("" + c));
}
}
return expr.peek().ex;
}
char[] infixToPostfix(char[] infix) throws Exception {
StringBuilder sb = new StringBuilder();
Stack<Integer> s = new Stack<>();
try {
for (char c : infix) {
int idx = ops.indexOf(c);
if (idx != -1) {
if (s.isEmpty())
s.push(idx);
else {
while (!s.isEmpty()) {
int prec2 = s.peek() / 2;
int prec1 = idx / 2;
if (prec2 >= prec1)
sb.append(ops.charAt(s.pop()));
else
break;
}
s.push(idx);
}
} else if (c == '(') {
s.push(-2);
} else if (c == ')') {
while (s.peek() != -2)
sb.append(ops.charAt(s.pop()));
s.pop();
} else {
sb.append(c);
}
}
while (!s.isEmpty())
sb.append(ops.charAt(s.pop()));
} catch (EmptyStackException e) {
throw new Exception("Invalid entry.");
}
return sb.toString().toCharArray();
}
void permute(List<Integer> lst, Set<List<Integer>> res, int k) {
for (int i = k; i < lst.size(); i++) {
Collections.swap(lst, i, k);
permute(lst, res, k + 1);
Collections.swap(lst, k, i);
}
if (k == lst.size())
res.add(new ArrayList<>(lst));
}
void permuteOperators(List<List<Integer>> res, int n, int total) {
for (int i = 0, npow = n * n; i < total; i++)
res.add(Arrays.asList((i / npow), (i % npow) / n, i % n));
}
}

View file

@ -0,0 +1,35 @@
editvar /modify -random- = <10
:a
editvar /newvar /withothervar /value=-random- /title=1
editvar /newvar /withothervar /value=-random- /title=2
editvar /newvar /withothervar /value=-random- /title=3
editvar /newvar /withothervar /value=-random- /title=4
printline These are your four digits: -1- -2- -3- -4-
printline Use an algorithm to make the number 24.
editvar /newvar /value=a /userinput=1 /title=Algorithm:
do -a-
if -a- /hasvalue 24 printline Your algorithm worked! & goto :b (
) else printline Your algorithm did not work.
editvar /newvar /value=b /userinput=1 /title=Do you want to see how you could have done it?
if -b- /hasvalue y goto :c else goto :b
:b
editvar /newvar /value=c /userinput=1 /title=Do you want to play again?
if -c- /hasvalue y goto :a else exitcurrentprogram
:c
editvar /newvar /value=do -1- + -2- + -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- - -2- + -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- / -2- + -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- * -2- + -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- + -2- - -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- + -2- / -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- + -2- * -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- + -2- + -3- - -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- + -2- + -3- / -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- + -2- + -3- * -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- - -2- - -3- - -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- / -2- / -3- / -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- * -2- * -3- * -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
:solve
printline you could have done it by doing -c-
stoptask
goto :b

View file

@ -0,0 +1,22 @@
:- initialization(main).
solve(N,Xs,Ast) :-
Err = evaluation_error(zero_divisor)
, gen_ast(Xs,Ast), catch(Ast =:= N, error(Err,_), fail)
.
gen_ast([N],N) :- between(1,9,N).
gen_ast(Xs,Ast) :-
Ys = [_|_], Zs = [_|_], split(Xs,Ys,Zs)
, ( member(Op, [(+),(*)]), Ys @=< Zs ; member(Op, [(-),(//)]) )
, gen_ast(Ys,A), gen_ast(Zs,B), Ast =.. [Op,A,B]
.
split(Xs,Ys,Zs) :- sublist(Ys,Xs), select_all(Ys,Xs,Zs).
% where
select_all([],Xs,Xs).
select_all([Y|Ys],Xs,Zs) :- select(Y,Xs,X1), !, select_all(Ys,X1,Zs).
test(T) :- solve(24, [2,3,8,9], T).
main :- forall(test(T), (write(T), nl)), halt.

View file

@ -3,7 +3,7 @@
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).
comprised soley of the numerals (digits) 1 9 (no zeroes).
In SSSS-FFFF SSSS is the start,
FFFF is the start.
@ -17,8 +17,8 @@ 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. */
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). */
@ -28,22 +28,22 @@ indent=left('',30) /*used to indent display of solutions. */
Lpar='(' /*a string to make REXX code prettier. */
Rpar=')' /*ditto. */
do g=start to finish /*process a (possible) range of values.*/
if pos(0,g)\==0 then iterate /*ignore values with zero in them. */
do g=start to finish /*process a (possible) range of values.*/
if pos(0,g)\==0 then iterate /*ignore values with zero in them. */
do _=1 for 4 /*define versions for faster execution.*/
do _=1 for 4 /*define versions for faster execution.*/
g._=substr(g,_,1)
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 to 3; L.= /*assume no left parenthesis so far. */
do n=m+1 to 4 /*match left paren with a right paren. */
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 )*/
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*/
@ -51,7 +51,7 @@ Rpar=')' /*ditto. */
/* /(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(")
if pos('/(',e)\==0 then e=changestr('/(', e, "/div(")
/*The above could be replaced by: */
/* e=changestr('/(',e,"/div(") */
@ -60,12 +60,12 @@ Rpar=')' /*ditto. */
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... */
interpret 'x=' e /*··· strain··· */
x=x/1 /*remove trailing decimal points(maybe)*/
if x\==24 then iterate /*Not correct? Try again. */
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. */
say indent 'a solution:' _ /*display a solution. */
end /*n*/
end /*m*/
end /*k*/
@ -79,15 +79,15 @@ 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. */
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
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.*/
s: if arg(1)==1 then return ''; return 's' /*simple pluralizer.*/
/*───────────────────────────validate subroutine────────────────────────*/
validate: parse arg y; errCode=0; _v=verify(y,digs)
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'

View file

@ -2,10 +2,10 @@ package require struct::list
# Encoding the various expression trees that are possible
set 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)}
{A x ((B y C) z D)}
{A x (B y (C z D))}
}
# Encoding the various permutations of digits
set permutations [struct::list map [struct::list permutations {a b c d}] \
@ -13,8 +13,8 @@ set permutations [struct::list map [struct::list permutations {a b c d}] \
# The permitted operations
set operations {+ - * /}
# Given a list of four integers (precondition not checked!) return a list of
# solutions to the 24 game using those four integers.
# Given a list of four integers (precondition not checked!)
# return a list of solutions to the 24 game using those four integers.
proc find24GameSolutions {values} {
global operations patterns permutations
set found {}

View file

@ -1,6 +1,7 @@
The [[wp:24 Game|24 Game]] tests one's mental arithmetic.
Write a program that [[task feature::Rosetta Code:randomness|randomly]] chooses and [[task feature::Rosetta Code:user output|displays]] four digits, each from one to nine, with repetitions allowed. The program should prompt for the player to enter an arithmetic expression using ''just'' those, and ''all'' of those four digits. The program should ''check'' then [[task feature::Rosetta Code:parsing|evaluate the expression]]. The goal is for the player to [[task feature::Rosetta Code:user input|enter]] an expression that evaluates to '''24'''.
Write a program that [[task feature::Rosetta Code:randomness|randomly]] chooses and [[task feature::Rosetta Code:user output|displays]] four digits, each from one to nine, with repetitions allowed. The program should prompt for the player to enter an arithmetic expression using ''just'' those, and ''all'' of those four digits, used exactly ''once'' each. The program should ''check'' then [[task feature::Rosetta Code:parsing|evaluate the expression]].
The goal is for the player to [[task feature::Rosetta Code:user input|enter]] an expression that evaluates to '''24'''.
* Only multiplication, division, addition, and subtraction operators/functions are allowed.
* Division should use floating point or rational arithmetic, etc, to preserve remainders.
* Brackets are allowed, if using an infix expression evaluator.

View file

@ -0,0 +1,83 @@
@echo off
::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
cls
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.
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"
goto SHOW
::Main Program Loop
:MAIN
set /a TRY+=1
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
set /p ANSWER="Try %TRY%: "
set "ANSWER=%ANSWER: =%"
if /i "%ANSWER%"=="SHOW" goto SHOW
if /i "%ANSWER%"=="EXIT" goto ABORT
if "%ANSWER:~6,1%"=="" goto ERROR_MISSING_CHARS:
::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
::Calculate and evaluate result
set /a "RESULT=%ANSWER%"
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
:SHOW
echo Given digits: %DIGIT_1% %DIGIT_2% %DIGIT_3% %DIGIT_4%
goto MAIN
:END
echo Correct input [Congratulations!]
:ABORT
echo.

View file

@ -9,7 +9,7 @@
chosen-digits)
(read))
(lose () (error 'bad-equation))
(choose () (setf chosen-digits (loop repeat 4 collecting (random 10))))
(choose () (setf chosen-digits (loop repeat 4 collecting (1+ (random 9)))))
(check (e)
(typecase e
((eql bye) (return-from 24-game))

View file

@ -0,0 +1,62 @@
import java.util.*;
public class Game24 {
public static void main(String[] args) {
int[] digits = randomDigits();
Scanner in = new Scanner(System.in);
System.out.print("Make 24 using these digits: ");
System.out.println(Arrays.toString(digits));
System.out.print("> ");
Stack<Float> s = new Stack<>();
long total = 0;
for (char c : in.nextLine().toCharArray()) {
if ('0' <= c && c <= '9') {
int d = c - '0';
total += (1 << (d * 5));
s.push((float) d);
} else if ("+/-*".indexOf(c) != -1) {
s.push(applyOperator(s.pop(), s.pop(), c));
}
}
if (tallyDigits(digits) != total)
System.out.print("Not the same digits. ");
else if (Math.abs(24 - s.peek()) < 0.001F)
System.out.println("Correct!");
else
System.out.print("Not correct.");
}
static float applyOperator(float a, float b, char c) {
switch (c) {
case '+':
return a + b;
case '-':
return b - a;
case '*':
return a * b;
case '/':
return b / a;
default:
return Float.NaN;
}
}
static long tallyDigits(int[] a) {
long total = 0;
for (int i = 0; i < 4; i++)
total += (1 << (a[i] * 5));
return total;
}
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;
return result;
}
}

View file

@ -1,48 +1,51 @@
String.prototype.replaceAll = function(patt,repl) { var that = this;
that = that.replace(patt,repl);
if (that.search(patt) != -1) {
that = that.replaceAll(patt,repl);
}
return that;
};
function twentyfour(numbers, input) {
var invalidChars = /[^\d\+\*\/\s-\(\)]/;
function validChars(input) { var regInvalidChar = /[^\d\+\*\/\s-\(\)]/;
return input.search(regInvalidChar) == -1;
}
var validNums = function(str) {
// Create a duplicate of our input numbers, so that
// both lists will be sorted.
var mnums = numbers.slice();
mnums.sort();
function validNums(str, nums) {
var arr, l;
arr = str.replaceAll(/[^\d\s]/," ").replaceAll(" "," ").trim().split(" ").sort();
l = arr.length;
// Sort after mapping to numbers, to make comparisons valid.
return str.replace(/[^\d\s]/g, " ")
.trim()
.split(/\s+/)
.map(function(n) { return parseInt(n, 10); })
.sort()
.every(function(v, i) { return v === mnums[i]; });
};
while(l--) { arr[l] = Number(arr[l]); }
var validEval = function(input) {
try {
return eval(input);
} catch (e) {
return {error: e.toString()};
}
};
return _.isEqual(arr,nums.sort());
if (input.trim() === "") return "You must enter a value.";
if (input.match(invalidChars)) return "Invalid chars used, try again. Use only:\n + - * / ( )";
if (!validNums(input)) return "Wrong numbers used, try again.";
var calc = validEval(input);
if (typeof calc !== 'number') return "That is not a valid input; please try again.";
if (calc !== 24) return "Wrong answer: " + String(calc) + "; please try again.";
return input + " == 24. Congratulations!";
};
// I/O below.
while (true) {
var numbers = [1, 2, 3, 4].map(function() {
return Math.floor(Math.random() * 8 + 1);
});
var input = prompt(
"Your numbers are:\n" + numbers.join(" ") +
"\nEnter expression. (use only + - * / and parens).\n", +"'x' to exit.", "");
if (input === 'x') {
break;
}
alert(twentyfour(numbers, input));
}
function validEval(input) { try { eval(input); } catch (e) { return false; };
return true;
}
var input;
while(true){ var numbers = [];
var i = 4;
while(i--) { numbers.push(Math.floor(Math.random()*8+1));
}
input = prompt("Your numbers are:\n"
+ numbers.join(" ")
+ "\nEnter expression. (use only + - * / and parens).\n"
+ "'x' to exit."
);
if (input === 'x') break;
!validChars(input) ? alert("Invalid chars used, try again. Use only:\n + - * / ( )")
: !validNums(input,numbers) ? alert("Wrong numbers used, try again.")
: !validEval(input) ? alert("Could not evaluate input, try again.")
: eval(input) != 24 ? alert("Wrong answer:" + eval(input) + "\nTry again.")
: alert(input + "== 24. Congrats!!")
;
}

View file

@ -1,63 +1,28 @@
validexpr(ex::Expr) = ex.head == :call && ex.args[1] in [:*,:/,:+,:-] && all(validexpr, ex.args[2:end])
validexpr(ex::Int) = true
validexpr(ex::Any) = false
findnumbers(ex::Number) = Int[ex]
findnumbers(ex::Expr) = vcat(map(findnumbers, ex.args)...)
findnumbers(ex::Any) = Int[]
function twentyfour()
function check(input)
d = ref(Int)
for i in input.args
if typeof(i) == Expr
c = check(i)
typeof(c) == String || append!(d,c)
elseif contains([:*,:/,:-,:+],i)
continue
elseif contains([1:9],i)
push!(d,i)
continue
elseif i > 9 || i < 1
d = "Sorry, $i is not allowed, please use only numbers between 1 and 9"
else
d = "Sorry, $i isn't allowed"
end
end
return d
end
new_digits() = [rand(1:9),rand(1:9),rand(1:9),rand(1:9)]
answer = new_digits()
print("The 24 Game\nYou will be given any four digits in the range 1 to 9, which may have repetitions.\n
Using just the +, -, *, and / operators show how to make an answer of 24.\n
Use parentheses, (), to ensure proper order of evaulation.\n
Enter 'n' fDouble>()
while( scanner.hasNext() ) {
if( scanner.hasNextInt() ) {
var n = scanner.nextInt()
// Make sure they're allowed to use n
if( n or a new set of digits, and 'q' to quit. Good luck!\n
Here's your first 4 digits\n$(answer[1]) $(answer[2]) $(answer[3]) $(answer[4])\n
>")
while true
input = chomp(readline(STDIN))
input == "q" && break
if input == "n"
answer = new_digits()
print("\nLet's try again, go ahead and guess\n Here's your 4 digits\n$(answer[1]) $(answer[2]) $(answer[3]) $(answer[4])\n>")
continue
end
input = try
parse(input)
catch
print("I couldn't calculate your answer, please try again\n>");
continue
end
c = check(input)
cc = all([sum(i .== answer) == sum(i .== c) for i in answer])
!cc && (print("Sorry, valid digits are \n$(answer[1]) $(answer[2]) $(answer[3]) $(answer[4])\n are allowed and all four must be used. Please try again\n>"); continue)
if eval(input) == 24
answer = new_digits()
print("\nYou did it!\nLet's do another round, or enter 'q' to quit\n
Here's your 4 digits\n$(answer[1]) $(answer[2]) $(answer[3]) $(answer[4])\n
>")
continue
else
print("\nSorry your answer calculates to $(eval(input))\nTry again\n>")
end
end
digits = sort!(rand(1:9, 4))
while true
print("enter expression using $digits => ")
ex = parse(readline())
try
validexpr(ex) || error("only *, /, +, - of integers is allowed")
nums = sort!(findnumbers(ex))
nums == digits || error("expression $ex used numbers $nums != $digits")
val = eval(ex)
val == 24 || error("expression $ex evaluated to $val, not 24")
println("you won!")
return
catch e
if isa(e, ErrorException)
println("incorrect: ", e.msg)
else
rethrow()
end
end
end
end

View file

@ -1,38 +1,23 @@
say "Here are your digits: ",
constant @digits = (1..9).roll(4)».Str;
grammar Exp24 {
token TOP { ^ <exp> $ }
token exp { <term> [ <op> <term> ]* }
token term { '(' <exp> ')' | \d }
token op { '+' | '-' | '*' | '/' }
token TOP { ^ <exp> $ { fail unless EVAL($/) == 24 } }
rule exp { <term>+ % <op> }
rule term { '(' <exp> ')' | <@digits> }
token op { < + - * / > }
}
my @digits = roll 4, 1..9; # to a gamer, that's a "4d9" roll
say "Here's your digits: {@digits}";
while my $exp = prompt "\n24-Exp? " {
unless is-valid($exp, @digits) {
say "Sorry, your expression is not valid!";
next;
while my $exp = prompt "\n24? " {
if Exp24.parse: $exp {
say "You win :)";
last;
} else {
say pick 1,
'Sorry. Try again.' xx 20,
'Try harder.' xx 5,
'Nope. Not even close.' xx 2,
'Are you five or something?',
'Come on, you can do better than that.';
}
my $value = eval $exp;
say "$exp = $value";
if $value == 24 {
say "You win!";
last;
}
say "Sorry, your expression doesn't evaluate to 24!";
}
sub is-valid($exp, @digits) {
unless ?Exp24.parse($exp) {
say "Expression doesn't match rules!";
return False;
}
unless $exp.comb(/\d/).sort.join == @digits.sort.join {
say "Expression must contain digits {@digits} only!";
return False;
}
return True;
}

View file

@ -1,122 +1,46 @@
#!/usr/bin/perl
use strict;
#!/usr/bin/env perl
use warnings;
use strict;
use feature 'say';
print <<'EOF';
The 24 Game
Given any four digits in the range 1 to 9, which may have repetitions,
Using just the +, -, *, and / operators; and the possible use of
brackets, (), show how to make an answer of 24.
parentheses, (), show how to make an answer of 24.
An answer of "q" will quit the game.
An answer of "!" will generate a new set of four digits.
Otherwise you are repeatedly asked for an expression until it evaluates to 24
An answer of "q" or EOF will quit the game.
A blank answer will generate a new set of four digits.
Otherwise you are repeatedly asked for an expression until it evaluates to 24.
Note: you cannot form multiple digit numbers from the supplied digits,
so an answer of 12+12 when given 1, 2, 2, and 1 would not be allowed.
EOF
while(1)
{
my $iteration_num = 0;
my $try = 1;
while (1) {
my @digits = map { 1+int(rand(9)) } 1..4;
say "\nYour four digits: ", join(" ", @digits);
print "Expression (try ", $try++, "): ";
my $numbers = make_numbers();
my $entry = <>;
if (!defined $entry || $entry eq 'q')
{ say "Goodbye. Sorry you couldn't win."; last; }
$entry =~ s/\s+//g; # remove all white space
next if $entry eq '';
TRY_SOLVING:
while(1)
{
$iteration_num++;
print "Expression ${iteration_num}: ";
my $given_digits = join "", sort @digits;
my $entry_digits = join "", sort grep { /\d/ } split(//, $entry);
if ($given_digits ne $entry_digits || # not correct digits
$entry =~ /\d\d/ || # combined digits
$entry =~ m|[-+*/]{2}| || # combined operators
$entry =~ tr|-0-9()+*/||c) # Invalid characters
{ say "That's not valid"; next; }
my $entry = <>;
chomp($entry);
my $n = eval $entry;
last TRY_SOLVING if $entry eq '!';
exit if $entry eq 'q';
my $result = play($numbers, $entry);
if (!defined $result)
{
print "That's not valid\n";
next TRY_SOLVING;
}
elsif ($result != 24)
{
print "Sorry, that's $result\n";
next TRY_SOLVING;
}
else
{
print "That's right! 24!!\n";
exit;
}
}
}
sub make_numbers
{
my %numbers = ();
print "Your four digits:";
for(1..4)
{
my $i = 1 + int(rand(9));
$numbers{$i}++;
print "$i ";
}
print "\n";
return \%numbers;
}
sub play
{
my ($numbers, $expression) = @_;
my %running_numbers = %$numbers;
my @chars = split //, $expression;
my $operator = 1;
CHARS:
foreach (@chars)
{
next CHARS if $_ =~ /[()]/;
$operator = !$operator;
if (! $operator)
{
if (defined $running_numbers{$_} && $running_numbers{$_} > 0)
{
$running_numbers{$_}--;
next CHARS;
}
else
{
return;
}
}
else
{
return if $_ !~ m{[-+*/]};
}
}
foreach my $remaining (values(%running_numbers))
{
if ($remaining > 0)
{
return;
}
}
return eval($expression);
if (!defined $n) { say "Invalid expression"; }
elsif ($n == 24) { say "You win!"; last; }
else { say "Sorry, your expression is $n, not 24"; }
}

View file

@ -0,0 +1,30 @@
:- initialization(main).
answer(24).
play :- round, play ; true.
round :-
prompt(Ns), get_line(Input), Input \= "stop"
, ( phrase(parse(Ns,[]), Input) -> Result = 'correct'
; Result = 'wrong'
), write(Result), nl, nl
. % where
prompt(Ns) :- length(Ns,4), maplist(random(1,10), Ns)
, write('Digits: '), write(Ns), nl
.
parse([],[X]) --> { answer(X) }.
parse(Ns,[Y,X|S]) --> "+", { Z is X + Y }, parse(Ns,[Z|S]).
parse(Ns,[Y,X|S]) --> "-", { Z is X - Y }, parse(Ns,[Z|S]).
parse(Ns,[Y,X|S]) --> "*", { Z is X * Y }, parse(Ns,[Z|S]).
parse(Ns,[Y,X|S]) --> "/", { Z is X div Y }, parse(Ns,[Z|S]).
parse(Ns,Stack) --> " ", parse(Ns,Stack).
parse(Ns,Stack) --> { select(N,Ns,Ns1), number_codes(N,[Code]) }
, [Code], parse(Ns1,[N|Stack])
.
get_line(Xs) :- get_code(X)
, ( X == 10 -> Xs = [] ; Xs = [X|Ys], get_line(Ys) )
.
main :- randomize, play, halt.

View file

@ -1,204 +1,22 @@
/*REXX program which allows a user to play the game of 24 (twenty-four).*/
/*
Argument 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 (no zeroes).
SSSS is the start,
FFFF is the start.
If no argument is specified, this program finds a four digit
number (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 () may be used in the normal manner for grouping,
as well as brackets [] or braces {}.
*/
parse arg orig /*get the guess from the argument. */
orig=space(orig,0) /*remove extraneous blanks from ORIG. */
parse var orig start '-' finish /*get the start and finish (maybe). */
finish=word(finish 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. */
indent=left('',30) /*used to indent display of solutions. */
Lpar='(' /*a string to make REXX code prettier. */
Rpar=')' /*ditto. */
show=1 /*flag used show solutions (0 = not). */
digs=123456789 /*numerals (digits) that can be used. */
do j=1 for ops /*define a version for fast execution. */
o.j=substr(opers,j,1)
end /*j*/
if orig\=='' then do
sols=solve(start,finish)
if sols<0 then exit 13
if sols==0 then sols='No' /*un-geek the SOLS var.*/
say; say sols 'unique solution's(finds) "found for" orig
exit /* [↑] "S" pluralizes.*/
end
show=0 /*stop SOLVE from blabbing solutions. */
do forever
rrrr=random(1111,9999)
if pos(0,rrrr)\==0 then iterate
if solve(rrrr)\==0 then leave
end /*forever*/
show=1 /*enable SOLVE to show solutions. */
rrrr=sort(rrrr) /*sort four elements. */
rd.=0
do j=1 for 9 /*digit count # for each digit in RRRR.*/
_=substr(rrrr,j,1)
rd._=countdigs(rrrr,_)
end /*j*/
do guesses=1; say
say 'Using the digits' rrrr", enter an expression that equals 24 (or QUIT):"
pull y; y=space(y,0) /*get Y from CL, then remove all blanks*/
if y=='QUIT' then exit /*Does user want to quit? If so, exit.*/
_v=verify(y, digs || opers || groupsymbols); __=substr(y, _v, 1)
if _v\==0 then do; call ger 'invalid character:' __; 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 guesses
end /*j*/
yd=countdigs(y,digs) /*count of 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 9; if rd.j==0 then iterate
_d=countdigs(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,'()()',"[]{}")
signal on syntax
interpret 'ans='y; ans=ans/1
if ans==24 then leave guesses
say 'incorrect,' y'='ans
end /*guesses*/
say
say center('', 79)
say center(' ', 79)
say center(' congratulations ! ', 79)
say center(' ', 79)
say center('', 79)
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
if \validate(ffff) then return -1
finds=0 /*number of found solutions (so far). */
x.=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)
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 4-1; 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*/
/*(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(") */
/*INTERPRET stresses REXX's groin, */
/*so try to avoid repeated 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. */
interpret 'x=' e
x=x/1 /*remove trailing decimal points. */
if x\==24 then iterate /*Not correct? Try again.*/
finds=finds+1 /*bump number of found solutions. */
_=translate(origE, '][', ")(") /*show [], not ().*/
if show then say indent 'a solution:' _ /*show solution.*/
end /*n*/
end /*m*/
end /*k*/
end /*j*/
end /*i*/
end /*g*/
return finds
/*───────────────────────────CHANGESTR subroutine───────────────────────*/
changestr: procedure; parse arg o,h,n,,r; w=length(o); if w==0 then return n||h
do forever; parse var h y (o) _ +(w) h; if _=='' then return r||y; r=r||y||n; end
/*───────────────────────────COUNTDIGS subroutine───────────────────────*/
countdigs: arg field,numerals /*count of digits NUMERALS.*/
return length(field)-length(space(translate(field,,numerals),0))
/*───────────────────────────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! *** for argument:' y; say arg(1); say; errCode=1; return 0
/*───────────────────────────S subroutine───────────────────────────────*/
s: if arg(1)==1 then return ''; return 's' /*simple pluralizer.*/
/*───────────────────────────SORT subroutine────────────────────────────*/
sort: procedure; arg nnnn; L=length(nnnn)
do i=1 for L /*build an array of digits from NNNN.*/
a.i=substr(nnnn,i,1) /*this enables SORT to sort an array. */
end /*i*/
do j=1 for L; _=a.j
do k=j+1 to L
if a.k<_ then parse value a.j a.k with a.k a.j
end /*k*/
end /*j*/
return a.1 || a.2 || a.3 || a.4
/*───────────────────────────SYNTAX subroutin───────────────────────────*/
syntax: call ger 'illegal syntax in' y; exit
/*───────────────────────────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
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.

View file

@ -1,25 +1,158 @@
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
/*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

View file

@ -0,0 +1,25 @@
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,4 +1,4 @@
require "rational"
require "rational" # for Ruby versions before 2.0
def play
digits = Array.new(4){rand(1..9)}

View file

@ -0,0 +1,30 @@
gen_digits() {
awk 'BEGIN { srand()
for(i = 1; i <= 4; i++) print 1 + int(9 * rand())
}' | sort
}
same_digits() {
[ "$(tr -dc 0-9 | sed 's/./&\n/g' | grep . | sort)" = "$*" ]
}
guessed() {
[ "$(echo "$1" | tr -dc '\n0-9()*/+-' | bc 2>/dev/null)" = 24 ]
}
while :
do
digits=$(gen_digits)
echo
echo Digits: $digits
read -r expr
echo " $expr" | same_digits "$digits" || \
{ echo digits should be: $digits; continue; }
guessed "$expr" && message=correct \
|| message=wrong
echo $message
done

View file

@ -1,4 +1,8 @@
In this puzzle, write code to print out the entire "99 bottles of beer on the wall" song. For those who do not know the song, the lyrics follow this form:
'''The beersong'''<br>
In this puzzle, write code to print out
the entire "99 bottles of beer on the wall" song.
For those who do not know the song, the lyrics follow this form:
X bottles of beer on the wall
X bottles of beer
Take one down, pass it around
@ -8,6 +12,14 @@ In this puzzle, write code to print out the entire "99 bottles of beer on the wa
...
Take one down, pass it around
0 bottles of beer on the wall
Where X and X-1 are replaced by numbers of course. Grammatical support for "1 bottle of beer" is optional. As with any puzzle, try to do it in as creative/concise/comical a way as possible (simple, obvious solutions allowed, too).
Where X and X-1 are replaced by numbers of course.
Grammatical support for "1 bottle of beer" is optional.
As with any puzzle, try to do it in as creative/concise/comical a way
as possible (simple, obvious solutions allowed, too).
See also: http://99-bottles-of-beer.net/
;See also:
* http://99-bottles-of-beer.net/
* [[:Category:99_Bottles_of_Beer]]
* [[:Category:Programming language families]]
<hr>

View file

@ -1,13 +1,29 @@
/* .<n>. is a termination metric to prove that the function terminates. It can be omitted. */
fun bottles {n:nat} .<n>. (n: int n): void =
if n = 0 then
()
else begin
printf ("%d bottles of beer on the wall\n", @(n));
printf ("%d bottles of beer\n", @(n));
printf ("Take one down, pass it around\n", @());
printf ("%d bottles of beer on the wall\n", @(n-1));
bottles (n - 1)
end
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
implement main () = bottles (99)
fun bottles
(n0: int): void = let
//
fun loop (n: int): void =
(
if n > 0 then
(
if n0 > n then println! ();
println! (n, " bottles of beer on the wall");
println! (n, " bottles of beer");
println! ("Take one down, pass it around");
println! (n-1, " bottles of beer on the wall");
loop (n - 1)
) (* end of [if] *)
)
//
in
loop (n0)
end // end of [bottles]
(* ****** ****** *)
implement main0 () = bottles (99)

View file

@ -1,7 +1,21 @@
{ i = 99
while (i > 0)
{print i, " bottles of beer on the wall,"
print i, " bottles of beer."
print "Take one down, pass it around,"
i--
print i, " bottles of beer on the wall\n"}}
# usage: gawk -v i=6 -f beersong.awk
function bb(n) {
b = " bottles of beer"
if( n==1 ) { sub("s","",b) }
if( n==0 ) { n="No more" }
return n b
}
BEGIN {
if( !i ) { i = 99 }
ow = "on the wall"
td = "Take one down, pass it around."
print "The beersong:\n"
while (i > 0) {
printf( "%s %s,\n%s.\n%s\n%s %s.\n\n",
bb(i), ow, bb(i), td, bb(--i), ow )
if( i==1 ) sub( "one","it", td )
}
print "Go to the store and buy some more!"
}

View file

@ -1,16 +1,12 @@
(defn verse
[n]
(printf "%d bottles of beer on the wall,
(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 sing
[start]
(doseq [n (range start 0 -1)]
(verse n)))
(dec n))))
(sing 99)

View file

@ -0,0 +1,5 @@
(clojure.pprint/cl-format
true
"~{~[~^~]~:*~D bottle~:P of beer on the wall~%~:*~D bottle~:P of beer
Take one down, pass it around,~%~D bottle~:P~:* of beer on the wall.~2%~}"
(range 99 0 -1))

View file

@ -1,36 +1,16 @@
\bottles_of_beer =
(\n
print (< n 1 "No more" n);
print " bottle"; print (== n 1 "" "s");
print " of beer";
\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_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
)
\bottles_of_beer_on_the_wall =
(\n
bottles_of_beer n; print " on the wall";
)
\sing_bottles_of_beer =
(\max
do (range max 0) \qty
bottles_of_beer_on_the_wall qty; nl;
bottles_of_beer qty; nl;
\qty =
(
> qty 0
(
print "Take one down, pass it around";nl;
- qty 1
)
(
print "Go to the store and buy some more";nl;
max
)
)
bottles_of_beer_on_the_wall qty; nl;
nl;
)
sing_bottles_of_beer 99;
sing 3

View file

@ -1,10 +1,9 @@
module Beer where
main = mapM_ (putStrLn . beer) [99, 98 .. 0]
beer 1 = "1 bottle of beer on the wall\n1 bottle of beer\nTake one down, pass it around"
beer 0 = "better go to the store and buy some more."
beer v = show v ++ " bottles of beer on the wall\n"
++ show v
++" bottles of beer\nTake one down, pass it around\n"
++ " bottles of beer\nTake one down, pass it around\n"
++ head (lines $ beer $ v-1) ++ "\n"
main _ = mapM_ (printStrLn . beer) (reverse (0..99))

View file

@ -0,0 +1,80 @@
package main
import (
"fmt"
"math/rand"
"strings"
"time"
)
func main() {
rand.Seed(time.Now().UnixNano())
for i := 99; i > 0; i-- {
fmt.Printf("%s %s %s\n",
slur(numberName(i), i),
pluralizeFirst(slur("bottle of", i), i),
slur("beer on the wall", i))
fmt.Printf("%s %s %s\n",
slur(numberName(i), i),
pluralizeFirst(slur("bottle of", i), i),
slur("beer", i))
fmt.Printf("%s %s %s\n",
slur("take one", i),
slur("down", i),
slur("pass it around", i))
fmt.Printf("%s %s %s\n",
slur(numberName(i-1), i),
pluralizeFirst(slur("bottle of", i), i-1),
slur("beer on the wall", i))
}
}
// adapted from Number names task
func numberName(n int) string {
switch {
case n < 0:
case n < 20:
return small[n]
case n < 100:
t := tens[n/10]
s := n % 10
if s > 0 {
t += " " + small[s]
}
return t
}
return ""
}
var small = []string{"no", "one", "two", "three", "four", "five", "six",
"seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen",
"fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen"}
var tens = []string{"ones", "ten", "twenty", "thirty", "forty",
"fifty", "sixty", "seventy", "eighty", "ninety"}
// pluralize first word of s by adding an s, but only if n is not 1.
func pluralizeFirst(s string, n int) string {
if n == 1 {
return s
}
w := strings.Fields(s)
w[0] += "s"
return strings.Join(w, " ")
}
// p is string to slur, d is drunkenness, from 0 to 99
func slur(p string, d int) string {
// shuffle only interior letters
a := []byte(p[1 : len(p)-1])
// adapted from Knuth shuffle task.
// shuffle letters with probability d/100.
for i := len(a) - 1; i >= 1; i-- {
if rand.Intn(100) >= d {
j := rand.Intn(i + 1)
a[i], a[j] = a[j], a[i]
}
}
// condense spaces
w := strings.Fields(p[:1] + string(a) + p[len(p)-1:])
return strings.Join(w, " ")
}

View file

@ -0,0 +1,4 @@
bob =: ": , ' bottle' , (1 = ]) }. 's of beer'"_
bobw=: bob , ' on the wall'"_
beer=: bobw , ', ' , bob , '; take one down and pass it around, ' , bobw@<:
beer"0 >:i.-99

View file

@ -0,0 +1,10 @@
verse = [[%i bottle%s of beer on the wall
%i bottle%s of beer
Take one down, pass it around
%i bottle%s of beer on the wall
]]
function suffix(i) return i ~= 1 and 's' or '' end
for i = 99, 1, -1 do
print(verse:format(i, suffix(i), i, suffix(i), i-1, suffix(i-1)))
end

View file

@ -0,0 +1,24 @@
sing_line: func (b: Int, suffix: Bool) {
"#{b > 0 ? "#{b}" : "No more"} bottle#{b == 1 ? "" : "s"}" print()
" of beer#{suffix ? " on the wall" : ""}" println()
}
sing_verse: func (b: Int) {
println()
sing_line(b, true)
sing_line(b, false)
if (b > 0) {
"Take one down, pass it around" println()
} else {
"Go to the store and buy some more" println()
b += 100
}
sing_line(b-1, true)
}
main: func {
b := 100
while (b > 0) {
sing_verse(--b)
}
}

View file

@ -0,0 +1,9 @@
for i 99 1 -1 [
x: rejoin [
i b: " bottles of beer" o: " on the wall. " i b
". Take one down, pass it around. " (i - 1) b o "^/"
]
r: :replace j: "bottles" k: "bottle"
switch i [1 [r x j k r at x 10 j k r x "0" "No"] 2 [r at x 40 j k]]
print x
] halt

View file

@ -0,0 +1 @@
for i 99 1 -1[print rejoin[i b:" bottles of beer"o:" on the wall. "i b". Take one down, pass it around. "(i - 1)b o"^/"]]

View file

@ -1,19 +1,20 @@
/*REXX pgm displays words to the song "99 Bottles of Beer on the Wall". */
/*REXX pgm displays lyrics to the song "99 Bottles of Beer on the Wall".*/
parse arg N .; if N=='' then N=99 /*let # bottles be specified*/
do j=99 by -1 to 1 /*start countdown | singdown*/
do j=N by -1 to 1 /*start countdown & singdown*/
say j 'bottle's(j) "of beer on the wall," /*sing the #bottles of beer.*/
say j 'bottle's(j) "of beer." /* ... and the refrain. */
say j 'bottle's(j) "of beer." /* ··· and the refrain.*/
say 'Take one down, pass it around,' /*get a bottle and share it.*/
n=j-1 /*N is #bottles we have now.*/
if n==0 then n='no' /*use "no" instead of 0. */
say n 'bottle's(n) "of beer on the wall." /*sing beer bottle inventory*/
m=j-1 /*M: # bottles we have now.*/
if m==0 then m='no' /*use "no" instead of 0. */
say m 'bottle's(m) "of beer on the wall." /*sing beer bottle inventory*/
say /*blank line between verses.*/
end /*j*/
/*Not tanked? Then sing it.*/
say 'No more bottles of beer on the wall,' /*Finally! The last verse.*/
say 'no more bottles of beer.' /*so sad ... */
say 'no more bottles of beer.' /*this is so forlorn ··· */
say 'Go to the store and buy some more,' /*replenishment of the beer.*/
say '99 bottles of beer on the wall.' /*All is well in the tavern.*/
say N 'bottles of beer on the wall.' /*all is well in the tavern.*/
exit /*we're done & also sloshed.*/
/*───────────────────────────────────S subroutine───────────────────────*/
s: if arg(1)=1 then return ''; return 's' /*a simple pluralizer funct.*/
s: if arg(1)=1 then return ''; return 's' /*simple pluralizer function*/

View file

@ -0,0 +1,13 @@
dim nBott as integer
nBott = 99
While nBott > 0
Print(str$(nBott ) + " bottle" + iif(nBott=1, "", "s") + " of beer on the wall")
Print(str$(nBott ) + " bottle" + iif(nBott=1, "", "s") + " of beer")
Print("Take one down, pass it around")
nBott--
Print(str$(nBott ) + " bottle" + iif(nBott=1, "", "s") + " of beer on the wall" + chr$(10))
Wend
while inkey$="":wend
end

View file

@ -1,24 +1,32 @@
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 {
match *self {
1 => print!("{} bottle of beer", self),
0 => print!("No bottles of beer"),
_ => print!("{} bottles of beer", self)
}
*self // return a number for chaining
}
fn on_the_wall(&self) {
println!(" on the wall!");
}
}
fn main() {
for num_bottles in range_step_inclusive(99, 1, -1) {
sing_bottles_line(num_bottles, true);
sing_bottles_line(num_bottles, false);
println("Take one down, pass it around...");
sing_bottles_line(num_bottles - 1, true);
println("-----------------------------------");
}
}
fn sing_bottles_line(num_bottles: int, on_the_wall: bool) {
// the print! macro uses a built in internationalization formatting language
// check out the docs for std::fmt
print!("{0, plural, =0{No bottles} =1{One bottle} other{# bottles}} of beer", num_bottles as uint);
if on_the_wall {
println(" on the wall!");
} else {
println("");
}
for i in range_step_inclusive(99is, 1, -1) {
i.bottles_of_beer().on_the_wall();
i.bottles_of_beer();
println!("\nTake one down, pass it around...");
(i - 1).bottles_of_beer().on_the_wall();
println!("-----------------------------------");
}
}

View file

@ -1,29 +1,9 @@
DELIMITER $$
DROP PROCEDURE IF EXISTS bottles_$$
CREATE pROCEDURE `bottles_`(inout bottle_count int, inout song text)
BEGIN
declare bottles_text varchar(30);
IF bottle_count > 0 THEN
if bottle_count != 1 then
set bottles_text := ' bottles of beer ';
else set bottles_text = ' bottle of beer ';
end if;
SELECT concat(song, bottle_count, bottles_text, ' \n') INTO song;
SELECT concat(song, bottle_count, bottles_text, 'on the wall\n') INTO song;
SELECT concat(song, 'Take one down, pass it around\n') into song;
SELECT concat(song, bottle_count -1 , bottles_text, 'on the wall\n\n') INTO song;
set bottle_count := bottle_count -1;
CALL bottles_( bottle_count, song);
END IF;
END$$
set @bottles=99;
set max_sp_recursion_depth=@bottles;
set @song='';
call bottles_( @bottles, @song);
select @song;
select
( 100 - level ) || ' bottle' || case 100 - level when 1 then '' else 's' end || ' of beer on the wall'
|| chr(10)
|| ( 100 - level ) || ' bottle' || case 100 - level when 1 then '' else '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'
from dual connect by level <= 99;

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