OFFSET
1,2
COMMENTS
Conjecture: this is a permutation of the nonprimes A018252.
From Max Alekseyev, Oct 22 2008: (Start)
The conjecture is true. It is easy to see that (i) a(n)=m cannot be prime; (ii) k_m is always nonzero; (iii) for any nonprime s, there exist integers k_p,...,k_s, where p is the smallest prime divisor of s, k_p and k_s are nonzero, for which p^(k_p)*...*s^(k_s) = 1. The bijectivity of a(n) (as a function between positive integers and nonprimes) now follows from the lemma.
*Lemma*. If a < b <= m and a^(p_a)*...* m^(p_m) = b^(q_b)*...* m^(q_m) = 1 where p_a, p_m, q_b and q_m are nonzero, then there exists integer s, a <= s < m, such that a^(r_a)*...* m^(r_s) = 1 where r_a and r_s are nonzero. Similarly, if a <= s < m and a^(p_a)*...* s^(p_s) = a^(q_a)*...* m^(q_m) = 1 where p_a, p_s, q_a and q_m are nonzero, then there exists integer b, a < b <= m, such that b^(r_b)*...* m^(r_m) = 1 where r_b and r_m are nonzero. (end)
EXAMPLE
a(18) = 25: we have 18^4 * 19^0 * 20^10 * 21^0 * 22^0 * 23^0 * 24^-8 * 25^-5 = 1.
MATHEMATICA
a[n_] := Module[{m, d, f, M, M2}, If[n == 1, Return[1]]; m = n; While[True, m++; If[PrimeQ[m], Continue[]]; d = PrimePi[m]; M = Array[0 &, {d, m - n + 1}]; For[k = 0, k <= m - n, k++, f = FactorInteger[n + k]; For[j = 1, j <= Length[f], j++, M[[PrimePi[f[[j, 1]]], k + 1]] = f[[j, 2]] ]]; M2 = Table[M[[i, j + 1]], {i, 1, d}, {j, 1, m - n}]; If[MatrixRank[M] == MatrixRank[M2], Return[m]]]];
Array[a, 81] (* Jean-François Alcover, Jun 12 2017, translated from PARI *)
PROG
(PARI) { a(n) = local(m, d, f, M, M2); if(n==1, return(1)); m=n; while(1, m++; if(isprime(m), next); d=primepi(m); M=matrix(d, m-n+1); for(k=0, m-n, f=factor(n+k); for(j=1, matsize(f)[1], M[primepi(f[j, 1]), k+1]=f[j, 2] )); M2=matrix(d, m-n, i, j, M[i, j+1]); if(matrank(M)==matrank(M2), return(m)); ) } \\ Max Alekseyev, Oct 22 2008
CROSSREFS
KEYWORD
nice,nonn
AUTHOR
Alex Fink, May 30 2002
EXTENSIONS
Corrected definition, comments and extra terms from Max Alekseyev, Oct 22 2008
STATUS
approved