cp's OEIS Frontend

A182118 Table of triangular arguments such that if A002262(14*k) = "r" then the product A182440(k,i + 1) *A182440(k,i + 2) equals "r" + a(k,i)*(a(k,i)+1)/2.

%I A182118 #23 Aug 11 2015 16:11:59
%S A182118 -1,0,-5,63,8,-8,440,151,15,-9,0,996,224,20,-11,0,0,1455,267,26,-12,0,
%T A182118 0,0,1720,325,31,-13,0,0,0,0,2082,368,36,-14,0,0,0,0,0,2347,411,41,
%U A182118 -15,0,0,0,0,0,0,2612,454,46
%N A182118 Table of triangular arguments such that if A002262(14*k) = "r" then the product A182440(k,i + 1) *A182440(k,i + 2) equals "r" + a(k,i)*(a(k,i)+1)/2.
%C A182118 It is noted that the difference between adjacent rows of the respective elements, depends on the difference between the elements of column 0 in the respective rows. It is apparent that the series of differences corresponding to a difference of d in column 0, i.e. A(k+1,0) - A(k,0) = d, is defined as follows: D(0) = d, D(1) = 4 - d, D(n) = 6*D(n-1) - D(n-2) -8*d + 4. The sequence of differences corresponding to a difference of -1 or 0 in column 0 form related series A182191 and A182190.
%C A182118 The Mathematica program below first calculates an array containing only the first four nonnegative triangular arguments P of each row then changes at most 2 of the arguments to the corresponding negative value, N = -P -1 in order to obtain the relation a(k,i) -7*a(k,i+1) + 7*a(k,i+2) - a(k,i+3) = 0, then chooses the appropriate argument to continue this relationship with the remainder of the row. In this way, the sequence is finally determined. Thus in this table a few 0's have been changed to -1.
%t A182118 highTri = Compile[{{S1,_Integer}},Module[{xS0=0,xS1=S1},
%t A182118 While[xS1-xS0*(xS0+1)/2>xS0,xS0++];
%t A182118 xS0]];
%t A182118 overTri = Compile[{{S2,_Integer}},Module[{xS0=0,xS2=S2},
%t A182118 While[xS2-xS0*(xS0+1)/2>xS0,xS0++];
%t A182118 xS2 - (xS0*(1+xS0)/2)]];
%t A182118 tt = SparseArray[{{12,1} -> 0,{1,12} -> 0}];
%t A182118 K1 = 0;
%t A182118 m = 14;While[K1<12,J1=highTri[m*K1];X =2*(m+K1+(J1*2+1));
%t A182118 K2 = 6 K1 - m + X; K3 = 6 K2 - K1 + X;K4 = 6 K3 - K2 + X;
%t A182118 o = overTri[m*K1]; tt[[1,K1+1]] =highTri[m*K1];
%t A182118 tt[[2,K1+1]] = highTri[K1*K2-o];tt[[3,K1+1]] = highTri[K2*K3-o];tt[[4,K1+1]] = highTri[K3*K4-o];
%t A182118 K1++];k = 1;
%t A182118 While[k<13,z = 1; xx = 99; While[z<5 && xx == 99,
%t A182118 If[tt[[1,k]]+ 7 tt[[3,k]] - 7 tt[[2,k]] - tt[[4,k]] == 0,Break[]];
%t A182118 If[z == 1,t = -tt[[z,k]]-1;tt[[z,k]] = t,s = -tt[[z-1,k]]-1;tt[[z-1,k]]=s;t =-tt[[z,k]]-1];tt[[z,k]] = t;
%t A182118 w = 1;While[w<5 && xx == 99,If[tt[[1,k]]+ 7 tt[[3,k]] - 7 tt[[2,k]] - tt[[4,k]] == 0,xx =0;Break[]];If[w==z,w++];
%t A182118 t=-tt[[w,k]] - 1;tt[[w,k]]=t;If[tt[[1,k]]+ 7 tt[[3,k]] - 7 tt[[2,k]] - tt[[4,k]] == 0,xx =0;Break[],
%t A182118 t = -tt[[w,k]] - 1];tt[[w,k]] = t;w++];z++];cc = tt[[1,k]] -6 tt[[2,k]] + tt[[3,k]];p = 5;While[p < 14-k,
%t A182118 tt[[p,k]] = 6 tt[[p-1,k]] - tt[[p-2,k]] + cc;p++]; k++];
%t A182118 a=1;list2 = Reap[While[a<12, b=a; While[b>4,Sow[0];b--];While[b>0, Sow[tt[[b, a+1-b]]]; b--]; a++]][[2, 1]];list2
%Y A182118 Cf. A182102, A182119, A182190, A182191.
%K A182118 sign
%O A182118 0,3
%A A182118 _Kenneth J Ramsey_, Apr 12 2012