login

Year-end appeal: Please make a donation to the OEIS Foundation to support ongoing development and maintenance of the OEIS. We are now in our 61st year, we have over 378,000 sequences, and we’ve reached 11,000 citations (which often say “discovered thanks to the OEIS”).

A334238
Rows n in A334184 that are not unimodal.
2
57, 63, 171, 258, 266, 294, 301, 329, 342, 343, 354, 361, 377, 378, 379, 381, 387, 399, 423, 437, 441, 462, 463, 469, 474, 481, 483, 489, 506, 513, 529, 567, 603, 621, 642, 643, 689, 798, 817, 889, 903, 931, 978, 1026, 1083, 1141, 1143, 1161, 1169, 1197, 1204
OFFSET
1,1
COMMENTS
Consider the mappings k -> (k - (k/p)), across primes p | k. a(n) = rank levels of antichains in the poset resulting from taking distinct terms generated by the mapping and preserving the order of their generation.
We deem a series of rank levels, such as those of n = 15, i.e., row 15 of A334184 = [1, 2, 3, 2, 1, 1], as unimodal, as the terms increase to a point, then decrease.
Early terms may suggest that 2^i +/- 1 appear often in a(n). Given 10000 terms, the only such instances are {63, 513, 2047, 16383} for i = {6, 9, 11, 14}.
a(n) for 1 <= n <= 710 are bimodal. Are there rows n > 710 in A334184 that increase and decrease more than twice?
LINKS
Michael De Vlieger Hasse diagrams of the 24 least terms of this sequence.
EXAMPLE
Example: n = 57 is the smallest number for which rank levels of antichains is not unimodal, under the poset formed from distinct terms resulting from the mapping f(n) := n -> n - n/p across primes p | n.
Hasse diagram Row 57 of A334184
------------- -----------------
57 1
| \
| \
54 38 2
| \/ \
| /\ \
36 27 19 3
| \ | /
| \| /
24 18 2
/| /|
/ | / |
16 12 9 3
| /| /
|/ |_/
8 6 2
| /|
|/ |
4 3 2
| /
|/
2 1
|
|
1 1
MATHEMATICA
Select[Range[2, 600], Function[k, Which[IntegerQ@ Log2@ k, False, And[PrimeQ@ k, IntegerQ@ Log2[k - 1]], False, True, ! AllTrue[Drop[#, FirstPosition[#, _?(# < 0 &)][[1]] - 1 ], # <= 0 &] &@ Sign@ Differences@ Map[Length@ Union@ # &, Transpose@ If[k == 1, {{1}}, NestWhile[If[Length[#] == 0, Map[{k, #} &, # - # /FactorInteger[#][[All, 1]] ], Union[Join @@ Map[Function[{w, n}, Map[Append[w, If[n == 0, 0, n - n/#]] &, FactorInteger[n][[All, 1]] ]] @@ {#, Last@ #} &, #]] ] &, k, If[ListQ[#], AllTrue[#, Last[#] > 1 &], # > 1] &]]]]]]
CROSSREFS
Cf. A334184.
Sequence in context: A345504 A345505 A216183 * A336328 A056082 A218562
KEYWORD
nonn
STATUS
approved