Sum to 100: Difference between revisions

From Rosetta Code
Content added Content deleted
m (→‎ES5: (removed redundant space before comment))
(→‎{{header|AppleScript}}: Only the first task seems accessible within a practical amount of time)
Line 185: Line 185:
123456789 23456790 23456788 12345687 12345669 3456801 3456792 3456790 3456788 3456786
123456789 23456790 23456788 12345687 12345669 3456801 3456792 3456790 3456788 3456786
</pre>
</pre>

=={{header|AppleScript}}==
{{Trans|JavaScript}}
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>property pSigns : {1, 0, -1} --> ( + | unsigned | - )

-- 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()
set lst100 to {"Sums to 100:", ""}
-- 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 lst100 to asString(xs)
end repeat
intercalate(linefeed, lst100)
end sumsTo100



-- TEST ----------------------------------------------------------------------
on run
sumsTo100()
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


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

{{Out}}
<pre>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</pre>


=={{header|Elixir}}==
=={{header|Elixir}}==

Revision as of 13:12, 9 January 2017

Sum to 100 is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.
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)

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

Translation of: JavaScript

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>property pSigns : {1, 0, -1} --> ( + | unsigned | - )

-- 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() 

   set lst100 to {"Sums to 100:", ""}
   
   -- 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 lst100 to asString(xs)
   end repeat
   intercalate(linefeed, lst100)

end sumsTo100


-- TEST ---------------------------------------------------------------------- on run 

   sumsTo100()

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


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

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]

Haskell

<lang Haskell>import Data.Function (on) 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 = 

 mapM_
   putStrLn
   [ "Sums to 100:\n"
   , unlines $ asString <$> filter ((== 100) . asSum) universe
   
   , "\n10 commonest sums [sum, number of routes to it]:\n"
   , show
       ((head &&& length) <$>
        take 10 (sortBy (on (flip compare) length) (group allNonNegativeSums)))
        
   , "\nFirst positive integer not expressible as a sum of this kind:\n"
   , maybeReport (find (uncurry (/=)) (zip [0 ..] uniqueNonNegativeSums))
   
   , "\n10 largest sums:\n"
   , show $ take 10 $ sortBy (flip compare) uniqueNonNegativeSums
   
   , "\n"
   ]
 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.237s]

JavaScript

ES5

Translation of: Haskell

<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

Translation of: Haskell

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

Perl 6

Works with: Rakudo version 2016.12

<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"])

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 0s*/ 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 # solutionson 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=#
      if y==0  then y='no'                      /*maybe adjust the number of solutions.*/
      if LO\==00  then say right(y, 9)  'solution's(y)  'found for'  right(j, length(HI))
      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

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))
Retrieved from "https://rosettacode.org/wiki/Sum_to_100?oldid=273518"