Singly lossy integers: Concatenated sequences missing a single element
APL (Dyalog Unicode), 62 bytesSBCS
Infinite printing full program, 63 bytes
s←⍎' '~⍨⍕
{⎕←s⊢a←⊃⍵⋄b←1+a⋄t←∪(b,⍨⊃a)(a,⊃⌽b)b,1↓⍵⋄t[⍋s¨t]}⍣≡⊂1 3
Try it online!
This one is pretty fast. Theoretically can be made faster using a min heap, but the challenge is code golf after all.
How it works: the concept
If we denote each item in the sequence as a list of integers ([1,3]
for 13, [1,2,4]
for 124, and so on), observe that subsequent items can be derived from an existing item x
in three ways:
- Add 1 to all numbers in
x
- Add 1 to all numbers in
x
, and then prepend the first element ofx
- Append 1 plus the last element of
x
tox
Therefore, the algorithm is to start with the single known value and infinitely run the following:
- Extract the smallest item and print it
- Derive three larger values from it and add them to the list of next candidate items
How it works: the code
s←⍎' '~⍨⍕ ⍝ Helper function: concat a list of numbers
⍕ ⍝ Stringify entire array, which will contain blanks between items
' '~⍨ ⍝ Remove blanks
⍎ ⍝ Eval
s← ⍝ Store the function to s
⍝ Main program: print all items in the sequence infinitely
{⎕←s⊢a←⊃⍵⋄b←1+a⋄t←∪(b,⍨⊃a)(a,⊃⌽b)b,1↓⍵⋄t[⍋s¨t]}⍣≡,⊂1 3
{...}⍣≡⊂1 3 ⍝ Specify starting item and infinite loop
⊂1 3 ⍝ singleton array containing [1 3]
{...}⍣≡ ⍝ Pass it to the infinite looping function
⎕←s⊢a←⊃⍵⋄b←1+a⋄t←∪(b,⍨⊃a)(a,⊃⌽b)b,1↓⍵⋄t[⍋s¨t] ⍝ Single iteration
⍵ ⍝ Sorted candidate items
a←⊃⍵ ⍝ Take the first element and store to a
⎕←s⊢a ⍝ Concat and print it
b←1+a ⍝ Add 1 to all items of a and store to b
t←∪(b,⍨⊃a)(a,⊃⌽b)b,1↓⍵ ⍝ Add next candidates
1↓⍵ ⍝ Remove the first item (already printed)
(b,⍨⊃a)(a,⊃⌽b)b, ⍝ Prepend three candidates:
b ⍝ 1+a
(a,⊃⌽b) ⍝ append 1+last element of a to a
(b,⍨⊃a) ⍝ prepend first element of a to 1+a
t←∪ ⍝ Uniquify and store to t
t[⍋s¨t] ⍝ t sorted with the key function s (concat'ed value)
Function returning first n
values, 62 bytes
⎕CY'dfns'
⊢↑∘{(⍋⊃¨⊂)⍵{a b c←⍵-1 0⍺⋄⍎dab⍕c↓a↓b~⍨⍳⍺}¨↓3cmat⍵}2+⊢
Try it online!
Slower, but still can handle 100 items in around 5 seconds.
How it works: the concept
This solution uses a systematic way to generate all possible singly lossy integers from the list 1..n
. It is equivalent to selecting three members from 1..n
:
- Select three distinct integers
a < b < c
from1..n
. - Take the inclusive range
a..c
and discardb
.
Original list: 1 2 3 4 5 6 7 8 9
Selection: ^ ^ ^
a b c
Take a..c: 2 3 4 5 6 7
Discard b: 2 4 5 6 7
Result: 24567
I use dfns.cmat
to generate all 3-combinations, generate all singly lossy numbers, sort them and take first n
elements. We need length n+2
for the combinations because lower numbers won't give enough number of items.
How it works: the code
⎕CY'dfns' ⍝ Import dfns library, so that we can use cmat
⍝ Inner function: generate enough singly lossy integers
{(⍋⊃¨⊂)⍵{a b c←⍵-1 0⍺⋄⍎dab⍕c↓a↓b~⍨⍳⍺}¨↓3cmat⍵} ⍝ Input: 2+n
⍵{...}¨↓3cmat⍵ ⍝ Generate all 3-combinations, and get singly lossy integers
3cmat⍵ ⍝ 3-combinations of 1..2+n
⍵{ }¨↓ ⍝ Map the inner function to each row of above, with left arg 2+n
a b c←⍵-1 0⍺⋄⍎' '~⍨⍕c↓a↓b~⍨⍳⍺ ⍝ From 3-combination to a singly lossy integer
a b c←⍵-1 0⍺ ⍝ Setup the numbers so that
⍝ "remove b, drop first a and last c elements" gives desired value
⍎dab⍕c↓a↓b~⍨⍳⍺ ⍝ Compute the target number
c↓a↓b~⍨⍳⍺ ⍝ Remove b, drop first a and last c elements from 1..2+n
⍎dab⍕ ⍝ Concat the numbers (dab stands for Delete All Blanks)
(⍋⊃¨⊂) ⍝ APL idiom for sorting
⊢↑∘{...}2+⊢ ⍝ Outer function; input: n
∘{...}2+⊢ ⍝ Pass 2+n to the inner function
⊢↑ ⍝ Take first n elements from the result
APL (Dyalog Extended), 49 bytesSBCS
⊢↑∘{∧⍵{a b c←⍵-1 0⍺⋄⍎⌂dab⍕c↓a↓b~⍨⍳⍺}¨↓3⌂cmat⍵}2+⊢
Try it online!
Simply uses extra built-ins provided in Extended version (dfns library pre-loaded as ⌂
functions, ∧
for ascending sort).
Haskell, 131, 114, 106 bytes
iterate(\n->minimum[x|x<-[read(show=<<filter(/=k)[i..j])::Int|i<-[1..n],j<-[i+2..n],k<-[i+1..j-1]],x>n])13
This is limited by the size of Int
, but it can be easily extended by replacing Int
with Integer
.
Less golfed:
concatInt x = read (concatMap show x) ::Int
allUpToN n = [concatInt $ filter (/=k) [i..j] | i <- [1..n], j <- [i+2..n], k <- [i+1..j-1]]
f n = minimum[x | x <- allUpToN, x > n ]
iterate f 13
8 bytes golfed by @nimi.
Mathematica, 101 bytes
Sort@Flatten@Table[FromDigits[""<>ToString/@(z~Range~x~Delete~y)],{x,3,#},{z,1,x-1},{y,2,x-z}][[1;;#]]&
Yay! For once I have the shortest answer! Party[Hard]