Advanced Search

Kitonum

20469 Reputation

26 Badges

16 years, 66 days
Contact Kitonum

MaplePrimes Activity


These are Posts that have been published by Kitonum

The solution to another problem of Putna...

Kitonum 20469
putnam-problems
December 12 2019
0 0

Here is two solutions with Maple of the problem A2 of  Putnam Mathematical Competition 2019 . The first solution is entirely based on the use of the  geometry  package; the second solution does not use this package. Since the triangle is defined up to similarity, without loss of generality, we can set its vertices  A(0,0) , B(1,0) , C(x0,y0)  and then calculate the parameters  x0, y0  using the conditions of the problem. 


 

The problem

A2: In the triangle ∆ABC, let G be the centroid, and let I be the center of the
inscribed circle. Let α and β be the angles at the vertices A and B, respectively.
Suppose that the segment IG is parallel to AB and that  β = 2*arctan(1/3).  Find α.
 

> 

# Solution 1 with the geometry package
restart;

# Calculation

with(geometry):
local I:
point(A,0,0): point(B,1,0): point(C,x0,y0):
assume(y0>0,-y0*(-1+x0-((1-x0)^2+y0^2)^(1/2))+y0*((x0^2+y0^2)^(1/2)+x0) <> 0):
triangle(t,[A,B,C]):
incircle(ic,t, 'centername'=I):
Cn:=coordinates(I):
centroid(G,t):
CG:=coordinates(G):
a:=-expand(tan(2*arctan(1/3))):
solve({Cn[2]=CG[2],y0/(x0-1)=a}, explicit);
point(C,eval([x0,y0],%)):
answer=FindAngle(line(AB,[A,B]),line(AC,[A,C]));

# Visualization (G is the point of medians intersection)

triangle(t,[A,B,C]):
incircle(ic,t, 'centername'=I):
centroid(G,t):
segment(s,[I,G]):
median(mB,B,t): median(mC,C,t):
draw([A(symbol=solidcircle,color=black),B(symbol=solidcircle,color=black),C(symbol=solidcircle,color=black),I(symbol=solidcircle,color=green),G(symbol=solidcircle,color=blue),t(color=black),s(color=red,thickness=2),ic(color=green),mB(color=blue,thickness=0),mC(color=blue,thickness=0)], axes=none, size=[800,500], printtext=true,font=[times,20]);

I

  

Warning, The imaginary unit, I, has been renamed _I

  

Warning, solve may be ignoring assumptions on the input variables.

  

{x0 = 0, y0 = 3/4}

  

answer = (1/2)*Pi

  

 
> 


# Solution 2 by a direct calculation

# Calculation

restart;
local I;
sinB:=y0/sqrt(x0^2+y0^2):
cosB:=x0/sqrt(x0^2+y0^2):
Sol1:=eval([x,y],solve({y=-(x-1)/3,y=(sinB/(1+cosB))*x}, {x,y})):
tanB:=expand(tan(2*arctan(1/3))):
Sol2:=solve({y0/3=Sol1[2],y0=-tanB*(x0-1)},explicit);
A:=[0,0]: B:=[1,0]: C:=eval([x0,y0],Sol2[2]):
AB:=<(B-A)[]>: AC:=<(C-A)[]>:
answer=arccos(AB.AC/sqrt(AB.AB)/sqrt(AC.AC));

# Visualization

with(plottools): with(plots):
ABC:=curve([A,B,C,A]):
I:=simplify(eval(Sol1,Sol2[2]));
c:=circle(I,eval(Sol1[2],Sol2[2]),color=green):
G:=(A+B+C)/~3;
IG:=line(I,G,color=red,thickness=2):
P:=pointplot([A,B,C,I,G], color=[black$3,green,blue], symbol=solidcircle):
T:=textplot([[A[],"A"],[B[],"B"],[C[],"C"],[I[],"I"],[G[],"G"]], font=[times,20], align=[left,below]):
M:=plot([[(C+t*~((A+B)/2-C))[],t=0..1],[(B+t*~((A+C)/2-B))[],t=0..1]], color=blue, thickness=0):
display(ABC,c,IG,P,T,M, scaling=constrained, axes=none,size=[800,500]);

I

  

Warning, The imaginary unit, I, has been renamed _I

  

{x0 = 1, y0 = 0}, {x0 = 0, y0 = 3/4}

  

answer = (1/2)*Pi

  

[1/4, 1/4]

  

[1/3, 1/4]

  

 
> 

 


 

Download Putnam.mw

Serpentine paths in matrices and genera...

Kitonum 20469 Maple 2018
numbrix-puzzle serpentine-paths
August 07 2019
3 0

This post is closely related to the previous one  https://www.mapleprimes.com/posts/210930-Numbrix-Puzzle-By-The-Branch-And-Bound-Method  which presents the procedure  NumbrixPuzzle   that allows you to effectively solve these puzzles (the text of this procedure is also available in the worksheet below).  
This post is about generating these puzzles. To do this, we need the procedure  SerpentinePaths  (see below) , which allows us to generate a large number of serpentine paths in a matrix of a specified size, starting with a specified matrix element. Note that for a square matrix of the order  n , the number of such paths starting from [1,1] - position is the sequence  https://oeis.org/search?q=1%2C2%2C8%2C52%2C824&language=english&go=Search .

The required parameter of  SerpentinePaths procedure is the list  S , which defines the dimensions of the matrix. The optional parameter is the list  P  - this is the position of the number 1 (by default P=[1,1] ).
As an example below, we generate 20 puzzles of size 6 by 6. In exactly the same way, we can generate the desired number of puzzles for matrices of other sizes.


 

> 

restart;
> 

SerpentinePaths:=proc(S::list, P::list:=[1,1])
local OneStep, A, m, F, B, T, a;

OneStep:=proc(A::listlist)
local s, L, B, T, k, l;

s:=max[index](A);
L:=[[s[1]-1,s[2]],[s[1]+1,s[2]],[s[1],s[2]-1],[s[1],s[2]+1]];
T:=table(); k:=0;
for l in L do
if l[1]>=1 and l[1]<=S[1] and l[2]>=1 and l[2]<=S[2] and A[op(l)]=0 then k:=k+1; B:=subsop(l=a+1,A);
T[k]:=B fi;
od;
convert(T, list);
end proc;
A:=convert(Matrix(S[], {(P[])=1}), listlist);
m:=S[1]*S[2]-1;
B:=[$ 1..m];
F:=LM->ListTools:-FlattenOnce(map(OneStep, `if`(nops(LM)<=30000,LM,LM[-30000..-1])));
T:=[A];
for a in B do
T:=F(T);
od;
map(convert, T, Matrix);

end proc:
 
> 

NumbrixPuzzle:=proc(A::Matrix)
local A1, L, N, S, MS, OneStepLeft, OneStepRight, F1, F2, m, L1, p, q, a, b, T, k, s1, s, H, n, L2, i, j, i1, j1, R;
uses ListTools;
S:=upperbound(A); N:=nops(op(A)[3]); MS:=`*`(S);
A1:=convert(A, listlist);
for i from 1 to S[1] do
for j from 1 to S[2] do
for i1 from i to S[1] do
for j1 from 1 to S[2] do
if A1[i,j]<>0 and A1[i1,j1]<>0 and abs(A1[i,j]-A1[i1,j1])<abs(i-i1)+abs(j-j1) then return `no solutions` fi;
od; od; od; od;
L:=sort(select(e->e<>0, Flatten(A1)));
L1:=[`if`(L[1]>1,seq(L[1]-k, k=0..L[1]-2),NULL)];
L2:=[seq(seq(`if`(L[i+1]-L[i]>1,L[i]+k,NULL),k=0..L[i+1]-L[i]-2), i=1..nops(L)-1), `if`(L[-1]<MS,seq(L[-1]+k,k=0..MS-L[-1]-1),NULL)];
OneStepLeft:=proc(A1::listlist)
local s, M, m, k, T;
uses ListTools;
s:=Search(a, Matrix(A1));   
M:=[[s[1]-1,s[2]],[s[1]+1,s[2]],[s[1],s[2]-1],[s[1],s[2]+1]];
T:=table(); k:=0;
for m in M do
if m[1]>=1 and m[1]<=S[1] and m[2]>=1 and m[2]<=S[2] and A1[op(m)]=0 then k:=k+1; T[k]:=subsop(m=a-1,A1);
fi;
od;
convert(T, list);
end proc;
OneStepRight:=proc(A1::listlist)
local s, M, m, k, T, s1;
uses ListTools;
s:=Search(a, Matrix(A1));  s1:=Search(a+2, Matrix(A1));  
M:=[[s[1]-1,s[2]],[s[1]+1,s[2]],[s[1],s[2]-1],[s[1],s[2]+1]];
T:=table(); k:=0;
for m in M do
if m[1]>=1 and m[1]<=S[1] and m[2]>=1 and m[2]<=S[2] and A1[op(m)]=0 and `if`(a+2 in L, `if`(is(abs(s1[1]-m[1])+abs(s1[2]-m[2])>1),false,true),true) then k:=k+1; T[k]:=subsop(m=a+1,A1);
fi;
od;
convert(T, list);   
end proc;
F1:=LM->ListTools:-FlattenOnce(map(OneStepLeft, LM));
F2:=LM->ListTools:-FlattenOnce(map(OneStepRight, LM));
T:=[A1];
for a in L1 do
T:=F1(T);
od;
for a in L2 do
T:=F2(T);
od;
R:=map(t->convert(t,Matrix), T);
if nops(R)=0 then return `no solutions` else R fi;
end proc:


Simple examples

> 

SerpentinePaths([3,3]);  # All the serpentine paths for the matrix  3x3, starting with [1,1]-position
SerpentinePaths([3,3],[1,2]);  # No solutions if the start with [1,2]-position
SerpentinePaths([4,4]):  # All the serpentine paths for the matrix  4x4, starting with [1,1]-position
nops(%);
nops(SerpentinePaths([4,4],[1,2]));  # The number of all the serpentine paths for the matrix  4x4, starting with [1,2]-position
nops(SerpentinePaths([4,4],[2,2]));  # The number of all the serpentine paths for the matrix  4x4, starting with [2,2]-position

[Matrix(3, 3, {(1, 1) = 1, (1, 2) = 6, (1, 3) = 7, (2, 1) = 2, (2, 2) = 5, (2, 3) = 8, (3, 1) = 3, (3, 2) = 4, (3, 3) = 9}), Matrix(3, 3, {(1, 1) = 1, (1, 2) = 8, (1, 3) = 7, (2, 1) = 2, (2, 2) = 9, (2, 3) = 6, (3, 1) = 3, (3, 2) = 4, (3, 3) = 5}), Matrix(3, 3, {(1, 1) = 1, (1, 2) = 8, (1, 3) = 9, (2, 1) = 2, (2, 2) = 7, (2, 3) = 6, (3, 1) = 3, (3, 2) = 4, (3, 3) = 5}), Matrix(3, 3, {(1, 1) = 1, (1, 2) = 4, (1, 3) = 5, (2, 1) = 2, (2, 2) = 3, (2, 3) = 6, (3, 1) = 9, (3, 2) = 8, (3, 3) = 7}), Matrix(3, 3, {(1, 1) = 1, (1, 2) = 2, (1, 3) = 9, (2, 1) = 4, (2, 2) = 3, (2, 3) = 8, (3, 1) = 5, (3, 2) = 6, (3, 3) = 7}), Matrix(3, 3, {(1, 1) = 1, (1, 2) = 2, (1, 3) = 3, (2, 1) = 8, (2, 2) = 7, (2, 3) = 4, (3, 1) = 9, (3, 2) = 6, (3, 3) = 5}), Matrix(3, 3, {(1, 1) = 1, (1, 2) = 2, (1, 3) = 3, (2, 1) = 8, (2, 2) = 9, (2, 3) = 4, (3, 1) = 7, (3, 2) = 6, (3, 3) = 5}), Matrix(3, 3, {(1, 1) = 1, (1, 2) = 2, (1, 3) = 3, (2, 1) = 6, (2, 2) = 5, (2, 3) = 4, (3, 1) = 7, (3, 2) = 8, (3, 3) = 9})]

  

[]

  

52

  

25

  

36

 (1)


Below we find 12,440 serpentine paths in the matrix  6x6 starting from various positions (the set  L )

> 

k:=0:  n:=6:
for i from 1 to n do
for j from i to n do
k:=k+1; S[k]:=SerpentinePaths([n,n],[i,j])[];
od: od:
L1:={seq(S[i][], i=1..k)}:
L2:=map(A->A^%T, L1):
L:=L1 union L2:
nops(L);

12440

 (2)


Further, using the list  L, we generate 20 examples of Numbrix puzzles with the unique solutions

> 

T:='T':
N:=20:
M:=[seq(L[i], i=combinat:-randcomb(nops(L),N))]:
for i from 1 to N do
for k from floor(n^2/4) do
T[i]:=Matrix(n,{seq(op(M[i])[3][j], j=combinat:-randcomb(n^2,k))});
if nops(NumbrixPuzzle(T[i]))=1 then break; fi;
od:  od:
T:=convert(T,list):
T1:=[seq([seq(T[i+j],i=1..5)],j=[0,5,10,15])]:
DocumentTools:-Tabulate(Matrix(4,5, (i,j)->T1[i,j]), fillcolor = "LightYellow", width=95):


The solutions of these puzzles

> 

DocumentTools:-Tabulate(Matrix(4,5, (i,j)->NumbrixPuzzle(T1[i,j])[]), fillcolor = "LightYellow", width=95):
> 

 


For some reason, these 20 examples and their solutions did not load here.

 Edit. I separately inserted these generated 20 puzzles as a picture:

 

Download SerpPathsinMatrix.mw

 

Numbrix Puzzle by the branch and bound m...

Kitonum 20469 Maple 2018
branchandbound numbrix-puzzle
July 28 2019
3 3

In this post, the Numbrix Puzzle is solved by the branch and bound method (see the details of this puzzle in  https://www.mapleprimes.com/posts/210643-Solving-A-Numbrix-Puzzle-With-Logic). The main difference from the solution using the  Logic  package is that here we get not one but all possible solutions. In the case of a unique solution, the  NumbrixPuzzle procedure is faster than the  Numbrix  one (for convenience, I inserted the code for Numbrix procedure into the worksheet below). In the case of many solutions, the  Numbrix  procedure is usually faster (see all the examples below).

 

> 

restart;
> 

NumbrixPuzzle:=proc(A::Matrix)
local A1, L, N, S, MS, OneStepLeft, OneStepRight, F1, F2, m, L1, p, q, a, b, T, k, s1, s, H, n, L2, i, j, i1, j1, R;
uses ListTools;
S:=upperbound(A); N:=nops(op(A)[3]); MS:=`*`(S);
A1:=convert(A, listlist);
for i from 1 to S[1] do
for j from 1 to S[2] do
for i1 from i to S[1] do
for j1 from 1 to S[2] do
if A1[i,j]<>0 and A1[i1,j1]<>0 and abs(A1[i,j]-A1[i1,j1])<abs(i-i1)+abs(j-j1) then return `no solutions` fi;
od; od; od; od;
L:=sort(select(e->e<>0, Flatten(A1)));
L1:=[`if`(L[1]>1,seq(L[1]-k, k=0..L[1]-2),NULL)];
L2:=[seq(seq(`if`(L[i+1]-L[i]>1,L[i]+k,NULL),k=0..L[i+1]-L[i]-2), i=1..nops(L)-1), `if`(L[-1]<MS,seq(L[-1]+k,k=0..MS-L[-1]-1),NULL)];
  

OneStepLeft:=proc(A1::listlist)
local s, M, m, k, T;
uses ListTools;
s:=Search(a, Matrix(A1));   
M:=[[s[1]-1,s[2]],[s[1]+1,s[2]],[s[1],s[2]-1],[s[1],s[2]+1]];
T:=table(); k:=0;
for m in M do
if m[1]>=1 and m[1]<=S[1] and m[2]>=1 and m[2]<=S[2] and A1[op(m)]=0 then k:=k+1; T[k]:=subsop(m=a-1,A1);
fi;
od;
convert(T, list);
end proc;

 
OneStepRight:=proc(A1::listlist)
local s, M, m, k, T, s1;
uses ListTools;
s:=Search(a, Matrix(A1));  s1:=Search(a+2, Matrix(A1));  
M:=[[s[1]-1,s[2]],[s[1]+1,s[2]],[s[1],s[2]-1],[s[1],s[2]+1]];
T:=table(); k:=0;
for m in M do
if m[1]>=1 and m[1]<=S[1] and m[2]>=1 and m[2]<=S[2] and A1[op(m)]=0 and `if`(a+2 in L, `if`(is(abs(s1[1]-m[1])+abs(s1[2]-m[2])>1),false,true),true) then k:=k+1; T[k]:=subsop(m=a+1,A1);
fi;
od;
convert(T, list);   
end proc;

F1:=LM->ListTools:-FlattenOnce(map(OneStepLeft, LM));
F2:=LM->ListTools:-FlattenOnce(map(OneStepRight, LM));

T:=[A1];
for a in L1 do
T:=F1(T);
od;

for a in L2 do
T:=F2(T);
od;

R:=map(t->convert(t,Matrix), T);
if nops(R)=0 then return `no solutions` else R[] fi;

end proc:
> 

Numbrix := proc( M :: ~Matrix, { inline :: truefalse := false } )

local S, adjacent, eq, i, initial, j, k, kk, m, n, one, single, sol, unique, val, var, x;

    (m,n) := upperbound(M);

    initial := &and(seq(seq(ifelse(M[i,j] = 0
                                   , NULL
                                   , x[i,j,M[i,j]]
                                  )
                            , i = 1..m)
                        , j = 1..n));

    adjacent := &and(seq(seq(seq(x[i,j,k] &implies &or(NULL
                                                       , ifelse(i>1, x[i-1, j, k+1], NULL)
                                                       , ifelse(i<m, x[i+1, j, k+1], NULL)
                                                       , ifelse(j>1, x[i, j-1, k+1], NULL)
                                                       , ifelse(j<n, x[i, j+1, k+1], NULL)
                                                      )
                                 , i = 1..m)
                             , j = 1..n)
                         , k = 1 .. m*n-1));

    one := &or(seq(seq(x[i,j,1], i=1..m), j=1..n));   


    single := &not(&or(seq(seq(seq(seq(x[i,j,k] &and x[i,j,kk], kk = k+1..m*n), k = 1..m*n-1)
                                , i = 1..m), j = 1..n)));

    sol := Logic:-Satisfy(&and(initial, adjacent, one, single));
    
    if sol = NULL then
        error "no solution";
    end if;
if inline then
        S := M;
     else
        S := Matrix(m,n);
    end if;

    for eq in sol do
        (var, val) := op(eq);
        if val then
            S[op(1..2, var)] := op(3,var);
        end if;
    end do;
    S;
end proc:

           Two simple examples

> 

A:=<0,0,5; 0,0,0; 0,0,9>;
# The unique solution
NumbrixPuzzle(A);

A:=<0,0,5; 0,0,0; 0,8,0>;
# 4 solutions
NumbrixPuzzle(A);

Matrix(3, 3, {(1, 1) = 0, (1, 2) = 0, (1, 3) = 5, (2, 1) = 0, (2, 2) = 0, (2, 3) = 0, (3, 1) = 0, (3, 2) = 0, (3, 3) = 9})

  

Matrix(3, 3, {(1, 1) = 3, (1, 2) = 4, (1, 3) = 5, (2, 1) = 2, (2, 2) = 7, (2, 3) = 6, (3, 1) = 1, (3, 2) = 8, (3, 3) = 9})

  

Matrix(3, 3, {(1, 1) = 0, (1, 2) = 0, (1, 3) = 5, (2, 1) = 0, (2, 2) = 0, (2, 3) = 0, (3, 1) = 0, (3, 2) = 8, (3, 3) = 0})

  

Matrix(%id = 18446746210121682686), Matrix(%id = 18446746210121682806), Matrix(%id = 18446746210121674750), Matrix(%id = 18446746210121674870)

 (1)


Comparison with Numbrix procedure. The example is taken from
http://rosettacode.org/wiki/Solve_a_Numbrix_puzzle 

> 

 A:=<0, 0, 0, 0, 0, 0, 0, 0, 0;
 0, 0, 46, 45, 0, 55, 74, 0, 0;
 0, 38, 0, 0, 43, 0, 0, 78, 0;
 0, 35, 0, 0, 0, 0, 0, 71, 0;
 0, 0, 33, 0, 0, 0, 59, 0, 0;
 0, 17, 0, 0, 0, 0, 0, 67, 0;
 0, 18, 0, 0, 11, 0, 0, 64, 0;
 0, 0, 24, 21, 0, 1, 2, 0, 0;
 0, 0, 0, 0, 0, 0, 0, 0, 0>;
CodeTools:-Usage(NumbrixPuzzle(A));
CodeTools:-Usage(Numbrix(A));

Matrix(9, 9, {(1, 1) = 0, (1, 2) = 0, (1, 3) = 0, (1, 4) = 0, (1, 5) = 0, (1, 6) = 0, (1, 7) = 0, (1, 8) = 0, (1, 9) = 0, (2, 1) = 0, (2, 2) = 0, (2, 3) = 46, (2, 4) = 45, (2, 5) = 0, (2, 6) = 55, (2, 7) = 74, (2, 8) = 0, (2, 9) = 0, (3, 1) = 0, (3, 2) = 38, (3, 3) = 0, (3, 4) = 0, (3, 5) = 43, (3, 6) = 0, (3, 7) = 0, (3, 8) = 78, (3, 9) = 0, (4, 1) = 0, (4, 2) = 35, (4, 3) = 0, (4, 4) = 0, (4, 5) = 0, (4, 6) = 0, (4, 7) = 0, (4, 8) = 71, (4, 9) = 0, (5, 1) = 0, (5, 2) = 0, (5, 3) = 33, (5, 4) = 0, (5, 5) = 0, (5, 6) = 0, (5, 7) = 59, (5, 8) = 0, (5, 9) = 0, (6, 1) = 0, (6, 2) = 17, (6, 3) = 0, (6, 4) = 0, (6, 5) = 0, (6, 6) = 0, (6, 7) = 0, (6, 8) = 67, (6, 9) = 0, (7, 1) = 0, (7, 2) = 18, (7, 3) = 0, (7, 4) = 0, (7, 5) = 11, (7, 6) = 0, (7, 7) = 0, (7, 8) = 64, (7, 9) = 0, (8, 1) = 0, (8, 2) = 0, (8, 3) = 24, (8, 4) = 21, (8, 5) = 0, (8, 6) = 1, (8, 7) = 2, (8, 8) = 0, (8, 9) = 0, (9, 1) = 0, (9, 2) = 0, (9, 3) = 0, (9, 4) = 0, (9, 5) = 0, (9, 6) = 0, (9, 7) = 0, (9, 8) = 0, (9, 9) = 0})

  

memory used=7.85MiB, alloc change=-3.01MiB, cpu time=172.00ms, real time=212.00ms, gc time=93.75ms

  

Matrix(9, 9, {(1, 1) = 49, (1, 2) = 50, (1, 3) = 51, (1, 4) = 52, (1, 5) = 53, (1, 6) = 54, (1, 7) = 75, (1, 8) = 76, (1, 9) = 81, (2, 1) = 48, (2, 2) = 47, (2, 3) = 46, (2, 4) = 45, (2, 5) = 44, (2, 6) = 55, (2, 7) = 74, (2, 8) = 77, (2, 9) = 80, (3, 1) = 37, (3, 2) = 38, (3, 3) = 39, (3, 4) = 40, (3, 5) = 43, (3, 6) = 56, (3, 7) = 73, (3, 8) = 78, (3, 9) = 79, (4, 1) = 36, (4, 2) = 35, (4, 3) = 34, (4, 4) = 41, (4, 5) = 42, (4, 6) = 57, (4, 7) = 72, (4, 8) = 71, (4, 9) = 70, (5, 1) = 31, (5, 2) = 32, (5, 3) = 33, (5, 4) = 14, (5, 5) = 13, (5, 6) = 58, (5, 7) = 59, (5, 8) = 68, (5, 9) = 69, (6, 1) = 30, (6, 2) = 17, (6, 3) = 16, (6, 4) = 15, (6, 5) = 12, (6, 6) = 61, (6, 7) = 60, (6, 8) = 67, (6, 9) = 66, (7, 1) = 29, (7, 2) = 18, (7, 3) = 19, (7, 4) = 20, (7, 5) = 11, (7, 6) = 62, (7, 7) = 63, (7, 8) = 64, (7, 9) = 65, (8, 1) = 28, (8, 2) = 25, (8, 3) = 24, (8, 4) = 21, (8, 5) = 10, (8, 6) = 1, (8, 7) = 2, (8, 8) = 3, (8, 9) = 4, (9, 1) = 27, (9, 2) = 26, (9, 3) = 23, (9, 4) = 22, (9, 5) = 9, (9, 6) = 8, (9, 7) = 7, (9, 8) = 6, (9, 9) = 5})

  

memory used=1.21GiB, alloc change=307.02MiB, cpu time=37.00s, real time=31.88s, gc time=9.30s

  

Matrix(%id = 18446746210094669942)

 (2)


In the example below, which has 104 solutions, the  Numbrix  procedure is faster.

> 

C:=Matrix(5,{(1,1)=1,(5,5)=25});
CodeTools:-Usage(NumbrixPuzzle(C)):
nops([%]);
CodeTools:-Usage(Numbrix(C)):

Matrix(5, 5, {(1, 1) = 1, (1, 2) = 0, (1, 3) = 0, (1, 4) = 0, (1, 5) = 0, (2, 1) = 0, (2, 2) = 0, (2, 3) = 0, (2, 4) = 0, (2, 5) = 0, (3, 1) = 0, (3, 2) = 0, (3, 3) = 0, (3, 4) = 0, (3, 5) = 0, (4, 1) = 0, (4, 2) = 0, (4, 3) = 0, (4, 4) = 0, (4, 5) = 0, (5, 1) = 0, (5, 2) = 0, (5, 3) = 0, (5, 4) = 0, (5, 5) = 25})

  

memory used=0.94GiB, alloc change=-22.96MiB, cpu time=12.72s, real time=11.42s, gc time=2.28s

  

104

  

memory used=34.74MiB, alloc change=0 bytes, cpu time=781.00ms, real time=783.00ms, gc time=0ns

  
> 

 


 

Download NumbrixPuzzle.mw

Three bucket problem and its generalizat...

Kitonum 20469
graphtheory water-transfusion
December 24 2018
3 3

Here is a classic puzzle:
You are camping, and have an 8-liter bucket which is full of fresh water. You need to share this water fairly into exactly two portions (4 + 4 liters). But you only have two empty buckets: a 5-liter and a 3-liter. Divide the 8 liters in half in as short a time as possible.

This is not an easy task and requires at least 7 transfusions to solve it. 

The procedure  Pouring  solves a similar problem for the general case. Given n buckets of known volume and the amount of water in each bucket is known. Buckets can be partially filled, be full or be empty (of course the case when all is empty or all is full is excluded). With each individual transfusion, the bucket from which it is poured must be completely free, or the bucket into which it is poured must be completely filled. It is forbidden to pour water anywhere other than the indicated buckets.

Formal parameters of the procedure: BucketVolumes  is a list of bucket volumes,  WaterVolumes  is a list of water volumes in these buckets. The procedure returns all possible states that can occur during transfusions in the form of a tree (the initial state  WaterVolumes  is its root).

restart;
Pouring:=proc(BucketVolumes::list(And(positive,{integer,float,fraction})),WaterVolumes::list(And(nonnegative,{integer,float,fraction})), Output:=graph)
local S, W, n, N, OneStep, j, v, H, G;
uses ListTools, GraphTheory;

n:=nops(BucketVolumes); 
if nops(WaterVolumes)<>n then error "The lists should be the same length" fi;
if n<2 then error "Must have at least 2 buckets" fi;
if not `or`(op(WaterVolumes>~0)) then error "There must be at least one non-empty bucket" fi;
if BucketVolumes=WaterVolumes then error "At least one bucket should not be full" fi;
if not `and`(seq(WaterVolumes[i]<=BucketVolumes[i], i=1..n)) then error "The amount of water in each bucket cannot exceed its volume" fi;
W:=[[WaterVolumes]];

OneStep:=proc(W)
local w, k, i, v, V, k1, v0;
global L;
L:=convert(Flatten(W,1), set);
k1:=0; 
for w in W do
k:=0; v:='v';
for i from 1 to n do
for j from 1 to n do
if i<>j and w[-1][i]<>0 and w[-1][j]<BucketVolumes[j] then k:=k+1; v[k]:=subsop(i=`if`(w[-1][i]<=BucketVolumes[j]-w[-1][j],0,w[-1][i]-(BucketVolumes[j]-w[-1][j])),j=`if`(w[-1][i]<=BucketVolumes[j]-w[-1][j],w[-1][j]+w[-1][i],BucketVolumes[j]),w[-1]); fi;
od; 
od; 
v:=convert(v,list);
if `and`(seq(v0 in L, v0=v)) then k1:=k1+1; V[k1]:=w else 
for v0 in v do  
if not (v0 in L) then k1:=k1+1; V[k1]:=[op(w),v0] fi;
od;
fi;
L:=L union convert(v,set);
od;
convert(V,list);
end proc:

S[0]:={};
for N from 1 do
H[N]:=(OneStep@@N)(W);
S[N]:=L;
if S[N-1]=S[N] then break fi;
od;
if Output=set then return L else
if Output=trails then interface(rtablesize=infinity);
return <H[N-1]> else
G:=Graph(seq(Trail(map(t->t[2..-2],convert~(h,string))),h=H[N-1]));
DrawGraph(G, style=tree, root=convert(WaterVolumes,string)[2..-2], stylesheet = [vertexcolor = "Yellow", vertexfont=[TIMES,20]], size=[800,500])  fi; fi;

end proc:

Examples of use:

Here is the solution to the original puzzle above. We see that at least 7 transfusions are  
required to get equal volumes (4 + 4) in two buckets

Pouring([8,5,3], [8,0,0]);
           

 

 With an increase in the number of buckets, the number of solutions is extremely 
 increased. Here is the solution to the problem: is it possible to equalize the amount of water (7+7+7+7) in the following example? 

Pouring([14,10,9,9],[14,10,4,0]);
S:=Pouring([14,10,9,9],[14,10,4,0], set);
is([7,7,7,7] in S);
nops(S);
         

 

 

Download Pouring.mw

 

 

Bugs in maximize and minimize commands...

Kitonum 20469 Maple 2018
minimize maximize
December 11 2018
2 1

Yesterday, I accidentally discovered a nasty bug in a fairly simple example:

restart;
Expr:=a*sin(x)+b*cos(x);
maximize(Expr, x=0..2*Pi);
minimize(Expr, x=0..2*Pi);
                                    

I am sure the correct answers are  sqrt(a^2+b^2)  and  -sqrt(a^2+b^2)  for any real values  a  and  b .  It is easy to prove in many ways. The simplest method does not require any calculations and can be done in the mind. We will consider  Expr  as the scalar product (or the dot product) of two vectors  <a, b>  and  <sin(x), cos(x)>, one of which is a unit vector. Then it is obvious that the maximum of this scalar product is reached if the vectors are codirectional and equals to the length of the first vector, that is, sqrt(a^2+b^2).

Bugs in these commands were noted by users and earlier (see search by keywords bug, maximize, minimize) but unfortunately are still not fixed. 

1 2 3 4 5 6 7 Last Page 2 of 11