I am interested and intrigued by optical illusions, such as that entitled 'Drawing A Hole in Line Paper

 - 3D Trick Art' by artist Jonathan Stephen Harris. Check out this YouTube video  to appreciate the following. Not being good at art, I tried to replicate this illusion using Maple..  The program below is merely a start towards this goal.  I have a procedure which draws the outline of the letter A.  Different letters have different peculiarities: I chose the letter A since it is relatively easy in that it does not have curves.  It does have a triangular region, so I created a separate procedure for that.  The whole letter A can be rotated through an angle phi.   Also I have drawn a grid of parallelograms for use as the lines drawn on the paper - but this I think has bugs. .

     The method I have used is rather long and messy, just using coordinate geometry, for the vertex points of the A, then rotating them through an angle phi.   Also in the program is a grid of parallelograms, for use in drawing the lines across the page.  That's as far as I've got.  Major problems I foresee is seeing/calculating where these lines meet the outline of the letter A, where vertical lines would be drawn.  Also, the artist draws in shading - how can that be done in Maple?  My attempt at the task has brought up some issues that there must be a simpler, better method of doing this.  eg first put the coords in a vector, and use matrix multiplication to calculate the new coords.  My method is long and error prone. 

   I'd appreciate some feedback about any attempts similar to this.  In my program I tried to fill the color of the polygon which was the boundary of the A, but it filled in the base trapezoidal region as well.  On top of that I failed to color the small triangular region a different color.  As always, any help or suggestions would be gratefully received. 

.   

restart:

printlevel:=0:

with(plots):

with(plottools):

# nrows= Number of rows ncols is one more than nrows

nrows:=8:ncols:=9:

x0:=0:y0:=0:theta:=Pi/12:psi:=Pi/3:
#Width, w, and length, l, of sides of the parallelograms/polygons c[i,j]

w:=2:l:=3:

for i from 0 to nrows do

  for j from 0 to ncols do

#c[i,j] := rectangle([i+1,j], [i,j+1], color=red):

c[i,j] := polygon([[x0,y0],[x0+i*w*cos(psi),y0+i*w*sin(psi)],[x0+i*w*cos(psi)+j*l*cos(theta),y0+i*w*sin(psi)+j*l*sin(theta)], [x0+j*l*cos(theta),y0+j*l*sin(theta)]], filled=true,color=red):

  end do:

end do:

plots[display](seq(seq(c[i,j], j=0..ncols),i=0..nrows), scaling=constrained);

#t1:=textplot([2,3,`David`]):

#for i from 0 to nrows do

#  for j from 0 to ncols do

   #c[i,j] := rectangle([j+1,i], [j,i+1], color=white):

#  end do;

#end do;

#pl1:=plots[display](seq(seq(c[j,i], i=0..ncols),j=0..nrows), scaling=constrained):

pl1:=plots[display](seq(seq(c[i,j], i=0..ncols),j=0..nrows), scaling=constrained):

plots[display](pl1);

# To draw the letter A

# Using proc poly_out:  also to put in initial coords (x0,y0) of lower left foot of A, then rotate the letter A through an angle of phi

#thet:=Pi/3:phi:=Pi/2:

# thet is angle the left "diagonal" makes with the horizontal.

# l is the length of the diagonals - ie the left and right hand sloping sides of the letter A

# w is width of the feet of the letter A.  (Both equal width)

# topl is the "top length" of the horizontal top part of the letter A.

# (x0, y0) are the coords of the bottom left point of the letter A.

# phi is the anti-clockwise angle of rotation about (0,0)

poly_out:=proc(thet,l,w, topl, x0, y0, phi)

local outA, outAr,trig, trigr,D,E,F,G, corr, eps:

#l:=10:thet:=Pi/3:w:=4:

#topl:=3:

eps:=3*w/4:corr:=.3*w:

trig:=polygon([[x0+(2*l*cos(thet)+topl)/2, y0+l*sin(thet)-eps],[x0+w+(l/3+corr*w)*cos(thet), y0+(l/3+corr*w)*sin(thet)],[x0+2*l*cos(thet)+topl-w-(l/3+corr*w)*cos(thet), y0+(l/3+corr*w)*sin(thet)]]):

trigr:=polygon([[(x0+(2*l*cos(thet)+topl)/2)*cos(phi)-(y0+l*sin(thet)-eps)*sin(phi),(x0+(2*l*cos(#thet)+topl)/2)*sin(phi)+(y0+l*sin(thet)-eps)*cos(phi)],[(x0+w+(l/3+corr*w)*cos(thet))*cos(phi)-(y#0+(l/3+corr*w)*sin(thet))*sin(phi),(x0+w+(l/3+corr*w)*cos(thet))*sin(phi)+(y0+(l/3+corr*w)*sin(th#et))*cos(phi)],[(x0+2*l*cos(thet)+topl-w-(l/3+corr*w)*cos(thet))*cos(phi)-(y0+(l/3+corr*w)*sin(th#et))*sin(phi),(x0+2*l*cos(thet)+topl-w-(l/3+corr*w)*cos(thet))*sin(phi)+( #y0+(l/3+corr*w)*sin(thet))*cos(phi)]], color=white,filled=true):

outA:=polygon([[x0,y0],[x0+l*cos(thet),y0+l*sin(thet)],[x0+l*cos(thet),y0+l*sin(thet)],[x0+l*cos(thet)+topl,y0+l*sin(thet)],[x0+2*l*cos(thet)+topl,y0], [x0+2*l*cos(thet)+topl-w,y0],[x0+5*l*cos(thet)/3+topl-w,y0+l*sin(thet)/3],[x0+l*cos(thet)/3+w,y0+l*sin(thet)/3], [x0+w,y0]]):

outAr:=polygon([[x0*cos(phi)-y0*sin(phi),x0*sin(phi)+y0*cos(phi)],[(x0+l*cos(thet))*cos(phi)-(y0+l*sin(thet))*sin(phi),(x0+l*cos(thet))*sin(phi)+(y0+l*sin(thet))*cos(phi)],[(x0+l*cos(thet))*cos(phi)-(y0+l*sin(thet))*sin(phi),(x0+l*cos(thet))*sin(phi)+(y0+l*sin(thet))*cos(phi)],[(x0+l*cos(thet)+topl)*cos(phi)-(y0+l*sin(thet))*sin(phi),(x0+l*cos(thet)+topl)*sin(phi)+(y0+l*sin(thet))*cos(phi)],[(x0+2*l*cos(thet)+topl)*cos(phi)-y0*sin(phi),(x0+2*l*cos(thet)+topl)*sin(phi)+y0*cos(phi)], [(x0+2*l*cos(thet)+topl-w)*cos(phi)-y0*sin(phi),(x0+2*l*cos(thet)+topl-w)*sin(phi)+y0*cos(phi)],

[(x0+5*l*cos(thet)/3+topl-w)*cos(phi)-(y0+l*sin(thet)/3)*sin(phi),(x0+5*l*cos(thet)/3+topl-w)*sin(phi)+(y0+l*sin(thet)/3)*cos(phi)],

[(x0+l*cos(thet)/3+w)*cos(phi)-(y0+l*sin(thet)/3)*sin(phi),(x0+l*cos(thet)/3+w)*sin(phi)+(y0+l*sin(thet)/3)*cos(phi)], [(x0+w)*cos(phi)-y0*sin(phi),(x0+w)*sin(phi)+y0*cos(phi)]], color=grey,filled=true):

plots[display](outAr,trigr, axes=none, scaling=constrained);  # view=[-l..l,-l..l]);

#outA & trig removed from display – these give the `upright` #letter A

end proc:

plot1:=poly_out(Pi/3,15,3,3, 0,0, Pi/15):

plots[display](plot1, pl1);

Since thinking over my question I have actually answered it!  ...so I'd just appreciate some comments regards some finer points.  I was initially trying to print out a complex number, and I see in Maple Primes that Joe Riel answered a similar question in Dec 2011  viz

printf"%5.3Z\n",5+3I);  outputs

5.000+ 3.000I

    The documentation in Maple 7 did not give any examples of printing a complex number, and it talked of using z or Z together with a 'c'.  Initially I thought the c was a reference to complex numbers - but after trial and error I finall figured it stood for character.   In the code below I have reinstated the c between the  z and f.  I wanted the output withour the c, and finally removed it - but leaving one space.  (More than one space returns a syntax error.)   My next question was how to find the real and imaginary parts - which I've answered in the code.

    I'm just wondering if the f in zcf is superfluous?  Also, the documentation in Maple 7 seems to make out there are differences between upper and lower case z?  Any comments gratefully received

David

 zz:=eval(Zeta(2.5+3*I));

#zz:=eval(2.5+3*I);

a:=Re(zz);

b:=Im(zz);

printf("%zcf   %6.5f  %6.5f\n",zz, a, b);

Its close to Valentine's Day on the 14th Feb.  I was hoping to combine the lemniscate and cardiod curves to make a decorative heart shaped "valentine".     Inn polar form the cardioid is r=2R(1 - cos theta)   and the lemniscate r=L*sqrt(cos(2*theta)

  However these are not with respect to the same origin:-(

Any suggestions please?

restart:

# # # # # # # # # # # # # # # # # # # # # # # # # # # #

#  Lemniscate - Cardioid - Valentine

# # # # # # # # # # # # # # # # # # # # # # # # # # # #

with(plots):

with(plottools):

#Lemniscate

pl1:=plot(sqrt(cos(2*x)),x=0..Pi/2, coords=polar, scaling=constrained):

#Cardioid

pl2:=plot(1-cos(x),x=0..3*Pi/4, coords=polar, scaling=constrained):

#pp1:=pointplot({seq([x/100,sqrt(cos(2*x/100))],x=0..150)});

##pp1:=seq(pointplot( {  [x/100,sqrt(cos(2*x/100)) ],x=0..150}) );

plots[display](pl1, pl2);

#l := {  seq(   point(  [x/100,sqrt(cos(2*x/100))]  ),x=0..150   )  }:

#l := {     point(  [0/100,sqrt(cos(2*0/100))]  ),point(  [2/100,sqrt(cos(2*2/100))]  ),point(  [4/100,sqrt(cos(2*4/100))]  )     }:

L:=11.30:R:=1.538:ext:=.2:

il:=floor(Pi*26-5);

#Lemniscate

#Equation of lemniscate in polar form is r=L*sqrt(cos(2*theta))

l:={seq(point([ext+cos(i/100),L*sqrt(cos(2*i/100))*sin(i/100)]),i=-78..il)}:

#Cardioid

#Equation of cardioid is r=2*R*(1-cos(theta))

#lc :={seq(  point(  [i/100,2*R*(1-cos(i/100))]  ), i=-ilast..ilast+30  )  }:

lc:={seq(point([cos(i/100),2*R*(1-cos(i/100))*sin(i/100)]),i=-4*il/3..il/4  )}:

plots[display](l,lc, axes=normal, scaling =constrained);

#l := point([0,0], color=green):

#plots[display](l, axes=boxed);

##pointplot({seq([n,sin(n/10)],n=0..30)});

printf("             Lemniscate                    Cardioid\n");

#ibeg:=convert(-4*il/3, float): iend:=il/4:

ibeg:=  -78:  #floor(-4*il/3):

iend:=floor(il/4):

for i from ibeg to iend do

#whattype(i);

xl:=evalf(ext+cos(i/100)): yl:=evalf(L*sqrt(cos(2*i/100))*sin(i/100)):

rr:=evalf(  L*sqrt(  cos(2*i/100)  )):

yc:=2*R*(1-cos(i/100))*sin(i/100):

rrc:=2*R*(1-cos(i/100)):

#  printf(" i = %d \n",i);

if type(xl, nonreal) or type(yl, nonreal) then

   printf("i=%d   xl or yl are not real\n", i);

                                          else  

 printf("i=%d   x=%4.3f   y=%4.3f r=%4.3f      yc=%4.3f  r_card=%4.3f\n",i, xl,yl,rr, yc, rrc);

end if;

end do:

Padovan is a British architect, more of whom van be found by googling 'Padovan series'.

  The program below draws the first few equilateral triangles of sides of which are in a series something akin to the Fibonacci sequence.  P(n)=P(n-2)+P(n-3).  It starts 1, 1, 1, 2,...The program below outputs a display of the first few such triangles, but is very klutsy.  It has a "manual input" for the various triangles.  I wondered if there was a quick way of doing this perhaps using theseq command?

  Thanks in advance.  David

 restart:

# # # # # # # # # # # # # # # # # # # # # # # # # # # #

#

#  Padovan

#

#  Series of equilaterla triangles of sides of length:

#  P(n)=P(n-2) + P(n-3)

# # # # # # # # # # # # # # # # # # # # # # # # # # # #

with(plots):

with(plottools):

# etring_up draws an equilateral triangle of side s, pointing up with # [x0,y0] being the coords of the "western most" vertex.

etring_up:=proc(x0,y0,s)

local tt, h:

h:=s*sqrt(3)/2:

tt:=polygon([[x0,y0],[x0+s/2,y0+h],[x0+s,y0]], color=brown, linestyle=1, thickness=1);

plots[display]([tt], scaling=constrained);

end proc:

# etring_down draws an equilateral triangle of side s, pointing down

# with [x0,y0] being the coords of the "western most" vertex.

etring_down:=proc(x0,y0,s)

local tt, h:

h:=s*sqrt(3)/2:  #2*s/sqrt(3):

#Only difference between two procs is the minus sign in [x0+s/2,y0-h]

tt:=polygon([[x0,y0],[x0+s/2,y0-h],[x0+s,y0]], color=red, linestyle=1, thickness=1);

plots[display]([tt], scaling=constrained);

end proc:

#etring_down(0,0,2);

#etring_up(0,0,2):

plots[display]([etring_down(0,0,1),etring_up(0,0,1),etring_down(1/2,sqrt(3)/2,1),etring_up(1/2,-sqrt(3)/2,2), etring_down(3/2, sqrt(3)/2,2),etring_up(1/2,sqrt(3)/2,3), etring_down(-2, 2*sqrt(3),4),etring_up(-9/2,-sqrt(3)/2,5),etring_down(-9/2,-sqrt(3)/2,7),etring_up(-1,-4*sqrt(3),9),etring_down(2,2*sqrt(3),12),etring_up(-2, 2*sqrt(3),16),etring_down(-15,10*sqrt(3),21)], scaling=constrained);

I originally was trying to verify that the determinant of an nxn matrix of binomial coefficients is zero if n is a multiple of 6. A description of the coefficients is shown in my program below under Row 1, Row 2 etc, using the old fashioned notation for binomial coefficients nCr=n!/r!/(n-r)!    I came across this in the interesting book 'Single Digits: in praise of small numbers' by Marc Chamberland. page 167.

   My pathetic attempt is below.  I tried to create a 5 x 5 matrix of binomial coeffs.  There is a procedure shft which attempts to create the rows of the matrix: the rows are just shifted along.  I've been successful in obtaining two rows, then after that gave up:-(  Thinking I'd try something easier, I thought I'd find the determinant of the matrix using the determinant command in the linear algebra package - without success.

  Any help would be most appreciated. 

 restart:

# # # # # # # # # # # # # # # # # # # # # # # # # # # #

# Matrix program - intro to learn matrices

# The proc shft shifts the elements of an array one to the right and the

# first becomes the last

# # # # # # # # # # # # # # # # # # # # # # # # # # # #

with(plots):

with(plottools):

#with(linalg);

with(LinearAlgebra);

#a:=array([1, 2, 3, 4, 5]);

#Row 1   1 nC1  nC2  nC3…    …nC(n-1)

#Row 2   nC(n-1)  1  nC1…      …nC(n-2)

#Row 3  nC(n-2)  nC(n-1)  1…  …nC(n-3)

#...

#Row n  nC1  nC2 nC3…        …1

n:=5:

a:=array([seq(binomial(n,i), i=0..n-1)]);

acopy:=array([seq(binomial(n,i), i=0..n-1)]);

#shift := (f::procedure) -> ( x->f(x+1) ):

#shift(a[1]);

shft := proc(a::array)

local i, b::array:

global n:

#printf("n=%d\n",n);

for i from 1 to n do

#printf("n=%d\n",n);

b[i]:=a[i]:

end do:

#nn:=n-1:

for i from 1 to n-1 do

if i<>n-1 then

a[i+1]:=b[i]:

      else

a[1]:=a[5]:

a[n]:=b[n-1]:

end if:

printf("In loop a[%d}=%5.3f\n", i, a[i]);

end do:

end proc:

shft(a);

for i from 1 to n do

#printf("n=%d\n",n);

   bnew[i]:=a[i];

printf("bnew[%d]=%d\n",i,bnew[i]);

end do:

bmatrix:=array(1,n,[seq(bnew[i], i=1..n)]);

#for m from 2 to n do

   #shft([seq(bmatrix[1,kk], kk=1..m)],[seq(bmatrix[1, k], k=1..n-m)]);

    shft(bmatrix);

printf("In for loop:  bnew[%d}=%5.3f\n", m, bnew[m]);

#end do:

#s:={seq((1,j)=eval(A[1,j]), j=1..n), (2,2)=1,(3,3)=1,(4,4)=1, (5,5)=1}:

s:={(1,1)=1,(1,2)=5,(1,3)=10,(1,4)=10,(1,5)=5, (2,2)=1,(3,3)=1,(4,4)=1, (5,5)=1}:

SSs:=Matrix(5,5,s);

determinant(SSs);

simplify(evalf @(determinant(SSs)));

Determinant(SSs,method=float);

#A := Matrix(2,2,[[9,9],[1,2]]);

print(`Printing matrix`);

#A[3,3]:=1;

A := Matrix(m,5,[[seq(acopy[i], i=1..5)],[seq(bnew[j], j=1..5)]]);

#end do;

for i from 1 to n do

  printf("a[%d}=%5.3f\n", i, a[i]);

end do: