## 19675 Reputation

15 years, 142 days

## Serious bugs in solve command...

Maple 2018

In the two examples below (in the second example, the range for the roots is simply expanded), we see bugs in both examples (Maple 2018.2). I wonder if these errors are fixed in Maple 2020?

 > restart;
 > solve({log[1/3](2*sin(x)^2-3*cos(2*x)+6)=-2,x>=-7*Pi/2,x<=-2*Pi}, explicit, allsolutions); # Example 1 - strange error message solve({log[1/3](2*sin(x)^2-3*cos(2*x)+6)=-2,x>=-4*Pi,x<=-2*Pi}, explicit, allsolutions);  # Example 2 - two roots missing
 (1)
 > plot(log[1/3](2*sin(x)^2-3*cos(2*x)+6)+2, x=-7*Pi/2..-2*Pi); plot(log[1/3](2*sin(x)^2-3*cos(2*x)+6)+2, x=-4*Pi..-2*Pi);
 > Student:-Calculus1:-Roots(log[1/3](2*sin(x)^2-3*cos(2*x)+6)=-2, x=-7*Pi/2..-2*Pi);  # OK Student:-Calculus1:-Roots(log[1/3](2*sin(x)^2-3*cos(2*x)+6)=-2, x=-4*Pi..-2*Pi);  # OK
 (2)
 >

I am glad that  Student:-Calculus1:-Roots  command successfully handles both examples.

## Uniform point plot...

When we plot a curve with the option  style=point  , symbols go evenly not along the length of this curve, but along the range of the independent variable. For this reason the plot often looks unattractive. Here are two examples. In the first example, the default option  adaptive=true  is used, in which Maple adds points in some places.

```restart;
plot(surd(x,3), x=-2.5..2.5, style=point, scaling=constrained, symbol=solidcircle, symbolsize=8, numpoints=30, size=[800,300]);
plot(surd(x,3), x=-2.5..2.5, style=point, scaling=constrained, symbol=solidcircle, symbolsize=8, numpoints=30, adaptive=false, size=[800,300]);
```

The  UniformPointPlot  procedure allows you to plot curves by symbols (as for  style=point), and these symbols go from each other at equal distances, measured along this curve. The procedure uses a well-known formula for the length of a curve in two and three dimensions. The procedure parameters are clear from the three examples below.

```UniformPointPlot:=proc(F::{algebraic,list},eq::`=`,n::posint:=40,Opt::list:=[symbol=solidcircle, symbolsize=8, scaling=constrained])
local t, R, P, g, L, step, L1, L2;
uses plots;
Digits:=4:
t:=lhs(eq); R:=rhs(eq);
P:=`if`(type(F,algebraic),[t,F],F);
g:=x->`if`(F::algebraic or nops(F)=2,evalf(Int(sqrt(diff(P[1],t)^2+diff(P[2],t)^2), t=lhs(R)..x, epsilon=0.001)),evalf(Int(sqrt(diff(P[1],t)^2+diff(P[2],t)^2+diff(P[3],t)^2), t=lhs(R)..x, epsilon=0.001))):
L:=g(rhs(R)); step:=L/(n-1);
L1:=[lhs(R),seq(fsolve(g-k*step, fulldigits),k=1..n-2),rhs(R)];
L2:=map(s->`if`(type(F,algebraic),[s,eval(F,t=s)],eval(F,t=s)), L1):
`if`(F::algebraic or nops(F)=2,plot(L2, style=point, Opt[]),pointplot3d(L2, Opt[]));
end proc:
```

Examples of use:

`UniformPointPlot(surd(x,3), x=-2.5..2.5, 30);`

`UniformPointPlot([5*cos(t),3*sin(t)], t=0..2*Pi, [color=red,symbol=solidcircle,scaling=constrained, symbolsize=8,  size=[800,400]]);`

`UniformPointPlot([cos(t),sin(t),2-2*cos(t)], t=0..2*Pi, 41, [color=red,symbol=solidsphere, symbolsize=8,scaling=constrained, labels=[x,y,z]]);`

Here's another example of using the same technique as in the procedure. In this example, we are plotting Archimedean spiral uniformly colored with 7 rainbow colors:

```f:=t->[t*cos(t),t*sin(t)]:
g:=t->evalf(Int(sqrt(diff(f(s)[1],s)^2+diff(f(s)[2],s)^2), s=0..t)):
h:=s->fsolve(s=g(t), t):
L:=evalf(g(2*Pi)): step:=L/7:
L1:=[0,seq(h(k*step), k=1..6),2*Pi]:
Colors:=convert~([Red,Orange,Yellow,Green,Blue,Indigo,Violet], string):
plots:-display(seq(plot([f(t)[], t=L1[i]..L1[i+1]], color=Colors[i], thickness=12), i=1..7), scaling=constrained, size=[500,400]);
```

Uniform_Point_Plot.mw

## Puzzle - cut it into 2 equal parts...

The following puzzle prompted me to write this post: "A figure is drawn on checkered paper that needs to be cut into 2 equal parts (the cuts must pass along the sides of the squares.)" (parts are called equal if, after cutting, they can be superimposed on one another, that is, if one of them can be moved, rotated and (if need to) flip so that they completely coincide) (see the first picture below).
I could not solve it manually and wrote a procedure called  CutTwoParts  that does this automatically (of course, this procedure applies to other similar puzzles). This procedure uses my procedure  AreIsometric  published earlier  https://www.mapleprimes.com/posts/200157-Testing-Of-Two-Plane-Sets-For-Isometry  (for convenience, I have included its text here). In the procedure  CutTwoParts  the figure is specified by the coordinates of the centers of the squares of which it consists).

I advise everyone to first try to solve this puzzle manually in order to feel its non-triviality, and only then load the worksheet with the procedure for automatic solution.

For some reason, the worksheet did not load and I was only able to insert the link.

## The solution to another problem of Putna...

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]);
 > # 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]);
 >

## Serpentine paths in matrices and genera...

Maple 2018

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])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]=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
 (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);
 (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: