Fordham University

Exotic sacks with a three sided die and \(k\) sided die for large \(k\): Maple™

Here again we used Maple™ to study exotic sacks containing one three sided die and one \(k\) sided die. We took a different approach that would allow us to write faster functions that would allow us to study large values of \(k\).

Our functions

Once again we use the constants eps, meps, eeps, and vaguec from our previous Maple™ calculation.

However, instead of using Maple™'s built-in functions for polynomial division to compute the swaps (as in our previous pages), we wrote our own functions that use linear algebra to compute the desired polynomials.

runsign returns the same values as the function signtype from our previous pages. However, it is designed to work one coefficient at a time, so that if we encounter a negative coefficient, we may stop. 

runsign := proc(s, c):: integer;
   local absc;
   global vaguec, eps, eeps, meps;   
   absc:= abs(c);
   if ((absc < eps) and (absc > eeps)) then vaguec:=vaguec+1; end if;
   if (s=-1) then return -1; end if; # have seen negative before
   # if here, we have seen no negatives
   if (c < meps) then return -1; end if; # see negative c
   if (absc < eeps) then return 0; end if; # see 0 c
   # if here, see positive c
   return s; 
end proc;

The function checkswap3 computes the polynomial \( f\). However, this time we use linear algebra to compute it. 


checkswap3 := proc(m,n,show) :: integer;
	local p,q,d,a,s;
		
	# entry i gives  x^(i-1) coefficient
	p := Vector(n, fill=1);
	q := Vector(n, fill=0);
	d := evalf(-2* cos(2*evalf(Pi)*(m/n)));if show then printf("d=%+-10.5f\n\n", d); end if;
	
	# divide (x^n-1)/(x-1) by the factor (x^2+dx+1)
	# at start q=0, p = (x^n-1)/(x-1)
	# invariant condition all coeffs of q(x)*(x^2+dx+1) + p(x) equal 1
	# at end q = c/(x^2+dx+1), p = 0
	for a from 1 to (n-2) do
	   q[a] := p[a];
	   p[a+2] := p[a+2]-p[a];
	   p[a+1] := p[a+1]-d* p[a];   
	   p[a] := 0.;
	end do;
	
	# multiply q by (x^2+x+1) to get p, checking signs of coeffs
	# at start p = 0
	s := 1;
	p[1] := q[1]; s := runsign(s, p[1]);
	p[2] := q[1]+q[2]; s := runsign(s, p[1]);
	
	for a from 3 to n do
	   p[a] := q[a-2]+q[a-1]+q[a]; s := runsign(s, p[a]);
	end do;
	
	if show then 
	    printf("   i         q[i]         p[i]\n\n");
	    for a from 1 to n do
	    printf("%4d   %+-10.5f   %+-10.5f\n", a-1, q[a], p[a]);
	    end do;
	end if;
	
    return s;
end proc;

Based on the results of our previous calculations, we believed that the most interesting values to study would be numbers of the form \( 603 a + 143 b\). We wrote a special function to check these values. 


check603143 := proc(j, h):: integer;
   local n,m,i,ii,s;
   n := 603*j+143*h;
   m := floor(.419*n);
   for i from m to (m+100) do
       s := checkswap3(i,n,false);
       if (s = -1) then printf("%5d %5d %5d ",j, n, i-1); break; end if;
   end do;
   n := n+143;
   m := i-1+59;
   for ii from m to (m+100) do
       s := checkswap3(ii,n,false);
       if (s = -1) then printf("%5d %5d %5d\n", n, ii-1, ii-i); break; end if;
   end do;
end proc;

for j from 1 to 15 do check603143(j, 1); end do;
    1   746   312   889   372    60
    2  1349   565  1492   625    60
    3  1952   818  2095   878    60
    4  2555  1071  2698  1131    60
    5  3158  1325  3301  1384    59
    6  3761  1578  3904  1637    59
    7  4364  1831  4507  1890    59
    8  4967  2084  5110  2143    59
    9  5570  2337  5713  2396    59
   10  6173  2590  6316  2650    60
   11  6776  2843  6919  2903    60
   12  7379  3096  7522  3156    60
   13  7982  3349  8125  3409    60
   14  8585  3602  8728  3662    60
   15  9188  3855  9331  3915    60

for j from 16 to 20 do check603143(j, 1); end do;
   16  9791  4108  9934  4168    60
   17 10394  4361 10537  4421    60
   18 10997  4614 11140  4674    60
   19 11600  4867 11743  4927    60
   20 12203  5120 12346  5180    60

for j from 6 to 20 do check603143(j, 2); end do;
    6  3904  1637  4047  1697    60
    7  4507  1890  4650  1950    60
    8  5110  2143  5253  2203    60
    9  5713  2396  5856  2456    60
   10  6316  2650  6459  2709    59
   11  6919  2903  7062  2962    59
   12  7522  3156  7665  3215    59
   13  8125  3409  8268  3468    59
   14  8728  3662  8871  3721    59
   15  9331  3915  9474  3975    60
   16  9934  4168 10077  4228    60
   17 10537  4421 10680  4481    60
   18 11140  4674 11283  4734    60
   19 11743  4927 11886  4987    60
   20 12346  5180 12489  5240    60
for j from 9 to 25 do check603143(j, 3); end do;
    9  5856  2456  5999  2516    60
   10  6459  2709  6602  2769    60
   11  7062  2962  7205  3022    60
   12  7665  3215  7808  3275    60
   13  8268  3468  8411  3528    60
   14  8871  3721  9014  3781    60
   15  9474  3975  9617  4034    59
   16 10077  4228 10220  4287    59
   17 10680  4481 10823  4540    59
   18 11283  4734 11426  4793    59
   19 11886  4987 12029  5047    60
   20 12489  5240 12632  5300    60
   21 13092  5493 13235  5553    60
   22 13695  5746 13838  5806    60
   23 14298  5999 14441  6059    60
   24 14901  6252 15044  6312    60
   25 15504  6505 15647  6565    60
for j from 14 to 25 do check603143(j, 4); end do;
   14  9014  3781  9157  3841    60
   15  9617  4034  9760  4094    60
   16 10220  4287 10363  4347    60
   17 10823  4540 10966  4600    60
   18 11426  4793 11569  4853    60
   19 12029  5047 12172  5106    59
   20 12632  5300 12775  5359    59
   21 13235  5553 13378  5612    59
   22 13838  5806 13981  5865    59
   23 14441  6059 14584  6118    59
   24 15044  6312 15187  6372    60
   25 15647  6565 15790  6625    60