cp's OEIS Frontend

A306481 Lychrel numbers k that set a new record for the number of 'Reverse and Add' steps in base 2 needed to reach a Lychrel number m < k (i.e., its seed).

%I A306481 #31 Nov 23 2019 21:11:36
%S A306481 22,26,67,106,157,199,281,1145,1594,1798,4326,12794,17407,18428,67583,
%T A306481 69628,73978
%N A306481 Lychrel numbers k that set a new record for the number of 'Reverse and Add' steps in base 2 needed to reach a Lychrel number m < k (i.e., its seed).
%C A306481 Records in A306482.
%C A306481 Similar to the number of steps needed to reach a palindrome in the Reverse and Add! trajectories (see A066144 and A066145), the number of steps needed for a Lychrel number to reach the trajectory of its seed is relatively small.
%C A306481 Lychrel numbers in A066059; seeds in A075252 (for base 2).
%C A306481 As a clarification, this sequence can also be described as: Base 2 Lychrel numbers (A066059) k that sets a new record for the number of 'Reverse and Add' steps in base 2 needed to reach the trajectory of a base 2 Lychrel number seed (A075252) that is less than k. - _Robert Price_, Nov 20 2019
%t A306481 limit = 200; (* Assumes that there is no palindrome if none is found before "limit" iterations *)
%t A306481 A066059 = Select[Range[50000],
%t A306481    Length@NestWhileList[# + IntegerReverse[#, 2] &, #, # !=
%t A306481          IntegerReverse[#, 2] &, 1, limit] == limit + 1 &];
%t A306481 utraj = {};
%t A306481 A075252 = Select[Range[50000],
%t A306481    (x = NestWhileList[# + IntegerReverse[#, 2] &, #, # !=
%t A306481          IntegerReverse[#, 2] & , 1, limit];
%t A306481      If[Length@x >= limit  && Intersection[x, utraj] == {},
%t A306481       utraj = Union[utraj, x]; True,
%t A306481       utraj = Union[utraj, x]]) &];
%t A306481 A306481 = {}; best = -1; lastj = 0;
%t A306481 utraj = {};
%t A306481 For[i = 1, i <= Length@A066059, i++,
%t A306481 For[j = lastj + 1, j <= Length@A075252, j++,
%t A306481   If[A066059[[i]] < A075252[[j]], Break[]];
%t A306481   utraj = Union[utraj, NestList[# + IntegerReverse[#, 2] &, A075252[[j]], limit]];
%t A306481   lastj = j; ];
%t A306481 l = NestWhileList[# + IntegerReverse[#, 2] &,
%t A306481    A066059[[i]], ! MemberQ[utraj, #] &, 1, limit];
%t A306481 If[Length@l == limit + 1, Continue[]];
%t A306481 If[Length@l > best, best = Length@l; AppendTo[A306481, A066059[[i]]]];
%t A306481 ]; A306481 (* _Robert Price_, Nov 20 2019 *)
%Y A306481 Cf. A066059, A066144, A066145, A075252, A306482.
%K A306481 nonn,base,more
%O A306481 1,1
%A A306481 _A.H.M. Smeets_, Feb 18 2019