A-M baby

Task/100-doors/Factor/100-doors.factor

@@ -0,0 +1,23 @@
+USING: bit-arrays formatting fry kernel math math.ranges
+sequences ;
+IN: rosetta.doors
+
+CONSTANT: number-of-doors 100
+
+: multiples ( n -- range )
+    0 number-of-doors rot <range> ;
+
+: toggle-multiples ( n doors -- )
+    [ multiples ] dip '[ _ [ not ] change-nth ] each ;
+
+: toggle-all-multiples ( doors -- )
+    [ number-of-doors [1,b] ] dip '[ _ toggle-multiples ] each ;
+
+: print-doors ( doors -- )
+    [
+        swap "open" "closed" ? "Door %d is %s\n" printf
+    ] each-index ;
+
+: main ( -- )
+    number-of-doors 1 + <bit-array>
+    [ toggle-all-multiples ] [ print-doors ] bi ;

Task/100-doors/Falcon/100-doors-1.falcon

@@ -0,0 +1,11 @@
+doors = arrayBuffer( 101, false )
+
+for pass in [ 0 : doors.len() ]
+  for door in [ 0 : doors.len() : pass+1 ]
+    doors[ door ] = not doors[ door ]
+  end
+end
+
+for door in [ 1 : doors.len() ]  // Show Output
+  >  "Door ", $door, " is: ", ( doors[ door ] ) ? "open" : "closed"
+end

Task/100-doors/Falcon/100-doors-2.falcon

@@ -0,0 +1 @@
+for door in [ 1 : 101 ]: > "Door ", $door, " is: ", fract( door ** 0.5 ) ? "closed" : "open"

Task/100-doors/Fantom/100-doors-1.fantom

@@ -0,0 +1,5 @@
+    states := (1..100).toList
+    100.times |i| {
+      states = states.map |state| { state % (i+1) == 0 ? -state : +state }
+    }
+    echo("Open doors are " + states.findAll { it < 0 }.map { -it })

Task/100-doors/Fantom/100-doors-2.fantom

@@ -0,0 +1 @@
+    echo("Open doors are " + (1..100).toList.findAll { it.toFloat.pow(0.5f).toInt.pow(2) == it})

Task/100-doors/GAP/100-doors.gap

@@ -0,0 +1,18 @@
+doors := function(n)
+  local a,j,s;
+  a := [ ];
+  for j in [1 .. n] do
+    a[j] := 0;
+  od;
+  for s in [1 .. n] do
+    j := s;
+    while j <= n do
+      a[j] := 1 - a[j];
+      j := j + s;
+    od;
+  od;
+  return Filtered([1 .. n], j -> a[j] = 1);
+end;
+
+doors(100);
+# [ 1, 4, 9, 16, 25, 36, 49, 64, 81, 100 ]

Task/100-doors/GML/100-doors.gml

@@ -0,0 +1,28 @@
+var doors,a,i;
+//Sets up the array for all of the doors.
+for (i=1;i<=100;i+=1)
+    {
+        doors[i]=0;
+    }
+//This first for loop goes through and passes the interval down to the next for loop.
+for (i=1;i<=100;i+=1)
+    {
+        //This for loop opens or closes the doors and uses the interval(if interval is 2 it only uses every other etc..)
+        for (a=0;a<=100;a+=i;)
+            {
+                //Opens or closes a door.
+                doors[a]=!doors[a];
+            }
+    }
+open_doors='';
+//This for loop goes through the array and checks for open doors.
+//If the door is open it adds it to the string then displays the string.
+for (i=1;i<=100;i+=1)
+    {
+        if doors[i]=1
+            {
+                open_doors+="Door Number "+string(i)+" is open#";
+            }
+    }
+show_message(open_doors);
+game_end();

Task/100-doors/Golfscript/100-doors-1.golf

@@ -0,0 +1,4 @@
+100:c;[{0}c*]:d;
+c,{.c,>\)%{.d<\.d=1^\)d>++:d;}/}/
+[c,{)"door "\+" is"+}%d{{"open"}{"closed"}if}%]zip
+{" "*puts}/

Task/100-doors/Golfscript/100-doors-2.golf

@@ -0,0 +1,3 @@
+100,{)}%
+{:d.sqrt 2?=
+{"open"}{"close"}if"door "d+" is "+\+puts}/

Task/100-doors/Golfscript/100-doors-3.golf

@@ -0,0 +1,4 @@
+[{"close"}100*]:d;
+10,{)2?(.d<\["open"]\)d>++:d;}/
+[100,{)"door "\+" is"+}%d]zip
+{" "*puts}/

Task/100-doors/Gosu/100-doors-1.gosu

@@ -0,0 +1,16 @@
+uses java.util.Arrays
+
+var doors = new boolean[100]
+Arrays.fill( doors, false )
+
+for( pass in 1..100 ) {
+    var counter = pass-1
+    while( counter < 100 ) {
+        doors[counter] = !doors[counter]
+        counter += pass
+  }
+}
+
+for( door in doors index i ) {
+    print( "door ${i+1} is ${door ? 'open' : 'closed'}" )
+}

Task/100-doors/Gosu/100-doors-2.gosu

@@ -0,0 +1,12 @@
+var door = 1
+var delta = 0
+
+for( i in 1..100 ) {
+    if( i == door ) {
+        print( "door ${i} is open" )
+        delta++
+        door += 2*delta + 1
+    } else {
+        print( "door ${i} is closed" )
+    }
+}

Task/100-doors/Groovy/100-doors-1.groovy

@@ -0,0 +1,9 @@
+doors = [false] * 100
+(0..99).each {
+   it.step(100, it + 1) {
+      doors[it] ^= true
+   }
+}
+(0..99).each {
+   println("Door #${it + 1} is ${doors[it] ? 'open' : 'closed'}.")
+}

Task/100-doors/Groovy/100-doors-2.groovy

@@ -0,0 +1,3 @@
+(1..100).each {
+   println("Door #${it} is ${Math.sqrt(it).with{it==(int)it} ? 'open' : 'closed'}.")
+}

Task/100-doors/Groovy/100-doors-3.groovy

@@ -0,0 +1,5 @@
+doors = ['closed'] * 100
+(1..10).each { doors[it**2 - 1] = 'open' }
+(0..99).each {
+   println("Door #${it + 1} is ${doors[it]}.")
+}

Task/100-doors/Haxe/100-doors.haxe

@@ -0,0 +1,18 @@
+class RosettaDemo
+{
+    static public function main()
+    {
+        findOpenLockers(100);
+    }
+
+    static function findOpenLockers(n : Int)
+    {
+        var i = 1;
+
+        while((i*i) <= n)
+        {
+            Sys.print(i*i + "\n");
+            i++;
+        }
+    }
+}

Task/100-doors/HicEst/100-doors-1.hicest

@@ -0,0 +1,9 @@
+REAL :: n=100, open=1, door(n)
+
+door = 1 - open ! = closed
+DO i = 1, n
+  DO j = i, n, i
+    door(j) = open - door(j)
+  ENDDO
+ENDDO
+DLG(Text=door, TItle=SUM(door)//" doors open")

Task/100-doors/HicEst/100-doors-2.hicest

@@ -0,0 +1,5 @@
+door = 1 - open ! = closed
+DO i = 1, n^0.5
+  door(i*i) = open
+ENDDO
+DLG(Text=door, TItle=SUM(door)//" doors open")

Task/100-doors/Icon/100-doors-1.icon

@@ -0,0 +1,7 @@
+procedure main()
+    door := table(0)    # default value of entries is 0
+    every pass := 1 to 100 do
+        every door[i := pass to 100 by pass] := 1 - door[i]
+
+    every write("Door ", i := 1 to 100, " is ", if door[i] = 1 then "open" else "closed")
+end

Task/100-doors/Icon/100-doors-2.icon

@@ -0,0 +1,3 @@
+procedure main()
+    every write("Door ", i := 1 to 100, " is ", if integer(sqrt(i)) = sqrt(i) then "open" else "closed")
+end

Task/100-doors/Icon/100-doors-3.icon

@@ -0,0 +1,5 @@
+procedure main(args)
+    dMap := table("closed")
+    every dMap[(1 to sqrt(100))^2] := "open"
+    every write("Door ",i := 1 to 100," is ",dMap[i])
+end

Task/100-doors/Inform-7/100-doors.inf

@@ -0,0 +1,29 @@
+Hallway is a room.
+
+A toggle door is a kind of thing.
+A toggle door can be open or closed. It is usually closed.
+A toggle door has a number called the door number.
+Understand the door number property as referring to a toggle door.
+Rule for printing the name of a toggle door: say "door #[door number]".
+
+There are 100 toggle doors.
+
+When play begins (this is the initialize doors rule):
+	let the next door number be 1;
+	repeat with D running through toggle doors:
+		now the door number of D is the next door number;
+		increment the next door number.
+
+To toggle (D - open toggle door): now D is closed.
+To toggle (D - closed toggle door): now D is open.
+
+When play begins (this is the solve puzzle rule):
+	let the door list be the list of toggle doors;
+	let the door count be the number of entries in the door list;
+	repeat with iteration running from 1 to 100:
+		let N be the iteration;
+		while N is less than the door count:
+			toggle entry N in the door list;
+			increase N by the iteration;
+	say "Doors left open: [list of open toggle doors].";
+	end the story.

Task/100-doors/Informix-4GL/100-doors.4gl

@@ -0,0 +1,22 @@
+MAIN
+    DEFINE
+        i, pass SMALLINT,
+        doors ARRAY[100] OF SMALLINT
+
+    FOR i = 1 TO 100
+        LET doors[i] = FALSE
+    END FOR
+
+    FOR pass = 1 TO 100
+        FOR i = pass TO 100 STEP pass
+            LET doors[i] = NOT doors[i]
+        END FOR
+    END FOR
+
+    FOR i = 1 TO 100
+        IF doors[i]
+          THEN DISPLAY i USING "Door <<& is open"
+          ELSE DISPLAY i USING "Door <<& is closed"
+        END IF
+    END FOR
+END MAIN

Task/100-doors/Io/100-doors.io

@@ -0,0 +1,6 @@
+doors := List clone
+for(i,1,100, doors append(false))
+for(i,1,100,
+    for(x,i,100, i, doors atPut(x - 1, doors at(x - 1) not))
+)
+doors foreach(i, x, if(x, "Door #{i + 1} is open" interpolate println))

Task/100-doors/Ioke/100-doors.ioke

@@ -0,0 +1,21 @@
+NDoors = Origin mimic
+
+NDoors Toggle = Origin mimic do(
+  initialize = method(toggled?, @toggled? = toggled?)
+  toggle! = method(@toggled? = !toggled?. self)
+)
+
+NDoors Doors = Origin mimic do(
+  initialize = method(n,
+    @n = n
+    @doors = {} addKeysAndValues(1..n, (1..n) map(_, NDoors Toggle mimic(false)))
+  )
+  numsToToggle = method(n, for(x <- (1..@n), (x % n) zero?, x))
+  toggleThese = method(nums, nums each(x, @doors[x] = @doors at(x) toggle))
+  show = method(@doors filter:dict(value toggled?) keys sort println)
+)
+
+; Test code
+x = NDoors Doors mimic(100)
+(1..100) each(n, x toggleThese(x numsToToggle(n)))
+x show

Task/100-doors/J/100-doors-1.j

@@ -0,0 +1,4 @@
+   ~:/ (100 $ - {. 1:)"0 >:i.100
+1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 ...
+   ~:/ 0=|/~ >:i.100  NB. alternative
+1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 ...

Task/100-doors/J/100-doors-2.j

@@ -0,0 +1,4 @@
+   (e. *:) 1+i.100
+1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 ...
+   1 (<:*:i.10)} 100$0  NB. alternative
+1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 ...

Task/100-doors/J/100-doors-3.j

@@ -0,0 +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│
+└────────────────────┴───────────────────────────┘

Task/100-doors/Julia/100-doors-1.julia

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

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

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

Task/100-doors/K/100-doors-1.k

@@ -0,0 +1 @@
+ `closed `open ![ ; 2 ] @ #:' 1 _ = ,/ &:' 0 = t !\:/: t : ! 101

Task/100-doors/K/100-doors-2.k

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

Task/100-doors/K/100-doors-3.k

@@ -0,0 +1 @@
+ { ( 1 + ! _ x ^ % 2 ) ^ 2 } 100

Task/100-doors/LOLCODE/100-doors.lol

@@ -0,0 +1,27 @@
+HAI 1.3
+
+I HAS A doors ITZ A BUKKIT
+IM IN YR hallway UPPIN YR door TIL BOTH SAEM door AN 100
+    doors HAS A SRS door ITZ FAIL BTW, INISHULIZE ALL TEH DOORZ AS CLOZD
+IM OUTTA YR hallway
+
+IM IN YR hallway UPPIN YR pass TIL BOTH SAEM pass AN 100
+    I HAS A door ITZ pass
+    IM IN YR passer
+        doors'Z SRS door R NOT doors'Z SRS door
+        door R SUM OF door AN SUM OF pass AN 1
+        DIFFRINT door AN SMALLR OF door AN 99, O RLY?
+            YA RLY, GTFO
+        OIC
+    IM OUTTA YR passer
+IM OUTTA YR hallway
+
+IM IN YR printer UPPIN YR door TIL BOTH SAEM door AN 100
+    VISIBLE "Door #" SUM OF door AN 1 " is "!
+    doors'Z SRS door, O RLY?
+        YA RLY, VISIBLE "open."
+        NO WAI, VISIBLE "closed."
+    OIC
+IM OUTTA YR printer
+
+KTHXBYE

Task/100-doors/Lhogho/100-doors.lhogho

@@ -0,0 +1,30 @@
+to doors
+	;Problem 100 Doors
+	;Lhogho
+
+	for "p [1 100]
+	[
+		make :p "false
+	]
+
+	for "a [1 100 1]
+	[
+		for "b [:a 100 :a]
+		[
+			if :b < 101
+			[
+				make :b not thing :b
+			]
+		]
+	]
+
+	for "c [1 100]
+	[
+		if thing :c
+		[
+			(print "door :c "is "open)
+		]
+	]
+end
+
+doors

Task/100-doors/Liberty-BASIC/100-doors.liberty

@@ -0,0 +1,10 @@
+dim doors(100)
+for pass = 1 to 100
+    for door = pass to 100 step pass
+        doors(door) = not(doors(door))
+    next door
+next pass
+print "open doors ";
+for door = 1 to 100
+    if doors(door) then print door;"  ";
+next door

Task/100-doors/Logo/100-doors.logo

@@ -0,0 +1,14 @@
+to doors
+;Problem 100 Doors
+;FMSLogo
+;lrcvs 2010
+
+make "door (vector 100 1)
+for [p 1 100][setitem :p :door 0]
+
+for [a 1 100 1][for [b :a 100 :a][make "x item :b :door
+	                          ifelse :x  = 0 [setitem :b :door 1][setitem :b :door 0] ] ]
+
+for [c 1 100][make "y item :c :door
+	      ifelse :y = 0 [pr (list :c "Close)] [pr (list :c "Open)] ]
+end

Task/100-doors/M4/100-doors.m4

@@ -0,0 +1,10 @@
+define(`_set', `define(`$1[$2]', `$3')')dnl
+define(`_get', `defn(`$1[$2]')')dnl
+define(`for',`ifelse($#,0,``$0'',`ifelse(eval($2<=$3),1,
+`pushdef(`$1',$2)$5`'popdef(`$1')$0(`$1',eval($2+$4),$3,$4,`$5')')')')dnl
+define(`opposite',`_set(`door',$1,ifelse(_get(`door',$1),`closed',`open',`closed'))')dnl
+define(`upper',`100')dnl
+for(`x',`1',upper,`1',`_set(`door',x,`closed')')dnl
+for(`x',`1',upper,`1',`for(`y',x,upper,x,`opposite(y)')')dnl
+for(`x',`1',upper,`1',`door x is _get(`door',x)
+')dnl

Task/100-doors/MAXScript/100-doors-1.max

@@ -0,0 +1,14 @@
+doorsOpen = for i in 1 to 100 collect false
+
+for pass in 1 to 100 do
+(
+    for door in pass to 100 by pass do
+    (
+        doorsOpen[door] = not doorsOpen[door]
+    )
+)
+
+for i in 1 to doorsOpen.count do
+(
+    format ("Door % is open?: %\n") i doorsOpen[i]
+)

Task/100-doors/MAXScript/100-doors-2.max

@@ -0,0 +1,5 @@
+for i in 1 to 100 do
+(
+    root = pow i 0.5
+    format ("Door % is open?: %\n") i (root == (root as integer))
+)

Task/100-doors/MIPS-Assembly/100-doors.mips

@@ -0,0 +1,63 @@
+.data
+  doors:     .space 100
+  num_str:   .asciiz "Number "
+  comma_gap: .asciiz " is "
+  newline:   .asciiz "\n"
+
+.text
+main:
+# Clear all the cells to zero
+  li $t1, 100
+  la $t2, doors
+clear_loop:
+  sb $0, ($t2)
+  add $t2, $t2, 1
+  sub $t1, $t1, 1
+  bnez $t1, clear_loop
+
+# Now start the loops
+  li $t0, 1         # This will the the step size
+  li $t4, 1         # just an arbitrary 1
+loop1:
+  move $t1, $t0      # Counter
+  la $t2, doors      # Current pointer
+  add $t2, $t2, $t0
+  addi $t2, $t2, -1
+loop2:
+  lb $t3, ($t2)
+  sub $t3, $t4, $t3
+  sb $t3, ($t2)
+  add $t1, $t1, $t0
+  add $t2, $t2, $t0
+  ble $t1, 100, loop2
+
+  addi $t0, $t0, 1
+  ble $t0, 100, loop1
+
+  # Now display everything
+  la $t0, doors
+  li $t1, 1
+loop3:
+  li $v0, 4
+  la $a0, num_str
+  syscall
+
+  li $v0, 1
+  move $a0, $t1
+  syscall
+
+  li $v0, 4
+  la $a0, comma_gap
+  syscall
+
+  li $v0, 1
+  lb $a0, ($t0)
+  syscall
+
+  li $v0, 4,
+  la $a0, newline
+  syscall
+
+  addi $t0, $t0, 1
+  addi $t1, $t1, 1
+  bne $t1, 101 loop3

Task/100-doors/ML-I/100-doors.ml

@@ -0,0 +1,41 @@
+MCSKIP "WITH" NL
+"" 100 doors
+MCINS %.
+MCSKIP MT,<>
+"" Doors represented by P1-P100, 0 is closed
+MCPVAR 100
+"" Set P variables to 0
+MCDEF ZEROPS WITHS NL AS <MCSET T1=1
+%L1.MCSET PT1=0
+MCSET T1=T1+1
+MCGO L1 UNLESS T1 EN 101
+>
+ZEROPS
+"" Generate door state
+MCDEF STATE WITHS () AS <MCSET T1=%A1.
+MCGO L1 UNLESS T1 EN 0
+closed<>MCGO L0
+%L1.open>
+"" Main macro - no arguments
+"" T1 is pass number
+"" T2 is door number
+MCDEF DOORS WITHS NL
+AS <MCSET T1=1
+"" pass loop
+%L1.MCGO L4 IF T1 GR 100
+"" door loop
+MCSET T2=T1
+%L2.MCGO L3 IF T2 GR 100
+MCSET PT2=1-PT2
+MCSET T2=T2+T1
+MCGO L2
+%L3.MCSET T1=T1+1
+MCGO L1
+%L4."" now output the result
+MCSET T1=1
+%L5.door %T1. is STATE(%PT1.)
+MCSET T1=T1+1
+MCGO L5 UNLESS T1 GR 100
+>
+"" Do it
+DOORS

Task/100-doors/MOO/100-doors.moo

@@ -0,0 +1,14 @@
+is_open = make(100);
+for pass in [1..100]
+  for door in [pass..100]
+    if (door % pass)
+      continue;
+    endif
+    is_open[door] = !is_open[door];
+  endfor
+endfor
+
+"output the result";
+for door in [1..100]
+  player:tell("door #", door, " is ", (is_open[door] ? "open" : "closed"), ".");
+endfor

Task/100-doors/MUMPS/100-doors.mumps

@@ -0,0 +1,18 @@
+doors	new door,pass
+	For door=1:1:100 Set door(door)=0
+	For pass=1:1:100 For door=pass:pass:100 Set door(door)='door(door)
+	For door=1:1:100 If door(door) Write !,"Door",$j(door,4)," is open"
+	Write !,"All other doors are closed."
+	Quit
+Do doors
+Door   1 is open
+Door   4 is open
+Door   9 is open
+Door  16 is open
+Door  25 is open
+Door  36 is open
+Door  49 is open
+Door  64 is open
+Door  81 is open
+Door 100 is open
+All other doors are closed.

Task/100-doors/Maple/100-doors-1.maple

@@ -0,0 +1,16 @@
+NDoors := proc( N :: posint )
+        # Initialise, using 0 to represent "closed"
+        local 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
+                        doors[ door ] := 1 - doors[ door ]
+                end do
+        end do;
+        # Output
+        for door from 1 to N do
+                printf( "Door %d is %s.\n", door, `if`( doors[ door ] = 0, "closed", "open" ) )
+        end do;
+        # Since this is a printing routine, return nothing.
+        NULL
+end proc:

Task/100-doors/Maple/100-doors-2.maple

@@ -0,0 +1 @@
+> NDoors( 100 );

Task/100-doors/Maple/100-doors-3.maple

@@ -0,0 +1,2 @@
+> seq( i^2, i = 1 .. isqrt( 100 ) );
+                  1, 4, 9, 16, 25, 36, 49, 64, 81, 100

Task/100-doors/Maple/100-doors-4.maple

@@ -0,0 +1,2 @@
+> [seq]( 1 .. 10 )^~2;
+                 [1, 4, 9, 16, 25, 36, 49, 64, 81, 100]

Task/100-doors/Mathematica/100-doors-1.mathematica

@@ -0,0 +1,3 @@
+f[n_] = "Closed";
+Do[Do[If[f[n] == "Closed", f[n] = "Open", f[n] = "Closed"], {n, k, 100, k}], {k, 1, 100}];
+Table[f[n], {n, 1, 100}]

Task/100-doors/Mathematica/100-doors-2.mathematica

@@ -0,0 +1 @@
+Do[Print["door ",i," is ",If[IntegerQ[Sqrt[i]],"open","closed"]],{i,100}]

Task/100-doors/Mathematica/100-doors-3.mathematica

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

Task/100-doors/Mathematica/100-doors-4.mathematica

@@ -0,0 +1,12 @@
+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"];
+ ];
+]

Task/100-doors/Mathematica/100-doors-5.mathematica

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

Task/100-doors/Mathematica/100-doors-6.mathematica

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

Task/100-doors/Maxima/100-doors.maxima

@@ -0,0 +1,10 @@
+doors(n) := block([v: makelist(i, i, 1, n)],
+   for i from 2 thru n do
+      for j from i step i while j <= n do v[j]: -v[j],
+   sublist(v, ?plusp))$
+
+doors(100);
+[1, 4, 9, 16, 25, 36, 49, 64, 81, 100]
+
+/* Note: ?plusp is a Lisp function. Maxima has nonnegintegerp, which is equivalent,
+but it needs load(linearalgebra)$ first. */

Task/100-doors/Mercury/100-doors.mercury

@@ -0,0 +1,33 @@
+:- module doors.
+:- interface.
+:- import_module array, io, int.
+
+:- type door ---> open ; closed.
+:- type doors == array(door).
+
+:- func toggle(door) = door.
+:- pred walk(int::in, doors::in, doors::out) is semidet.
+:- pred walks(int::in, int::in, doors::in, doors::out) is det.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+toggle(open) = closed.
+toggle(closed) = open.
+
+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),
+        ( walk(At + By, By, !D) -> true ; true ).
+
+walks(N, End, !D) :-
+        ( N =< End, walk(N, !D) -> walks(N + 1, End, !D) ; true ).
+
+main(!IO) :-
+        io.write(Doors1, !IO), io.nl(!IO),
+        array.init(100, closed, Doors0),
+        walks(1, 100, Doors0, Doors1).

Task/100-doors/Metafont/100-doors.metafont

@@ -0,0 +1,11 @@
+boolean doors[];
+for i = 1 upto 100: doors[i] := false; endfor
+for i = 1 upto 100:
+  for j = 1 step i until 100:
+    doors[j] := not doors[j];
+  endfor
+endfor
+for i = 1 upto 100:
+  message decimal(i) & " " & if doors[i]: "open" else: "close" fi;
+endfor
+end

Task/100-doors/Mirah/100-doors.mirah

@@ -0,0 +1,44 @@
+import java.util.ArrayList
+
+class Door
+	:state
+
+	def initialize
+		@state=false
+	end
+
+	def closed?; !@state; end
+	def open?; @state; end
+
+	def close; @state=false; end
+	def open; @state=true; end
+
+	def toggle
+		if closed?
+			open
+		else
+			close
+		end
+	end
+
+	def toString; Boolean.toString(@state); end
+end
+
+doors=ArrayList.new
+1.upto(100) do
+    doors.add(Door.new)
+end
+
+1.upto(100) do |multiplier|
+    index = 0
+    doors.each do |door|
+        Door(door).toggle if (index+1)%multiplier == 0
+        index += 1
+    end
+end
+
+i = 0
+doors.each do |door|
+    puts "Door #{i+1} is #{door}."
+    i+=1
+end

Task/100-doors/Modula-2/100-doors-1.mod2

@@ -0,0 +1,36 @@
+MODULE Doors;
+IMPORT InOut;
+
+TYPE State = (Closed, Open);
+TYPE List = ARRAY [1 .. 100] OF State;
+
+VAR
+  Doors: List;
+  I, J:  CARDINAL;
+
+BEGIN
+  FOR I := 1 TO 100 DO
+    FOR J := 1 TO 100 DO
+      IF J MOD I = 0 THEN
+        IF Doors[J] = Closed THEN
+          Doors[J] := Open
+        ELSE
+          Doors[J] := Closed
+        END
+      END
+    END
+  END;
+
+  FOR I := 1 TO 100 DO
+    InOut.WriteCard(I, 3);
+    InOut.WriteString(' is ');
+
+    IF Doors[I] = Closed THEN
+      InOut.WriteString('Closed.')
+    ELSE
+      InOut.WriteString('Open.')
+    END;
+
+    InOut.WriteLn
+  END
+END Doors.

Task/100-doors/Modula-2/100-doors-2.mod2

@@ -0,0 +1,26 @@
+MODULE DoorsOpt;
+IMPORT InOut;
+
+TYPE State = (Closed, Open);
+TYPE List = ARRAY [1 .. 100] OF State;
+
+VAR
+  Doors: List;
+  I:  CARDINAL;
+
+BEGIN
+  FOR I := 1 TO 10 DO
+    Doors[I*I] := Open
+  END;
+
+  FOR I := 1 TO 100 DO
+    InOut.WriteCard(I, 3);
+    InOut.WriteString(' is ');
+    IF Doors[I] = Closed THEN
+      InOut.WriteString('Closed.')
+    ELSE
+      InOut.WriteString('Open.')
+    END;
+    InOut.WriteLn
+  END
+END DoorsOpt.

Task/100-doors/Modula-3/100-doors-1.mod3

@@ -0,0 +1,31 @@
+MODULE Doors EXPORTS Main;
+
+IMPORT IO, Fmt;
+
+TYPE State = {Closed, Open};
+TYPE List = ARRAY [1..100] OF State;
+
+VAR doors := List{State.Closed, ..};
+
+BEGIN
+  FOR i := 1 TO 100 DO
+    FOR j := FIRST(doors) TO LAST(doors) DO
+      IF j MOD i = 0 THEN
+        IF doors[j] = State.Closed THEN
+          doors[j] := State.Open;
+        ELSE
+          doors[j] := State.Closed;
+        END;
+      END;
+    END;
+  END;
+
+  FOR i := FIRST(doors) TO LAST(doors) DO
+    IO.Put(Fmt.Int(i) & " is ");
+    IF doors[i] = State.Closed THEN
+      IO.Put("Closed.\n");
+    ELSE
+      IO.Put("Open.\n");
+    END;
+  END;
+END Doors.

Task/100-doors/Modula-3/100-doors-2.mod3

@@ -0,0 +1,23 @@
+MODULE DoorsOpt EXPORTS Main;
+
+IMPORT IO, Fmt;
+
+TYPE State = {Closed, Open};
+TYPE List = ARRAY [1..100] OF State;
+
+VAR doors := List{State.Closed, ..};
+
+BEGIN
+  FOR i := 1 TO 10 DO
+    doors[i * i] := State.Open;
+  END;
+
+  FOR i := FIRST(doors) TO LAST(doors) DO
+    IO.Put(Fmt.Int(i) & " is ");
+    IF doors[i] = State.Closed THEN
+      IO.Put("Closed.\n");
+    ELSE
+      IO.Put("Open.\n");
+    END;
+  END;
+END DoorsOpt.

Task/24-game-Solve/0DESCRIPTION

@@ -0,0 +1,6 @@
+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
+
+
+C.F: [[Arithmetic Evaluator]]

Task/24-game-Solve/ABAP/24-game-solve.abap

@@ -0,0 +1,198 @@
+data: lv_flag type c,
+      lv_number type i,
+      lt_numbers type table of i.
+
+constants: c_no_val type i value 9999.
+
+append 1 to lt_numbers.
+append 1 to lt_numbers.
+append 2 to lt_numbers.
+append 7 to lt_numbers.
+
+write 'Evaluating 24 with the following input: '.
+loop at lt_numbers into lv_number.
+  write lv_number.
+endloop.
+perform solve_24 using lt_numbers.
+
+form eval_formula using iv_eval type string changing ev_out type i.
+  call function 'EVAL_FORMULA' "analysis of a syntactically correct formula
+    exporting
+      formula = iv_eval
+    importing
+      value   = ev_out
+    exceptions
+   others     = 1.
+
+  if sy-subrc <> 0.
+    ev_out = -1.
+  endif.
+endform.
+
+" Solve a 24 puzzle.
+form solve_24 using it_numbers like lt_numbers.
+  data: lv_flag   type c,
+        lv_op1    type c,
+        lv_op2    type c,
+        lv_op3    type c,
+        lv_var1   type c,
+        lv_var2   type c,
+        lv_var3   type c,
+        lv_var4   type c,
+        lv_eval   type string,
+        lv_result type i,
+        lv_var     type i.
+
+  define retrieve_var.
+    read table it_numbers index &1 into lv_var.
+    &2 = lv_var.
+  end-of-definition.
+
+  define retrieve_val.
+    perform eval_formula using lv_eval changing lv_result.
+    if lv_result = 24.
+        write / lv_eval.
+    endif.
+  end-of-definition.
+  " Loop through all the possible number permutations.
+  do.
+    " Init. the operations table.
+
+    retrieve_var: 1 lv_var1, 2 lv_var2, 3 lv_var3, 4 lv_var4.
+    do 4 times.
+      case sy-index.
+        when 1.
+          lv_op1 = '+'.
+        when 2.
+          lv_op1 = '*'.
+        when 3.
+          lv_op1 = '-'.
+        when 4.
+          lv_op1 = '/'.
+      endcase.
+      do 4 times.
+        case sy-index.
+        when 1.
+          lv_op2 = '+'.
+        when 2.
+          lv_op2 = '*'.
+        when 3.
+          lv_op2 = '-'.
+        when 4.
+          lv_op2 = '/'.
+        endcase.
+        do 4 times.
+          case sy-index.
+          when 1.
+            lv_op3 = '+'.
+          when 2.
+            lv_op3 = '*'.
+          when 3.
+            lv_op3 = '-'.
+          when 4.
+            lv_op3 = '/'.
+          endcase.
+          concatenate '(' '(' lv_var1 lv_op1 lv_var2 ')' lv_op2 lv_var3 ')' lv_op3 lv_var4  into lv_eval separated by space.
+          retrieve_val.
+          concatenate '(' lv_var1 lv_op1 lv_var2 ')' lv_op2 '(' lv_var3 lv_op3 lv_var4 ')'  into lv_eval separated by space.
+          retrieve_val.
+          concatenate '(' lv_var1 lv_op1 '(' lv_var2 lv_op2 lv_var3 ')' ')' lv_op3 lv_var4  into lv_eval separated by space.
+          retrieve_val.
+          concatenate lv_var1 lv_op1 '(' '(' lv_var2 lv_op2 lv_var3 ')' lv_op3 lv_var4 ')'  into lv_eval separated by space.
+          retrieve_val.
+          concatenate lv_var1 lv_op1 '(' lv_var2 lv_op2 '(' lv_var3 lv_op3 lv_var4 ')' ')'  into lv_eval separated by space.
+          retrieve_val.
+        enddo.
+      enddo.
+    enddo.
+
+    " Once we've reached the last permutation -> Exit.
+    perform permute using it_numbers changing lv_flag.
+    if lv_flag = 'X'.
+      exit.
+    endif.
+  enddo.
+endform.
+
+
+" Permutation function - this is used to permute:
+" A = {A1...AN} -> Set of supplied variables.
+" B = {B1...BN - 1} -> Set of operators.
+" Can be used for an unbounded size set. Relies
+" on lexicographic ordering of the set.
+form permute using iv_set like lt_numbers
+             changing ev_last type c.
+  data: lv_len     type i,
+        lv_first   type i,
+        lv_third   type i,
+        lv_count   type i,
+        lv_temp    type i,
+        lv_temp_2  type i,
+        lv_second  type i,
+        lv_changed type c,
+        lv_perm    type i.
+  describe table iv_set lines lv_len.
+
+  lv_perm = lv_len - 1.
+  lv_changed = ' '.
+  " Loop backwards through the table, attempting to find elements which
+  " can be permuted. If we find one, break out of the table and set the
+  " flag indicating a switch.
+  do.
+    if lv_perm <= 0.
+      exit.
+    endif.
+    " Read the elements.
+    read table iv_set index lv_perm into lv_first.
+    add 1 to lv_perm.
+    read table iv_set index lv_perm into lv_second.
+    subtract 1 from lv_perm.
+    if lv_first < lv_second.
+      lv_changed = 'X'.
+      exit.
+    endif.
+    subtract 1 from lv_perm.
+  enddo.
+
+  " Last permutation.
+  if lv_changed <> 'X'.
+    ev_last = 'X'.
+    exit.
+  endif.
+
+  " Swap tail decresing to get a tail increasing.
+  lv_count = lv_perm + 1.
+  do.
+    lv_first = lv_len + lv_perm - lv_count + 1.
+    if lv_count >= lv_first.
+      exit.
+    endif.
+
+    read table iv_set index lv_count into lv_temp.
+    read table iv_set index lv_first into lv_temp_2.
+    modify iv_set index lv_count from lv_temp_2.
+    modify iv_set index lv_first from lv_temp.
+    add 1 to lv_count.
+  enddo.
+
+  lv_count = lv_len - 1.
+  do.
+    if lv_count <= lv_perm.
+      exit.
+    endif.
+
+    read table iv_set index lv_count into lv_first.
+    read table iv_set index lv_perm into lv_second.
+    read table iv_set index lv_len into lv_third.
+    if ( lv_first < lv_third ) and ( lv_first > lv_second ).
+      lv_len = lv_count.
+    endif.
+
+    subtract 1 from lv_count.
+  enddo.
+
+  read table iv_set index lv_perm into lv_temp.
+  read table iv_set index lv_len into lv_temp_2.
+  modify iv_set index lv_perm from lv_temp_2.
+  modify iv_set index lv_len from lv_temp.
+endform.

Task/24-game-Solve/Argile/24-game-solve.argile

@@ -0,0 +1,98 @@
+die "Please give 4 digits as argument 1\n" if argc < 2
+
+print a function that given four digits argv[1] subject to the rules of	\
+the _24_ game, computes an expression to solve the game if possible.
+
+use std, array
+
+let digits    be an array of 4 byte
+let operators be an array of 4 byte
+(: reordered arrays :)
+let (type of digits)    rdigits
+let (type of operators) roperators
+
+.: a function that given four digits <text digits> subject to
+   the rules of the _24_ game, computes an expression to solve
+   the game if possible.                                       :. -> text
+  if #digits != 4 {return "[error: need exactly 4 digits]"}
+  operators[0] = '+' ; operators[1] = '-'
+  operators[2] = '*' ; operators[3] = '/'
+  for each (val int d) from 0 to 3
+    if (digits[d] < '1') || (digits[d] > '9')
+      return "[error: non-digit character given]"
+    (super digits)[d] = digits[d]
+  let expr = for each operand order stuff
+  return "" if expr is nil
+  expr
+
+.:for each operand order stuff:. -> text
+  for each (val int a) from 0 to 3
+    for each (val int b) from 0 to 3
+      next if (b == a)
+      for each (val int c) from 0 to 3
+        next if (c == b) or (c == a)
+	for each (val int d) from 0 to 3
+	  next if (d == c) or (d == b) or (d == a)
+	  rdigits[0] = digits[a] ; rdigits[1] = digits[b]
+	  rdigits[2] = digits[c] ; rdigits[3] = digits[d]
+	  let found = for each operator order stuff
+	  return found unless found is nil
+  nil
+
+.:for each operator order stuff:. -> text
+  for each (val int i) from 0 to 3
+    for each (val int j) from 0 to 3
+      for each (val int k) from 0 to 3
+        roperators[0] = operators[i]
+	roperators[1] = operators[j]
+	roperators[2] = operators[k]
+	let found = for each RPN pattern stuff
+	return found if found isn't nil
+  nil
+
+our (raw array of text) RPN_patterns = Cdata
+  "xx.x.x."
+  "xx.xx.."
+  "xxx..x."
+  "xxx.x.."
+  "xxxx..."
+our (raw array of text) formats = Cdata
+  "((%c%c%c)%c%c)%c%c"
+  "(%c%c%c)%c(%c%c%c)"
+  "(%c%c(%c%c%c))%c%c"
+  "%c%c((%c%c%c)%c%c)"
+  "%c%c(%c%c(%c%c%c))"
+our (raw array of array of 3 int) rrop = Cdata
+  {0;1;2}; {0;2;1}; {1;0;2}; {2;0;1}; {2;1;0}
+
+.:for each RPN pattern stuff:. -> text
+  let RPN_stack be an array of 4 real
+  for each (val int rpn) from 0 to 4
+    let (nat) sp=0, op=0, dg=0.
+    let text p
+    for (p = RPN_patterns[rpn]) (*p != 0) (p++)
+      if *p == 'x'
+        if sp >= 4 {die "RPN stack overflow\n"}
+	if dg >  3 {die "RPN digits overflow\n"}
+	RPN_stack[sp++] = (rdigits[dg++] - '0') as real
+      if *p == '.'
+        if sp < 2 {die "RPN stack underflow\n"}
+	if op > 2 {die "RPN operators overflow\n"}
+	sp -= 2
+	let x = RPN_stack[sp]
+	let y = RPN_stack[sp + 1]
+	switch roperators[op++]
+	  case '+' {x += y}
+	  case '-' {x -= y}
+	  case '*' {x *= y}
+	  case '/' {x /= y}
+	  default  {die "RPN operator unknown\n"}
+	RPN_stack[sp++] = x
+    if RPN_stack[0] == 24.0
+      our array of 12 byte buffer (: 4 paren + 3 ops + 4 digits + null :)
+      snprintf (buffer as text) (size of buffer) (formats[rpn])		\
+         (rdigits[0]) (roperators[(rrop[rpn][0])]) (rdigits[1])		\
+                      (roperators[(rrop[rpn][1])]) (rdigits[2])		\
+                      (roperators[(rrop[rpn][2])]) (rdigits[3]);
+      return buffer as text
+  nil

Task/24-game-Solve/AutoHotkey/24-game-solve.ahk

@@ -0,0 +1,108 @@
+#NoEnv
+InputBox, NNNN       ; user input 4 digits
+NNNN := RegExReplace(NNNN, "(\d)(?=\d)", "$1,") ; separate with commas for the sort command
+sort NNNN, d`, ; sort in ascending order for the permutations to work
+StringReplace NNNN, NNNN, `,, , All ; remove comma separators after sorting
+
+ops := "+-*/"
+patterns := [	 "x x.x.x."
+		,"x x.x x.."
+		,"x x x..x."
+		,"x x x.x.."
+		,"x x x x..."	]
+
+; build bruteforce operator list ("+++, ++-, ++* ... ///")
+a := b := c := 0
+While (++a<5){
+ While (++b<5){
+  While (++c<5){
+   l := SubStr(ops, a, 1) . SubStr(ops, b, 1) . SubStr(ops, c, 1)
+
+   ; build bruteforce template ("x x+x+x+, x x+x x++ ... x x x x///")
+   For each, pattern in patterns
+   {
+      Loop 3
+         StringReplace, pattern, pattern, ., % SubStr(l, A_Index, 1)
+      pat .= pattern "`n"
+   }
+  }c := 0
+ }b := 0
+}
+StringTrimRight, pat, pat, 1 ; remove trailing newline
+
+
+; permutate input. As the lexicographic algorithm is used, each permutation generated is unique
+While NNNN
+{
+	StringSplit, N, NNNN
+	; substitute numbers in for x's and evaluate
+	Loop Parse, pat, `n
+	{
+		eval := A_LoopField ; current line
+		Loop 4
+			StringReplace, eval, eval, x, % N%A_Index% ; substitute number for "x"
+		If Round(evalRPN(eval), 4) = 24
+			final .= eval "`n"
+	}
+	NNNN := perm_next(NNNN) ; next lexicographic permutation of user's digits
+}
+MsgBox % final ? clipboard := final : "No solution"
+
+; simple stack-based evaluation. Integers only. Whitespace is used to push a value.
+evalRPN(s){
+	stack := []
+	Loop Parse, s
+		If A_LoopField is number
+			t .= A_LoopField
+		else
+		{
+			If t
+				stack.Insert(t), t := ""
+			If InStr("+-/*", l := A_LoopField)
+			{
+				a := stack.Remove(), b := stack.Remove()
+				stack.Insert(	 l = "+" ? b + a
+						:l = "-" ? b - a
+						:l = "*" ? b * a
+						:l = "/" ? b / a
+						:0	)
+			}
+		}
+	return stack.Remove()
+}
+
+
+
+perm_Next(str){
+	p := 0, sLen := StrLen(str)
+	Loop % sLen
+	{
+		If A_Index=1
+			continue
+		t := SubStr(str, sLen+1-A_Index, 1)
+		n := SubStr(str, sLen+2-A_Index, 1)
+		If ( t < n )
+		{
+			p := sLen+1-A_Index, pC := SubStr(str, p, 1)
+			break
+		}
+	}
+	If !p
+		return false
+	Loop
+	{
+		t := SubStr(str, sLen+1-A_Index, 1)
+		If ( t > pC )
+		{
+			n := sLen+1-A_Index, nC := SubStr(str, n, 1)
+			break
+		}
+	}
+	return SubStr(str, 1, p-1) . nC . Reverse(SubStr(str, p+1, n-p-1) . pC .  SubStr(str, n+1))
+}
+
+Reverse(s){
+	Loop Parse, s
+		o := A_LoopField o
+	return o
+}

Task/24-game-Solve/BBC-BASIC/24-game-solve.bbc

@@ -0,0 +1,56 @@
+      PROCsolve24("1234")
+      PROCsolve24("6789")
+      PROCsolve24("1127")
+      PROCsolve24("5566")
+      END
+
+      DEF PROCsolve24(s$)
+      LOCAL F%, I%, J%, K%, L%, P%, T%, X$, o$(), p$(), t$()
+      DIM o$(4), p$(24,4), t$(11)
+      o$() = "", "+", "-", "*", "/"
+      RESTORE
+      FOR T% = 1 TO 11
+        READ t$(T%)
+      NEXT
+      DATA "abcdefg", "(abc)defg", "ab(cde)fg", "abcd(efg)", "(abc)d(efg)", "(abcde)fg"
+      DATA "ab(cdefg)", "((abc)de)fg", "(ab(cde))fg", "ab((cde)fg)", "ab(cd(efg))"
+
+      FOR I% = 1 TO 4
+        FOR J% = 1 TO 4
+          FOR K% = 1 TO 4
+            FOR L% = 1 TO 4
+              IF I%<>J% IF J%<>K% IF K%<>L% IF I%<>K% IF J%<>L% IF I%<>L% THEN
+                P% += 1
+                p$(P%,1) = MID$(s$,I%,1)
+                p$(P%,2) = MID$(s$,J%,1)
+                p$(P%,3) = MID$(s$,K%,1)
+                p$(P%,4) = MID$(s$,L%,1)
+              ENDIF
+            NEXT
+          NEXT
+        NEXT
+      NEXT
+
+      FOR I% = 1 TO 4
+        FOR J% = 1 TO 4
+          FOR K% = 1 TO 4
+            FOR T% = 1 TO 11
+              FOR P% = 1 TO 24
+                X$ = t$(T%)
+                MID$(X$, INSTR(X$,"a"), 1) = p$(P%,1)
+                MID$(X$, INSTR(X$,"b"), 1) = o$(I%)
+                MID$(X$, INSTR(X$,"c"), 1) = p$(P%,2)
+                MID$(X$, INSTR(X$,"d"), 1) = o$(J%)
+                MID$(X$, INSTR(X$,"e"), 1) = p$(P%,3)
+                MID$(X$, INSTR(X$,"f"), 1) = o$(K%)
+                MID$(X$, INSTR(X$,"g"), 1) = p$(P%,4)
+                F% = TRUE : ON ERROR LOCAL F% = FALSE
+                IF F% IF EVAL(X$) = 24 THEN PRINT X$ : EXIT FOR I%
+                RESTORE ERROR
+              NEXT
+            NEXT
+          NEXT
+        NEXT
+      NEXT
+      IF I% > 4 PRINT "No solution found"
+      ENDPROC

Task/24-game-Solve/C/24-game-solve.c

@@ -0,0 +1,141 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <time.h>
+
+#define n_cards 4
+#define solve_goal 24
+#define max_digit 9
+
+typedef struct { int num, denom; } frac_t, *frac;
+typedef enum { C_NUM = 0, C_ADD, C_SUB, C_MUL, C_DIV, } op_type;
+
+typedef struct expr_t *expr;
+typedef struct expr_t {
+        op_type op;
+        expr left, right;
+        int value;
+} expr_t;
+
+void show_expr(expr e, op_type prec, int is_right)
+{
+        const char * op;
+        switch(e->op) {
+        case C_NUM:     printf("%d", e->value);
+                        return;
+        case C_ADD:     op = " + "; break;
+        case C_SUB:     op = " - "; break;
+        case C_MUL:     op = " x "; break;
+        case C_DIV:     op = " / "; break;
+        }
+
+        if ((e->op == prec && is_right) || e->op < prec) printf("(");
+        show_expr(e->left, e->op, 0);
+        printf("%s", op);
+        show_expr(e->right, e->op, 1);
+        if ((e->op == prec && is_right) || e->op < prec) printf(")");
+}
+
+void eval_expr(expr e, frac f)
+{
+        frac_t left, right;
+        if (e->op == C_NUM) {
+                f->num = e->value;
+                f->denom = 1;
+                return;
+        }
+        eval_expr(e->left, &left);
+        eval_expr(e->right, &right);
+        switch (e->op) {
+        case C_ADD:
+                f->num = left.num * right.denom + left.denom * right.num;
+                f->denom = left.denom * right.denom;
+                return;
+        case C_SUB:
+                f->num = left.num * right.denom - left.denom * right.num;
+                f->denom = left.denom * right.denom;
+                return;
+        case C_MUL:
+                f->num = left.num * right.num;
+                f->denom = left.denom * right.denom;
+                return;
+        case C_DIV:
+                f->num = left.num * right.denom;
+                f->denom = left.denom * right.num;
+                return;
+        default:
+                fprintf(stderr, "Unknown op: %d\n", e->op);
+                return;
+        }
+}
+int solve(expr ex_in[], int len)
+{
+        int i, j;
+        expr_t node;
+        expr ex[n_cards];
+        frac_t final;
+
+        if (len == 1) {
+                eval_expr(ex_in[0], &final);
+                if (final.num == final.denom * solve_goal && final.denom) {
+                        show_expr(ex_in[0], 0, 0);
+                        return 1;
+                }
+                return 0;
+        }
+
+        for (i = 0; i < len - 1; i++) {
+                for (j = i + 1; j < len; j++)
+                        ex[j - 1] = ex_in[j];
+                ex[i] = &node;
+                for (j = i + 1; j < len; j++) {
+                        node.left = ex_in[i];
+                        node.right = ex_in[j];
+                        for (node.op = C_ADD; node.op <= C_DIV; node.op++)
+                                if (solve(ex, len - 1))
+                                        return 1;
+
+                        node.left = ex_in[j];
+                        node.right = ex_in[i];
+                        node.op = C_SUB;
+                        if (solve(ex, len - 1)) return 1;
+                        node.op = C_DIV;
+                        if (solve(ex, len - 1)) return 1;
+
+                        ex[j] = ex_in[j];
+                }
+                ex[i] = ex_in[i];
+        }
+
+        return 0;
+}
+
+int solve24(int n[])
+{
+        int i;
+        expr_t ex[n_cards];
+        expr   e[n_cards];
+        for (i = 0; i < n_cards; i++) {
+                e[i] = ex + i;
+                ex[i].op = C_NUM;
+                ex[i].left = ex[i].right = 0;
+                ex[i].value = n[i];
+        }
+        return solve(e, n_cards);
+}
+
+int main()
+{
+        int i, j, n[] = { 3, 3, 8, 8, 9 };
+        srand(time(0));
+
+        for (j = 0; j < 10; j++) {
+                for (i = 0; i < n_cards; i++) {
+                        n[i] = 1 + (double) rand() * max_digit / RAND_MAX;
+                        printf(" %d", n[i]);
+                }
+                printf(":  ");
+                printf(solve24(n) ? "\n" : "No solution\n");
+        }
+
+        return 0;
+}

Task/24-game-Solve/Clojure/24-game-solve.clj

@@ -0,0 +1,30 @@
+(use 'clojure.contrib.combinatorics)
+
+(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))))
+
+(defn format-solution [sol]
+(cond
+(number? sol) sol
+(seq? sol)
+    (list (format-solution (second sol)) (first sol) (format-solution (nth sol 2)))))
+
+(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)))))

Task/24-game-Solve/CoffeeScript/24-game-solve-1.coffee

@@ -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'}"

Task/24-game-Solve/CoffeeScript/24-game-solve-2.coffee

@@ -0,0 +1,16 @@
+> coffee 24_game.coffee
+Solution for 8,3,1,8: ((1 + 8) * (8 / 3))
+Solution for 6,9,5,7: (6 - ((5 - 7) * 9))
+Solution for 4,2,1,1: no solution
+Solution for 3,5,1,3: (((3 + 5) * 1) * 3)
+Solution for 6,4,1,7: ((7 - (4 - 1)) * 6)
+Solution for 8,1,3,1: (((8 + 1) - 1) * 3)
+Solution for 6,1,3,3: (((6 + 1) * 3) + 3)
+Solution for 7,1,5,6: (((7 - 1) * 5) - 6)
+Solution for 4,2,3,1: ((3 + 1) * (4 + 2))
+Solution for 8,8,5,8: ((5 * 8) - (8 + 8))
+Solution for 3,8,4,1: ((1 - (3 - 8)) * 4)
+Solution for 6,4,3,8: ((8 - (6 / 3)) * 4)
+Solution for 2,1,8,7: (((2 * 8) + 1) + 7)
+Solution for 5,2,7,5: ((2 * 7) + (5 + 5))
+Solution for 2,4,8,9: ((9 - (2 + 4)) * 8)

Task/24-game-Solve/Common-Lisp/24-game-solve.lisp

@@ -0,0 +1,56 @@
+(defconstant +ops+ '(* / + -))
+
+(defun digits ()
+  (sort (loop repeat 4 collect (1+ (random 9))) #'<))
+
+(defun expr-value (expr)
+  (eval expr))
+
+(defun divides-by-zero-p (expr)
+  (when (consp expr)
+    (destructuring-bind (op &rest args) expr
+      (or (divides-by-zero-p (car args))
+          (and (eq op '/)
+               (or (and (= 1 (length args))
+                        (zerop (expr-value (car args))))
+                   (some (lambda (arg)
+                           (or (divides-by-zero-p arg)
+                               (zerop (expr-value arg))))
+                         (cdr args))))))))
+
+(defun solvable-p (digits &optional expr)
+  (unless (divides-by-zero-p expr)
+    (if digits
+        (destructuring-bind (next &rest rest) digits
+          (if expr
+              (some (lambda (op)
+                      (solvable-p rest (cons op (list next expr))))
+                    +ops+)
+            (solvable-p rest (list (car +ops+) next))))
+      (when (and expr
+                 (eql 24 (expr-value expr)))
+        (merge-exprs expr)))))
+
+(defun merge-exprs (expr)
+  (if (atom expr)
+      expr
+    (destructuring-bind (op &rest args) expr
+      (if (and (member op '(* +))
+               (= 1 (length args)))
+          (car args)
+        (cons op
+              (case op
+                ((* +)
+                 (loop for arg in args
+                       for merged = (merge-exprs arg)
+                       when (and (consp merged)
+                                 (eq op (car merged)))
+                       append (cdr merged)
+                       else collect merged))
+                (t (mapcar #'merge-exprs args))))))))
+
+(defun solve-24-game (digits)
+  "Generate a lisp form using the operators in +ops+ and the given
+digits which evaluates to 24.  The first form found is returned, or
+NIL if there is no solution."
+  (solvable-p digits))

Task/24-game-Solve/D/24-game-solve.d

@@ -0,0 +1,47 @@
+import std.stdio, std.algorithm, std.range, std.typecons, std.conv,
+       std.string, 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;
+
+    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;
+            }
+          }
+        }
+      }
+
+      return result;
+    }
+  }
+
+
+  foreach (p; problem.map!Rational.array.permutations)
+    foreach (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));
+}

Task/24-game-Solve/Euler-Math-Toolbox/24-game-solve-1.euler

@@ -0,0 +1,22 @@
+>function try24 (v) ...
+$n=cols(v);
+$if n==1 and v[1]~=24 then
+$  "Solved the problem",
+$  return 1;
+$endif
+$loop 1 to n
+$  w=tail(v,2);
+$  loop 1 to n-1
+$    h=w; a=v[1]; b=w[1];
+$    w[1]=a+b; if try24(w); ""+a+"+"+b+"="+(a+b), return 1; endif;
+$    w[1]=a-b; if try24(w); ""+a+"-"+b+"="+(a-b), return 1; endif;
+$    w[1]=a*b; if try24(w); ""+a+"*"+b+"="+(a*b), return 1; endif;
+$    if not b~=0 then
+$       w[1]=a/b; if try24(w); ""+a+"/"+b+"="+(a/b), return 1; endif;
+$    endif;
+$    w=rotright(w);
+$  end;
+$  v=rotright(v);
+$end;
+$return 0;
+$endfunction

Task/24-game-Solve/Euler-Math-Toolbox/24-game-solve-2.euler

@@ -0,0 +1,20 @@
+>try24([1,2,3,4]);
+ Solved the problem
+ 6*4=24
+ 3+3=6
+ 1+2=3
+>try24([8,7,7,1]);
+ Solved the problem
+ 22+2=24
+ 14+8=22
+ 7+7=14
+>try24([8,4,7,1]);
+ Solved the problem
+ 6*4=24
+ 7-1=6
+ 8-4=4
+>try24([3,4,5,6]);
+ Solved the problem
+ 4*6=24
+ -1+5=4
+ 3-4=-1

Task/24-game-Solve/Fortran/24-game-solve-1.f

@@ -0,0 +1,69 @@
+program solve_24
+  use helpers
+  implicit none
+  real                 :: vector(4), reals(4), p, q, r, s
+  integer              :: numbers(4), n, i, j, k, a, b, c, d
+  character, parameter :: ops(4) = (/ '+', '-', '*', '/' /)
+  logical              :: last
+  real,parameter       :: eps = epsilon(1.0)
+
+  do n=1,12
+    call random_number(vector)
+    reals   = 9 * vector + 1
+    numbers = int(reals)
+    call Insertion_Sort(numbers)
+
+    permutations: do
+      a = numbers(1); b = numbers(2); c = numbers(3); d = numbers(4)
+      reals = real(numbers)
+      p = reals(1);   q = reals(2);   r = reals(3);   s = reals(4)
+      ! combinations of operators:
+      do i=1,4
+        do j=1,4
+          do k=1,4
+            if      ( abs(op(op(op(p,i,q),j,r),k,s)-24.0) < eps ) then
+              write (*,*) numbers, ' : ', '((',a,ops(i),b,')',ops(j),c,')',ops(k),d
+              exit permutations
+            else if ( abs(op(op(p,i,op(q,j,r)),k,s)-24.0) < eps ) then
+              write (*,*) numbers, ' : ', '(',a,ops(i),'(',b,ops(j),c,'))',ops(k),d
+              exit permutations
+            else if ( abs(op(p,i,op(op(q,j,r),k,s))-24.0) < eps ) then
+              write (*,*) numbers, ' : ', a,ops(i),'((',b,ops(j),c,')',ops(k),d,')'
+              exit permutations
+            else if ( abs(op(p,i,op(q,j,op(r,k,s)))-24.0) < eps ) then
+              write (*,*) numbers, ' : ', a,ops(i),'(',b,ops(j),'(',c,ops(k),d,'))'
+              exit permutations
+            else if ( abs(op(op(p,i,q),j,op(r,k,s))-24.0) < eps ) then
+              write (*,*) numbers, ' : ', '(',a,ops(i),b,')',ops(j),'(',c,ops(k),d,')'
+              exit permutations
+            end if
+          end do
+        end do
+      end do
+      call nextpermutation(numbers,last)
+      if ( last ) then
+        write (*,*) numbers, ' : no solution.'
+        exit permutations
+      end if
+    end do permutations
+
+  end do
+
+contains
+
+  pure real function op(x,c,y)
+    integer, intent(in) :: c
+    real, intent(in)    :: x,y
+    select case ( ops(c) )
+      case ('+')
+        op = x+y
+      case ('-')
+        op = x-y
+      case ('*')
+        op = x*y
+      case ('/')
+        op = x/y
+    end select
+  end function op
+
+end program solve_24

Task/24-game-Solve/Fortran/24-game-solve-2.f

@@ -0,0 +1,72 @@
+module helpers
+
+contains
+
+  pure subroutine Insertion_Sort(a)
+    integer, intent(inout) :: a(:)
+    integer                :: temp, i, j
+    do i=2,size(a)
+      j = i-1
+      temp = a(i)
+      do while ( j>=1 .and. a(j)>temp )
+        a(j+1) = a(j)
+        j = j - 1
+      end do
+      a(j+1) = temp
+    end do
+  end subroutine Insertion_Sort
+
+  subroutine nextpermutation(perm,last)
+    integer, intent(inout) :: perm(:)
+    logical, intent(out)   :: last
+    integer :: k,l
+    k = largest1()
+    last = k == 0
+    if ( .not. last ) then
+      l = largest2(k)
+      call swap(l,k)
+      call reverse(k)
+    end if
+  contains
+    pure integer function largest1()
+      integer :: k, max
+      max = 0
+      do k=1,size(perm)-1
+        if ( perm(k) < perm(k+1) ) then
+          max = k
+        end if
+      end do
+      largest1 = max
+    end function largest1
+
+    pure integer function largest2(k)
+      integer, intent(in) :: k
+      integer             :: l, max
+      max = k+1
+      do l=k+2,size(perm)
+        if ( perm(k) < perm(l) ) then
+          max = l
+        end if
+      end do
+      largest2 = max
+    end function largest2
+
+    subroutine swap(l,k)
+      integer, intent(in) :: k,l
+      integer             :: temp
+      temp    = perm(k)
+      perm(k) = perm(l)
+      perm(l) = temp
+    end subroutine swap
+
+    subroutine reverse(k)
+      integer, intent(in) :: k
+      integer             :: i
+      do i=1,(size(perm)-k)/2
+        call swap(k+i,size(perm)+1-i)
+      end do
+    end subroutine reverse
+
+  end subroutine nextpermutation
+
+end module helpers

Task/24-game-Solve/GAP/24-game-solve.gap

@@ -0,0 +1,84 @@
+# Solution in '''RPN'''
+check := function(x, y, z)
+	local r, c, s, i, j, k, a, b, p;
+	i := 0;
+	j := 0;
+	k := 0;
+	s := [ ];
+	r := "";
+	for c in z do
+		if c = 'x' then
+			i := i + 1;
+			k := k + 1;
+			s[k] := x[i];
+			Append(r, String(x[i]));
+		else
+			j := j + 1;
+			b := s[k];
+			k := k - 1;
+			a := s[k];
+			p := y[j];
+			r[Size(r) + 1] := p;
+			if p = '+' then
+				a := a + b;
+			elif p = '-' then
+				a := a - b;
+			elif p = '*' then
+				a := a * b;
+			elif p = '/' then
+				if b = 0 then
+					continue;
+				else
+					a := a / b;
+				fi;
+			else
+				return fail;
+			fi;
+			s[k] := a;
+		fi;
+	od;
+	if s[1] = 24 then
+		return r;
+	else
+		return fail;
+	fi;
+end;
+	
+Player24 := function(digits)
+	local u, v, w, x, y, z, r;
+	u := PermutationsList(digits);
+	v := Tuples("+-*/", 3);
+	w := ["xx*x*x*", "xx*xx**", "xxx**x*", "xxx*x**", "xxxx***"];
+	for x in u do
+		for y in v do
+			for z in w do
+				r := check(x, y, z);
+				if r <> fail then
+					return r;
+				fi;
+			od;
+		od;
+	od;
+	return fail;
+end;
+
+Player24([1,2,7,7]);
+# "77*1-2/"
+Player24([9,8,7,6]);
+# "68*97-/"
+Player24([1,1,7,7]);
+# fail
+
+# Solutions with only one distinct digit are found only for 3, 4, 5, 6:
+Player24([3,3,3,3]);
+# "33*3*3-"
+Player24([4,4,4,4]);
+# "44*4+4+"
+Player24([5,5,5,5]);
+# "55*55/-"
+Player24([6,6,6,6]);
+# "66*66+-"
+
+# A tricky one:
+Player24([3,3,8,8]);
+"8383/-/"

Task/24-game-Solve/Go/24-game-solve.go

@@ -0,0 +1,171 @@
+package main
+
+import (
+	"fmt"
+	"math/rand"
+	"time"
+)
+
+const (
+	op_num = iota
+	op_add
+	op_sub
+	op_mul
+	op_div
+)
+
+type frac struct {
+	num, denom int
+}
+
+// Expression: can either be a single number, or a result of binary
+// operation from left and right node
+type Expr struct {
+	op          int
+	left, right *Expr
+	value       frac
+}
+
+var n_cards = 4
+var goal = 24
+var digit_range = 9
+
+func (x *Expr) String() string {
+	if x.op == op_num {
+		return fmt.Sprintf("%d", x.value.num)
+	}
+
+	var bl1, br1, bl2, br2, opstr string
+	switch {
+	case x.left.op == op_num:
+	case x.left.op >= x.op:
+	case x.left.op == op_add && x.op == op_sub:
+		bl1, br1 = "", ""
+	default:
+		bl1, br1 = "(", ")"
+	}
+
+	if x.right.op == op_num || x.op < x.right.op {
+		bl2, br2 = "", ""
+	} else {
+		bl2, br2 = "(", ")"
+	}
+
+	switch {
+	case x.op == op_add:
+		opstr = " + "
+	case x.op == op_sub:
+		opstr = " - "
+	case x.op == op_mul:
+		opstr = " * "
+	case x.op == op_div:
+		opstr = " / "
+	}
+
+	return bl1 + x.left.String() + br1 + opstr +
+		bl2 + x.right.String() + br2
+}
+
+func expr_eval(x *Expr) (f frac) {
+	if x.op == op_num {
+		return x.value
+	}
+
+	l, r := expr_eval(x.left), expr_eval(x.right)
+
+	switch {
+	case x.op == op_add:
+		f.num = l.num*r.denom + l.denom*r.num
+		f.denom = l.denom * r.denom
+		return
+
+	case x.op == op_sub:
+		f.num = l.num*r.denom - l.denom*r.num
+		f.denom = l.denom * r.denom
+		return
+
+	case x.op == op_mul:
+		f.num = l.num * r.num
+		f.denom = l.denom * r.denom
+		return
+
+	case x.op == op_div:
+		f.num = l.num * r.denom
+		f.denom = l.denom * r.num
+		return
+	}
+	return
+}
+
+func solve(ex_in []*Expr) bool {
+	// only one expression left, meaning all numbers are arranged into
+	// a binary tree, so evaluate and see if we get 24
+	if len(ex_in) == 1 {
+		f := expr_eval(ex_in[0])
+		if f.denom != 0 && f.num == f.denom*goal {
+			fmt.Println(ex_in[0].String())
+			return true
+		}
+		return false
+	}
+
+	var node Expr
+	ex := make([]*Expr, len(ex_in)-1)
+
+	// try to combine a pair of expressions into one, thus reduce
+	// the list length by 1, and recurse down
+	for i := range ex {
+		copy(ex[i:len(ex)], ex_in[i+1:len(ex_in)])
+
+		ex[i] = &node
+		for j := i + 1; j < len(ex_in); j++ {
+			node.left = ex_in[i]
+			node.right = ex_in[j]
+
+			// try all 4 operators
+			for o := op_add; o <= op_div; o++ {
+				node.op = o
+				if solve(ex) {
+					return true
+				}
+			}
+
+			// also - and / are not commutative, so swap arguments
+			node.left = ex_in[j]
+			node.right = ex_in[i]
+
+			node.op = op_sub
+			if solve(ex) {
+				return true
+			}
+
+			node.op = op_div
+			if solve(ex) {
+				return true
+			}
+
+			if j < len(ex) {
+				ex[j] = ex_in[j]
+			}
+		}
+		ex[i] = ex_in[i]
+	}
+	return false
+}
+
+func main() {
+	cards := make([]*Expr, n_cards)
+	rand.Seed(time.Now().Unix())
+
+	for k := 0; k < 10; k++ {
+		for i := 0; i < n_cards; i++ {
+			cards[i] = &Expr{op_num, nil, nil,
+				frac{rand.Intn(digit_range-1) + 1, 1}}
+			fmt.Printf(" %d", cards[i].value.num)
+		}
+		fmt.Print(":  ")
+		if !solve(cards) {
+			fmt.Println("No solution")
+		}
+	}
+}

Task/24-game-Solve/Gosu/24-game-solve.gosu

@@ -0,0 +1,110 @@
+uses java.lang.Integer
+uses java.lang.Double
+uses java.lang.System
+uses java.util.ArrayList
+uses java.util.LinkedList
+uses java.util.List
+uses java.util.Scanner
+uses java.util.Stack
+
+function permutations<T>( lst : List<T> ) : List<List<T>> {
+    if( lst.size() == 0 ) return {}
+    if( lst.size() == 1 ) return { lst }
+
+    var pivot = lst.get(lst.size()-1)
+
+    var sublist = new ArrayList<T>( lst )
+    sublist.remove( sublist.size() - 1 )
+
+    var subPerms = permutations( sublist )
+
+    var ret = new ArrayList<List<T>>()
+    for( x in subPerms ) {
+        for( e in x index i ) {
+            var next = new LinkedList<T>( x )
+            next.add( i, pivot )
+            ret.add( next )
+        }
+        x.add( pivot )
+        ret.add( x )
+    }
+    return ret
+}
+
+function readVals() : List<Integer> {
+    var line = new java.io.BufferedReader( new java.io.InputStreamReader( System.in ) ).readLine()
+    var scan = new Scanner( line )
+
+    var ret = new ArrayList<Integer>()
+    for( i in 0..3 ) {
+        var next = scan.nextInt()
+        if( 0 >= next || next >= 10 ) {
+            print( "Invalid entry: ${next}" )
+            return null
+        }
+        ret.add( next )
+    }
+    return ret
+}
+
+function getOp( i : int ) : char[] {
+    var ret = new char[3]
+    var ops = { '+', '-', '*', '/' }
+    ret[0] = ops[i / 16]
+    ret[1] = ops[(i / 4) % 4 ]
+    ret[2] = ops[i % 4 ]
+    return ret
+}
+
+function isSoln( nums : List<Integer>, ops : char[] ) : boolean {
+    var stk = new Stack<Double>()
+    for( n in nums ) {
+        stk.push( n )
+    }
+
+    for( c in ops ) {
+        var r = stk.pop().doubleValue()
+        var l = stk.pop().doubleValue()
+        if( c == '+' ) {
+            stk.push( l + r )
+        } else if( c == '-' ) {
+            stk.push( l - r )
+        } else if( c == '*' ) {
+            stk.push( l * r )
+        } else if( c == '/' ) {
+            // Avoid division by 0
+            if( r == 0.0 ) {
+                return false
+            }
+            stk.push( l / r )
+        }
+    }
+
+    return java.lang.Math.abs( stk.pop().doubleValue() - 24.0 ) < 0.001
+}
+
+function printSoln( nums : List<Integer>, ops : char[] ) {
+    // RPN: a b c d + - *
+    // Infix (a * (b - (c + d)))
+    print( "Found soln: (${nums.get(0)} ${ops[0]} (${nums.get(1)} ${ops[1]} (${nums.get(2)} ${ops[2]} ${nums.get(3)})))" )
+}
+
+System.out.print( "#> " )
+var vals = readVals()
+
+var opPerms = 0..63
+var solnFound = false
+
+for( i in permutations( vals ) ) {
+    for( j in opPerms ) {
+        var opList = getOp( j )
+        if( isSoln( i, opList ) ) {
+            printSoln( i, opList )
+            solnFound = true
+        }
+    }
+}
+
+if( ! solnFound ) {
+    print( "No solution!" )
+}

Task/24-game-Solve/Haskell/24-game-solve-1.hs

@@ -0,0 +1,50 @@
+import Data.List
+import Data.Ratio
+import Control.Monad
+import System.Environment (getArgs)
+
+data Expr = Constant Rational |
+    Expr :+ Expr | Expr :- Expr |
+    Expr :* Expr | Expr :/ Expr
+    deriving (Eq)
+
+ops = [(:+), (:-), (:*), (:/)]
+
+instance Show Expr where
+    show (Constant x) = show $ numerator x
+      -- In this program, we need only print integers.
+    show (a :+ b)     = strexp "+" a b
+    show (a :- b)     = strexp "-" a b
+    show (a :* b)     = strexp "*" a b
+    show (a :/ b)     = strexp "/" a b
+
+strexp :: String -> Expr -> Expr -> String
+strexp op a b = "(" ++ show a ++ " " ++ op ++ " " ++ show b ++ ")"
+
+templates :: [[Expr] -> Expr]
+templates = do
+    op1 <- ops
+    op2 <- ops
+    op3 <- ops
+    [\[a, b, c, d] -> op1 a $ op2 b $ op3 c d,
+     \[a, b, c, d] -> op1 (op2 a b) $ op3 c d,
+     \[a, b, c, d] -> op1 a $ op2 (op3 b c) d,
+     \[a, b, c, d] -> op1 (op2 a $ op3 b c) d,
+     \[a, b, c, d] -> op1 (op2 (op3 a b) c) d]
+
+eval :: Expr -> Maybe Rational
+eval (Constant c) = Just c
+eval (a :+ b)     = liftM2 (+) (eval a) (eval b)
+eval (a :- b)     = liftM2 (-) (eval a) (eval b)
+eval (a :* b)     = liftM2 (*) (eval a) (eval b)
+eval (a :/ b)     = do
+    denom <- eval b
+    guard $ denom /= 0
+    liftM (/ denom) $ eval a
+
+solve :: Rational -> [Rational] -> [Expr]
+solve target r4 = filter (maybe False (== target) . eval) $
+    liftM2 ($) templates $
+    nub $ permutations $ map Constant r4
+
+main = getArgs >>= mapM_ print . solve 24 . map (toEnum . read)

Task/24-game-Solve/Haskell/24-game-solve-2.hs

@@ -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

Task/24-game-Solve/J/24-game-solve.j

@@ -0,0 +1,9 @@
+perm=: (A.&i.~ !) 4
+ops=: ' ',.'+-*%' {~ >,{i.each 4 4 4
+cmask=: 1 + 0j1 * i.@{:@$@[ e. ]
+left=:  [ #!.'('~"1 cmask
+right=: [ #!.')'~"1 cmask
+paren=: 2 :'[: left&m right&n'
+parens=: ], 0 paren 3, 0 paren 5, 2 paren 5, [: 0 paren 7 (0 paren 3)
+all=: [: parens [:,/ ops ,@,."1/ perm { [:;":each
+answer=: ({.@#~ 24 = ".)@all

Task/24-game-Solve/JavaScript/24-game-solve.js

@@ -0,0 +1,104 @@
+var ar=[],order=[0,1,2],op=[],val=[];
+var NOVAL=9999,oper="+-*/",out;
+
+function rnd(n){return Math.floor(Math.random()*n)}
+
+function say(s){
+ try{document.write(s+"<br>")}
+ catch(e){WScript.Echo(s)}
+}
+
+function getvalue(x,dir){
+ var r=NOVAL;
+ if(dir>0)++x;
+ while(1){
+  if(val[x]!=NOVAL){
+   r=val[x];
+   val[x]=NOVAL;
+   break;
+  }
+  x+=dir;
+ }
+ return r*1;
+}
+
+function calc(){
+ var c=0,l,r,x;
+ val=ar.join('/').split('/');
+ while(c<3){
+  x=order[c];
+  l=getvalue(x,-1);
+  r=getvalue(x,1);
+  switch(op[x]){
+   case 0:val[x]=l+r;break;
+   case 1:val[x]=l-r;break;
+   case 2:val[x]=l*r;break;
+   case 3:
+   if(!r||l%r)return 0;
+   val[x]=l/r;
+  }
+  ++c;
+ }
+ return getvalue(-1,1);
+}
+
+function shuffle(s,n){
+ var x=n,p=eval(s),r,t;
+ while(x--){
+  r=rnd(n);
+  t=p[x];
+  p[x]=p[r];
+  p[r]=t;
+ }
+}
+
+function parenth(n){
+ while(n>0)--n,out+='(';
+ while(n<0)++n,out+=')';
+}
+
+function getpriority(x){
+ for(var z=3;z--;)if(order[z]==x)return 3-z;
+ return 0;
+}
+
+function showsolution(){
+ var x=0,p=0,lp=0,v=0;
+ while(x<4){
+  if(x<3){
+   lp=p;
+   p=getpriority(x);
+   v=p-lp;
+   if(v>0)parenth(v);
+  }
+  out+=ar[x];
+  if(x<3){
+   if(v<0)parenth(v);
+   out+=oper.charAt(op[x]);
+  }
+  ++x;
+ }
+ parenth(-p);
+ say(out);
+}
+
+function solve24(s){
+ var z=4,r;
+ while(z--)ar[z]=s.charCodeAt(z)-48;
+ out="";
+ for(z=100000;z--;){
+  r=rnd(256);
+  op[0]=r&3;
+  op[1]=(r>>2)&3;
+  op[2]=(r>>4)&3;
+  shuffle("ar",4);
+  shuffle("order",3);
+  if(calc()!=24)continue;
+  showsolution();
+  break;
+ }
+}
+
+solve24("1234");
+solve24("6789");
+solve24("1127");

Task/24-game-Solve/Liberty-BASIC/24-game-solve.liberty

@@ -0,0 +1,123 @@
+dim d(4)
+input "Enter 4 digits: "; a$
+nD=0
+for i =1 to len(a$)
+    c$=mid$(a$,i,1)
+    if instr("123456789",c$) then
+        nD=nD+1
+        d(nD)=val(c$)
+    end if
+next
+'for i = 1 to 4
+'    print d(i);
+'next
+
+'precompute permutations. Dumb way.
+nPerm = 1*2*3*4
+dim perm(nPerm, 4)
+n = 0
+for i = 1 to 4
+    for j = 1 to 4
+        for k = 1 to 4
+            for l = 1 to 4
+            'valid permutation (no dupes?)
+                if i<>j and i<>k and i<>l _
+                    and j<>k and j<>l _
+                        and k<>l then
+                    n=n+1
+                    '
+'                    perm(n,1)=i
+'                    perm(n,2)=j
+'                    perm(n,3)=k
+'                    perm(n,4)=l
+                    'actually, we can as well permute given digits
+                    perm(n,1)=d(i)
+                    perm(n,2)=d(j)
+                    perm(n,3)=d(k)
+                    perm(n,4)=d(l)
+                end if
+            next
+        next
+    next
+next
+'check if permutations look OK. They are
+'for i =1 to n
+'    print i,
+'    for j =1 to 4: print perm(i,j);:next
+'    print
+'next
+
+'possible brackets
+NBrackets = 11
+dim Brakets$(NBrackets)
+DATA "4#4#4#4"
+DATA "(4#4)#4#4"
+DATA "4#(4#4)#4"
+DATA "4#4#(4#4)"
+DATA "(4#4)#(4#4)"
+DATA "(4#4#4)#4"
+DATA "4#(4#4#4)"
+DATA "((4#4)#4)#4"
+DATA "(4#(4#4))#4"
+DATA "4#((4#4)#4)"
+DATA "4#(4#(4#4))"
+for i = 1 to NBrackets
+    read Tmpl$: Brakets$(i) = Tmpl$
+next
+
+'operations: full search
+count = 0
+Ops$="+ - * /"
+dim Op$(3)
+For op1=1 to 4
+    Op$(1)=word$(Ops$,op1)
+    For op2=1 to 4
+        Op$(2)=word$(Ops$,op2)
+        For op3=1 to 4
+            Op$(3)=word$(Ops$,op3)
+            'print "*"
+            'substitute all brackets
+            for t = 1 to NBrackets
+                Tmpl$=Brakets$(t)
+                'print , Tmpl$
+                'now, substitute all digits: permutations.
+                for p = 1 to nPerm
+                    res$= ""
+                    nOp=0
+                    nD=0
+                    for i = 1 to len(Tmpl$)
+                        c$ = mid$(Tmpl$, i, 1)
+                        select case c$
+                        case "#"                'operations
+                            nOp = nOp+1
+                            res$ = res$+Op$(nOp)
+                        case "4"                'digits
+                            nD = nOp+1
+                            res$ = res$; perm(p,nD)
+                        case else               'brackets goes here
+                            res$ = res$+ c$
+                        end select
+                    next
+                    'print,, res$
+                    'eval here
+                    if evalWithErrCheck(res$) = 24 then
+                        print "24 = ";res$
+                        end 'comment it out if you want to see all versions
+                    end if
+                    count = count + 1
+                next
+            next
+        Next
+    Next
+next
+
+print "If you see this, probably task cannot be solved with these digits"
+'print count
+end
+
+function evalWithErrCheck(expr$)
+    on error goto [handler]
+    evalWithErrCheck=eval(expr$)
+    exit function
+[handler]
+end function

Task/24-game-Solve/Lua/24-game-solve.lua

@@ -0,0 +1,74 @@
+local SIZE = #arg[1]
+local GOAL = tonumber(arg[2]) or 24
+
+local input = {}
+for v in arg[1]:gmatch("%d") do
+	table.insert(input, v)
+end
+assert(#input == SIZE, 'Invalid input')
+
+local operations = {'+', '-', '*', '/'}
+
+local function BinaryTrees(vert)
+	if vert == 0 then
+		return {false}
+	else
+		local buf = {}
+		for leften = 0, vert - 1 do
+			local righten = vert - leften - 1
+			for _, left in pairs(BinaryTrees(leften)) do
+				for _, right in pairs(BinaryTrees(righten)) do
+					table.insert(buf, {left, right})
+				end
+			end
+		end
+		return buf
+	end
+end
+local trees = BinaryTrees(SIZE-1)
+local c, opc, oper, str
+local max = math.pow(#operations, SIZE-1)
+local function op(a,b)
+	opc = opc + 1
+	local i = math.floor(oper/math.pow(#operations, opc-1))%#operations+1
+	return '('.. a .. operations[i] .. b ..')'
+end
+
+local function EvalTree(tree)
+	if tree == false then
+		c = c + 1
+		return input[c-1]
+	else
+		return op(EvalTree(tree[1]), EvalTree(tree[2]))
+	end
+end
+
+local function printResult()
+	for _, v in ipairs(trees) do
+		for i = 0, max do
+			c, opc, oper = 1, 0, i
+			str = EvalTree(v)
+			loadstring('res='..str)()
+			if(res == GOAL) then print(str, '=', res) end
+		end
+	end
+end
+
+local uniq = {}
+local function permgen (a, n)
+	if n == 0 then
+		local str = table.concat(a)
+		if not uniq[str] then
+			printResult()
+			uniq[str] = true
+		end
+	else
+		for i = 1, n do
+			a[n], a[i] = a[i], a[n]
+			permgen(a, n - 1)
+			a[n], a[i] = a[i], a[n]
+		end
+	end
+end
+
+permgen(input, SIZE)

Task/24-game-Solve/Mathematica/24-game-solve-1.mathematica

@@ -0,0 +1,16 @@
+treeR[n_] := Table[o[trees[a], trees[n - a]], {a, 1, n - 1}]
+treeR[1] := n
+tree[n_] :=
+ Flatten[treeR[n] //. {o[a_List, b_] :> (o[#, b] & /@ a),
+    o[a_, b_List] :> (o[a, #] & /@ b)}]
+game24play[val_List] :=
+ Union[StringReplace[StringTake[ToString[#, InputForm], {10, -2}],
+     "-1*" ~~ n_ :> "-" <> n] & /@ (HoldForm /@
+      Select[Union@
+        Flatten[Outer[# /. {o[q_Integer] :> #2[[q]],
+             n[q_] :> #3[[q]]} &,
+          Block[{O = 1, N = 1}, # /. {o :> o[O++], n :> n[N++]}] & /@
+           tree[4], Tuples[{Plus, Subtract, Times, Divide}, 3],
+          Permutations[Array[v, 4]], 1]],
+       Quiet[(# /. v[q_] :> val[[q]]) == 24] &] /.
+     Table[v[q] -> val[[q]], {q, 4}])]

Task/24-game-Solve/Mathematica/24-game-solve-2.mathematica

@@ -0,0 +1 @@
+game24play[RandomInteger[{1, 9}, 4]]

Task/24-game-Solve/Perl/24-game-solve.pl

@@ -0,0 +1,54 @@
+# Fischer-Krause ordered permutation generator
+# http://faq.perl.org/perlfaq4.html#How_do_I_permute_N_e
+sub permute (&@) {
+		my $code = shift;
+		my @idx = 0..$#_;
+		while ( $code->(@_[@idx]) ) {
+			my $p = $#idx;
+			--$p while $idx[$p-1] > $idx[$p];
+			my $q = $p or return;
+			push @idx, reverse splice @idx, $p;
+			++$q while $idx[$p-1] > $idx[$q];
+			@idx[$p-1,$q]=@idx[$q,$p-1];
+		}
+	}
+
+@formats = (
+	'((%d %s %d) %s %d) %s %d',
+	'(%d %s (%d %s %d)) %s %d',
+	'(%d %s %d) %s (%d %s %d)',
+	'%d %s ((%d %s %d) %s %d)',
+	'%d %s (%d %s (%d %s %d))',
+	);
+
+# generate all possible combinations of operators
+@op = qw( + - * / );
+@operators = map{ $a=$_; map{ $b=$_; map{ "$a $b $_" }@op }@op }@op;
+
+while(1)
+{
+	print "Enter four integers or 'q' to exit: ";
+	chomp($ent = <>);
+	last if $ent eq 'q';
+
+	
+	if($ent !~ /^[1-9] [1-9] [1-9] [1-9]$/){ print "invalid input\n"; next }
+
+	@n = split / /,$ent;
+	permute { push @numbers,join ' ',@_ }@n;
+
+	for $format (@formats)
+	{
+		for(@numbers)
+		{
+			@n = split;
+			for(@operators)
+			{
+				@o = split;
+				$str = sprintf $format,$n[0],$o[0],$n[1],$o[1],$n[2],$o[2],$n[3];
+				$r = eval($str);
+				print "$str\n" if $r == 24;
+			}
+		}
+	}
+}

Task/24-game-Solve/PicoLisp/24-game-solve.l

@@ -0,0 +1,18 @@
+(be play24 (@Lst @Expr)                # Define Pilog rule
+   (permute @Lst (@A @B @C @D))
+   (member @Op1 (+ - * /))
+   (member @Op2 (+ - * /))
+   (member @Op3 (+ - * /))
+   (or
+      ((equal @Expr (@Op1 (@Op2 @A @B) (@Op3 @C @D))))
+      ((equal @Expr (@Op1 @A (@Op2 @B (@Op3 @C @D))))) )
+   (@ = 24 (catch '("Div/0") (eval (-> @Expr)))) )
+
+(de play24 (A B C D)                   # Define PicoLisp function
+   (pilog
+      (quote
+         @L (list A B C D)
+         (play24 @L @X) )
+      (println @X) ) )
+
+(play24 5 6 7 8)                       # Call 'play24' function

Task/24-game-Solve/Prolog/24-game-solve.pro

@@ -0,0 +1,91 @@
+play24(Len, Range, Goal) :-
+	game(Len, Range, Goal, L, S),
+	maplist(my_write, L),
+	format(': ~w~n', [S]).
+
+game(Len, Range, Value, L, S) :-
+	length(L, Len),
+	maplist(choose(Range), L),
+	compute(L, Value, [], S).
+
+
+choose(Range, V) :-
+	V is random(Range) + 1.
+
+
+write_tree([M], [M]).
+
+write_tree([+, M, N], S) :-
+	write_tree(M, MS),
+	write_tree(N, NS),
+	append(MS, [+ | NS], S).
+
+write_tree([-, M, N], S) :-
+	write_tree(M, MS),
+	write_tree(N, NS),
+	(   is_add(N) -> append(MS, [-, '(' | NS], Temp), append(Temp, ')', S)
+	;   append(MS, [- | NS], S)).
+
+
+write_tree([Op, M, N], S) :-
+	member(Op, [*, /]),
+	write_tree(M, MS),
+	write_tree(N, NS),
+	(   is_add(M) -> append(['(' | MS], [')'], TempM)
+	;  TempM = MS),
+	(   is_add(N) -> append(['(' | NS], [')'], TempN)
+	;   TempN = NS),
+	append(TempM, [Op | TempN], S).
+
+is_add([Op, _, _]) :-
+	member(Op, [+, -]).
+
+compute([Value], Value, [[_R-S1]], S) :-
+	write_tree(S1, S2),
+	with_output_to(atom(S), maplist(write, S2)).
+
+compute(L, Value, CS, S) :-
+	select(M, L, L1),
+	select(N, L1, L2),
+	next_value(M, N, R, CS, Expr),
+	compute([R|L2], Value, Expr, S).
+
+next_value(M, N, R, CS,[[R - [+, M1, N1]] | CS2]) :-
+	R is M+N,
+	(   member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM
+	;   M1 = [M], CS1 = CS
+	),
+	(   member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN
+	;   N1 = [N], CS2 = CS1
+	).
+
+next_value(M, N, R, CS,[[R - [-, M1, N1]] | CS2]) :-
+	R is M-N,
+	(   member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM
+	;   M1 = [M], CS1 = CS
+	),
+	(   member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN
+	;   N1 = [N], CS2 = CS1
+	).
+
+next_value(M, N, R, CS,[[R - [*, M1, N1]] | CS2]) :-
+	R is M*N,
+	(   member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM
+	;   M1 = [M], CS1 = CS
+	),
+	(   member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN
+	;   N1 = [N], CS2 = CS1
+	).
+
+next_value(M, N, R, CS,[[R - [/, M1, N1]] | CS2]) :-
+	N \= 0,
+	R is rdiv(M,N),
+	(   member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM
+	;   M1 = [M], CS1 = CS
+	),
+	(   member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN
+	;   N1 = [N], CS2 = CS1
+	).
+
+my_write(V) :-
+	format('~w ', [V]).

Task/24-game-Solve/Python/24-game-solve.py

@@ -0,0 +1,159 @@
+'''
+ The 24 Game Player
+
+ 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.
+
+ An answer of "q"  will quit the game.
+ An answer of "!"  will generate a new set of four digits.
+ An answer of "!!" will ask you for a new set of four digits.
+ An answer of "?"  will compute an expression for the current 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.
+
+'''
+
+from   __future__ import division, print_function
+from   itertools  import permutations, combinations, product, \
+                         chain
+from   pprint     import pprint as pp
+from   fractions  import Fraction as F
+import random, ast, re
+import sys
+
+if sys.version_info[0] < 3:
+    input = raw_input
+    from itertools import izip_longest as zip_longest
+else:
+    from itertools import zip_longest
+
+
+def choose4():
+    'four random digits >0 as characters'
+    return [str(random.randint(1,9)) for i in range(4)]
+
+def ask4():
+    'get four random digits >0 from the player'
+    digits = ''
+    while len(digits) != 4 or not all(d in '123456789' for d in digits):
+        digits = input('Enter the digits to solve for: ')
+        digits = ''.join(digits.strip().split())
+    return list(digits)
+
+def welcome(digits):
+    print (__doc__)
+    print ("Your four digits: " + ' '.join(digits))
+
+def check(answer, digits):
+    allowed = set('() +-*/\t'+''.join(digits))
+    ok = all(ch in allowed for ch in answer) and \
+         all(digits.count(dig) == answer.count(dig) for dig in set(digits)) \
+         and not re.search('\d\d', answer)
+    if ok:
+        try:
+            ast.parse(answer)
+        except:
+            ok = False
+    return ok
+
+def solve(digits):
+    """\
+    >>> for digits in '3246 4788 1111 123456 1127 3838'.split():
+            solve(list(digits))
+
+
+    Solution found: 2 + 3 * 6 + 4
+    '2 + 3 * 6 + 4'
+    Solution found: ( 4 + 7 - 8 ) * 8
+    '( 4 + 7 - 8 ) * 8'
+    No solution found for: 1 1 1 1
+    '!'
+    Solution found: 1 + 2 + 3 * ( 4 + 5 ) - 6
+    '1 + 2 + 3 * ( 4 + 5 ) - 6'
+    Solution found: ( 1 + 2 ) * ( 1 + 7 )
+    '( 1 + 2 ) * ( 1 + 7 )'
+    Solution found: 8 / ( 3 - 8 / 3 )
+    '8 / ( 3 - 8 / 3 )'
+    >>> """
+    digilen = len(digits)
+    # length of an exp without brackets
+    exprlen = 2 * digilen - 1
+    # permute all the digits
+    digiperm = sorted(set(permutations(digits)))
+    # All the possible operator combinations
+    opcomb   = list(product('+-*/', repeat=digilen-1))
+    # All the bracket insertion points:
+    brackets = ( [()] + [(x,y)
+                         for x in range(0, exprlen, 2)
+                         for y in range(x+4, exprlen+2, 2)
+                         if (x,y) != (0,exprlen+1)]
+                 + [(0, 3+1, 4+2, 7+3)] ) # double brackets case
+    for d in digiperm:
+        for ops in opcomb:
+            if '/' in ops:
+                d2 = [('F(%s)' % i) for i in d] # Use Fractions for accuracy
+            else:
+                d2 = d
+            ex = list(chain.from_iterable(zip_longest(d2, ops, fillvalue='')))
+            for b in brackets:
+                exp = ex[::]
+                for insertpoint, bracket in zip(b, '()'*(len(b)//2)):
+                    exp.insert(insertpoint, bracket)
+                txt = ''.join(exp)
+                try:
+                    num = eval(txt)
+                except ZeroDivisionError:
+                    continue
+                if num == 24:
+                    if '/' in ops:
+                        exp = [ (term if not term.startswith('F(') else term[2])
+                               for term in exp ]
+                    ans = ' '.join(exp).rstrip()
+                    print ("Solution found:",ans)
+                    return ans
+    print ("No solution found for:", ' '.join(digits))
+    return '!'
+
+def main():
+    digits = choose4()
+    welcome(digits)
+    trial = 0
+    answer = ''
+    chk = ans = False
+    while not (chk and ans == 24):
+        trial +=1
+        answer = input("Expression %i: " % trial)
+        chk = check(answer, digits)
+        if answer == '?':
+            solve(digits)
+            answer = '!'
+        if answer.lower() == 'q':
+            break
+        if answer == '!':
+            digits = choose4()
+            trial = 0
+            print ("\nNew digits:", ' '.join(digits))
+            continue
+        if answer == '!!':
+            digits = ask4()
+            trial = 0
+            print ("\nNew digits:", ' '.join(digits))
+            continue
+        if not chk:
+            print ("The input '%s' was wonky!" % answer)
+        else:
+            if '/' in answer:
+                # Use Fractions for accuracy in divisions
+                answer = ''.join( (('F(%s)' % char) if char in '123456789' else char)
+                                  for char in answer )
+            ans = eval(answer)
+            print (" = ", ans)
+            if ans == 24:
+                print ("Thats right!")
+    print ("Thank you and goodbye")
+
+main()

Task/24-game-Solve/R/24-game-solve-1.r

@@ -0,0 +1,34 @@
+library(gtools)
+
+solve24 <- function(vals=c(8, 4, 2, 1),
+                    goal=24,
+                    ops=c("+", "-", "*", "/")) {
+
+  val.perms <- as.data.frame(t(
+                  permutations(length(vals), length(vals))))
+
+  nop <- length(vals)-1
+  op.perms <- as.data.frame(t(
+                  do.call(expand.grid,
+                          replicate(nop, list(ops)))))
+
+  ord.perms <- as.data.frame(t(
+                   do.call(expand.grid,
+                           replicate(n <- nop, 1:((n <<- n-1)+1)))))
+
+  for (val.perm in val.perms)
+    for (op.perm in op.perms)
+      for (ord.perm in ord.perms)
+        {
+          expr <- as.list(vals[val.perm])
+          for (i in 1:nop) {
+            expr[[ ord.perm[i] ]] <- call(as.character(op.perm[i]),
+                                          expr[[ ord.perm[i]   ]],
+                                          expr[[ ord.perm[i]+1 ]])
+            expr <- expr[ -(ord.perm[i]+1) ]
+          }
+          if (identical(eval(expr[[1]]), goal)) return(expr[[1]])
+        }
+
+  return(NA)
+}

Task/24-game-Solve/R/24-game-solve-2.r

@@ -0,0 +1,12 @@
+> solve24()
+8 * (4 - 2 + 1)
+> solve24(c(6,7,9,5))
+6 + (7 - 5) * 9
+> solve24(c(8,8,8,8))
+[1] NA
+> solve24(goal=49) #different goal value
+8 * (4 + 2) + 1
+> solve24(goal=52) #no solution
+[1] NA
+> solve24(ops=c('-', '/')) #restricted set of operators
+(8 - 2)/(1/4)

Task/24-game-Solve/REXX/24-game-solve.rexx

@@ -0,0 +1,99 @@
+/*REXX program to help the user find solutions to the game of  24.      */
+/* ┌──────────────────────────────────────────────────────────────────┐
+   │ Argument is either of two forms:     ssss    ==or==   ssss-ffff  │
+   │                                                                  │
+   │ where one or both strings must be exactly four numerals (digits) │
+   │ comprised soley of the numerals (digits)  1 ──> 9   (no zeroes). │
+   │                                                                  │
+   │ In    SSSS-FFFF           SSSS  is the start,                    │
+   │                           FFFF  is the start.                    │
+   └──────────────────────────────────────────────────────────────────┘ */
+parse arg orig                   /*get the  guess  from the argument.   */
+parse var orig start '-' finish  /*get the start and finish  (maybe).   */
+start=space(start,0)             /*remove any blanks from the  START.   */
+finish=space(finish,0)           /*remove any blanks from the  FINISH.  */
+finish=word(finish start,1)      /*if no  FINISH  specified, use  START.*/
+digs=123456789                   /*numerals (digits) that can be used.  */
+call validate start
+call validate finish
+opers='+-*/'                     /*define the legal arithmetic operators*/
+ops=length(opers)                /* ... and the count of them (length). */
+         do j=1 for ops          /*define a version for fast execution. */
+         o.j=substr(opers,j,1)
+         end   /*j*/
+finds=0                          /*number of found solutions (so far).  */
+x.=0                             /*a method to hold unique expressions. */
+indent=left('',30)               /*used to indent display of solutions. */
+                                 /*alternative:  indent=copies(' ',30)  */
+Lpar='('                         /*a string to make REXX code prettier. */
+Rpar=')'                         /*ditto.                               */
+
+  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.*/
+          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. */
+            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 heavy lifting.*/
+            if x.e then iterate  /*was the expression already used?     */
+            x.e=1                /*mark this expression as unique.      */
+                                 /*have REXX do the heavy lifting (ugh).*/
+            interpret 'x=' e     /*... strain...                        */
+            x=x/1                /*remove trailing decimal points(maybe)*/
+            if x\==24 then iterate        /*Not correct?  Try again.    */
+            finds=finds+1        /*bump number of found solutions.      */
+            _=translate(origE, '][', ")(")     /*show  [],  not  ().    */
+            say indent 'a solution:' _         /*display a solution.    */
+            end   /*n*/
+          end     /*m*/
+        end       /*k*/
+      end         /*j*/
+    end           /*i*/
+  end             /*g*/
+
+sols=finds
+if sols==0 then sols='No'        /*make the sentence not so geek-like.  */
+say;   say sols 'unique solution's(finds) "found for" orig  /*pluralize.*/
+exit
+/*───────────────────────────DIV subroutine─────────────────────────────*/
+div: procedure;   parse arg q    /*tests if dividing by  0  (zero).     */
+if q=0 then q=1e9                /*if dividing by zero, change divisor. */
+return q                         /*changing Q invalidates the expression*/
+/*───────────────────────────GER subroutine─────────────────────────────*/
+ger:  say;     say '*** error! ***';     if _\=='' then say 'guess=' _
+say arg(1);     say;      exit 13
+/*───────────────────────────S subroutine───────────────────────────────*/
+s: if arg(1)==1 then return '';   return 's'        /*simple pluralizer.*/
+/*───────────────────────────validate subroutine────────────────────────*/
+validate: parse arg y;   errCode=0;   _v=verify(y,digs)
+    select
+    when y==''        then call ger 'no digits entered.'
+    when length(y)<4  then call ger 'not enough digits entered, must be 4'
+    when length(y)>4  then call ger 'too many digits entered, must be 4'
+    when pos(0,y)\==0 then call ger "can't use the digit  0 (zero)"
+    when _v\==0       then call ger 'illegal character:' substr(y,_v,1)
+    otherwise nop
+    end    /*select*/
+return \errCode

Task/24-game-Solve/Ruby/24-game-solve.rb

@@ -0,0 +1,57 @@
+require 'rational'
+
+class TwentyFourGamePlayer
+  EXPRESSIONS = [
+    '((%d %s %d) %s %d) %s %d',
+    '(%d %s (%d %s %d)) %s %d',
+    '(%d %s %d) %s (%d %s %d)',
+    '%d %s ((%d %s %d) %s %d)',
+    '%d %s (%d %s (%d %s %d))',
+  ]
+  OPERATORS = [:+, :-, :*, :/]
+
+  @@objective = Rational(24,1)
+
+  def initialize(digits)
+    @digits = digits
+    @solutions = []
+    solve
+  end
+
+  attr_reader :digits, :solutions
+
+  def solve
+    digits.permutation.to_a.uniq.each do |a,b,c,d|
+      OPERATORS.each   do |op1|
+      OPERATORS.each   do |op2|
+      OPERATORS.each   do |op3|
+      EXPRESSIONS.each do |expr|
+        # evaluate using rational arithmetic
+        test = expr.gsub('%d', 'Rational(%d,1)') % [a, op1, b, op2, c, op3, d]
+        value = eval(test) rescue -1  # catch division by zero
+        if value == @@objective
+          @solutions << expr % [a, op1, b, op2, c, op3, d]
+        end
+      end;end;end;end
+    end
+  end
+
+end
+
+# validate user input
+digits = ARGV.map do |arg|
+  begin
+    Integer(arg)
+  rescue ArgumentError
+    raise "error: not an integer: '#{arg}'"
+  end
+end
+digits.size == 4 or raise "error: need 4 digits, only have #{digits.size}"
+
+player = TwentyFourGamePlayer.new(digits)
+if player.solutions.empty?
+  puts "no solutions"
+else
+  puts "found #{player.solutions.size} solutions, including #{player.solutions.first}"
+  puts player.solutions.sort.join("\n")
+end

Task/24-game-Solve/Scala/24-game-solve.scala

@@ -0,0 +1,25 @@
+def permute(l: List[Double]): List[List[Double]] = l match {
+  case Nil => List(Nil)
+  case x :: xs =>
+    for {
+      ys <- permute(xs)
+      position <- 0 to ys.length
+      (left, right) = ys splitAt position
+    } yield left ::: (x :: right)
+}
+
+def computeAllOperations(l: List[Double]): List[(Double,String)] = l match {
+  case Nil => Nil
+  case x :: Nil => List((x, "%1.0f" format x))
+  case x :: xs =>
+    for {
+      (y, ops) <- computeAllOperations(xs)
+      (z, op) <-
+        if (y == 0)
+          List((x*y, "*"), (x+y, "+"), (x-y, "-"))
+        else
+          List((x*y, "*"), (x/y, "/"), (x+y, "+"), (x-y, "-"))
+    } yield (z, "(%1.0f%s%s)" format (x,op,ops))
+}
+
+def hasSolution(l: List[Double]) = permute(l) flatMap computeAllOperations filter (_._1 == 24) map (_._2)

Task/24-game-Solve/Tcl/24-game-solve.tcl

@@ -0,0 +1,62 @@
+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))}
+}
+# Encoding the various permutations of digits
+set permutations [struct::list map [struct::list permutations {a b c d}] \
+        {apply {v {lassign $v a b c d; list A $a B $b C $c D $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.
+proc find24GameSolutions {values} {
+    global operations patterns permutations
+    set found {}
+    # For each possible structure with numbers at the leaves...
+    foreach pattern $patterns {
+	foreach permutation $permutations {
+	    set p [string map [subst {
+		a [lindex $values 0].0
+		b [lindex $values 1].0
+		c [lindex $values 2].0
+		d [lindex $values 3].0
+	    }] [string map $permutation $pattern]]
+
+            # For each possible structure with operators at the branches...
+	    foreach x $operations {
+		foreach y $operations {
+		    foreach z $operations {
+			set e [string map [subst {x $x y $y z $z}] $p]
+
+			# Try to evaluate (div-zero is an issue!) and add it to
+			# the result if it is 24
+			catch {
+			    if {[expr $e] == 24.0} {
+				lappend found [string map {.0 {}} $e]
+			    }
+			}
+		    }
+		}
+	    }
+	}
+    }
+    return $found
+}
+
+# Wrap the solution finder into a player
+proc print24GameSolutionFor {values} {
+    set found [lsort -unique [find24GameSolutions $values]]
+    if {![llength $found]} {
+	puts "No solution possible"
+    } else {
+	puts "Total [llength $found] solutions (may include logical duplicates)"
+        puts "First solution: [lindex $found 0]"
+    }
+}
+print24GameSolutionFor $argv

Task/24-game/Falcon/24-game.falcon

@@ -0,0 +1,71 @@
+load compiler
+
+function genRandomNumbers( amount )
+  rtn = []
+  for i in [ 0 : amount ]: rtn += random( 1, 9 )
+  return( rtn )
+end
+
+function getAnswer( exp )
+  ic = ICompiler()
+  ic.compileAll(exp)
+
+  return( ic.result )
+end
+
+function validInput( str )
+  for i in [ 0 : str.len() ]
+    if str[i] notin ' ()[]0123456789-+/*'
+      > 'INVALID Character = ', str[i]
+      return( false )
+    end
+  end
+
+  return( true )
+end
+
+printl('
+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.
+
+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
+
+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.
+')
+
+num = genRandomNumbers( 4 )
+
+while( true )
+
+  >>  "Here are the numbers to choose from: "
+  map({ a => print(a, " ") }, num)
+  >
+
+  exp = input()
+
+  switch exp
+    case "q", "Q"
+      exit()
+
+    case "!"
+      > 'Generating new numbers list'
+      num = genRandomNumbers( 4 )
+
+    default
+      if not validInput( exp ): continue
+
+      answer = getAnswer( exp )
+
+      if answer == 24
+        > "By George you GOT IT! Your expression equals 24"
+      else
+        > "Ahh Sorry, So Sorry your answer of ", answer, " does not equal 24."
+      end
+  end
+end

Task/24-game/GAP/24-game.gap

@@ -0,0 +1,92 @@
+# Solution in '''RPN'''
+Play24 := function()
+	local input, digits, line, c, chars, stack, stackptr, cur, p, q, ok, a, b, run;
+	input := InputTextUser();
+	run := true;
+	while run do
+		digits := List([1 .. 4], n -> Random(1, 9));
+		while true do
+			Display(digits);
+			line := ReadLine(input);
+			line := Chomp(line);
+			if line = "end" then
+				run := false;
+				break;
+			elif line = "next" then
+				break;
+			else
+				ok := true;
+				stack := [ ];
+				stackptr := 0;
+				chars := "123456789+-*/ ";
+				cur := ShallowCopy(digits);
+				for c in line do
+					if c = ' ' then
+						continue;
+					fi;
+					p := Position(chars, c);
+					if p = fail then
+						ok := false;
+						break;
+					fi;
+					if p < 10 then
+						q := Position(cur, p);
+						if q = fail then
+							ok := false;
+							break;
+						fi;
+						Unbind(cur[q]);
+						stackptr := stackptr + 1;
+						stack[stackptr] := p;
+					else
+						if stackptr < 2 then
+							ok := false;
+							break;
+						fi;
+						b := stack[stackptr];
+						a := stack[stackptr - 1];
+						stackptr := stackptr - 1;
+						if c = '+' then
+							a := a + b;
+						elif c = '-' then
+							a := a - b;
+						elif c = '*' then
+							a := a * b;
+						elif c = '/' then
+							if b = 0 then
+								ok := false;
+								break;
+							fi;
+							a := a / b;
+						else
+							ok := false;
+							break;
+						fi;
+						stack[stackptr] := a;
+					fi;
+				od;
+				if ok and stackptr = 1 and Size(cur) = 0 then
+					if stack[1] = 24 then
+						Print("Good !\n");
+						break;
+					else
+						Print("Bad value: ", stack[1], "\n");
+						continue;
+					fi;
+				fi;
+				Print("Invalid expression\n");
+			fi;
+		od;
+	od;
+	CloseStream(input);
+end;
+
+# example session
+# type "end" to quit the game, "next" to try another list of digits
+gap> Play24();
+[ 7, 6, 8, 5 ]
+86*75-/
+Good !
+[ 5, 9, 2, 7 ]
+end
+gap>