login
a(1)=1; a(n+1) is the smallest positive integer not yet used such that all the digits of a(n) and a(n+1) are present in the decimal expansion (including any leading and trailing zeros) of a(n)/a(n+1).
3

%I #29 Dec 23 2015 14:13:35

%S 1,6,13,10,14,17,7,8,19,23,21,29,34,31,3,38,28,46,47,35,39,49,43,51,

%T 42,41,48,53,26,12,57,58,59,2,61,24,68,11,52,63,22,69,62,71,56,65,76,

%U 81,44,67,64,83,85,78,77,79,72,70,80,87,84,86,89,9,91,92,73

%N a(1)=1; a(n+1) is the smallest positive integer not yet used such that all the digits of a(n) and a(n+1) are present in the decimal expansion (including any leading and trailing zeros) of a(n)/a(n+1).

%C Conjecture: a(n) is a permutation of the natural numbers.

%C The following table shows:

%C C = number of terms calculated

%C F = first term that is missing

%C C F F/C

%C 1000 5 0.005

%C 2000 50 0.025

%C 5000 1650 0.330

%C 10000 1650 0.165

%C 20000 2475 0.124

%C 50000 24750 0.495

%C 100000 100000 1.000

%C 200000 199800 0.999

%C 500000 499500 0.999

%C which seems to support the conjecture.

%H Lars Blomberg, <a href="/A265740/b265740.txt">Table of n, a(n) for n = 1..10000</a>

%e 1/6 = 0.1666... (1 and 6 are visible on the right-hand side)

%e 6/13 = 0.461538461538... (6, 1 and 3 are visible)

%e 13/10 = 1.30 (trailing zeros are included)

%e 10/14 = 0.7142857142... (1, 0 and 4)

%e 14/17 = 0.8235294117... (1, 4 and 7)

%e 17/7 = 2.4285714285... (1 and 7)

%e 7/8 = 0.875 (7 and 8)

%e ...

%t f[n_] := Block[{a = {1}, k}, Do[k = If[MissingQ@ #, Max@ a, #] &@ SelectFirst[Range@ Max@ a, ! MemberQ[a, #] &]; While[Or[! AllTrue[Join[IntegerDigits@ a[[i - 1]], IntegerDigits@ k], MemberQ[Union@ Flatten@ Prepend[First@ #, If[Last@ # <= 0, 0, Nothing]] &@ If[Depth@ First@ # < 3, Insert[#, 0, {1, 1}], #] &@ RealDigits[a[[i - 1]]/k], #] &], MemberQ[a, k]], k++]; AppendTo[a, k], {i, 2, n}]; a]; f@ 67 (* Version 10.2 *)

%t f[n_] := Block[{a = {1}, k}, Do[k = 1; While[Or[If[# == 1, False, True] &[Times @@ Boole[MemberQ[Union@ Flatten@ Prepend[First@ #, If[Last@ # <= 0, 0]] &@ If[Depth@ First@ # < 3, Insert[#, 0, {1, 1}], #] &@ RealDigits[a[[i - 1]]/k], #] & /@ Join[IntegerDigits@ a[[i - 1]], IntegerDigits@ k]]], MemberQ[a, k]], k++]; AppendTo[a, k], {i, 2, n}]; a]; f@ 67 (* _Michael De Vlieger_, Dec 16 2015, Version 6 *)

%Y See A265756 for another version.

%Y See also A257664.

%K nonn,base

%O 1,2

%A _Eric Angelini_, submitted by _Lars Blomberg_, Dec 15 2015

%E Corrected values for n>=58 by _Lars Blomberg_, Dec 16 2015