cp's OEIS Frontend

This is a front-end for the Online Encyclopedia of Integer Sequences, made by Christian Perfect. The idea is to provide OEIS entries in non-ancient HTML, and then to think about how they're presented visually. The source code is on GitHub.

Showing 1-8 of 8 results.

A064097 A quasi-logarithm defined inductively by a(1) = 0 and a(p) = 1 + a(p-1) if p is prime and a(n*m) = a(n) + a(m) if m,n > 1.

Original entry on oeis.org

0, 1, 2, 2, 3, 3, 4, 3, 4, 4, 5, 4, 5, 5, 5, 4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 6, 6, 7, 6, 7, 5, 7, 6, 7, 6, 7, 7, 7, 6, 7, 7, 8, 7, 7, 8, 9, 6, 8, 7, 7, 7, 8, 7, 8, 7, 8, 8, 9, 7, 8, 8, 8, 6, 8, 8, 9, 7, 9, 8, 9, 7, 8, 8, 8, 8, 9, 8, 9, 7, 8, 8, 9, 8, 8, 9, 9, 8, 9, 8, 9, 9, 9, 10, 9, 7, 8, 9, 9, 8, 9, 8, 9, 8
Offset: 1

Views

Author

Thomas Schulze (jazariel(AT)tiscalenet.it), Sep 16 2001

Keywords

Comments

Note that this is the logarithm of a completely multiplicative function. - Michael Somos
Number of iterations of r -> r - (largest divisor d < r) needed to reach 1 starting at r = n. a(n) = a(n - A032742(n)) + 1 for n >= 2. - Jaroslav Krizek, Jan 28 2010
From Antti Karttunen, Apr 04 2020: (Start)
Krizek's comment above stems from the fact that n - n/p = (p-1)*(n/p), where p is the least prime dividing n [= A020639(n), thus n/p = A032742(n)] and because this is fully additive sequence we can write a(n) = a(p) + a(n/p) = (1+a(p-1)) + a(n/p) = 1 + a((p-1)*(n/p)) = 1 + a(n - n/p), for any composite n.
Note that in above formula p can be any prime factor of n, not only the smallest, which proves Robert G. Wilson v's comment in A333123 that all such iteration paths from n to 1 are of the same length, regardless of the route taken.
(End)
From Antti Karttunen, May 11 2020: (Start)
Moreover, those paths form the chains of a graded poset, which is also a lattice. See the Mathematics Stack Exchange link.
Keeping the formula otherwise same, but changing it for primes either as a(p) = 1 + a(A064989(p)), a(p) = 1 + a(floor(p/2)) or a(p) = 1 + a(A048673(p)) gives sequences A056239, A064415 and A334200 respectively.
(End)
a(n) is the number of iterations r->A060681(r) to reach 1 starting at r=n. - R. J. Mathar, Nov 06 2023

Examples

			a(19) = 6: 19 - 1 = 18; 18 - 9 = 9; 9 - 3 = 6; 6 - 3 = 3; 3 - 1 = 2; 2 - 1 = 1. That is a total of 6 iterations. - _Jaroslav Krizek_, Jan 28 2010
From _Antti Karttunen_, Apr 04 2020: (Start)
We can follow also alternative routes, where we do not always select the largest proper divisor to subtract, for example, from 19 to 1, we could go as:
19-1 = 18; 18-(18/3) = 12; 12-(12/2) = 6; 6-(6/3) = 4; 4-(4/2) = 2; 2-(2/2) = 1, or as
19-1 = 18; 18-(18/3) = 12; 12-(12/3) = 8; 8-(8/2) = 4; 4-(4/2) = 2; 2-(2/2) = 1,
both of which also have exactly 6 iterations.
(End)
		

Crossrefs

Similar to A061373 which uses the same recurrence relation but a(1) = 1.
Cf. A000079 (position of last occurrence), A105017 (position of records), A334197 (positions of record jumps upward).
Partial sums of A334090.
Cf. also A056239.

Programs

  • Haskell
    import Data.List (genericIndex)
    a064097 n = genericIndex a064097_list (n-1)
    a064097_list = 0 : f 2 where
       f x | x == spf  = 1 + a064097 (spf - 1) : f (x + 1)
           | otherwise = a064097 spf + a064097 (x `div` spf) : f (x + 1)
           where spf = a020639 x
    -- Reinhard Zumkeller, Mar 08 2013
    
  • Maple
    a:= proc(n) option remember;
          add((1+a(i[1]-1))*i[2], i=ifactors(n)[2])
        end:
    seq(a(n), n=1..120);  # Alois P. Heinz, Apr 26 2019
    # alternative which can be even used outside this entry
    A064097 := proc(n)
            option remember ;
            add((1+procname(i[1]-1))*i[2], i=ifactors(n)[2]) ;
    end proc:
    seq(A064097(n),n=1..100) ; # R. J. Mathar, Aug 07 2022
  • Mathematica
    quasiLog := (Length@NestWhileList[# - Divisors[#][[-2]] &, #, # > 1 &] - 1) &;
    quasiLog /@ Range[1024]
    (* Terentyev Oleg, Jul 17 2011 *)
    fi[n_] := Flatten[ Table[#[[1]], {#[[2]]}] & /@ FactorInteger@ n]; a[1] = 0; a[n_] := If[ PrimeQ@ n, a[n - 1] + 1, Plus @@ (a@# & /@ fi@ n)]; Array[a, 105] (* Robert G. Wilson v, Jul 17 2013 *)
    a[n_] := Length@ NestWhileList[# - #/FactorInteger[#][[1, 1]] &, n, # != 1 &] - 1; Array[a, 100] (* or *)
    a[n_] := a[n - n/FactorInteger[n][[1, 1]]] +1; a[1] = 0; Array[a, 100]  (* Robert G. Wilson v, Mar 03 2020 *)
  • PARI
    NN=200; an=vector(NN);
    a(n)=an[n];
    for(n=2,NN,an[n]=if(isprime(n),1+a(n-1), sumdiv(n,p, if(isprime(p),a(p)*valuation(n,p)))));
    for(n=1,100,print1(a(n)", "))
    
  • PARI
    a(n)=if(isprime(n), return(a(n-1)+1)); if(n==1, return(0)); my(f=factor(n)); apply(a,f[,1])~ * f[,2] \\ Charles R Greathouse IV, May 10 2016
    
  • Scheme
    (define (A064097 n) (if (= 1 n) 0 (+ 1 (A064097 (A060681 n))))) ;; After Jaroslav Krizek's Jan 28 2010 formula.
    (define (A060681 n) (- n (A032742 n))) ;; See also code under A032742.
    ;; Antti Karttunen, Aug 23 2017

Formula

Conjectures: for n>1, log(n) < a(n) < (5/2)*log(n); lim n ->infinity sum(k=1, n, a(k))/(n*log(n)-n) = C = 1.8(4)... - Benoit Cloitre, Oct 30 2002
Conjecture: for n>1, floor(log_2(n)) <= a(n) < (5/2)*log(n). - Robert G. Wilson v, Aug 10 2013
a(n) = Sum_{k=1..n} a(p_k)*e_k if n is composite with factorization p_1^e_1 * ... * p_k^e_k. - Orson R. L. Peters, May 10 2016
From Antti Karttunen, Aug 23 2017: (Start)
a(1) = 0; for n > 1, a(n) = 1 + a(A060681(n)). [From Jaroslav Krizek's Jan 28 2010 formula in comments.]
a(n) = A073933(n) - 1. (End)
a(n) = A064415(n) + A329697(n) [= A054725(n) + A329697(n), for n > 1]. - Antti Karttunen, Apr 16 2020
a(n) = A323077(n) + A334202(n) = a(A052126(n)) + a(A006530(n)). - Antti Karttunen, May 12 2020

Extensions

More terms from Michael Somos, Sep 25 2001

A333123 Consider the mapping k -> (k - (k/p)), where p is any of k's prime factors. a(n) is the number of different possible paths from n to 1.

Original entry on oeis.org

1, 1, 1, 1, 1, 2, 2, 1, 2, 2, 2, 3, 3, 5, 5, 1, 1, 5, 5, 3, 10, 5, 5, 4, 3, 7, 5, 9, 9, 12, 12, 1, 17, 2, 21, 9, 9, 14, 16, 4, 4, 28, 28, 9, 21, 14, 14, 5, 28, 7, 7, 12, 12, 14, 16, 14, 28, 23, 23, 21, 21, 33, 42, 1, 33, 47, 47, 3, 61, 56, 56, 14, 14, 23, 28, 28, 103, 42, 42, 5
Offset: 1

Views

Author

Ali Sada and Robert G. Wilson v, Mar 09 2020

Keywords

Comments

The iteration always terminates at 1, regardless of the prime factor chosen at each step.
Although there may exist multiple paths to 1, their path lengths (A064097) are the same! See A064097 for a proof. Note that this behavior does not hold if we allow any divisor of k.
First occurrence of k or 0 if no such value exists: 1, 6, 12, 24, 14, 96, 26, 85, 28, 21, 578, 30, 194, 38, 164, 39, 33, 104, 1538, 112, 35, 328, 58, 166, ..., .
Records: 1, 2, 3, 5, 10, 12, 17, 21, 28, 33, 42, 47, 61, 103, 168, ..., .
Record indices: 1, 6, 12, 14, 21, 30, 33, 35, 42, 62, 63, 66, 69, ..., .
When viewed as a graded poset, the paths of the said graph are the chains of the corresponding poset. This poset is also a lattice (see Ewan Delanoy's answer to Peter Kagey's question at the Mathematics Stack Exchange link). - Antti Karttunen, May 09 2020

Examples

			a(1): {1}, therefore a(1) = 1;
a(6): {6, 4, 2, 1} or {6, 3, 2, 1}, therefore a(6) = 2;
a(12): {12, 8, 4, 2, 1}, {12, 6, 4, 2, 1} or {12, 6, 3, 2, 1}, therefore a(12) = 3;
a(14): {14, 12, 8, 4, 2, 1}, {14, 12, 6, 4, 2, 1}, {14, 12, 6, 3, 2, 1}, {14, 7, 6, 4, 2, 1} or {14, 7, 6, 3, 2, 1}, therefore a(14) = 5.
From _Antti Karttunen_, Apr 05 2020: (Start)
For n=15 we have five alternative paths from 15 to 1: {15, 10, 5, 4, 2, 1}, {15, 10, 8, 4, 2, 1}, {15, 12, 8, 4, 2, 1},  {15, 12, 6, 4, 2, 1},  {15, 12, 6, 3, 2, 1}, therefore a(15) = 5. These form a graph illustrated below:
        15
       / \
      /   \
    10     12
    / \   / \
   /   \ /   \
  5     8     6
   \_   |  __/|
     \__|_/   |
        4     3
         \   /
          \ /
           2
           |
           1
(End)
		

Crossrefs

Cf. A064097, A332809 (size of the lattice), A332810.
Cf. A332904 (sum of distinct integers present in such a graph/lattice), A333000 (sum over all paths), A333001, A333785.
Cf. A332992 (max. outdegree), A332999 (max. indegree), A334144 (max. rank level).
Cf. A334230, A334231 (meet and join).
Partial sums of A332903.
Cf. also tables A334111, A334184.

Programs

  • Mathematica
    a[n_] := Sum[a[n - n/p], {p, First@# & /@ FactorInteger@n}]; a[1] = 1; (* after PARI coding by Rémy Sigrist *) Array[a, 70]
    (* view the various paths *)
    f[n_] := Block[{i, j, k, p, q, mtx = {{n}}}, Label[start]; If[mtx[[1, -1]] != 1, j = Length@ mtx;  While[j > 0, k = mtx[[j, -1]]; p = First@# & /@ FactorInteger@k; q = k - k/# & /@ p; pl = Length@p; If[pl > 1, Do[mtx = Insert[mtx, mtx[[j]], j], {pl - 1}]]; i = 1;  While[i < 1 + pl, mtx[[j + i - 1]] = Join[mtx[[j + i - 1]], {q[[i]]}]; i++]; j--]; Goto[start], mtx]]
  • PARI
    for (n=1, #a=vector(80), print1 (a[n]=if (n==1, 1, vecsum(apply(p -> a[n-n/p], factor(n)[,1]~)))", ")) \\ Rémy Sigrist, Mar 11 2020

Formula

a(n) = 1 iff n is a power of two (A000079) or a Fermat Prime (A019434).
a(p) = a(p-1) if p is prime.
a(n) = Sum_{p prime and dividing n} a(n - n/p) for any n > 1. - Rémy Sigrist, Mar 11 2020

A334100 Square array where the row n lists all numbers k for which A329697(k) = n, read by falling antidiagonals.

Original entry on oeis.org

1, 2, 3, 4, 5, 7, 8, 6, 9, 19, 16, 10, 11, 21, 43, 32, 12, 13, 23, 47, 127, 64, 17, 14, 27, 49, 129, 283, 128, 20, 15, 29, 57, 133, 301, 659, 256, 24, 18, 31, 59, 139, 329, 817, 1319, 512, 34, 22, 33, 63, 141, 343, 827, 1699, 3957, 1024, 40, 25, 35, 67, 147, 347, 839, 1787, 4079, 9227, 2048, 48, 26, 37, 69, 161, 361, 849, 1849, 4613, 9233, 21599
Offset: 1

Views

Author

Antti Karttunen, Apr 14 2020

Keywords

Comments

Array is read by descending antidiagonals with (n,k) = (0,1), (0,2), (1,1), (0,3), (1,2), (2,1), ... where A(n,k) is the k-th solution x to A329697(x) = n. The row indexing (n) starts from 0, and column indexing (k) from 1.
Any odd prime that appears on row n is 1+{some term on row n-1}.
The e-th powers of the terms on row n form a subset of terms on row (e*n). More generally, a product of terms that occur on rows i_1, i_2, ..., i_k can be found at row (i_1 + i_2 + ... + i_k), because A329697 is completely additive.
The binary weight (A000120) of any term on row n is at most 2^n.

Examples

			The top left corner of the array:
  n\k |    1     2     3     4     5     6     7     8     9    10
------+----------------------------------------------------------------
   0  |    1,    2,    4,    8,   16,   32,   64,  128,  256,  512, ...
   1  |    3,    5,    6,   10,   12,   17,   20,   24,   34,   40, ...
   2  |    7,    9,   11,   13,   14,   15,   18,   22,   25,   26, ...
   3  |   19,   21,   23,   27,   29,   31,   33,   35,   37,   38, ...
   4  |   43,   47,   49,   57,   59,   63,   67,   69,   71,   77, ...
   5  |  127,  129,  133,  139,  141,  147,  161,  163,  171,  173, ...
   6  |  283,  301,  329,  343,  347,  361,  379,  381,  383,  387, ...
   7  |  659,  817,  827,  839,  849,  863,  883,  889,  893,  903, ...
   8  | 1319, 1699, 1787, 1849, 1977, 1979, 1981, 2021, 2039, 2083, ...
   9  | 3957, 4079, 4613, 4903, 5097, 5179, 5361, 5377, 5399, 5419, ...
etc.
Note that the row 9 is the first one which begins with composite, as 3957 = 3*1319. The next such rows are row 15 and row 22. See A334099.
		

Crossrefs

Cf. A329697.
Cf. A334099 (the leftmost column).
Cf. A000079, A334101, A334102, A334103, A334104, A334105, A334106 for the rows 0-6.
Cf. A019434, A334092, A334093, A334094, A334095, A334096 for the primes on the rows 1-6.
Cf. also irregular triangle A334111.

Programs

  • Mathematica
    Block[{nn = 16, s}, s = Values@ PositionIndex@ Array[-1 + Length@ NestWhileList[# - #/FactorInteger[#][[-1, 1]] &, #, # != 2^IntegerExponent[#, 2] &] &, 2^nn]; Table[s[[#, k]] &[m - k + 1], {m, nn - Ceiling[nn/4]}, {k, m, 1, -1}]] // Flatten (* Michael De Vlieger, Apr 30 2020 *)
  • PARI
    up_to = 105; \\ up_to = 1081; \\ = binomial(46+1,2)
    A329697(n) = if(!bitand(n,n-1),0,1+A329697(n-(n/vecmax(factor(n)[, 1]))));
    memoA334100sq = Map();
    A334100sq(n, k) = { my(v=0); if(!mapisdefined(memoA334100sq,[n,k-1],&v),if(1==k, v=0, v = A334100sq(n, k-1))); for(i=1+v,oo,if(A329697(i)==(n-1),mapput(memoA334100sq,[n,k],i); return(i))); };
    A334100list(up_to) = { my(v = vector(up_to), i=0); for(a=1,oo, for(col=1,a, i++; if(i > up_to, return(v)); v[i] = A334100sq(col,(a-(col-1))))); (v); };
    v334100 = A334100list(up_to);
    A334100(n) = v334100[n];

A334184 Irregular table read by rows: T(n,k) gives the number of values that can be reached after exactly k iterations of maps of the form (n - n/p) where p is a prime divisor of n. 0 <= k < A073933(n).

Original entry on oeis.org

1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 2, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 2, 2, 1, 1, 1, 1, 2, 2, 1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 3, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 1, 1, 1, 1, 2, 2, 2
Offset: 1

Views

Author

Peter Kagey, Apr 17 2020

Keywords

Comments

Row lengths are given by A073933(n). Row sums are given by A332809(n). The maximum value in each row is given by A334144(n).
The n-th row consists of all 1's if and only if n is a power of two (A000079) or a Fermat prime (A019434).
Conjecture: rows are unimodal (increasing and then decreasing).
Not all rows are unimodal. Indices of rows that have terms that increase and decrease more than once are A334238. - Michael De Vlieger, Apr 18 2020

Examples

			For n = 15, the fifteenth row of this table is [1,2,3,2,1,1] because there is one value (15 itself) that can be reached with zero iterations of (n - n/p) maps, two values (10 and 12) that can be reached after one iteration, three values (5, 8, and 6) that can be reached after two iterations, and so on.
      15
     _/ \_
    /     \
  10       12
  | \_   _/ |
  |   \ /   |
  5    8    6
   \_  |  _/|
     \_|_/  |
       4    3
       |  _/
       |_/
       2
       |
       |
       1
Table begins:
1
1, 1
1, 1, 1
1, 1, 1
1, 1, 1, 1
1, 2, 1, 1
1, 1, 2, 1, 1
1, 1, 1, 1
1, 1, 2, 1, 1
1, 2, 1, 1, 1
1, 1, 2, 1, 1, 1
1, 2, 2, 1, 1
1, 1, 2, 2, 1, 1
1, 2, 2, 2, 1, 1
1, 2, 3, 2, 1, 1
1, 1, 1, 1, 1
		

Crossrefs

Programs

  • Mathematica
    Table[Length@ Union@ # & /@ Transpose@ # &@ If[n == 1, {{1}}, NestWhile[If[Length[#] == 0, Map[{n, #} &, # - # /FactorInteger[#][[All, 1]] ], Union[Join @@ Map[Function[{w, n}, Map[Append[w, If[n == 0, 0, n - n/#]] &, FactorInteger[n][[All, 1]] ]] @@ {#, Last@ #} &, #]]] &, n, If[ListQ[#], AllTrue[#, Last[#] > 1 &], # > 1] &]], {n, 22}] // Flatten (* Michael De Vlieger, Apr 18 2020 *)

Formula

T(n,0) = T(n, A073933(n) - 2) = T(n, A073933(n) - 1) = 1.
T(n,1) = A001221(n) for n > 1.

A058812 Irregular triangle of rows of numbers in increasing order. Row 1 = {1}. Row m + 1 contains all numbers k such that phi(k) is in row m.

Original entry on oeis.org

1, 2, 3, 4, 6, 5, 7, 8, 9, 10, 12, 14, 18, 11, 13, 15, 16, 19, 20, 21, 22, 24, 26, 27, 28, 30, 36, 38, 42, 54, 17, 23, 25, 29, 31, 32, 33, 34, 35, 37, 39, 40, 43, 44, 45, 46, 48, 49, 50, 52, 56, 57, 58, 60, 62, 63, 66, 70, 72, 74, 76, 78, 81, 84, 86, 90, 98, 108, 114, 126
Offset: 0

Views

Author

Labos Elemer, Jan 03 2001

Keywords

Comments

Nontotient values (A007617) are also present as inverses of some previous value.
Old name was: Irregular triangle of inverse totient values of integers generated recursively. Initial value is 1. The inverse-phi sets in increasing order are as follows: {1} -> {2} -> {3, 4, 6} -> {5, 7, 8, 9, 10, 12, 14, 18} -> ... The terms of each row are arranged by magnitude. The next row starts when the increase of terms is violated. 2^n is included in the n-th row. - David A. Corneth, Mar 26 2019

Examples

			Triangle begins:
  1;
  2;
  3, 4, 6;
  5, 7, 8, 9, 10, 12, 14, 18;
  ...
Row 3 is {3, 4, 6} as for each number k in this row, phi(k) is in row 2. - _David A. Corneth_, Mar 26 2019
		

Crossrefs

A058811 gives the number of terms in each row.
Cf. also A334111.

Programs

  • Mathematica
    inversePhi[m_?OddQ] = {}; inversePhi[1] = {1, 2}; inversePhi[m_] := Module[{p, nmax, n, nn}, p = Select[Divisors[m] + 1, PrimeQ]; nmax = m*Times @@ (p/(p-1)); n = m; nn = {}; While[n <= nmax, If[EulerPhi[n] == m, AppendTo[nn, n]]; n++]; nn]; row[n_] := row[n] = inversePhi /@ row[n-1] // Flatten // Union; row[0] = {1}; row[1] = {2}; Table[row[n], {n, 0, 5}] // Flatten (* Jean-François Alcover, Dec 06 2012 *)

Extensions

Definition revised by T. D. Noe, Nov 30 2007
New name from David A. Corneth, Mar 26 2019

A334144 Consider the mapping k -> (k - (k/p)), where prime p | k. a(n) = maximum distinct terms at any position j among the various paths to 1.

Original entry on oeis.org

1, 1, 1, 1, 1, 2, 2, 1, 2, 2, 2, 2, 2, 2, 3, 1, 1, 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 1, 4, 2, 4, 3, 3, 3, 3, 2, 2, 4, 4, 3, 4, 3, 3, 2, 4, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 1, 5, 5, 5, 2, 5, 5, 5, 3, 3, 3, 4, 3, 6, 4, 4, 2, 3, 2, 2, 4, 3, 4, 4, 3, 3, 5, 5, 3, 5, 3, 5, 2, 2, 4, 6, 3, 3, 3, 3, 3, 6, 3
Offset: 1

Views

Author

Keywords

Comments

Let i = A064097(n) be the common path length and let 1 <= j <= i. Given a path P, we find for any j relatively few distinct values. Regarding a common path length i, see A333123 comment 2, and proof at A064097.
Maximum term in row n of A334184.

Examples

			For n=15, the paths are shown vertically at left, and the graph obtained appears at right:
  15   15   15   15   15  =>         15
   |    |    |    |    |            _/ \_
   |    |    |    |    |           /     \
  10   10   12   12   12  =>     10       12
   |    |    |    |    |         | \_   _/ |
   |    |    |    |    |         |   \ /   |
   5    8    6    6    8  =>     5    8    6
   |    |    |    |    |          \_  |  _/|
   |    |    |    |    |            \_|_/  |
   4    4    3    4    4  =>          4    3
   |    |    |    |    |              |  _/
   |    |    |    |    |              |_/
   2    2    2    2    2  =>          2
   |    |    |    |    |              |
   |    |    |    |    |              |
   1    1    1    1    1  =>          1
Because the maximum number of distinct terms in any row is 3, a(15) = 3.
		

Crossrefs

Programs

  • Mathematica
    Max[Length@ Union@ # & /@ Transpose@ #] & /@ Nest[Function[{a, n}, Append[a, Join @@ Table[Flatten@ Prepend[#, n] & /@ a[[n - n/p]], {p, FactorInteger[n][[All, 1]]}]]] @@ {#, Length@ # + 1} &, {{{1}}}, 105]
    (* Second program: *)
    g[n_] := Block[{lst = {{n}}}, While[lst[[-1]] != {1}, lst = Join[lst, {Union@ Flatten[# - #/(First@ # & /@ FactorInteger@ #) & /@ lst[[-1]] ]}]]; Max[Length /@ lst]]; Array[g, 105] (* Robert G. Wilson v, May 08 2020 *)

A332992 Maximum outdegree in the graph formed by a subset of numbers in range 1 .. n with edge relation k -> k - k/p, where p can be any of the prime factors of k.

Original entry on oeis.org

0, 1, 1, 1, 1, 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 1, 3, 2, 3, 2, 2, 2, 2, 2, 2, 3, 3, 2, 3, 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 1, 3, 3, 3, 2, 3, 3, 3, 2, 2, 2, 3, 2, 3, 3, 3, 2, 2, 2, 2, 3, 2, 3, 3, 2, 2, 3, 3, 2, 3, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 2, 3
Offset: 1

Views

Author

Antti Karttunen, Apr 04 2020

Keywords

Comments

Maximum number of distinct prime factors of any one integer encountered on all possible paths from n to 1 when iterating with nondeterministic map k -> k - k/p, where p can be any of the prime factors of k.

Examples

			For n=15 we have five alternative paths from 15 to 1: {15, 10, 5, 4, 2, 1}, {15, 10, 8, 4, 2, 1}, {15, 12, 8, 4, 2, 1},  {15, 12, 6, 4, 2, 1},  {15, 12, 6, 3, 2, 1}. These form a lattice illustrated below:
        15
       / \
      /   \
    10     12
    / \   / \
   /   \ /   \
  5     8     6
   \__  |  __/|
      \_|_/   |
        4     3
         \   /
          \ /
           2
           |
           1
With edges going from 15 towards 1, the maximum outdegree is 2, which occurs at nodes 15, 12, 10 and 6, therefore a(15) = 2.
		

Crossrefs

Cf. A002110 (positions of records and the first occurrence of each n).

Programs

  • Mathematica
    With[{s = Nest[Function[{a, n}, Append[a, Join @@ Table[Flatten@ Prepend[#, n] & /@ a[[n - n/p]], {p, FactorInteger[n][[All, 1]]}]]] @@ {#, Length@ # + 1} &, {{{1}}}, 105]}, Array[If[# == 1, 0, Max@ Tally[#][[All, -1]] &@ Union[Join @@ Map[Partition[#, 2, 1] &, s[[#]] ]][[All, 1]] ] &, Length@ s]] (* Michael De Vlieger, May 02 2020 *)
  • PARI
    up_to = 105;
    A332992list(up_to) = { my(v=vector(up_to)); v[1] = 0; for(n=2,up_to, v[n] = max(omega(n),vecmax(apply(p -> v[n-n/p], factor(n)[, 1]~)))); (v); };
    v332992 = A332992list(up_to);
    A332992(n) = v332992[n];

Formula

a(n) = max(A001221(n), {Max a(n - n/p), for p prime and dividing n}).
For all odd primes p, a(p) = a(p-1).
For all n >= 0, a(A002110(n)) = n.

A332999 Maximum indegree in the graph formed by a subset of numbers in range 1 .. n with edge relation k -> k - k/p, where p is any of the prime factors of k.

Original entry on oeis.org

0, 1, 1, 1, 1, 2, 2, 1, 2, 2, 2, 2, 2, 2, 3, 1, 1, 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 1, 3, 2, 3, 2, 2, 2, 3, 2, 2, 3, 3, 2, 3, 2, 2, 2, 3, 2, 3, 2, 2, 2, 3, 2, 3, 2, 2, 3, 3, 3, 3, 1, 3, 3, 3, 2, 3, 3, 3, 2, 2, 2, 3, 2, 3, 3, 3, 2, 2, 2, 2, 3, 3, 3, 3, 2, 2, 3, 4, 2, 3, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 2, 4
Offset: 1

Views

Author

Antti Karttunen, Apr 05 2020

Keywords

Examples

			For n=15 we have five alternative paths from 15 to 1: {15, 10, 5, 4, 2, 1}, {15, 10, 8, 4, 2, 1}, {15, 12, 8, 4, 2, 1},  {15, 12, 6, 4, 2, 1},  {15, 12, 6, 3, 2, 1}. These form a lattice illustrated below:
        15
       / \
      /   \
    10     12
    / \   / \
   /   \ /   \
  5     8     6
   \__  |  __/|
      \_|_/   |
        4     3
         \   /
          \ /
           2
           |
           1
With edges going from 15 towards 1, the maximum indegree is 3, which occurs at node 4, therefore a(15) = 3.
		

Crossrefs

Cf. A332992 (max. outdegree), A333123, A334144, A334184.
Cf. A067513 for the maximal indegree in the whole semilattice (see A334111).

Programs

  • Mathematica
    With[{s = Nest[Function[{a, n}, Append[a, Join @@ Table[Flatten@ Prepend[#, n] & /@ a[[n - n/p]], {p, FactorInteger[n][[All, 1]]}]]] @@ {#, Length@ # + 1} &, {{{1}}}, 105]}, Array[If[# == 1, 0, Max@ Tally[#][[All, -1]] &@ Union[Join @@ Map[Partition[#, 2, 1] &, s[[#]] ]][[All, -1]] ] &, Length@ s]] (* Michael De Vlieger, May 02 2020 *)
  • PARI
    A332999(n) = { my(m = Map(), nodes = List([n]), x, xps, s=0, u, v); while(#nodes, x = nodes[#nodes]; listpop(nodes); xps = factor(x)[, 1]~; for(i=1,#xps, u=x-(x/xps[i]); if(!mapisdefined(m,u,&v), v=0; listput(nodes,u)); mapput(m,u,v+1); s = max(s,v+1))); (s); };
Showing 1-8 of 8 results.