|
%I #11 May 15 2016 05:09:24
%S 240,390,624,630,1008,1020,1040,1560,1632,1638,1650,1680,2520,2640,
%T 2652,2670,2720,2730,4080,4095,4272,4284,4290,4320,4368,4400,4420,
%U 6552,6600,6630,6912,6930,6942,6990,7072,7120,7140,7150,10608,10680,10710,10725,10920
%N Products of four distinct Fibonacci numbers > 1.
%H Giovanni Resta, <a href="/A272950/b272950.txt">Table of n, a(n) for n = 1..10000</a>
%e a(1) = 240 = 2*3*5*8.
%t s = {1}; nn = 60; f = Fibonacci[2 + Range[nn]]; Do[s = Union[s, Select[s*f[[i]], # <= f[[nn]] &]], {i, nn}]; s = Prepend[s, 0]; Take[s, 100] (* A160009 *)
%t isFibonacciQ[n_] := Apply[Or, Map[IntegerQ, Sqrt[{# + 4, # - 4} &[5 n^2]]]];
%t ans = Join[{{0}}, {{1}}, Table[#[[Flatten[Position[Map[Apply[Times, #] &, #], s[[n]]]][[1]]]] &[Rest[Subsets[Rest[Map[#[[1]] &, Select[Map[{#, isFibonacciQ[#]} &, Divisors[s[[n]]]], #[[2]] &]]]]]], {n, 3, 500}]]
%t Map[Length, ans] (* A272947 *)
%t Flatten[Position[Map[Length, ans], 1]] (* A272948 *)
%t Map[Apply[Times, #] &, Select[ans, Length[#] == 1 &]] (* A000045 *)
%t Map[Apply[Times, #] &, Select[ans, Length[#] == 2 &]] (* A271354 *)
%t Map[Apply[Times, #] &, Select[ans, Length[#] == 3 &]] (* A272949 *)
%t Map[Apply[Times, #] &, Select[ans, Length[#] == 4 &]] (* A272950 *)
%t (* _Peter J. C. Moses_, May 11 2016 *)
%t up=10^6; F=Fibonacci; i=3; Union[ Reap[ While[(a = F[i++]) < up, j=i; While[ (b = F[j++]*a) < up, h=j; While[(c = F[h++]*b) < up, k=h; While[ (d = F[k++]*c) < up, Sow@d ]]]]][[2, 1]]] (* _Giovanni Resta_, May 14 2016 *)
%o (PARI) list(lim)=my(v=List(),F,best=5,t2,t3,t4,j,k,l); while(fibonacci(best++)<=30*lim,); F=vector(best,i,fibonacci(i)); for(i=6,best, j=4; while(j++<i && (t2=F[i]*F[j])<=6*lim, k=3; while(k++<j && (t3=t2*F[k])<=2*lim, l=2; while(l++<k && (t4=t3*F[l])<=lim, listput(v,t4))))); Set(v) \\ _Charles R Greathouse IV_, May 14 2016
%Y Cf. A000045, A160009, A272947, A271354, A272949.
%K nonn,easy
%O 1,1
%A _Clark Kimberling_, May 14 2016
|
