The well-known  combinat[composition]  command computes and returns a list containing all distinct ordered  k-tuples of positive integers whose elements sum equals  n . These are known as the compositions of  n .  For some applications, additional constraints are required for the elements of these k-tuples, for example, that they are within a certain range.

The  Composition  procedure solves this problem. Required parameters:  n - a nonnegative integer, k - a positive integer. The parameter  res  is the optional parameter (by default  res is  0 ). If  res  is a number, all elements of  k-tuples must be greater than or equal  res .  If  res  is a range  a .. b ,   all elements of  k-tuples must be greater than or equal  a  and  less than or equal  b .  Composition(n,k,1)  is equivalent to  combinat[composition](n,k) .

The code of the procedure:

Composition := proc (n::nonnegint, k::posint, res::{range, nonnegint} := 0)

local a, b, It, L0; 

if res::nonnegint then a := res; b := n-(k-1)*a  else a := lhs(res); b := rhs(res) fi;

if b < a or b*k < n then return `No solutions` fi; 

It := proc (L)

local m, j, P, R, i, N;

m := nops(L[1]); j := k-m; N := 0;

for i to nops(L) do

R := n-`+`(op(L[i]));

if R <= b*j and a*j <= R then N := N+1;

P[N] := [seq([op(L[i]), s], s = max(a, R-b*(j-1)) .. min(R, b))] fi;

od;

[seq(op(P[s]), s = 1 .. N)];

end proc;

L0 := [[]];

(It@@k)(L0); 

end proc:

Three simple examples:

Composition(10,3); ``;   # All terms greater than or equal 0

Composition(10,3, 2);   # All terms greater than or equal 2

Composition(10,3, 2..4);   # All terms greater than or equal 2 and less than or equal to 4 

A more complex example. The problem - to find all the numbers in the range  1 .. 99999999  whose digits sum is equal to 21 .

Each number is represented by a list of digits from left to right, replacing missing digits at the left with zeros.

M:=Composition(21,8, 0..9):  

nops(M);  # The number of solutions

[seq(M[1+100000*i], i=0..9)]; # 10 solutions from the list M starting the first one

seq(add(%[i,k]*10^(8-k), k=1..8),i=1..nops(%));  # Conversion into numbers

Composition.mws

The procedure  NumbersGame  generalizes the well-known 24 game  (implementation in Maple see here), as well as related issues (see here and here).

Required parameters of the procedure:

Result is an integer or a fraction of any sign.

Numbers is a list of positive integers.

Optional parameters:

Operators is a list of permitted arithmetic operations. By default  Operators is  ["+","-","*","/"]

NumbersOrder is a string. It is equal to "strict order" or "arbitrary order" . By default  NumbersOrder is "strict order"

Parentheses is a symbol  no  or  yes . By default  Parentheses is  no 

The procedure puts the signs of operations from the list  Operators  between the numbers from  Numbers  so that the result is equal to Result. The procedure finds all possible solutions. The global  M  saves the list of the all solutions.

Code the procedure:

restart;

NumbersGame:=proc(Result::{integer,fraction}, Numbers::list(posint), Operators::list:=["+","-","*","/"], NumbersOrder::string:="strict order", Parentheses::symbol:=no)

local MyHandler, It, K, i, P, S, n, s, L, c;

global M;

uses StringTools, ListTools, combinat; 

 MyHandler := proc(operator,operands,default_value)

      NumericStatus( division_by_zero = false );

      return infinity;

   end proc;

   NumericEventHandler(division_by_zero=MyHandler); 

if Parentheses=yes then 

It:=proc(L1,L2)

local i, j, L;

for i in L1 do

for j in L2 do

L[i,j]:=seq(Substitute(Substitute(Substitute("( i Op j )","i",convert(i,string)),"j",convert(j,string)),"Op",Operators[k]), k=1..nops(Operators));

od; od;

L:=convert(L, list);

end proc; 

P:=proc(L::list)

local n, K, i, M1, M2, S;

n:=nops(L);

if n=1 then return L else

for i to n-1 do

M1:=P(L[1..i]); M2:=P(L[i+1..n]);

K[i]:=seq(seq(It(M1[j], M2[k]), k=1..nops(M2)), j=1..nops(M1))

od; fi;

K:=convert(K,list);

end proc;

if NumbersOrder="arbitrary order" then S:=permute(Numbers); K:=[seq(op(Flatten([op(P(s))])), s=S)] else  K:=[op(Flatten([op(P(Numbers))]))] fi; 

else 

if NumbersOrder="strict order" then

K:=[convert(Numbers[1],string)];

for i in Numbers[2..-1] do

K:=[seq(seq(cat(k, Substitute(Substitute(" j i","j",convert(j,string)),"i",convert(i,string))), k in K), j in Operators)]

od;   else 

S:=permute(Numbers);

for s in S do

L:=[convert(s[1],string)];

for i in s[2..-1] do

L:=[seq(seq(cat(k, Substitute(Substitute(" j i","j",convert(j,string)),"i",convert(i,string))), k in L), j in Operators)]

od; K[s]:=op(L) od; K:=convert(K,list) fi;  

fi; 

M:='M'; c:=0;

for i in K do

if parse(i)=Result then c:=c+1; if Parentheses=yes then M[i]:= convert(SubString(i,2..length(i)-1),symbol)=convert(Result,symbol) else M[i]:=convert(i,symbol)=convert(Result,symbol) fi; fi;

od; 

if c=0 then M:=[]; return `No solutions` else M:=convert(M,list);  op(M) fi; 

end proc:

Examples of use.

Example 1:

NumbersGame(1/20, [$ 1..9]);

     1 * 2 - 3 + 4 / 5 / 6 * 7 / 8 * 9 = 1/20

Example 2. Numbers in the list  Numbers  may be repeated and permitted operations can be reduced:

NumbersGame(15, [3,3,5,5,5], ["+","-"]);

         3 - 3 + 5 + 5 + 5 = 15

Example 3. 

NumbersGame(10, [1,2,3,4,5]);

         1 + 2 + 3 * 4 - 5 = 10

If the order of the number in Numbers is arbitrary, then the number of solutions is greatly increased (10 solutions displayed):

NumbersGame(10, [1,2,3,4,5], "arbitrary order"):

nops(M);

for i to 10 do

M[1+50*(i-1)] od;

If you use the parentheses, the number of solutions will increase significantly more (10 solutions displayed):

NumbersGame(10, [1,2,3,4,5], "arbitrary order", yes):

nops(M);

for i to 10 do

M[1+600*(i-1)] od;

Game.mws

I learned about this problem from Aser's post   See  page of tasks still without  Maple implementation. 

The procedure  game24  solves the problem. In the procedure Acer's  procedure  MyHandler is  used, which prevents the program to stop in case of 0 in the denominator.

game24:=proc(a,b,c,d)

local MyHandler,It, K, M, i, P;

uses StringTools, combinat;

 MyHandler := proc(operator,operands,default_value)

      NumericStatus( division_by_zero = false );

      return infinity;

   end proc;

   NumericEventHandler(division_by_zero=MyHandler); 

It:=proc(L1,L2)

local i, j, L;

L:=[];

for i in L1 do

for j in L2 do

L:=[op(L), op([Substitute(Substitute("( i + j )","i",convert(i,string)),"j",convert(j,string)),Substitute(Substitute("( i - j )","i",convert(i,string)),"j",convert(j,string)),Substitute(Substitute("( i * j )","i",convert(i,string)),"j",convert(j,string)),Substitute(Substitute("( i / j )","i",convert(i,string)),"j",convert(j,string))])];

od; od;

L;

end proc; 

P:=permute([a,b,c,d]); 

K:=[];

for i in P do

K:=[op(K),op(It(It(It([i[1]],[i[2]]),[i[3]]),[i[4]])), op(It(It([i[1]],It([i[2]],[i[3]])),[i[4]])), op(It([i[1]],It(It([i[2]],[i[3]]),[i[4]]))), op(It([i[1]],It([i[2]],It([i[3]],[i[4]])))), op(It(It([i[1]],[i[2]]),It([i[3]],[i[4]])))];

od;

M:=[];

for i in K do

if parse(i)=24 then M:=[op(M), i] fi;

od;

if nops(M)=0 then return `No solutions` else

for i in M do

print(SubString(i,2..length(i)-1));

od; fi; 

end proc:

Two examples:

game24(2,3,8,9);

game24(2,3,3,4);

        No solutions

24.mws

In this post we present the solution with Maple to the logical problem of "Gardens Puzzle"

http://www.mathsisfun.com/puzzles/gardens-solution.html

The Puzzle:

Five friends have their gardens next to one another, where they grow three kinds of crops: fruits (apple, pear, nut, cherry), vegetables (carrot, parsley, gourd, onion) and flowers (aster, rose, tulip, lily).

1. They grow 12 different varieties.
2. Everybody grows exactly 4 different varieties
3. Each variety is at least in one garden.
4. Only one variety is in 4 gardens.
5. Only in one garden are all 3 kinds of crops.
6. Only in one garden are all 4 varieties of one kind of crops.
7. Pear is only in the two border gardens.
8. Paul's garden is in the middle with no lily.
9. Aster grower doesn't grow vegetables.
10. Rose growers don't grow parsley.
11. Nuts grower has also gourd and parsley.
12. In the first garden are apples and cherries.
13. Only in two gardens are cherries.
14. Sam has onions and cherries.
15. Luke grows exactly two kinds of fruit.
16. Tulip is only in two gardens.
17. Apple is in a single garden.
18. Only in one garden next to Zick's is parsley.
19. Sam's garden is not on the border.
20. Hank grows neither vegetables nor asters.
21. Paul has exactly three kinds of vegetable.

Who has which garden and what is grown where?

About methods of solution. At first I just wanted to generate all variations and using conditions 1 .. 21 to find all solutions. But even if we use the condition that everybody grows exactly 4 different varieties then the total number variants equals  5!^2*binomial(12,4)^5=427945522455000000

So from the very beginning using some of the conditions 1 .. 21 we maximally reduce the number of possible variants. For example from the conditions 11, 18 and 6 implies that only in one garden are all 4 varieties of flowers. Next we pass through these variants and using conditions 1 .. 21 and finally come to a unique solution:

restart;

Fruits:={apple, pear, nut, cherry}:

Vegetables:={carrot, parsley, gourd, onion}:

Flowers:={aster, rose, tulip, lily}:

Set1:=Flowers:

Garden1:={Set1}:

Set2:=Fruits union Vegetables union Flowers minus {nut,gourd,parsley} minus {apple,cherry,rose}:

Garden2:={seq({nut,gourd,parsley} union {Set2[i]}, i=1..nops(Set2))}:

Set3:=Vegetables union Flowers minus {parsley}:

Garden3:={seq({apple,cherry,pear} union {Set3[i]}, i=1..nops(Set3))}:

Set4:=combinat[choose](Fruits union Vegetables union Flowers minus {onion,cherry} minus {apple,parsley,pear,nut}, 2):

Garden4:={seq({onion,cherry} union Set4[i], i=1..nops(Set4))}:

Set5:=Fruits union Vegetables union Flowers minus {apple, cherry,nut,parsley}:

Garden5:=combinat[choose](Set5, 4):

S:=[]:

for s1 in Garden1 do

for s2 in Garden2 do

for s3 in Garden3 do

for s4 in Garden4 do

for s5 in Garden5 do

s:=[s1,s2,s3,s4,s5]: s_4:=combinat[choose](s,4): m:=0: n:=0: k:=0: p:=0: q:=0:

for i in s do

if `intersect`(i,Fruits)<>{} and `intersect`(i,Vegetables)<>{} and `intersect`(i,Flowers)<>{} then m:=m+1: fi:

if pear in i then n:=n+1: fi:

if tulip in i then k:=k+1: fi:

if aster in i and `intersect`(i,Vegetables)<>{} then p:=p+1: fi:

if i=Fruits or i=Vegetables or i=Flowers then q:=q+1: fi:

od:

if nops(`union`(op(s)))=12 and nops(`union`(seq(`intersect`(op(s_4[j])), j=1..nops(s_4))))=1 and m=1 and n=2 and k=2 and p=0 and q=1 then S:=[op(S),[s1,s2,s3,s4,s5]]: fi:

od: od: od: od: od:

L1:=[seq([[3,Paul],[2,Sam],seq([combinat[permute]([1,4,5])[i,j],[Luke,Zick,Hank][j]],j=1..3)],i=1..6)]:

L2:=[seq([[3,Paul],[4,Sam],seq([combinat[permute]([1,2,5])[i,j],[Luke,Zick,Hank][j]],j=1..3)],i=1..6)]:

L0:=[op(L1),op(L2)]:

L:=[seq(op(combinat[permute](L0[i])),i=1..nops(L0))]:

Sol:=[]:

for l in L do

for s in S do

sol:=[seq([op(l[i]),s[i]], i=1..5)]:

gad1:=op(select(has,sol,parsley)): gad2:=op(select(has,sol,Zick)):

if abs(gad1[1]-gad2[1])=1 and convert([seq(((pear in sol[i][3] implies (sol[i][1]=1 or sol[i][1]=5)) and (sol[i][2]=Paul implies (not lily in sol[i][3])) and (sol[i][1]=1 implies (apple in sol[i][3] and cherry in sol[i][3])) and (sol[i][2]=Sam implies (onion in sol[i][3] and cherry in sol[i][3])) and (sol[i][2]=Luke implies nops(`intersect`(sol[i][3],Fruits))=2) and (sol[i][2]=Hank implies (`intersect`(sol[i][3],Vegetables)={} and not aster in sol[i][3])) and (sol[i][2]=Paul implies nops(`intersect`(sol[i][3],Vegetables))=3)), i=1..5)], `and`) then Sol:=[op(Sol), sol]: fi:

od: od:

for i in Sol do

Matrix(sort(i,(x,y)->x[1]<y[1]));

od;

In this post we present another compact proof of this remarkable theorem without using  geometry package.
The proof uses a procedure called  Cc , which for three points returns a list of the coordinates of the center and the radius of the circumscribed circle.

restart;

Cc:=proc(A,B,C)

local x1, y1, x2, y2, x3, y3, x, y;

x1,y1:=op(A);  x2,y2:=op(B);  x3,y3:=op(C);

solve({(x2-x1)*(x-(x1+x2)/2)+(y2-y1)*(y-(y1+y2)/2)=0, (x2-x3)*(x-(x2+x3)/2)+(y2-y3)*(y-(y2+y3)/2)=0},{x,y});

assign(%);

[simplify([x,y]), simplify(sqrt((x-x1)^2+(y-y1)^2))];

end proc:

Proof for arbitrary triangle:

A, B, C:=[x1,y1], [x2,y2], [x3,y3]:

A1, B1, C1, M:=(B+C)/2, (A+C)/2, (A+B)/2, (A+B+C)/3:

P1:=Cc(A,M,B1)[1]: P2:=Cc(B1,M,C)[1]: P3:=Cc(C,M,A1)[1]:

P4:=Cc(A1,M,B)[1]: P5:=Cc(B,M,C1)[1]: P6:=Cc(C1,M,A)[1]:

Cc1:=Cc(P1,P2,P3):  Cc2:=Cc(P4,P5,P6):

is(Cc1=Cc2);

                                                  true