Sum to 100: Difference between revisions
| Line 833: | Line 833: | ||
} |
} |
||
void |
void Init(void){ |
||
int i; |
int i; |
||
for ( i = 0; i < NUMBER_OF_EXPRESSIONS; i++ ){ |
for ( i = 0; i < NUMBER_OF_EXPRESSIONS; i++ ){ |
||
| Line 842: | Line 842: | ||
} |
} |
||
void |
void Comment(char* string){ |
||
printf("\n\n%s\n\n", string); |
printf("\n\n%s\n\n", string); |
||
} |
} |
||
void |
void Print(int i){ |
||
printf("%9d = %s\n", data[i].value,EncodedExpressionAsString(data[i].code)); |
printf("%9d = %s\n", data[i].value,EncodedExpressionAsString(data[i].code)); |
||
} |
} |
||
int main(void){ |
int main(void){ |
||
Init(); |
|||
Comment("Show all solutions that sum to 100"); |
|||
{ |
{ |
||
const int givenValue = 100; |
const int givenValue = 100; |
||
| Line 860: | Line 860: | ||
i++; |
i++; |
||
while ( data[i].value == givenValue ) |
while ( data[i].value == givenValue ) |
||
Print(i++); |
|||
putchar('\n'); |
putchar('\n'); |
||
} |
} |
||
Comment("Show the sum that has the maximum number of solutions"); |
|||
{ |
{ |
||
int bestFreq = 0; |
int bestFreq = 0; |
||
| Line 872: | Line 872: | ||
int value = data[i].value; |
int value = data[i].value; |
||
int freq = 0; |
int freq = 0; |
||
while( i < NUMBER_OF_EXPRESSIONS && data[i |
while( i < NUMBER_OF_EXPRESSIONS && data[i].value == value ){ |
||
freq++; |
freq++; |
||
i++; |
|||
} |
|||
if ( freq >= bestFreq ){ |
if ( freq >= bestFreq ){ |
||
if ( freq > bestFreq ) |
if ( freq > bestFreq ) |
||
| Line 890: | Line 892: | ||
for ( i = 0; i < NUMBER_OF_EXPRESSIONS; i++ ) |
for ( i = 0; i < NUMBER_OF_EXPRESSIONS; i++ ) |
||
if ( data[i].value == value ) |
if ( data[i].value == value ) |
||
Print(i); |
|||
putchar('\n'); |
putchar('\n'); |
||
} |
} |
||
} |
} |
||
Comment("Show the lowest positive number that can't be expressed"); |
|||
{ |
{ |
||
int i; |
int i; |
||
| Line 909: | Line 911: | ||
} |
} |
||
Comment("Show the ten highest numbers that can be expressed"); |
|||
{ |
{ |
||
int i; |
int i; |
||
for ( i = NUMBER_OF_EXPRESSIONS-1; i >= NUMBER_OF_EXPRESSIONS-10; i-- ) |
for ( i = NUMBER_OF_EXPRESSIONS-1; i >= NUMBER_OF_EXPRESSIONS-10; i-- ) |
||
Print(i); |
|||
} |
} |
||
getchar(); |
getchar(); |
||
return 0; |
return 0; |
||
} |
|||
</lang> |
|||
{{Out}} |
{{Out}} |
||
| ⚫ | |||
<pre> |
|||
| ⚫ | |||
100 = 123+4-5+67-89 |
100 = 123+4-5+67-89 |
||
| Line 941: | Line 942: | ||
Show the sum that has the maximum number of solutions |
Show the sum that has the maximum number of solutions |
||
2 values, |
2 values, 46 decompositions for each |
||
9 = 12-34-56+78+9 |
9 = 12-34-56+78+9 |
||
| Line 1,056: | Line 1,057: | ||
3456790 = -1+2+3456789 |
3456790 = -1+2+3456789 |
||
3456788 = 1-2+3456789 |
3456788 = 1-2+3456789 |
||
3456786 = -1-2+3456789 |
3456786 = -1-2+3456789</pre> |
||
</pre> |
|||
=={{header|C sharp|C#}}== |
=={{header|C sharp|C#}}== |
||
Revision as of 00:13, 2 May 2017
You are encouraged to solve this task according to the task description, using any language you may know.
- Task
Find solutions to the sum to one hundred puzzle.
Add (insert) the mathematical
operators + or ─ (plus
or minus) before any of the digits in the
decimal numeric string 123456789 such that the
resulting mathematical expression adds up to a
particular sum (in this iconic case, 100).
Example:
123 + 4 - 5 + 67 - 89 = 100
Show all output here.
- Show all solutions that sum to 100
- Show the sum that has the maximum number of solutions (from zero to infinity*)
- Show the lowest positive sum that can't be expressed (has no solutions), using the rules for this task
- Show the ten highest numbers that can be expressed using the rules for this task (extra credit)
An example of a sum that can't be expressed (within the rules of this task) is: 5074
which, of course, is not the lowest positive sum that can't be expressed.
* (where infinity would be a relatively small 123,456,789)
Ada
The Package Sum_To
Between any two consecutive digits, there can be a "+", a "-", or no operator. E.g., the digits "4" and "5" occur in the string as either of the following three substrings: "4+5", "4-5", or "45". For the first digit, we only have two choices: "+1" (written as "1"), and "-1". This makes 2*3^8 (two times (three to the power of eight)) different strings. Essential is the generic function Eval in the package Sum_To calls the procedure Callback for each such string Str, with the number Int holding the sum corresponding to the evaluation of Str. The second generic procedure Print is for convenience. If the Sum fits the condition, i.e., if Print_If(Sum, Number), then Print writes Sum = Str to the output.
<lang Ada>package Sum_To is
generic
with procedure Callback(Str: String; Int: Integer);
procedure Eval;
generic
Number: Integer;
with function Print_If(Sum, Number: Integer) return Boolean;
procedure Print(S: String; Sum: Integer);
end Sum_To;</lang>
The implementation of Eval follows the observation above: Eval calls Rec_Eval with the initial string "1" and "-1". For each call, Rec_Eval recursively evaluates a ternary tree with 3^8 leafs. At each leaf, Rec_Eval calls Callback. The implementation of Print is straightforward.
<lang Ada>with Ada.Text_IO, Ada.Containers.Ordered_Maps;
package body Sum_To is
procedure Eval is
procedure Rec_Eval(Str: String; Previous, Current, Next: Integer) is
Next_Image: String := Integer'Image(Next); -- Next_Image(1) holds a blank, Next_Image(2) a digit
function Sign(N: Integer) return Integer is (if N<0 then -1 elsif N>0 then 1 else 0);
begin
if Next = 10 then -- end of recursion Callback(Str, Previous+Current); else -- Next < 10 Rec_Eval(Str & Next_Image(2), -- concatenate current and Next Previous, Sign(Current)*(10*abs(Current)+Next), Next+1); Rec_Eval(Str & "+" & Next_Image(2), -- add Next Previous+Current, Next, Next+1); Rec_Eval(Str & "-" & Next_Image(2), -- subtract Next Previous+Current, -Next, Next+1); end if;
end Rec_Eval;
begin -- Eval
Rec_Eval("1", 0, 1, 2); -- unary "+", followed by "1"
Rec_Eval("-1", 0, -1, 2); -- unary "-", followed by "1"
end Eval;
procedure Print(S: String; Sum: Integer) is
-- print solution (S,N), if N=Number
begin
if Print_If(Sum, Number) then
Ada.Text_IO.Put_Line(Integer'Image(Sum) & " = " & S & ";");
end if; end Print;
end Sum_To;</lang>
The First Subtask
Given the package Sum_To, the solution to the first subtask (print all solution for the sum 100) is trivial: Eval_100 calls Print_100 for all 2*3^8 strings, and Print_100 writes the output if the sum is equal to 100.
<lang Ada>with Sum_To;
procedure Sum_To_100 is
procedure Print_100 is new Sum_To.Print(100, "="); procedure Eval_100 is new Sum_To.Eval(Print_100);
begin
Eval_100;
end Sum_To_100;</lang>
- Output:
100 = 123+45-67+8-9; 100 = 123+4-5+67-89; 100 = 123-45-67+89; 100 = 123-4-5-6-7+8-9; 100 = 12+3+4+5-6-7+89; 100 = 12+3-4+5+67+8+9; 100 = 12-3-4+5-6+7+89; 100 = 1+23-4+56+7+8+9; 100 = 1+23-4+5+6+78-9; 100 = 1+2+34-5+67-8+9; 100 = 1+2+3-4+5+6+78+9; 100 = -1+2-3+4+5+6+78+9;
The other subtasks (including the extra credit)
For the three other subtasks, we maintain an ordered map of sums (as the keys) and counters for the number of solutions (as the elements). The procedure Generate_Map generates the Map by calling the procedure Insert_Solution for all 2*3^8 solutions. Finding (1) the sum with the maximal number of solutions, (2) the first sum>=0 without a solution and (3) the ten largest sums with a solution (extra credit) are done by iterating this map.
<lang Ada>with Sum_To, Ada.Containers.Ordered_Maps, Ada.Text_IO; use Ada.Text_IO;
procedure Three_Others is
package Num_Maps is new Ada.Containers.Ordered_Maps
(Key_Type => Integer, Element_Type => Positive);
use Num_Maps;
Map: Num_Maps.Map;
-- global Map stores how often a sum did occur
procedure Insert_Solution(S: String; Sum: Integer) is
-- inserts a solution into global Map
use Num_Maps;
-- use type Num_Maps.Cursor;
Position: Cursor := Map.Find(Sum);
begin
if Position = No_Element then -- first solutions for Sum
Map.Insert(Key => Sum, New_Item => 1); -- counter is 1
else -- increase counter for Sum
Map.Replace_Element(Position => Position, New_Item => (Element(Position))+1);
end if; end Insert_Solution; procedure Generate_Map is new Sum_To.Eval(Insert_Solution); Current: Cursor; -- Points into Map Sum: Integer; -- current Sum of interest Max: Natural;
begin
Generate_Map;
-- find Sum >= 0 with maximum number of solutions
Max := 0; -- number of solutions for Sum (so far, none)
Current := Map.Ceiling(0); -- first element in Map with Sum >= 0
while Has_Element(Current) loop
if Element(Current) > Max then
Max := Element(Current); -- the maximum of solutions, so far Sum := Key(Current); -- the Sum with Max solutions
end if;
Next(Current);
end loop;
Put_Line("Most frequent result:" & Integer'Image(Sum));
Put_Line("Frequency of" & Integer'Image(Sum) & ":" &
Integer'Image(Max));
New_Line;
-- find smallest Sum >= 0 with no solution
Sum := 0;
while Map.Find(Sum) /= No_Element loop
Sum := Sum + 1;
end loop;
Put_Line("Smallest nonnegative impossible sum:" & Integer'Image(Sum));
New_Line;
-- find ten highest numbers with a solution
Current := Map.Last; -- highest element in Map with a solution
Put_Line("Highest sum:" & Integer'Image(Key(Current)));
Put("Next nine:");
for I in 1 .. 9 loop -- 9 steps backward
Previous(Current);
Put(Integer'Image(Key(Current)));
end loop;
New_Line;
end Three_others;</lang>
- Output:
Most frequent result: 9 Frequency of 9: 46 Smallest nonnegative impossible sum: 211 Highest sum: 123456789 Next nine: 23456790 23456788 12345687 12345669 3456801 3456792 3456790 3456788 3456786
ALGOL 68
<lang algol68>BEGIN
# find the numbers the string 123456789 ( with "+/-" optionally inserted # # before each digit ) can generate #
# experimentation shows that the largest hundred numbers that can be # # generated are are greater than or equal to 56795 # # as we can't declare an array with bounds -123456789 : 123456789 in # # Algol 68G, we use -60000 : 60000 and keep counts for the top hundred #
INT max number = 60 000; [ - max number : max number ]STRING solutions; [ - max number : max number ]INT count; FOR i FROM LWB solutions TO UPB solutions DO solutions[ i ] := ""; count[ i ] := 0 OD;
# calculate the numbers ( up to max number ) we can generate and the strings leading to them #
# also determine the largest numbers we can generate #
[ 100 ]INT largest;
[ 100 ]INT largest count;
INT impossible number = - 999 999 999;
FOR i FROM LWB largest TO UPB largest DO
largest [ i ] := impossible number;
largest count[ i ] := 0
OD;
[ 1 : 18 ]CHAR sum string := ".1.2.3.4.5.6.7.8.9";
[]CHAR sign char = []CHAR( "-", " ", "+" )[ AT -1 ];
# we don't distinguish between strings starting "+1" and starting " 1" #
FOR s1 FROM -1 TO 0 DO
sum string[ 1 ] := sign char[ s1 ];
FOR s2 FROM -1 TO 1 DO
sum string[ 3 ] := sign char[ s2 ];
FOR s3 FROM -1 TO 1 DO
sum string[ 5 ] := sign char[ s3 ];
FOR s4 FROM -1 TO 1 DO
sum string[ 7 ] := sign char[ s4 ];
FOR s5 FROM -1 TO 1 DO
sum string[ 9 ] := sign char[ s5 ];
FOR s6 FROM -1 TO 1 DO
sum string[ 11 ] := sign char[ s6 ];
FOR s7 FROM -1 TO 1 DO
sum string[ 13 ] := sign char[ s7 ];
FOR s8 FROM -1 TO 1 DO
sum string[ 15 ] := sign char[ s8 ];
FOR s9 FROM -1 TO 1 DO
sum string[ 17 ] := sign char[ s9 ];
INT number := 0;
INT part := IF s1 < 0 THEN -1 ELSE 1 FI;
IF s2 = 0 THEN part *:= 10 +:= 2 * SIGN part ELSE number +:= part; part := 2 * s2 FI;
IF s3 = 0 THEN part *:= 10 +:= 3 * SIGN part ELSE number +:= part; part := 3 * s3 FI;
IF s4 = 0 THEN part *:= 10 +:= 4 * SIGN part ELSE number +:= part; part := 4 * s4 FI;
IF s5 = 0 THEN part *:= 10 +:= 5 * SIGN part ELSE number +:= part; part := 5 * s5 FI;
IF s6 = 0 THEN part *:= 10 +:= 6 * SIGN part ELSE number +:= part; part := 6 * s6 FI;
IF s7 = 0 THEN part *:= 10 +:= 7 * SIGN part ELSE number +:= part; part := 7 * s7 FI;
IF s8 = 0 THEN part *:= 10 +:= 8 * SIGN part ELSE number +:= part; part := 8 * s8 FI;
IF s9 = 0 THEN part *:= 10 +:= 9 * SIGN part ELSE number +:= part; part := 9 * s9 FI;
number +:= part;
IF number >= LWB solutions
AND number <= UPB solutions
THEN
solutions[ number ] +:= ";" + sum string;
count [ number ] +:= 1
FI;
BOOL inserted := FALSE;
FOR l pos FROM LWB largest TO UPB largest WHILE NOT inserted DO
IF number > largest[ l pos ] THEN
# found a new larger number #
FOR m pos FROM UPB largest BY -1 TO l pos + 1 DO
largest [ m pos ] := largest [ m pos - 1 ];
largest count[ m pos ] := largest count[ m pos - 1 ]
OD;
largest [ l pos ] := number;
largest count[ l pos ] := 1;
inserted := TRUE
ELIF number = largest[ l pos ] THEN
# have another way of generating this number #
largest count[ l pos ] +:= 1;
inserted := TRUE
FI
OD
OD
OD
OD
OD
OD
OD
OD
OD
OD;
# show the solutions for 100 #
print( ( "100 has ", whole( count[ 100 ], 0 ), " solutions:" ) );
STRING s := solutions[ 100 ];
FOR s pos FROM LWB s TO UPB s DO
IF s[ s pos ] = ";" THEN print( ( newline, " " ) )
ELIF s[ s pos ] /= " " THEN print( ( s[ s pos ] ) )
FI
OD;
print( ( newline ) );
# find the number with the most solutions #
INT max solutions := 0;
INT number with max := LWB count - 1;
FOR n FROM 0 TO max number DO
IF count[ n ] > max solutions THEN
max solutions := count[ n ];
number with max := n
FI
OD;
FOR n FROM LWB largest count TO UPB largest count DO
IF largest count[ n ] > max solutions THEN
max solutions := largest count[ n ];
number with max := largest[ n ]
FI
OD;
print( ( whole( number with max, 0 ), " has the maximum number of solutions: ", whole( max solutions, 0 ), newline ) );
# find the smallest positive number that has no solutions #
BOOL have solutions := TRUE;
FOR n FROM 0 TO max number
WHILE IF NOT ( have solutions := count[ n ] > 0 )
THEN print( ( whole( n, 0 ), " is the lowest positive number with no solutions", newline ) )
FI;
have solutions
DO SKIP OD;
IF have solutions
THEN print( ( "All positive numbers up to ", whole( max number, 0 ), " have solutions", newline ) )
FI;
print( ( "The 10 largest numbers that can be generated are:", newline ) );
FOR t pos FROM 1 TO 10 DO
print( ( " ", whole( largest[ t pos ], 0 ) ) )
OD;
print( ( newline ) )
END</lang>
- Output:
100 has 12 solutions:
-1+2-3+4+5+6+78+9
12-3-4+5-6+7+89
123-4-5-6-7+8-9
123-45-67+89
123+4-5+67-89
123+45-67+8-9
12+3-4+5+67+8+9
12+3+4+5-6-7+89
1+23-4+56+7+8+9
1+23-4+5+6+78-9
1+2+3-4+5+6+78+9
1+2+34-5+67-8+9
9 has the maximum number of solutions: 46
211 is the lowest positive number with no solutions
The 10 largest numbers that can be generated are:
123456789 23456790 23456788 12345687 12345669 3456801 3456792 3456790 3456788 3456786
AppleScript
AppleScript is essentially out of its depth at this scale. The first task (number of distinct paths to 100) is accessible within a few seconds. Subsequent tasks, however, terminate only (if at all) after impractical amounts of time. Note the contrast with the lighter and more optimised JavaScript interpreter, which takes less than half a second to return full results for all the listed tasks. <lang AppleScript>use framework "Foundation" -- for basic NSArray sort
property pSigns : {1, 0, -1} --> ( + | unsigned | - ) property plst100 : {"Sums to 100:", ""} property plstSums : {} property plstSumsSorted : missing value property plstSumGroups : missing value
-- data Sign :: [ 1 | 0 | -1 ] = ( Plus | Unsigned | Minus ) -- asSum :: [Sign] -> Int on asSum(xs)
script
on lambda(a, sign, i)
if sign ≠ 0 then
{digits:{}, n:(n of a) + (sign * ((i & digits of a) as string as integer))}
else
{digits:{i} & (digits of a), n:n of a}
end if
end lambda
end script
set rec to foldr(result, {digits:{}, n:0}, xs)
set ds to digits of rec
if length of ds > 0 then
(n of rec) + (ds as string as integer)
else
n of rec
end if
end asSum
-- data Sign :: [ 1 | 0 | -1 ] = ( Plus | Unisigned | Minus ) -- asString :: [Sign] -> String on asString(xs)
script
on lambda(a, sign, i)
set d to i as string
if sign ≠ 0 then
if sign > 0 then
a & " +" & d
else
a & " -" & d
end if
else
a & d
end if
end lambda
end script
foldl(result, "", xs)
end asString
-- sumsTo100 :: () -> String on sumsTo100()
-- From first permutation without leading '+' (3 ^ 8) to end of universe (3 ^ 9)
repeat with i from 6561 to 19683
set xs to nthPermutationWithRepn(pSigns, 9, i)
if asSum(xs) = 100 then set end of plst100 to asString(xs)
end repeat
intercalate(linefeed, plst100)
end sumsTo100
-- mostCommonSum :: () -> String
on mostCommonSum()
-- From first permutation without leading '+' (3 ^ 8) to end of universe (3 ^ 9)
repeat with i from 6561 to 19683
set intSum to asSum(nthPermutationWithRepn(pSigns, 9, i))
if intSum ≥ 0 then set end of plstSums to intSum
end repeat
set plstSumsSorted to sort(plstSums)
set plstSumGroups to group(plstSumsSorted)
script groupLength
on lambda(a, b)
set intA to length of a
set intB to length of b
if intA < intB then
-1
else if intA > intB then
1
else
0
end if
end lambda
end script
set lstMaxSum to maximumBy(groupLength, plstSumGroups)
intercalate(linefeed, {"Most common sum: " & item 1 of lstMaxSum, "Number of instances: " & length of lstMaxSum})
end mostCommonSum
-- TEST ----------------------------------------------------------------------
on run
return sumsTo100() -- Also returns a value, but slow: -- mostCommonSum()
end run
-- GENERIC FUNCTIONS ---------------------------------------------------------
-- nthPermutationWithRepn :: [a] -> Int -> Int -> [a] on nthPermutationWithRepn(xs, groupSize, iIndex)
set intBase to length of xs
set intSetSize to intBase ^ groupSize
if intBase < 1 or iIndex > intSetSize then
{}
else
set baseElems to inBaseElements(xs, iIndex)
set intZeros to groupSize - (length of baseElems)
if intZeros > 0 then
replicate(intZeros, item 1 of xs) & baseElems
else
baseElems
end if
end if
end nthPermutationWithRepn
-- inBaseElements :: [a] -> Int -> [String] on inBaseElements(xs, n)
set intBase to length of xs
script nextDigit
on lambda(residue)
set {divided, remainder} to quotRem(residue, intBase)
{valid:divided > 0, value:(item (remainder + 1) of xs), new:divided}
end lambda
end script
reverse of unfoldr(nextDigit, n)
end inBaseElements
-- sort :: [a] -> [a] on sort(lst)
((current application's NSArray's arrayWithArray:lst)'s ¬
sortedArrayUsingSelector:"compare:") as list
end sort
-- maximumBy :: (a -> a -> Ordering) -> [a] -> a on maximumBy(f, xs)
set cmp to mReturn(f)
script max
on lambda(a, b)
if a is missing value or cmp's lambda(a, b) < 0 then
b
else
a
end if
end lambda
end script
foldl(max, missing value, xs)
end maximumBy
-- group :: Eq a => [a] -> a on group(xs)
script eq
on lambda(a, b)
a = b
end lambda
end script
groupBy(eq, xs)
end group
-- groupBy :: (a -> a -> Bool) -> [a] -> a on groupBy(f, xs)
set mf to mReturn(f)
script enGroup
on lambda(a, x)
if length of (active of a) > 0 then
set h to item 1 of active of a
else
set h to missing value
end if
if h is not missing value and mf's lambda(h, x) then
{active:(active of a) & x, sofar:sofar of a}
else
{active:{x}, sofar:(sofar of a) & {active of a}}
end if
end lambda
end script
if length of xs > 0 then
set dct to foldl(enGroup, {active:{item 1 of xs}, sofar:{}}, tail(xs))
if length of (active of dct) > 0 then
sofar of dct & {active of dct}
else
sofar of dct
end if
else
{}
end if
end groupBy
-- tail :: [a] -> [a] on tail(xs)
if length of xs > 1 then
items 2 thru -1 of xs
else
{}
end if
end tail
-- intercalate :: Text -> [Text] -> Text
on intercalate(strText, lstText)
set {dlm, my text item delimiters} to {my text item delimiters, strText}
set strJoined to lstText as text
set my text item delimiters to dlm
return strJoined
end intercalate
-- quotRem :: Integral a => a -> a -> (a, a) on quotRem(m, n)
{m div n, m mod n}
end quotRem
-- replicate :: Int -> a -> [a] on replicate(n, a)
set out to {}
if n < 1 then return out
set dbl to {a}
repeat while (n > 1)
if (n mod 2) > 0 then set out to out & dbl
set n to (n div 2)
set dbl to (dbl & dbl)
end repeat
return out & dbl
end replicate
-- foldr :: (a -> b -> a) -> a -> [b] -> a on foldr(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from lng to 1 by -1
set v to lambda(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldr
-- foldl :: (a -> b -> a) -> a -> [b] -> a on foldl(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from 1 to lng
set v to lambda(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldl
-- unfoldr :: (b -> Maybe (a, b)) -> b -> [a] on unfoldr(f, v)
set mf to mReturn(f)
set lst to {}
set recM to mf's lambda(v)
repeat while (valid of recM) is true
set end of lst to value of recM
set recM to mf's lambda(new of recM)
end repeat
lst & value of recM
end unfoldr
-- until :: (a -> Bool) -> (a -> a) -> a -> a on |until|(p, f, x)
set mp to mReturn(p)
set v to x
tell mReturn(f)
repeat until mp's lambda(v)
set v to lambda(v)
end repeat
end tell
return v
end |until|
-- range :: Int -> Int -> [Int] on range(m, n)
if n < m then
set d to -1
else
set d to 1
end if
set lst to {}
repeat with i from m to n by d
set end of lst to i
end repeat
return lst
end range
-- map :: (a -> b) -> [a] -> [b] on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to lambda(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then
f
else
script
property lambda : f
end script
end if
end mReturn</lang>
- Output:
Sums to 100: 1 +2 +34 -5 +67 -8 +9 1 +2 +3 -4 +5 +6 +78 +9 1 +23 -4 +5 +6 +78 -9 1 +23 -4 +56 +7 +8 +9 12 +3 +4 +5 -6 -7 +89 12 +3 -4 +5 +67 +8 +9 123 +45 -67 +8 -9 123 +4 -5 +67 -89 123 -45 -67 +89 123 -4 -5 -6 -7 +8 -9 12 -3 -4 +5 -6 +7 +89 -1 +2 -3 +4 +5 +6 +78 +9
AutoHotkey
Inspired by https://autohotkey.com/board/topic/149914-five-challenges-to-do-in-an-hour/ <lang AutoHotkey>global Matches:=[] AllPossibilities100() for eq, val in matches res .= eq "`n" MsgBox % res return
AllPossibilities100(n:=0, S:="") { if (n = 0) ; First call AllPossibilities100(n+1, n) ; Recurse else if (n < 10){ AllPossibilities100(n+1, S ",-" n) ; Recurse. Concatenate S, ",-" and n AllPossibilities100(n+1, S ",+" n) ; Recurse. Concatenate S, ",+" and n AllPossibilities100(n+1, S n) ; Recurse. Concatenate S and n } else { ; 10th level recursion Loop, Parse, S, CSV ; Total the values of S and check if equal to 100 { SubS := SubStr(A_LoopField, 2) ; The number portion of A_LoopField if (A_Index = 1) Total := A_LoopField else if (SubStr(A_LoopField, 1, 1) = "+") ; If the first character is + add Total += SubS else ; else subtract Total -= SubS } if (Total = 100) matches[LTrim(LTrim(StrReplace(S, ","), "0"),"+")] := true ; remove leading 0's, +'s and all commas } }</lang>
Outputs:
-1+2-3+4+5+6+78+9 1+2+3-4+5+6+78+9 1+2+34-5+67-8+9 1+23-4+5+6+78-9 1+23-4+56+7+8+9 12+3+4+5-6-7+89 12+3-4+5+67+8+9 12-3-4+5-6+7+89 123+4-5+67-89 123+45-67+8-9 123-4-5-6-7+8-9 123-45-67+89
C
<lang C>/*
* RossetaCode: Sum to 100, C89 * * Find solutions to the "sum to one hundred" puzzle. */
- include <stdio.h>
- include <stdlib.h>
/*
* There are only 13122 (i.e. 2*3**8) different possible expressions, * encoded as integer positive numbers from 0 to 13121. */
- define NUMBER_OF_EXPRESSIONS (2 * 3*3*3*3 * 3*3*3*3 )
enum OP { ADD, SUB, JOIN };
struct Item{
int code; int value;
} data[NUMBER_OF_EXPRESSIONS];
int stack[NUMBER_OF_EXPRESSIONS]; int sp = 0;
int BinaryToBinaryCodedTernary(int bin){
return ((bin / 1) % 3) << 0
| ((bin / 3) % 3) << 2
| ((bin / 9) % 3) << 4
| ((bin / 27) % 3) << 6
| ((bin / 81) % 3) << 8
| ((bin / 243) % 3) << 10
| ((bin / 729) % 3) << 12
| ((bin / 2187) % 3) << 14
| ((bin / 6561) % 3) << 16;
}
int EvaluateEncodedExpression(int bin){
int bct = BinaryToBinaryCodedTernary(bin);
int value = 0;
int number = 0;
int sign = (+1);
int i;
for ( i = 1; i <= 9; i++ )
switch ( (bct >> 2*(9 - i)) & 0x3 )
{
case JOIN:
number = 10*number + i;
break;
case ADD:
value += sign*number;
number = i;
sign = (+1);
break;
case SUB:
value += sign*number;
number = i;
sign = (-1);
break;
}
return value + sign*number;
}
char* EncodedExpressionAsString(int bin){
int bct = BinaryToBinaryCodedTernary(bin);
static char string[256];
char* ptr = string;
int i;
for ( i = 1; i <= 9; i++ ){
switch( (bct >> 2*(9 - i)) & 0x3 ) {
case ADD: *ptr++ = '+'; break;
case SUB: *ptr++ = '-'; break;
}
*ptr++ = '0' + i;
}
*ptr = 0;
return *string != '+' ? string : string + 1;
}
int CompareItemValues(const struct Item* a, const struct Item* b){
return a->value - b->value;
}
void Init(void){
int i;
for ( i = 0; i < NUMBER_OF_EXPRESSIONS; i++ ){
data[i].code = i;
data[i].value = EvaluateEncodedExpression(i);
}
qsort(data,NUMBER_OF_EXPRESSIONS,sizeof(struct Item),CompareItemValues);
}
void Comment(char* string){
printf("\n\n%s\n\n", string);
}
void Print(int i){
printf("%9d = %s\n", data[i].value,EncodedExpressionAsString(data[i].code));
}
int main(void){
Init();
Comment("Show all solutions that sum to 100");
{
const int givenValue = 100;
int i = 0;
while ( i < NUMBER_OF_EXPRESSIONS && data[i].value < givenValue )
i++;
while ( data[i].value == givenValue )
Print(i++);
putchar('\n');
}
Comment("Show the sum that has the maximum number of solutions");
{
int bestFreq = 0;
int i = 0;
while ( i < NUMBER_OF_EXPRESSIONS ){
int value = data[i].value;
int freq = 0;
while( i < NUMBER_OF_EXPRESSIONS && data[i].value == value ){
freq++;
i++;
}
if ( freq >= bestFreq ){
if ( freq > bestFreq )
sp = 0;
stack[sp++] = value;
bestFreq = freq;
}
}
printf("%d %s, %d %s for each\n\n",
sp, sp > 1 ? "values" : "value",
bestFreq, bestFreq > 1 ? "decompositions" : "decomposition");
while ( sp ){
int value = stack[--sp];
for ( i = 0; i < NUMBER_OF_EXPRESSIONS; i++ )
if ( data[i].value == value )
Print(i);
putchar('\n');
}
}
Comment("Show the lowest positive number that can't be expressed");
{
int i;
int j = 0;
for ( i = 0; i < 123456789+1; i++ ){
while ( j < NUMBER_OF_EXPRESSIONS && data[j].value < i )
j++;
if ( data[j].value > i ){
printf("%d\n\n", i);
break;
}
}
}
Comment("Show the ten highest numbers that can be expressed");
{
int i;
for ( i = NUMBER_OF_EXPRESSIONS-1; i >= NUMBER_OF_EXPRESSIONS-10; i-- )
Print(i);
}
getchar(); return 0;
} </lang>
- Output:
Show all solutions that sum to 100
100 = 123+4-5+67-89
100 = 123-4-5-6-7+8-9
100 = 123-45-67+89
100 = 1+2+34-5+67-8+9
100 = 123+45-67+8-9
100 = 1+2+3-4+5+6+78+9
100 = 1+23-4+5+6+78-9
100 = 12-3-4+5-6+7+89
100 = 12+3+4+5-6-7+89
100 = -1+2-3+4+5+6+78+9
100 = 12+3-4+5+67+8+9
100 = 1+23-4+56+7+8+9
Show the sum that has the maximum number of solutions
2 values, 46 decompositions for each
9 = 12-34-56+78+9
9 = 1-2+3-4-5+6-7+8+9
9 = -1+2-3+4-5+6+7+8-9
9 = 1-23+4+5-67+89
9 = -1+2-3+4+5-6+7-8+9
9 = -1+2+3-45+67-8-9
9 = -1-2-34+56+7-8-9
9 = -1+23-4+5-6-7+8-9
9 = -1+23+4-5-6-7-8+9
9 = -1+23-4-5+6+7-8-9
9 = 1+23-45+6+7+8+9
9 = -1-2-3-4+5+6+7-8+9
9 = -1+23+4+5+67-89
9 = 1+2-34-56+7+89
9 = -1-2-3+45-6-7-8-9
9 = -1-23+45-6-7-8+9
9 = 1+23+4-5-6-7+8-9
9 = -12+34+56-78+9
9 = 1+2+3-4-5+6+7+8-9
9 = 1-23+45-6-7+8-9
9 = 1+2-3-4-56+78-9
9 = -12-34+5+67-8-9
9 = 1-23-4+5+6+7+8+9
9 = -12+34+5+6-7-8-9
9 = 1-2-3-4-5-67+89
9 = 1-2+3+4+5+6-7+8-9
9 = 1+2-3-4-5-6+7+8+9
9 = -1+2+3-4+5-6-7+8+9
9 = 1+2-3+4+5+6-7-8+9
9 = 1+2-3+4+5-6+7+8-9
9 = -1-2-3+4-5+6-7+8+9
9 = -12+3-45-6+78-9
9 = -1+2+3+4+5+6+7-8-9
9 = -1-2+3-4-5-6+7+8+9
9 = 1-2-3+4+5-6-7+8+9
9 = 1-2-3-4+5+6+7+8-9
9 = 1-2-3+4-5+6+7-8+9
9 = 1+2+3-4+5-6+7-8+9
9 = -1+2+34+56+7-89
9 = -1-2+3+4+5+6-7-8+9
9 = -1+2+3-4-5+6+7-8+9
9 = 1-23-45-6-7+89
9 = -1-2+3+4+5-6+7+8-9
9 = 1+23-4+5-6+7-8-9
9 = 1+2+3+4-5-6-7+8+9
9 = -1-2+3-4-56+78-9
-9 = 1-23+4-5+6+7-8+9
-9 = 1+2+3-4+5-6+7-8-9
-9 = -1+23-4-5+67-89
-9 = -1-2-3-4+5+6+7-8-9
-9 = 1+2-3-4-5+6-7-8+9
-9 = 1-2-34-56-7+89
-9 = 1-2-3+4+5-6-7+8-9
-9 = 12-34-56+78-9
-9 = -1+23+4-5-6-7-8-9
-9 = -1-2+3+4+56-78+9
-9 = 1+2-3-4-5-6+7+8-9
-9 = -12+34+56-78-9
-9 = 1+2-3+4+5+6-7-8-9
-9 = -1-23+4-5+6-7+8+9
-9 = -1+23-45+6+7-8+9
-9 = 1-2+3-4+5-6-7-8+9
-9 = 1+23-45+6+7+8-9
-9 = -1+2+3-4-5+6+7-8-9
-9 = -1+23+45+6+7-89
-9 = 12-3+45+6-78+9
-9 = -1-2+3+4+5+6-7-8-9
-9 = 1-23+4+5-6-7+8+9
-9 = 1-23-4+5+6+7+8-9
-9 = -1-2+34+56-7-89
-9 = -1-23+45-6-7-8-9
-9 = 1+2+3+4-5-6-7+8-9
-9 = -1-2+3-4-5+6-7-8+9
-9 = -1+2-3-4-5-6+7-8+9
-9 = 12+34-5-67+8+9
-9 = 1-2-3+4-5+6+7-8-9
-9 = 1+2-3+4+56-78+9
-9 = -1-2+3-4-5-6+7+8-9
-9 = 12-34-5-6+7+8+9
-9 = -1+2+3+4-5-6-7-8+9
-9 = 1-23-4-5-67+89
-9 = -1+2+3+4+5+67-89
-9 = -1+2+3-4+5-6-7+8-9
-9 = -1-2-3+4-5+6-7+8-9
-9 = 1-2+3-4-5+6-7+8-9
-9 = 1-2-3-4-5-6-7+8+9
-9 = 1-2-3+45-67+8+9
-9 = 1+2+3-45+6+7+8+9
-9 = 1+2+34-56-7+8+9
-9 = -1-2-3+4+5-6-7-8+9
-9 = -1+2-3+4+5-6+7-8-9
-9 = -1-23-4+5+6+7-8+9
Show the lowest positive number that can't be expressed
211
Show the ten highest numbers that can be expressed
123456789 = 123456789
23456790 = 1+23456789
23456788 = -1+23456789
12345687 = 12345678+9
12345669 = 12345678-9
3456801 = 12+3456789
3456792 = 1+2+3456789
3456790 = -1+2+3456789
3456788 = 1-2+3456789
3456786 = -1-2+3456789
C#
<lang csharp>using System; using System.Collections.Generic; using System.Linq;
class Program {
static void Main(string[] args)
{
// All unique expressions that have a plus sign in front of the 1; calculated in parallel
var expressionsPlus = Enumerable.Range(0, (int)Math.Pow(3, 8)).AsParallel().Select(i => new Expression(i, 1));
// All unique expressions that have a minus sign in front of the 1; calculated in parallel
var expressionsMinus = Enumerable.Range(0, (int)Math.Pow(3, 8)).AsParallel().Select(i => new Expression(i, -1));
var expressions = expressionsPlus.Concat(expressionsMinus);
var results = new Dictionary<int, List<Expression>>();
foreach (var e in expressions)
{
if (results.Keys.Contains(e.Value))
results[e.Value].Add(e);
else
results[e.Value] = new List<Expression>() { e };
}
Console.WriteLine("Show all solutions that sum to 100");
foreach (Expression e in results[100])
Console.WriteLine(" " + e);
Console.WriteLine("Show the sum that has the maximum number of solutions (from zero to infinity)");
var summary = results.Keys.Select(k => new Tuple<int, int>(k, results[k].Count));
var maxSols = summary.Aggregate((a, b) => a.Item2 > b.Item2 ? a : b);
Console.WriteLine(" The sum " + maxSols.Item1 + " has " + maxSols.Item2 + " solutions.");
Console.WriteLine("Show the lowest positive sum that can't be expressed (has no solutions), using the rules for this task");
var lowestPositive = Enumerable.Range(1, int.MaxValue).First(x => !results.Keys.Contains(x));
Console.WriteLine(" " + lowestPositive);
Console.WriteLine("Show the ten highest numbers that can be expressed using the rules for this task (extra credit)");
var highest = from k in results.Keys
orderby k descending
select k;
foreach (var x in highest.Take(10))
Console.WriteLine(" " + x);
}
} public enum Operations { Plus, Minus, Join }; public class Expression {
protected Operations[] Gaps;
// 123456789 => there are 8 "gaps" between each number
/// with 3 possibilities for each gap: plus, minus, or join
public int Value; // What this expression sums up to
protected int _one;
public Expression(int serial, int one)
{
_one = one;
Gaps = new Operations[8];
// This represents "serial" as a base 3 number, each Gap expression being a base-three digit
int divisor = 2187; // == Math.Pow(3,7)
int times;
for (int i = 0; i < 8; i++)
{
times = Math.DivRem(serial, divisor, out serial);
divisor /= 3;
if (times == 0)
Gaps[i] = Operations.Join;
else if (times == 1)
Gaps[i] = Operations.Minus;
else
Gaps[i] = Operations.Plus;
}
// go ahead and calculate the value of this expression
// because this is going to be done in a parallel thread (save time)
Value = Evaluate();
}
public override string ToString()
{
string ret = _one.ToString();
for (int i = 0; i < 8; i++)
{
switch (Gaps[i])
{
case Operations.Plus:
ret += "+";
break;
case Operations.Minus:
ret += "-";
break;
}
ret += (i + 2);
}
return ret;
}
private int Evaluate()
/* Calculate what this expression equals */
{
var numbers = new int[9];
int nc = 0;
var operations = new List<Operations>();
int a = 1;
for (int i = 0; i < 8; i++)
{
if (Gaps[i] == Operations.Join)
a = a * 10 + (i + 2);
else
{
if (a > 0)
{
if (nc == 0)
a *= _one;
numbers[nc++] = a;
a = i + 2;
}
operations.Add(Gaps[i]);
}
}
if (nc == 0)
a *= _one;
numbers[nc++] = a;
int ni = 0;
int left = numbers[ni++];
foreach (var operation in operations)
{
int right = numbers[ni++];
if (operation == Operations.Plus)
left = left + right;
else
left = left - right;
}
return left;
}
}</lang>
- Output:
Show all solutions that sum to 100 123-45-67+89 123-4-5-6-7+8-9 123+45-67+8-9 123+4-5+67-89 12-3-4+5-6+7+89 12+3-4+5+67+8+9 12+3+4+5-6-7+89 1+23-4+5+6+78-9 1+23-4+56+7+8+9 1+2+34-5+67-8+9 1+2+3-4+5+6+78+9 -1+2-3+4+5+6+78+9 Show the sum that has the maximum number of solutions (from zero to infinity) The sum 9 has 46 solutions. Show the lowest positive sum that can't be expressed (has no solutions), using the rules for this task 211 Show the ten highest numbers that can be expressed using the rules for this task (extra credit) 123456789 23456790 23456788 12345687 12345669 3456801 3456792 3456790 3456788 3456786
Elixir
<lang elixir>defmodule Sum do
def to(val) do
generate
|> Enum.map(&{eval(&1), &1})
|> Enum.filter(fn {v, _s} -> v==val end)
|> Enum.each(&IO.inspect &1)
end
def max_solve do
generate
|> Enum.group_by(&eval &1)
|> Enum.filter_map(fn {k,_} -> k>=0 end, fn {k,v} -> {length(v),k} end)
|> Enum.max
|> fn {len,sum} -> IO.puts "sum of #{sum} has the maximum number of solutions : #{len}" end.()
end
def min_solve do
solve = generate |> Enum.group_by(&eval &1)
Stream.iterate(1, &(&1+1))
|> Enum.find(fn n -> solve[n]==nil end)
|> fn sum -> IO.puts "lowest positive sum that can't be expressed : #{sum}" end.()
end
def highest_sums(n\\10) do
IO.puts "highest sums :"
generate
|> Enum.map(&eval &1)
|> Enum.uniq
|> Enum.sort_by(fn sum -> -sum end)
|> Enum.take(n)
|> IO.inspect
end
defp generate do
x = ["+", "-", ""]
for a <- ["-", ""], b <- x, c <- x, d <- x, e <- x, f <- x, g <- x, h <- x, i <- x,
do: "#{a}1#{b}2#{c}3#{d}4#{e}5#{f}6#{g}7#{h}8#{i}9"
end
defp eval(str), do: Code.eval_string(str) |> elem(0)
end
Sum.to(100) Sum.max_solve Sum.min_solve Sum.highest_sums</lang>
- Output:
{100, "-1+2-3+4+5+6+78+9"}
{100, "1+2+3-4+5+6+78+9"}
{100, "1+2+34-5+67-8+9"}
{100, "1+23-4+5+6+78-9"}
{100, "1+23-4+56+7+8+9"}
{100, "12+3+4+5-6-7+89"}
{100, "12+3-4+5+67+8+9"}
{100, "12-3-4+5-6+7+89"}
{100, "123+4-5+67-89"}
{100, "123+45-67+8-9"}
{100, "123-4-5-6-7+8-9"}
{100, "123-45-67+89"}
sum of 9 has the maximum number of solutions : 46
lowest positive sum that can't be expressed : 211
highest sums :
[123456789, 23456790, 23456788, 12345687, 12345669, 3456801, 3456792, 3456790,
3456788, 3456786]
F#
<lang fsharp> (* Generate the data set Nigel Galloway February 22nd., 2017
- )
type N = {n:string; g:int} let N = seq {
let rec fn n i g e l = seq {
match i with
|9 -> yield {n=l + "-9"; g=g+e-9}
yield {n=l + "+9"; g=g+e+9}
yield {n=l + "9"; g=g+e*10+9*n}
|_ -> yield! fn -1 (i+1) (g+e) -i (l + string -i)
yield! fn 1 (i+1) (g+e) i (l + "+" + string i)
yield! fn n (i+1) g (e*10+i*n) (l + string i)
}
yield! fn 1 2 0 1 "1"
yield! fn -1 2 0 -1 "-1"
} </lang>
- Output:
<lang fsharp> N |> Seq.filter(fun n->n.g=100) |> Seq.iter(fun n->printfn "%s" n.n) </lang>
1+2+3-4+5+6+78+9 1+2+34-5+67-8+9 1+23-4+5+6+78-9 1+23-4+56+7+8+9 12-3-4+5-6+7+89 12+3-4+5+67+8+9 12+3+4+5-6-7+89 123-4-5-6-7+8-9 123-45-67+89 123+4-5+67-89 123+45-67+8-9 -1+2-3+4+5+6+78+9
<lang fsharp> let n,g = N |> Seq.filter(fun n->n.g>=0) |> Seq.countBy(fun n->n.g) |> Seq.maxBy(snd) printfn "%d has %d solutions" n g </lang>
9 has 46 solutions
<lang fsharp> match N |> Seq.filter(fun n->n.g>=0) |> Seq.distinctBy(fun n->n.g) |> Seq.sortBy(fun n->n.g) |> Seq.pairwise |> Seq.tryFind(fun n->(snd n).g-(fst n).g > 1) with
|Some(n) -> printfn "least non-value is %d" ((fst n).g+1) |None -> printfn "No non-values found"
</lang>
least non-value is 211
<lang fsharp> N |> Seq.filter(fun n->n.g>=0) |> Seq.distinctBy(fun n->n.g) |> Seq.sortBy(fun n->(-n.g)) |> Seq.take 10 |> Seq.iter(fun n->printfn "%d" n.g ) </lang>
123456789 23456790 23456788 12345687 12345669 3456801 3456792 3456790 3456788 3456786
Haskell
<lang Haskell>import Data.Monoid ((<>)) import Data.Ord (comparing) import Control.Arrow ((&&&)) import Data.Char (intToDigit) import Control.Monad (replicateM) import Data.List (nub, group, sort, sortBy, find, intercalate)
data Sign
= Unsigned | Plus | Minus deriving (Eq, Show)
universe :: (Int, Sign) universe =
zip [1 .. 9] <$> filter ((/= Plus) . head) (replicateM 9 [Unsigned, Plus, Minus])
allNonNegativeSums :: [Int] allNonNegativeSums = sort $ filter (>= 0) (asSum <$> universe)
uniqueNonNegativeSums :: [Int] uniqueNonNegativeSums = nub allNonNegativeSums
asSum :: [(Int, Sign)] -> Int asSum xs =
n +
(if null s
then 0
else read s :: Int)
where
(n, s) = foldr readSign (0, []) xs
readSign :: (Int, Sign) -> (Int, String) -> (Int, String)
readSign (i, x) (n, s)
| x == Unsigned = (n, intToDigit i : s)
| otherwise =
( (if x == Plus
then (+)
else (-))
n
(read (show i <> s) :: Int)
, [])
asString :: [(Int, Sign)] -> String asString = foldr signedDigit []
where
signedDigit (i, x) s
| x == Unsigned = intToDigit i : s
| otherwise =
(if x == Plus
then " +"
else " -") <>
[intToDigit i] <>
s
main :: IO () main =
putStrLn $
unlines
[ "Sums to 100:"
, unlines $ asString <$> filter ((== 100) . asSum) universe
, "\n10 commonest sums [sum, number of routes to it]:"
, show
((head &&& length) <$>
take 10 (sortBy (flip (comparing length)) (group allNonNegativeSums)))
, "\nFirst positive integer not expressible as a sum of this kind:"
, maybeReport (find (uncurry (/=)) (zip [0 ..] uniqueNonNegativeSums))
, "\n10 largest sums:"
, show $ take 10 $ sortBy (flip compare) uniqueNonNegativeSums
]
where
maybeReport
:: Show a
=> Maybe (a, b) -> String
maybeReport (Just (x, _)) = show x
maybeReport _ = "No gaps found"</lang>
- Output:
(Run in Atom editor, through Script package)
Sums to 100: 123 +45 -67 +8 -9 123 +4 -5 +67 -89 123 -45 -67 +89 123 -4 -5 -6 -7 +8 -9 12 +3 +4 +5 -6 -7 +89 12 +3 -4 +5 +67 +8 +9 12 -3 -4 +5 -6 +7 +89 1 +23 -4 +56 +7 +8 +9 1 +23 -4 +5 +6 +78 -9 1 +2 +34 -5 +67 -8 +9 1 +2 +3 -4 +5 +6 +78 +9 -1 +2 -3 +4 +5 +6 +78 +9 10 commonest sums [sum, number of routes to it]: [(9,46),(27,44),(1,43),(15,43),(21,43),(45,42),(3,41),(5,40),(7,39),(17,39)] First positive integer not expressible as a sum of this kind: 211 10 largest sums: [123456789,23456790,23456788,12345687,12345669,3456801,3456792,3456790,3456788,3456786] [Finished in 1.204s]
JavaScript
ES5
<lang JavaScript>(function () {
'use strict';
// GENERIC FUNCTIONS ----------------------------------------------------
// permutationsWithRepetition :: Int -> [a] -> a var permutationsWithRepetition = function (n, as) { return as.length > 0 ? foldl1(curry(cartesianProduct)(as), replicate(n, as)) : []; };
// cartesianProduct :: [a] -> [b] -> a, b var cartesianProduct = function (xs, ys) { return [].concat.apply([], xs.map(function (x) { return [].concat.apply([], ys.map(function (y) { return [ [x].concat(y) ]; })); })); };
// curry :: ((a, b) -> c) -> a -> b -> c
var curry = function (f) {
return function (a) {
return function (b) {
return f(a, b);
};
};
};
// flip :: (a -> b -> c) -> b -> a -> c
var flip = function (f) {
return function (a, b) {
return f.apply(null, [b, a]);
};
};
// foldl1 :: (a -> a -> a) -> [a] -> a
var foldl1 = function (f, xs) {
return xs.length > 0 ? xs.slice(1)
.reduce(f, xs[0]) : [];
};
// replicate :: Int -> a -> [a]
var replicate = function (n, a) {
var v = [a],
o = [];
if (n < 1) return o;
while (n > 1) {
if (n & 1) o = o.concat(v);
n >>= 1;
v = v.concat(v);
}
return o.concat(v);
};
// group :: Eq a => [a] -> a var group = function (xs) { return groupBy(function (a, b) { return a === b; }, xs); };
// groupBy :: (a -> a -> Bool) -> [a] -> a var groupBy = function (f, xs) { var dct = xs.slice(1) .reduce(function (a, x) { var h = a.active.length > 0 ? a.active[0] : undefined, blnGroup = h !== undefined && f(h, x);
return {
active: blnGroup ? a.active.concat(x) : [x],
sofar: blnGroup ? a.sofar : a.sofar.concat([a.active])
};
}, {
active: xs.length > 0 ? [xs[0]] : [],
sofar: []
});
return dct.sofar.concat(dct.active.length > 0 ? [dct.active] : []);
};
// compare :: a -> a -> Ordering
var compare = function (a, b) {
return a < b ? -1 : a > b ? 1 : 0;
};
// on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
var on = function (f, g) {
return function (a, b) {
return f(g(a), g(b));
};
};
// nub :: [a] -> [a]
var nub = function (xs) {
return nubBy(function (a, b) {
return a === b;
}, xs);
};
// nubBy :: (a -> a -> Bool) -> [a] -> [a]
var nubBy = function (p, xs) {
var x = xs.length ? xs[0] : undefined;
return x !== undefined ? [x].concat(nubBy(p, xs.slice(1)
.filter(function (y) {
return !p(x, y);
}))) : [];
};
// find :: (a -> Bool) -> [a] -> Maybe a
var find = function (f, xs) {
for (var i = 0, lng = xs.length; i < lng; i++) {
if (f(xs[i], i)) return xs[i];
}
return undefined;
};
// Int -> [a] -> [a]
var take = function (n, xs) {
return xs.slice(0, n);
};
// unlines :: [String] -> String
var unlines = function (xs) {
return xs.join('\n');
};
// show :: a -> String
var show = function (x) {
return JSON.stringify(x);
}; //, null, 2);
// head :: [a] -> a
var head = function (xs) {
return xs.length ? xs[0] : undefined;
};
// tail :: [a] -> [a]
var tail = function (xs) {
return xs.length ? xs.slice(1) : undefined;
};
// length :: [a] -> Int
var length = function (xs) {
return xs.length;
};
// SIGNED DIGIT SEQUENCES (mapped to sums and to strings)
// data Sign :: [ 0 | 1 | -1 ] = ( Unsigned | Plus | Minus )
// asSum :: [Sign] -> Int
var asSum = function (xs) {
var dct = xs.reduceRight(function (a, sign, i) {
var d = i + 1; // zero-based index to [1-9] positions
if (sign !== 0) {
// Sum increased, digits cleared
return {
digits: [],
n: a.n + sign * parseInt([d].concat(a.digits)
.join(), 10)
};
} else return { // Digits extended, sum unchanged
digits: [d].concat(a.digits),
n: a.n
};
}, {
digits: [],
n: 0
});
return dct.n + (
dct.digits.length > 0 ? parseInt(dct.digits.join(), 10) : 0
);
};
// data Sign :: [ 0 | 1 | -1 ] = ( Unsigned | Plus | Minus )
// asString :: [Sign] -> String
var asString = function (xs) {
var ns = xs.reduce(function (a, sign, i) {
var d = (i + 1)
.toString();
return sign === 0 ? a + d : a + (sign > 0 ? ' +' : ' -') + d;
}, );
return ns[0] === '+' ? tail(ns) : ns; };
// SUM T0 100 ------------------------------------------------------------
// universe :: Sign var universe = permutationsWithRepetition(9, [0, 1, -1]) .filter(function (x) { return x[0] !== 1; });
// allNonNegativeSums :: [Int]
var allNonNegativeSums = universe.map(asSum)
.filter(function (x) {
return x >= 0;
})
.sort();
// uniqueNonNegativeSums :: [Int] var uniqueNonNegativeSums = nub(allNonNegativeSums);
return ["Sums to 100:\n", unlines(universe.filter(function (x) {
return asSum(x) === 100;
})
.map(asString)),
"\n\n10 commonest sums (sum, followed by number of routes to it):\n",
show(take(10, group(allNonNegativeSums)
.sort(on(flip(compare), length))
.map(function (xs) {
return [xs[0], xs.length];
}))),
"\n\nFirst positive integer not expressible as a sum of this kind:\n",
show(find(function (x, i) {
return x !== i;
}, uniqueNonNegativeSums.sort(compare)) - 1), // zero-based index
"\n10 largest sums:\n",
show(take(10, uniqueNonNegativeSums.sort(flip(compare))))
].join('\n') + '\n';
})();</lang>
- Output:
(Run in Atom editor, through Script package)
Sums to 100: 123 +45 -67 +8 -9 123 +4 -5 +67 -89 123 -45 -67 +89 123 -4 -5 -6 -7 +8 -9 12 +3 +4 +5 -6 -7 +89 12 +3 -4 +5 +67 +8 +9 12 -3 -4 +5 -6 +7 +89 1 +23 -4 +56 +7 +8 +9 1 +23 -4 +5 +6 +78 -9 1 +2 +34 -5 +67 -8 +9 1 +2 +3 -4 +5 +6 +78 +9 -1 +2 -3 +4 +5 +6 +78 +9 10 commonest sums (sum, followed by number of routes to it): [[9,46],[27,44],[1,43],[15,43],[21,43],[45,42],[3,41],[5,40],[17,39],[7,39]] First positive integer not expressible as a sum of this kind: 211 10 largest sums: [123456789,23456790,23456788,12345687,12345669,3456801,3456792,3456790,3456788,3456786] [Finished in 0.381s]
ES6
<lang JavaScript>(() => {
'use strict';
// GENERIC FUNCTIONS ----------------------------------------------------
// permutationsWithRepetition :: Int -> [a] -> a const permutationsWithRepetition = (n, as) => as.length > 0 ? ( foldl1(curry(cartesianProduct)(as), replicate(n, as)) ) : [];
// cartesianProduct :: [a] -> [b] -> a, b const cartesianProduct = (xs, ys) => [].concat.apply([], xs.map(x => [].concat.apply([], ys.map(y => [[x].concat(y)]))));
// curry :: ((a, b) -> c) -> a -> b -> c const curry = f => a => b => f(a, b);
// flip :: (a -> b -> c) -> b -> a -> c const flip = f => (a, b) => f.apply(null, [b, a]);
// foldl1 :: (a -> a -> a) -> [a] -> a
const foldl1 = (f, xs) =>
xs.length > 0 ? xs.slice(1)
.reduce(f, xs[0]) : [];
// replicate :: Int -> a -> [a]
const replicate = (n, a) => {
let v = [a],
o = [];
if (n < 1) return o;
while (n > 1) {
if (n & 1) o = o.concat(v);
n >>= 1;
v = v.concat(v);
}
return o.concat(v);
};
// group :: Eq a => [a] -> a const group = xs => groupBy((a, b) => a === b, xs);
// groupBy :: (a -> a -> Bool) -> [a] -> a const groupBy = (f, xs) => { const dct = xs.slice(1) .reduce((a, x) => { const h = a.active.length > 0 ? a.active[0] : undefined, blnGroup = h !== undefined && f(h, x);
return {
active: blnGroup ? a.active.concat(x) : [x],
sofar: blnGroup ? a.sofar : a.sofar.concat([a.active])
};
}, {
active: xs.length > 0 ? [xs[0]] : [],
sofar: []
});
return dct.sofar.concat(dct.active.length > 0 ? [dct.active] : []);
};
// compare :: a -> a -> Ordering const compare = (a, b) => a < b ? -1 : (a > b ? 1 : 0);
// on :: (b -> b -> c) -> (a -> b) -> a -> a -> c const on = (f, g) => (a, b) => f(g(a), g(b));
// nub :: [a] -> [a] const nub = xs => nubBy((a, b) => a === b, xs);
// nubBy :: (a -> a -> Bool) -> [a] -> [a]
const nubBy = (p, xs) => {
const x = xs.length ? xs[0] : undefined;
return x !== undefined ? [x].concat(
nubBy(p, xs.slice(1)
.filter(y => !p(x, y)))
) : [];
};
// find :: (a -> Bool) -> [a] -> Maybe a
const find = (f, xs) => {
for (var i = 0, lng = xs.length; i < lng; i++) {
if (f(xs[i], i)) return xs[i];
}
return undefined;
}
// Int -> [a] -> [a] const take = (n, xs) => xs.slice(0, n);
// unlines :: [String] -> String
const unlines = xs => xs.join('\n');
// show :: a -> String const show = x => JSON.stringify(x); //, null, 2);
// head :: [a] -> a const head = xs => xs.length ? xs[0] : undefined;
// tail :: [a] -> [a] const tail = xs => xs.length ? xs.slice(1) : undefined;
// length :: [a] -> Int const length = xs => xs.length;
// SIGNED DIGIT SEQUENCES (mapped to sums and to strings)
// data Sign :: [ 0 | 1 | -1 ] = ( Unsigned | Plus | Minus )
// asSum :: [Sign] -> Int
const asSum = xs => {
const dct = xs.reduceRight((a, sign, i) => {
const d = i + 1; // zero-based index to [1-9] positions
if (sign !== 0) { // Sum increased, digits cleared
return {
digits: [],
n: a.n + (sign * parseInt([d].concat(a.digits)
.join(), 10))
};
} else return { // Digits extended, sum unchanged
digits: [d].concat(a.digits),
n: a.n
};
}, {
digits: [],
n: 0
});
return dct.n + (dct.digits.length > 0 ? (
parseInt(dct.digits.join(), 10)
) : 0);
};
// data Sign :: [ 0 | 1 | -1 ] = ( Unsigned | Plus | Minus )
// asString :: [Sign] -> String
const asString = xs => {
const ns = xs.reduce((a, sign, i) => {
const d = (i + 1)
.toString();
return (sign === 0 ? (
a + d
) : (a + (sign > 0 ? ' +' : ' -') + d));
}, );
return ns[0] === '+' ? tail(ns) : ns; };
// SUM T0 100 ------------------------------------------------------------
// universe :: Sign const universe = permutationsWithRepetition(9, [0, 1, -1]) .filter(x => x[0] !== 1);
// allNonNegativeSums :: [Int]
const allNonNegativeSums = universe.map(asSum)
.filter(x => x >= 0)
.sort();
// uniqueNonNegativeSums :: [Int] const uniqueNonNegativeSums = nub(allNonNegativeSums);
return [
"Sums to 100:\n",
unlines(universe.filter(x => asSum(x) === 100)
.map(asString)),
"\n\n10 commonest sums (sum, followed by number of routes to it):\n",
show(take(10, group(allNonNegativeSums)
.sort(on(flip(compare), length))
.map(xs => [xs[0], xs.length]))),
"\n\nFirst positive integer not expressible as a sum of this kind:\n",
show(find(
(x, i) => x !== i,
uniqueNonNegativeSums.sort(compare)
) - 1), // i is the the zero-based Array index.
"\n10 largest sums:\n",
show(take(10, uniqueNonNegativeSums.sort(flip(compare))))
].join('\n') + '\n';
})();</lang>
- Output:
(Run in Atom editor, through Script package)
Sums to 100: 123 +45 -67 +8 -9 123 +4 -5 +67 -89 123 -45 -67 +89 123 -4 -5 -6 -7 +8 -9 12 +3 +4 +5 -6 -7 +89 12 +3 -4 +5 +67 +8 +9 12 -3 -4 +5 -6 +7 +89 1 +23 -4 +56 +7 +8 +9 1 +23 -4 +5 +6 +78 -9 1 +2 +34 -5 +67 -8 +9 1 +2 +3 -4 +5 +6 +78 +9 -1 +2 -3 +4 +5 +6 +78 +9 10 commonest sums (sum, followed by number of routes to it): [[9,46],[27,44],[1,43],[15,43],[21,43],[45,42],[3,41],[5,40],[17,39],[7,39]] First positive integer not expressible as a sum of this kind: 211 10 largest sums: [123456789,23456790,23456788,12345687,12345669,3456801,3456792,3456790,3456788,3456786] [Finished in 0.382s]
Mathematica
Defining all possible sums and counting them:
<lang Mathematica>operations =
DeleteCases[Tuples[{"+", "-", ""}, 9], {x_, y__} /; x == "+"];
allsums =
Map[StringJoin[Riffle[#, CharacterRange["1", "9"]]] &, operations];
counts = CountsBy[allsums, ToExpression];</lang>
Sums to 100:
<lang Mathematica> TableForm@Select[allsums, ToExpression@# == 100 &] </lang>
- Output:
-1+2-3+4+5+6+78+9 1+2+3-4+5+6+78+9 1+2+34-5+67-8+9 1+23-4+5+6+78-9 1+23-4+56+7+8+9 12+3+4+5-6-7+89 12+3-4+5+67+8+9 12-3-4+5-6+7+89 123+4-5+67-89 123+45-67+8-9 123-4-5-6-7+8-9 123-45-67+89
Maximum number of solutions: <lang Mathematica> MaximalBy[counts, Identity] </lang>
- Output:
<|9 -> 46, -9 -> 46|>
First unsolvable: <lang Mathematica> i = 1; While[KeyExistsQ[counts, i], ++i]; i </lang>
- Output:
221
Ten largest sums: <lang Mathematica> TakeLargest[Keys@counts, 10] </lang>
- Output:
{123456789, 23456790, 23456788, 12345687, 12345669, 3456801, 3456792, 3456790, 3456788, 3456786}
Nim
<lang Nim> import strutils
var
ligne: string = "" sum: int opera: array[0..9, int] = [0,0,1,1,1,1,1,1,1,1] curseur: int = 9 boucle: bool tot: array[1..123456789, int] pG: int plusGrandes: array[1..10, string]
let
ope: array[0..3, string] = ["-",""," +"," -"] aAtteindre = 100
proc calcul(li: string): int =
var liS: seq[string] liS = split(li," ") for i in liS: result += parseInt(i)
echo "Valeur à atteindre : ",aAtteindre
while opera[1]<2:
ligne.add(ope[opera[1]])
ligne.add("1")
for i in 2..9:
ligne.add(ope[opera[i]])
ligne.add($i)
sum = calcul(ligne)
if sum == aAtteindre:
stdout.write(ligne)
echo " = ",sum
if sum>0:
tot[sum] += 1
pG = 1
while pG<10:
if sum>calcul(plusGrandes[pG]):
for k in countdown(10,pG+1):
plusGrandes[k]=plusGrandes[k-1]
plusGrandes[pG]=ligne
pG = 11
pG += 1
ligne = ""
boucle = true
while boucle:
opera[curseur] += 1
if opera[curseur] == 4:
opera[curseur]=1
curseur -= 1
else:
curseur = 9
boucle = false
echo "Valeur atteinte ",tot[aAtteindre]," fois." echo ""
var
min0: int = 0 max: int = 0 valmax: int = 0
for i in 1..123456789:
if tot[i]==0 and min0 == 0: min0 = i if tot[i]>max: max = tot[i] valmax = i
echo "Plus petite valeur ne pouvant pas être atteinte : ",min0 echo "Valeur atteinte le plus souvent : ",valmax,", atteinte ",max," fois." echo "" echo "Plus grandes valeurs pouvant être atteintes :" for i in 1..10:
echo calcul(plusGrandes[i])," = ",plusGrandes[i]</lang>
- Output:
Valeur à atteindre : 100 -1 +2 -3 +4 +5 +6 +78 +9 = 100 123 +45 -67 +8 -9 = 100 123 +4 -5 +67 -89 = 100 123 -45 -67 +89 = 100 123 -4 -5 -6 -7 +8 -9 = 100 12 +3 +4 +5 -6 -7 +89 = 100 12 +3 -4 +5 +67 +8 +9 = 100 12 -3 -4 +5 -6 +7 +89 = 100 1 +23 -4 +56 +7 +8 +9 = 100 1 +23 -4 +5 +6 +78 -9 = 100 1 +2 +34 -5 +67 -8 +9 = 100 1 +2 +3 -4 +5 +6 +78 +9 = 100 Valeur atteinte 12 fois. Plus petite valeur ne pouvant pas être atteinte : 211 Valeur atteinte le plus souvent : 9, atteinte 46 fois. Plus grandes valeurs pouvant être atteintes : 123456789 = 123456789 23456790 = 1 +23456789 23456788 = -1 +23456789 12345687 = 12345678 +9 12345669 = 12345678 -9 3456801 = 12 +3456789 3456792 = 1 +2 +3456789 3456790 = -1 +2 +3456789 3456788 = 1 -2 +3456789 3456786 = -1 -2 +3456789
Perl 6
<lang perl6>my @ops = ['-', ], |( [' + ', ' - ', ] xx 8 ); my @str = [X~] map { .Slip }, ( @ops Z 1..9 ); my %sol = @str.classify: *.subst( ' - ', ' -', :g )\
.subst( ' + ', ' ', :g ).words.sum;
my %count.push: %sol.map({ .value.elems => .key });
my $max_solutions = %count.max( + *.key ); my $first_unsolvable = first { %sol{$_} :!exists }, 1..*; my @two_largest_sums = %sol.keys.sort(-*)[^2];
given %sol{100}:p {
say "{.value.elems} solutions for sum {.key}:";
say " $_" for .value.list;
}
say .perl for :$max_solutions, :$first_unsolvable, :@two_largest_sums;</lang>
- Output:
12 solutions for sum 100:
-1 + 2 - 3 + 4 + 5 + 6 + 78 + 9
1 + 2 + 3 - 4 + 5 + 6 + 78 + 9
1 + 2 + 34 - 5 + 67 - 8 + 9
1 + 23 - 4 + 5 + 6 + 78 - 9
1 + 23 - 4 + 56 + 7 + 8 + 9
12 + 3 + 4 + 5 - 6 - 7 + 89
12 + 3 - 4 + 5 + 67 + 8 + 9
12 - 3 - 4 + 5 - 6 + 7 + 89
123 + 4 - 5 + 67 - 89
123 + 45 - 67 + 8 - 9
123 - 4 - 5 - 6 - 7 + 8 - 9
123 - 45 - 67 + 89
:max_solutions("46" => $["9", "-9"])
:first_unsolvable(211)
:two_largest_sums(["123456789", "23456790"])
Phix
This is just a trivial count in base 3, with a leading '+' being irrelevant, so from 0(3)000_000_000 to 0(3)122_222_222 which is only (in decimal) 13,122 ...
Admittedly, categorising them into 3429 bins is slightly more effort, but otherwise I am somewhat bemused by all the applescript/javascript/Haskell shenanegins.
<lang Phix>enum SUB=-1, NOP=0, ADD=1
function eval(sequence s) integer res = 0, this = 0, op = ADD
for i=1 to length(s) do
if s[i]=NOP then
this = this*10+i
else
res += op*this
this = i
op = s[i]
end if
end for
return res + op*this
end function
procedure show(sequence s) string res = ""
for i=1 to length(s) do
if s[i]!=NOP then
res &= ','-s[i]
end if
res &= '0'+i
end for
puts(1,res&" = ")
end procedure
-- Logically this intersperses -/nop/+ between each digit, but you do not actually need the digit. sequence s = repeat(SUB,9) -- (==> ..nop+add*8)
bool done = false integer maxl = 0, maxr integer count = 0 while not done do
count += 1
integer r = eval(s), k = getd_index(r)
sequence solns = iff(k=0?{s}:append(getd_by_index(k),s))
setd(r,solns)
if r>0 and maxl<length(solns) then
maxl = length(solns)
maxr = r
end if
for i=length(s) to 1 by -1 do
if i=1 and s[i]=NOP then
done = true
exit
elsif s[i]!=ADD then
s[i] += 1
exit
end if
s[i] = SUB
end for
end while
printf(1,"%d solutions considered (dictionary size: %d)\n",{count,dict_size()})
sequence s100 = getd(100) printf(1,"There are %d sums to 100:\n",{length(s100)}) for i=1 to length(s100) do
show(s100[i]) ?100
end for
printf(1,"The positive sum of %d has the maximum number of solutions: %d\n",{maxr,maxl})
integer prev = 0 function missing(integer key, sequence /*data*/, integer /*pkey*/, object /*user_data=-2*/)
if key!=prev+1 then
return 0
end if
prev = key
return 1
end function traverse_dict_partial_key(routine_id("missing"),1) printf(1,"The lowest positive sum that cannot be expressed: %d\n",{prev+1})
sequence highest = {} function top10(integer key, sequence /*data*/, object /*user_data*/)
highest &= key return length(highest)<10
end function traverse_dict(routine_id("top10"),rev:=1) printf(1,"The 10 highest sums: ") ?highest</lang>
- Output:
13122 solutions considered (dictionary size: 3429)
There are 12 sums to 100:
-1+2-3+4+5+6+78+9 = 100
12-3-4+5-6+7+89 = 100
123-4-5-6-7+8-9 = 100
123-45-67+89 = 100
123+4-5+67-89 = 100
123+45-67+8-9 = 100
12+3-4+5+67+8+9 = 100
12+3+4+5-6-7+89 = 100
1+23-4+56+7+8+9 = 100
1+23-4+5+6+78-9 = 100
1+2+3-4+5+6+78+9 = 100
1+2+34-5+67-8+9 = 100
The positive sum of 9 has the maximum number of solutions: 46
The lowest positive sum that cannot be expressed: 211
The 10 highest sums: {123456789,23456790,23456788,12345687,12345669,3456801,3456792,3456790,3456788,3456786}
Python
<lang python> from itertools import product, islice
def expr(p):
return "{}1{}2{}3{}4{}5{}6{}7{}8{}9".format(*p)
def gen_expr():
op = ['+', '-', ] return [expr(p) for p in product(op, repeat=9) if p[0] != '+']
def all_exprs():
values = {}
for expr in gen_expr():
val = eval(expr)
if val not in values:
values[val] = 1
else:
values[val] += 1
return values
def sum_to(val):
for s in filter(lambda x: x[0] == val, map(lambda x: (eval(x), x), gen_expr())):
print(s)
def max_solve():
print("Sum {} has the maximum number of solutions: {}".
format(*max(all_exprs().items(), key=lambda x: x[1])))
def min_solve():
values = all_exprs()
for i in range(123456789):
if i not in values:
print("Lowest positive sum that can't be expressed: {}".format(i))
return
def highest_sums(n=10):
sums = map(lambda x: x[0],
islice(sorted(all_exprs().items(), key=lambda x: x[0], reverse=True), n))
print("Highest Sums: {}".format(list(sums)))
sum_to(100)
max_solve()
min_solve()
highest_sums()
</lang>
Racket
<lang racket>#lang racket
(define list-partitions
(match-lambda
[(list) (list null)]
[(and L (list _)) (list (list L))]
[(list L ...)
(for*/list
((i (in-range 1 (add1 (length L))))
(r (in-list (list-partitions (drop L i)))))
(cons (take L i) r))]))
(define digits->number (curry foldl (λ (dgt acc) (+ (* 10 acc) dgt)) 0))
(define partition-digits-to-numbers
(let ((memo (make-hash)))
(λ (dgts)
(hash-ref! memo dgts
(λ ()
(map (λ (p) (map digits->number p))
(list-partitions dgts)))))))
(define (fold-sum-to-ns digits kons k0)
(define (get-solutions nmbrs acc chain k)
(match nmbrs
[(list)
(kons (cons acc (let ((niahc (reverse chain)))
(if (eq? '+ (car niahc)) (cdr niahc) niahc)))
k)]
[(cons a d)
(get-solutions d (- acc a) (list* a '- chain)
(get-solutions d (+ acc a) (list* a '+ chain) k))]))
(foldl (λ (nmbrs k) (get-solutions nmbrs 0 null k)) k0 (partition-digits-to-numbers digits)))
(define sum-to-ns/hash-promise
(delay (fold-sum-to-ns
'(1 2 3 4 5 6 7 8 9)
(λ (a.s d) (hash-update d (car a.s) (λ (x) (cons (cdr a.s) x)) list))
(hash))))
(module+ main
(define S (force sum-to-ns/hash-promise))
(displayln "Show all solutions that sum to 100")
(pretty-print (hash-ref S 100))
(displayln "Show the sum that has the maximum number of solutions (from zero to infinity*)")
(let-values (([k-max v-max]
(for/fold ((k-max #f) (v-max 0))
(([k v] (in-hash S)) #:when (> (length v) v-max))
(values k (length v)))))
(printf "~a has ~a solutions~%" k-max v-max))
(displayln "Show the lowest positive sum that can't be expressed (has no solutions),
using the rules for this task")
(for/first ((n (in-range 1 (add1 123456789))) #:unless (hash-has-key? S n)) n)
(displayln "Show the ten highest numbers that can be expressed using the rules for this task")
(take (sort (hash-keys S) >) 10))
(module+ test
(require rackunit) (check-equal? (list-partitions null) '(())) (check-equal? (list-partitions '(1)) '(((1)))) (check-equal? (list-partitions '(1 2)) '(((1) (2)) ((1 2)))) (check-equal? (partition-digits-to-numbers '()) '(())) (check-equal? (partition-digits-to-numbers '(1)) '((1))) (check-equal? (partition-digits-to-numbers '(1 2)) '((1 2) (12))))</lang>
- Output:
Show all solutions that sum to 100 '((123 - 45 - 67 + 89) (123 + 45 - 67 + 8 - 9) (123 + 4 - 5 + 67 - 89) (123 - 4 - 5 - 6 - 7 + 8 - 9) (12 + 3 - 4 + 5 + 67 + 8 + 9) (12 - 3 - 4 + 5 - 6 + 7 + 89) (12 + 3 + 4 + 5 - 6 - 7 + 89) (1 + 23 - 4 + 56 + 7 + 8 + 9) (1 + 23 - 4 + 5 + 6 + 78 - 9) (1 + 2 + 34 - 5 + 67 - 8 + 9) (- 1 + 2 - 3 + 4 + 5 + 6 + 78 + 9) (1 + 2 + 3 - 4 + 5 + 6 + 78 + 9)) Show the sum that has the maximum number of solutions (from zero to infinity*) 9 has 46 solutions Show the lowest positive sum that can't be expressed (has no solutions), using the rules for this task 211 Show the ten highest numbers that can be expressed using the rules for this task '(123456789 23456790 23456788 12345687 12345669 3456801 3456792 3456790 3456788 3456786)
REXX
<lang rexx>/*REXX pgm solves a puzzle: using the string 123456789, insert - or + to sum to 100*/ parse arg LO HI . /*obtain optional arguments from the CL*/ if LO== | LO=="," then LO=100 /*Not specified? Then use the default.*/ if HI== | HI=="," then HI=LO /* " " " " " " */ if LO==00 then HI=123456789 /*LOW specified as zero with leading 0.*/ ops= '+-'; L=length(ops) + 1 /*define operators (and their length). */ @.=; do i=1 to L-1; @.i=substr(ops,i,1) /* " some handy-dandy REXX literals*/
end /*i*/ /* " individual operators for speed*/
mx=0; mn=999999 /*initialize the minimums and maximums.*/ mxL=; mnL=; do j=LO to HI until LO==00 & mn==0 /*solve with a range of sums*/
z=solve(j) /*find # of solutions for J.*/
if z> mx then mxL= /*see if this is a new max. */
if z>=mx then do; mxL=mxL j; mx=z; end /*remember this new maximum.*/
if z< mn then mnL= /*see if this is a new min. */
if z<=mn then do; mnL=mnL j; mn=z; end /*remember this new minimum.*/
end /*j*/
if LO==HI then exit /*don't display max & min ? */ @@= 'number of solutions: '; say _=words(mxL); say 'sum's(_) "of" mxL ' 's(_,"have",'has') 'the maximum' @@ mx _=words(mnL); say 'sum's(_) "of" mnL ' 's(_,"have",'has') 'the minimum' @@ mn exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ s: if arg(1)==1 then return arg(3); return word(arg(2) "s",1) /*simple pluralizer*/ /*──────────────────────────────────────────────────────────────────────────────────────*/ solve: parse arg answer; # =0 /*obtain the answer (sum) to the puzzle*/
do a=L-1 to L; aa= @.a'1' /*choose one of ─ or nothing. */
do b=1 for L; bb=aa || @.b'2' /* " " " ─ +, or abutment.*/
do c=1 for L; cc=bb || @.c'3' /* " " " " " " " */
do d=1 for L; dd=cc || @.d'4' /* " " " " " " " */
do e=1 for L; ee=dd || @.e'5' /* " " " " " " " */
do f=1 for L; ff=ee || @.f'6' /* " " " " " " " */
do g=1 for L; gg=ff || @.g'7' /* " " " " " " " */
do h=1 for L; hh=gg || @.h'8' /* " " " " " " " */
do i=1 for L; ii=hh || @.i'9' /* " " " " " " " */
interpret '$=' ii /*calculate the sum of modified string.*/
if $\==answer then iterate /*Is sum not equal to answer? Then skip*/
#=#+1; if LO==HI then say 'solution: ' $ " ◄───► " ii
end /*i*/
end /*h*/
end /*g*/
end /*f*/
end /*e*/
end /*d*/
end /*c*/
end /*b*/
end /*a*/
y=# /* [↓] adjust the number of solutions?*/
if y==0 then y='no' /* [↓] left justify plural of solution*/
if LO\==00 then say right(y, 9) 'solution's(#, , " ") 'found for' ,
right(j, length(HI) ) left(, #, "─")
return # /*return the number of solutions found.*/</lang>
output when the default input is used:
solution: 100 ◄───► -1+2-3+4+5+6+78+9
solution: 100 ◄───► 1+2+3-4+5+6+78+9
solution: 100 ◄───► 1+2+34-5+67-8+9
solution: 100 ◄───► 1+23-4+5+6+78-9
solution: 100 ◄───► 1+23-4+56+7+8+9
solution: 100 ◄───► 12+3+4+5-6-7+89
solution: 100 ◄───► 12+3-4+5+67+8+9
solution: 100 ◄───► 12-3-4+5-6+7+89
solution: 100 ◄───► 123+4-5+67-89
solution: 100 ◄───► 123+45-67+8-9
solution: 100 ◄───► 123-4-5-6-7+8-9
solution: 100 ◄───► 123-45-67+89
12 solutions found for 100
output when the following input is used: 00
sum of 9 has the maximum number of solutions: 46 sum of 211 has the minimum number of solutions: 0
Ruby
<lang ruby>def gen_expr
x = ['-', ]
y = ['+', '-', ]
x.product(y,y,y,y,y,y,y,y)
.map do |a,b,c,d,e,f,g,h,i|
"#{a}1#{b}2#{c}3#{d}4#{e}5#{f}6#{g}7#{h}8#{i}9"
end
end
def sum_to(val)
gen_expr.map{|expr| [eval(expr), expr]}.select{|v,expr| v==val}.each{|x| p x}
end
def max_solve
n,size = gen_expr.group_by{|expr| eval(expr)}
.select{|val,_| val>=0}
.map{|val,exprs| [val, exprs.size]}
.max_by{|_,size| size}
puts "sum of #{n} has the maximum number of solutions : #{size}"
end
def min_solve
solves = gen_expr.group_by{|expr| eval(expr)}
n = 0.step{|i| break i unless solves[i]}
puts "lowest positive sum that can't be expressed : #{n}"
end
def highest_sums(n=10)
n = gen_expr.map{|expr| eval(expr)}.uniq.sort.reverse.take(n)
puts "highest sums : #{n}"
end
sum_to(100) max_solve min_solve highest_sums</lang>
- Output:
[100, "-1+2-3+4+5+6+78+9"] [100, "1+2+3-4+5+6+78+9"] [100, "1+2+34-5+67-8+9"] [100, "1+23-4+5+6+78-9"] [100, "1+23-4+56+7+8+9"] [100, "12+3+4+5-6-7+89"] [100, "12+3-4+5+67+8+9"] [100, "12-3-4+5-6+7+89"] [100, "123+4-5+67-89"] [100, "123+45-67+8-9"] [100, "123-4-5-6-7+8-9"] [100, "123-45-67+89"] sum of 9 has the maximum number of solutions : 46 lowest positive sum that can't be expressed : 211 highest sums : [123456789, 23456790, 23456788, 12345687, 12345669, 3456801, 3456792, 3456790, 3456788, 3456786]
Tcl
<lang Tcl>proc sum_to_100 {} {
for {set i 0} {$i <= 13121} {incr i} {
set i3 [format %09d [dec2base 3 $i]] set form "" set subs {"" - +} foreach a [split $i3 ""] b [split 123456789 ""] { append form [lindex $subs $a] $b } lappend R([expr $form]) $form
}
puts "solutions for sum=100:\n[join [lsort $R(100)] \n]"
set max -1
foreach key [array names R] {
if {[llength $R($key)] > $max} { set max [llength $R($key)] set maxkey $key }
}
puts "max solutions: $max for $maxkey"
for {set i 0} {$i <= 123456789} {incr i} {
if ![info exists R($i)] { puts "first unsolvable: $i" break }
} puts "highest 10:\n[lrange [lsort -integer -decr [array names R]] 0 9]"
} proc dec2base {base dec} {
set res ""
while {$dec > 0} {
set res [expr $dec%$base]$res set dec [expr $dec/$base]
}
if {$res eq ""} {set res 0}
return $res
} sum_to_100</lang>
~ $ ./sum_to_100.tcl solutions for sum=100: -1+2-3+4+5+6+78+9 1+2+3-4+5+6+78+9 1+2+34-5+67-8+9 1+23-4+5+6+78-9 1+23-4+56+7+8+9 12+3+4+5-6-7+89 12+3-4+5+67+8+9 12-3-4+5-6+7+89 123+4-5+67-89 123+45-67+8-9 123-4-5-6-7+8-9 123-45-67+89 max solutions: 46 for 9 first unsolvable: 211 highest 10: 123456789 23456790 23456788 12345687 12345669 3456801 3456792 3456790 3456788 3456786
zkl
Taking a big clue from Haskell and just calculate the world. <lang zkl>var all = // ( (1,12,123...-1,-12,...), (2,23,...) ...)
(9).pump(List,fcn(n){ split("123456789"[n,*]) }) // 45
.apply(fcn(ns){ ns.extend(ns.copy().apply('*(-1))) }); // 90
fcn calcAllSums{ // calculate all 6572 sums (1715 unique)
fcn(n,sum,soFar,r){
if(n==9) return();
foreach b in (all[n]){
if(sum+b>=0 and b.abs()%10==9) r.appendV(sum+b,"%s%+d".fmt(soFar,b)); self.fcn(b.abs()%10,sum + b,"%s%+d".fmt(soFar,b),r);
} }(0,0,"",r:=Dictionary()); r
}
// "123" --> (1,12,123)
fcn split(nstr){ (1).pump(nstr.len(),List,nstr.get.fp(0),"toInt") }</lang> <lang zkl>fcn showSums(allSums,N=100,printSolutions=2){
slns:=allSums.find(N,T);
if(printSolutions) println("%d solutions for N=%d".fmt(slns.len(),N));
if(printSolutions==2) println(slns.concat("\n"));
println();
}
allSums:=calcAllSums(); showSums(allSums); showSums(allSums,0,1);
println("Smallest postive integer with no solution: ",
[1..].filter1('wrap(n){ Void==allSums.find(n) }));
println("5 commonest sums (sum, number of ways to calculate to it):"); ms:=allSums.values.apply("len").sort()[-5,*]; // 5 mostest sums allSums.pump(List, // get those pairs
'wrap([(k,v)]){ v=v.len(); ms.holds(v) and T(k.toInt(),v) or Void.Skip })
.sort(fcn(kv1,kv2){ kv1[1]>kv2[1] }) // and sort .println();</lang>
- Output:
12 solutions for N=100 +1+2+3-4+5+6+78+9 +1+2+34-5+67-8+9 +1+23-4+5+6+78-9 +1+23-4+56+7+8+9 +12+3+4+5-6-7+89 +12+3-4+5+67+8+9 +12-3-4+5-6+7+89 +123+4-5+67-89 +123+45-67+8-9 +123-4-5-6-7+8-9 +123-45-67+89 -1+2-3+4+5+6+78+9 22 solutions for N=0 Smallest postive integer with no solution: 211 5 commonest sums (sum, number of ways to calculate to it): L(L(9,46),L(27,44),L(15,43),L(1,43),L(21,43))
- Puzzles
- Programming Tasks
- Solutions by Programming Task
- Ada
- ALGOL 68
- AppleScript
- AutoHotkey
- AutoHotkey examples needing attention
- Examples needing attention
- C
- C sharp
- Elixir
- F Sharp
- Haskell
- JavaScript
- Mathematica
- Mathematica examples needing attention
- Nim
- Perl 6
- Phix
- Python
- Python examples needing attention
- Racket
- REXX
- Ruby
- Tcl
- Zkl