Klarner-Rado sequence: Difference between revisions

=={{header|AppleScript}}==

One way to test numbers for membership of the sequence is to feed them to a recursive handler which determines whether or not there's a Klarner-Rado route from them down to 0. It makes finding the elements in order simple, but takes about five and a half minutes to get to the millionth one.

<lang applescript>-- Is n in the Klarner-Rado sequence?

-- Fully recursive:

(* on isKlarnerRado(n)

set n to n - 1

return ((n = 0) or ((n mod 2 = 0) and (isKlarnerRado(n div 2))) or ((n mod 3 = 0) and (isKlarnerRado(n div 3))))

end isKlarnerRado *)

-- Optimised with tail call elimination. 90 seconds faster than the above in this script.

on isKlarnerRado(n)

set n to n - 1

repeat

if ((n = 0) or ((n mod 3 = 0) and (isKlarnerRado(n div 3)))) then

return true

else if (n mod 2 = 0) then

set n to n div 2 - 1

else

return false

end if

end repeat

end isKlarnerRado

on join(lst, delim)

set astid to AppleScript's text item delimiters

set AppleScript's text item delimiters to delim

set txt to lst as text

set AppleScript's text item delimiters to astid

return txt

end join

on task()

set output to {"First 100 elements:"}

set n to 0

set |count| to 0

set K to {}

repeat until (|count| = 100)

set n to n + 1

if (isKlarnerRado(n)) then

set K's end to n

set |count| to |count| + 1

end if

end repeat

repeat with i from 1 to 100 by 20

set output's end to join(K's items i thru (i + 19), " ")

end repeat

repeat with this in {{1000, "1,000th element: "}, {10000, "10,000th element: "}, {100000, "100,000th element: "}, ¬

{1000000, "1,000,000th element: "}}

set {target, spiel} to this

repeat until (|count| = target)

set n to n + 1

if (isKlarnerRado(n)) then set |count| to |count| + 1

end repeat

set output's end to spiel & n

end repeat

return join(output, linefeed)

end task

task()</lang>

{{output}}

<lang applescript>"First 100 elements:

1 3 4 7 9 10 13 15 19 21 22 27 28 31 39 40 43 45 46 55

57 58 63 64 67 79 81 82 85 87 91 93 94 111 115 117 118 121 127 129

130 135 136 139 159 163 165 166 171 172 175 183 187 189 190 193 202 223 231 235

237 238 243 244 247 255 256 259 261 262 271 273 274 279 280 283 319 327 331 333

334 343 345 346 351 352 355 364 367 375 379 381 382 387 388 391 405 406 409 418

1,000th element: 8487

10,000th element: 157653

100,000th element: 2911581

1,000,000th element: 54381285"</lang>

Another way is to produce a list with Klarner-Rado elements in the slots indexed by those numbers and 'missing values' in the other slots. If a number being tested is exactly divisible by 2 or by 3, and the slot whose index is the result of the division contains a number instead of 'missing value', the tested number plus 1 is a Klarner-Rado element and should go into the slot it indexes. The list will contain vastly more 'missing values' than Klarner-Rado elements and it — or portions of it — ideally need to exist before the sequence elements are inserted. So while an overabundance and sorting of sequence elements isn't needed, an overabundance of 'missing values' is! The script below carries out the task in about 75 seconds on my current machine and produces the same output as above.

<lang applescript>on KlarnerRadoSequence(target)

-- To find a million KR numbers with this method nominally needs a list with at least 54,381,285

-- slots. But the number isn't known in advance, "growing" a list to the required length would

-- take forever, and accessing its individual items could also take a while. Instead, K will

-- here contain reasonably sized and quickly produced sublists which are added as needed.

-- The 1-based referencing calculations will be ((index - 1) div sublistLen + 1) for the sublist

-- and ((index - 1) mod sublistLen + 1) for the slot within it.

set sublistLen to 10000

script o

property spare : makeList(sublistLen, missing value)

property K : {spare's items}

end script

-- Insert the initial 1, start the KR counter at 1, start the number-to-test variable at 2.

set {o's K's beginning's 1st item, |count|, n} to {1, 1, 2}

-- Test the first, second, third, and fifth of every six consecutive numbers starting at 2.

-- These are known to be divisible by 2 or by 3 and the fourth and sixth known not to be.

-- If the item at index (n div 2) or index (n div 3) isn't 'missing value', it's a number,

-- so insert (n + 1) at index (n + 1).

if (|count| < target) then ¬

repeat -- Per increase of n by 6.

-- The first of the six numbers in this range is divisible by 2.

-- Precalculate (index - 1) for index (n div 2) to reduce code clutter and halve calculation time.

set pre to n div 2 - 1

if (o's K's item (pre div sublistLen + 1)'s item (pre mod sublistLen + 1) is missing value) then

else

-- Insert (n + 1) at index (n + 1). The 'n's in the reference calculations are for ((n + 1) - 1)!

set o's K's item (n div sublistLen + 1)'s item (n mod sublistLen + 1) to n + 1

set |count| to |count| + 1

if (|count| = target) then exit repeat

end if

-- The second number of the six is divisible by 3.

set n to n + 1

set pre to n div 3 - 1

if (o's K's item (pre div sublistLen + 1)'s item (pre mod sublistLen + 1) is missing value) then

else

set o's K's item (n div sublistLen + 1)'s item (n mod sublistLen + 1) to n + 1

set |count| to |count| + 1

if (|count| = target) then exit repeat

end if

-- The third is divisible by 2.

set n to n + 1

set pre to n div 2 - 1

if (o's K's item (pre div sublistLen + 1)'s item (pre mod sublistLen + 1) is missing value) then

else

set o's K's item (n div sublistLen + 1)'s item (n mod sublistLen + 1) to n + 1

set |count| to |count| + 1

if (|count| = target) then exit repeat

end if

-- The fifth is divisible by both 2 and 3.

set n to n + 2

set pre2 to n div 2 - 1

set pre3 to n div 3 - 1

if ((o's K's item (pre2 div sublistLen + 1)'s item (pre2 mod sublistLen + 1) is missing value) and ¬

(o's K's item (pre3 div sublistLen + 1)'s item (pre3 mod sublistLen + 1) is missing value)) then

else

set o's K's item (n div sublistLen + 1)'s item (n mod sublistLen + 1) to n + 1

set |count| to |count| + 1

if (|count| = target) then exit repeat

end if

-- Advance to the first number of the next six.

set n to n + 2

-- If another sublist is about to be needed, append one to the end of K.

if ((n + 6) mod sublistLen < 6) then copy o's spare to o's K's end

end repeat

-- Once the target's reached, replace the sublists with lists containing just the numbers.

set sublistCount to (count o's K)

repeat with i from 1 to sublistCount

set o's K's item i to o's K's item i's numbers

end repeat

-- Concatenate the number lists to leave K as a single list of numbers.

repeat while (sublistCount > 1)

set o's spare to o's K

set o's K to {}

repeat with i from 2 to sublistCount by 2

set end of o's K to o's spare's item (i - 1) & o's spare's item i

end repeat

if (i < sublistCount) then set o's K's last item to o's K's end & o's spare's end

set sublistCount to sublistCount div 2

end repeat

set o's K to o's K's beginning

return o's K

end KlarnerRadoSequence

on makeList(len, content)

script o

property lst : {}

end script

if (len > 0) then

set o's lst's end to content

set |count| to 1

repeat until (|count| + |count| > len)

set o's lst to o's lst & o's lst

set |count| to |count| + |count|

end repeat

if (|count| < len) then set o's lst to o's lst & o's lst's items 1 thru (len - |count|)

end if

return o's lst

end makeList

on join(lst, delim)

set astid to AppleScript's text item delimiters

set AppleScript's text item delimiters to delim

set txt to lst as text

set AppleScript's text item delimiters to astid

return txt

end join

on task()

script o

property K : KlarnerRadoSequence(1000000)

end script

set output to {"First 100 elements:"}

repeat with i from 1 to 100 by 20

set output's end to join(o's K's items i thru (i + 19), " ")

end repeat

set output's end to "1,000th element: " & o's K's item 1000

set output's end to "10,000th element: " & o's K's item 10000

set output's end to "100,000th element: " & o's K's item 100000

set output's end to "1,000,000th element: " & o's K's item 1000000

return join(output, linefeed)

end task

task()</lang>