Longest bitonic subarray

Question

Solve this problem in the fewest number of bytes of code possible.

We have a data variable that contains user input data. Data is a list of integers. Write the code that finds the longest bitonic subarray in the data list.

A bitonic subarray is a sub-list that first increases and then decreases (or always increases or always decreases).

enter image description here

Example:

[1,2,5,5,9,9,3,2]
[1,2,3]
[-5,3,2,0,-4]

Constraints and additional rules: If there are several longest bitonic subarrays in the array, then return the first one.

Test cases:

[1] => [1]
[-1,2,1,3,1,4,1,5,1] => [-1,2,1]
[3,2,3,4,5,3,2,1,5,2,3] => [2,3,4,5,3,2,1] 
[1,2,3,2,3,4,5,3,2,1,5,2,3] => [2,3,4,5,3,2,1]
[1,2,5,6,3,2,1,0,6,3,2,1,0] => [1,2,5,6,3,2,1,0]
[3,3,2,2,3,3,4,4,4,5,5,5,5,3,3,2,2,1,1,5,5,2,3] => [2,2,3,3,4,4,4,5,5,5,5,3,3,2,2,1,1]
[1,2,3,4,5] => [1,2,3,4,5]
[5,4,3,2,1] => [5,4,3,2,1]

P.S.: I really would like to see a one-line C# answer

• Kevin Cruijssen: Are the input-integers guaranteed to be non-negative? If not, please add some test cases that contain negative integers.
• tsh: Maybe other answers such as 1,3,1 is also valid for second testcase?
• Unrelated String: Suggested test case: [1,2,2,1,5,5,5,5,5,1,3,3,3,1,4,4,4,4,1] => [5,5,5,5,5,1,3,3,3]. Currently, the only test case with equal runs lets you greedily assume that they're "going in the direction of" the last change between runs. One solution I was sketching in my head fails this, and it seems that tsh's Python solution does as well (after increasing the recursion limit in the header).
• Kevin Cruijssen: @UnrelatedString Are you sure your output is valid? [5,1,3] is decreasing and then increasing, which isn't a valid bitonic sub-array. If the 1 in the middle would be a 7 the output would be [1,5,5,5,5,5,7,3,3,3,1] instead. For which my answer seems to fail unfortunately, since I output [1,5,5,5,5,5,7,3] instead.. :( Will fix it.
• Wheat Wizard: I think this should really specify that what is meant by "increasing" and "decreasing" allows for consecutive equal elements. I don't think this is the usual interpretation of the words and it has to be inferred as the meaning from test cases.

Answer 1

Python 2, 87 bytes

def f(a,*p):i=iter(map(cmp,a[1:],a));return a*((-1in i)>(1in i))or f(*p+(a[:-1],a[1:]))

Try it online!

Notice that this answer is in Python 2 instead of Python 3. They have several differences:

• cmp is available in Python 2, but not in Python 3. Using cmp, it return -1, 0, 1 based on its two operand. When both operand are int, it compare them, and return -1 for less than, 1 for greater than. When one is int while the other is None, None is considered less than int.
• map is different in Python 2 and Python 3. Use map(lambda *p:p, [2], [1, 2]) in Python 2, you will get [(2, 1), (None, 2)]. However, list(map(lambda *p:p, [2], [1, 2])) in Python 3 returns [(2, 1)]. Python 2 will padding extra None's at end of the shorter one.
• Then, map(cmp, a[1:], a) will return an array that compare each number with its next one, and always have an extra -1 at the end of the return value. Since there is always a -1, an output is valid iff it contains no 1 after first -1 occurred. Convert it to iter and -1 in i will consume the iter until first -1 find (which will always be True as discussed above). And we try to find 1 in i. Notice that here i is the part followed by -1, not the whole compare result. The array a is valid if no 1 found in the following part. So 1 in i should be False. So (-1 in i) > (1 in i) could be used to test if given array is valid.
• If the given array is valid, a*(...)(...) returns a, and otherwise it return something falsy, and fallback to following searching. f(*p+(a[:-1],a[1:])) loop following possible substrings first by length, then by first occurrence. Sadly, you cannot use f(*a,a[:-1],a[1:]) in Python 2, which is valid in Python 3.

Answer 2

Jelly, (削除) 15 14 13 (削除ここまで) 11 bytes

-1 thanks to Unrelated String (sublists reversed sorted by length, ẆṚLÞ -> sublists of reverse, each reversed, ṚẆU).

ṚẆUtṂ$ÐLÐḟṪ

A monadic Link that accepts a list of integers and yields the first, longest bitonic sublist.

Try it online!

How?

ṚẆUtṂ$ÐLÐḟṪ - Link: list of integers, I e.g. [3,1,2]
Ṛ - reverse {I} [2,1,3]
 Ẇ - all non-empty sublists of {that} [[2],[1],[3],[2,1],[1,3],[2,1,3]]
 U - reverse each of {those} [[2],[1],[3],[1,2],[3,1],[3,1,2]]
 (-> all sublists of I ordered by length then right to left)
 Ðḟ - discard those Sublists for which:
 ÐL - repeat until results are no longer unique under:
 $ - last two links as a monad - f(Sublist):
 Ṃ - minimum {Sublist}
 t - remove {that} from both ends of {Sublist}
 (only a bitonic sublist results in an empty list, and
 non-empty lists are truthy) 
 Ṫ - tail

• Unrelated String: This... this pains me to say, but you can golf ẆṚLÞ to UẆU.
• Jonathan Allan: Nice golf @UnrelatedString
• Unrelated String: ...oh, that's brilliant. Almost obvious.
• Jonathan Allan: Inspiration struck, always a pleasant feeling :)

Answer 3

05AB1E, 15 bytes

ŒRéR.ΔÔ¬š\dÔJR!

(Don't) try it online (it's too slow to even handle the example test case).
Verify all test cases with a small addition of 3.£ to speed things up substantially.

Explanation:

Π# Get all sub-lists of the (implicit) input-list
 R # Reverse this list of sub-lists †
 é # Then sort it from shortest to longest
 R # Reverse that again so it's from longest to shortest
 .Δ # Pop and find the first/longest sub-list that's truthy for:
 Ô # Connected-uniquify the sub-lists ††
 ¬š # Prepend its first item
 # (edge case for inputs of length 1)
 \ # Pop and get the forward-differences
 d # Check for each if they're non-negative (>=0)
 Ô # Connected-uniquify this list of checks
 J # Join them together
 R # Reverse it
 ! # Factorial †††
 # (only 1 is truthy in 05AB1E, so this will only be truthy if the
 # `ÔJR` was "0", "1", or "01" ††††, and falsey otherwise)

• † The R before the éR is to output the first instead of last longest bitonic sub-list if there are multiple valid ones of the same length.
• †† The Ô is so we won't have any equal adjacent values for our checks, except for the one added by ¬š.
• ††† ! is the main bottleneck for why it's so slow, since the numbers can become very large for invalid sub-lists that go up and down a bunch of times. The 3.£ in the test suite link will only keep the last three digits after the JR, so we won't have to do the factorial on very large binary-strings.
• †††† 0 are decreasing lists; 1 are increasing lists; 01 are first increasing and then decreasing lists.

• Pavel: A wonderful solution. I'm rewriting it in C#. It turned out to be quite long. 590 characters, but in one line. Thank you very much.

Answer 4

R, 150 bytes

\(x)`if`(length(x)-1,{y=rle(x)
p=rle(cumsum(c(T,diff(diff(y$v)>0))>0))
q=which.max(p$l)
r=cumsum(p$l)[q]+1
inverse.rle(lapply(y,`[`,(r-p$l[q]):r))},x)

Attempt This Online!

Two things I couldn't figure out (and would love if someone has ideas for):

• It failed for the first test case, so I added 20 bytes to handle the case where x is length 1. Is there a way to avoid having to handle this case specially?
• It failed when there were repeated values at the end of the answer, which I solved by run-length encoding the input and converting back at the end. But converting back takes 27 bytes (on top of the 9 to encode). Is there a shorter way to un-encode it?

Commented:

\(x) `if`( # if statement to handle case where length(x) == 1
 length(x)-1, # F if length 1, T otherwise
 {
 # run-length encoding to avoid problems with repeated values
 y = rle(x) 
 # get lengths of bitonic stretches
 p = rle(
 # give a unique number to each potential bitonic stretch
 # i.e., increment group number whenever it starts increasing
 cumsum(c(T, diff(
 diff(y$v) > 0
 )) > 0)
 )
 # index of longest bitonic stretch in p
 q = which.max(p$l)
 # index of end of longest bitonic stretch in y
 r = cumsum(p$l)[q] + 1
 # inverse of run-length encoding
 inverse.rle(
 # lapply is needed to subset both the $length and $values of y
 lapply(y, `[`, 
 # indices of longest bitonic subarray in y
 (r-p$l[q]):r
 )
 )
 },
 x
)

Answer 5

JavaScript (Node.js), 92 bytes

x=>(g=i=>(e=x.slice(i,n+i||1/0)).some(t=u=c=>t?u>(u=c)&&++t:u<(u=c))?g(n+i?i+1:!--n):e)(n=0)

Try it online!

Answer 6

Vyxal, 13 bytes

ÞSṘÞṡ' ̄ꜝ±ÞṘ;t

Try it Online! Port of Jonathan Allan's Jelly answer feat. Why Does Vyxal Have A "Is Reverse Sorted" Builtin?

ÞS # Sublists
 Ṙ # Reversed
 Þṡ # And sorted by length
 ' ; # Keep those where
 ± # Signs of
 ̄ # Consecutive differences
 ꜝ # Excluding zeroes
 ÞṘ # Are sorted in reverse?
 t # Take the last i.e. longest and earliest one

Answer 7

Wolfram Language (Mathematica), 116 bytes

First@MaximalBy[#,Length]&@SequenceCases[#,{x___,y___,z__}/;OrderedQ[{x,y}]&&OrderedQ[Reverse[{z}]],Overlaps->True]&

Try it online!

• Weird Glyphs: Welcome to Code Golf. Your answer seems pretty nice, but please remember to remove useless whitespace before posting, since the goal is to use as few bytes as possible (Your code uses 116 bytes without).
• IntroductionToProbability: Thank you for pointing that out! I didn't realise that TIO added the white space. I will edit the code
• att: -36 mostly from using <=/>= instead of OrderedQ

Answer 8

JavaScript (ES6), 101 bytes

a=>(g=n=>a.some((m,i)=>!(b=a.slice(i,i+n)).some(p=v=>(m=p<m?m:p)>p&p<(p=v)))/b[--n]?b:g(n))(a.length)

Try it online!

Answer 9

Charcoal, 50 bytes

≔⟦⟧θFA«⊞θιWNo⭆EΦθμ−λ§θμ⎇λ‹λ0ω10≔Φθμθ¿›LθLυ≔⮌⮌θυ»⭆1υ

Try it online! Link is to verbose version of code. Explanation:

≔⟦⟧θFA«

Start looping over the input values.

⊞θι

Collect the next value.

WNo⭆EΦθμ−λ§θμ⎇λ‹λ0ω10

While the subarray contains a decreasing pair followed by an increasing pair...

≔Φθμθ

... remove the first element from the subarray.

¿›LθLυ

If this subarray sets a new length record, then...

≔⮌⮌θυ

... remember a clone of the subarray.

»⭆1υ

Pretty-print the first longest valid subarray.

Incorrect 55 byte version which allows both decreasing and increasing as well as increasing and decreasing, because I misread the question:

≔⟦⟧θFA«⊞θιW⬤⪪I⊕φ2No⭆EΦθξ−ν§θξ⎇ν‹ν0ωλ≔Φθμθ¿›LθLυ≔⮌⮌θυ»⭆1υ

Try it online! Link is to verbose version of code. Explanation: As above but allows either an increasing pair followed by a decreasing pair or a decreasing pair followed by an increasing pair but not both.

Answer 10

Jelly, (削除) 19 (削除ここまで) 18 bytes

IṠo@\IŻ=2ÄkμÐƤẈÞṪḢ

Try it online!

-1 by remembering that by the time I need to bandaid the sort order I'm just in truthiness land

Probably loses to something that brute forces over all sublists directly, but porting Kevin Cruijssen's 05ab1e solution doesn't strike me as viable due to a number of substantial differences in the builtin set.

 μÐƤ For every suffix of the input:
 Ṡ Take the signs of
I the forward deltas,
 \ scan by
 o@ right ? right : left,
 I take the forward deltas of that,
 Ż prepend 0,
 k and partition the original suffix after the positions of
 =2 twos in that--i.e.,
IṠ Ż before delta signs which
 I =2 jump from -1 to 1
 o@\ compared to the last nonzero delta sign.
 Äk (Also partition everything after that into singletons.)
 Þ Sort lexicographically ascending by
 Ẉ the lengths of each partition,
 ṪḢ and take the first partition from the last element.

Answer 11

Haskell + hgl, 20 bytes

xBL<cSt(mnI<pac<nbc)

Attempt This Online!

Explanation

• xBL longest of the ...
• cSt infixes satisfying ...
• nbc remove consecutive equal elements
• pac countour
• mnI weakly monotonically increasing

Parsers, 27 bytes

ggL$Rv$ah'$h'@~mnI<>h'@~mnD

Attempt This Online!

I wanted to do this with parsers to see how bad it would be. (削除) It's bad. (削除ここまで) It's not that bad.

Explanation

• ggL get the longest parse
• Rv invert parse priority, (only needed as to break ties for earlier elements)
• ah' parse an arbitrary number of characters ignoring them
• h' parse some number of characters
• @~mnI such that it is monotonically increasing
• <> then
• h' parse some number of characters
• @~mnD such that it is monotonically decreasing

Reflection

I am a little disappointed. I am also kind of annoyed by the challenge. The arbitrary choice to require the first such answer in a tie irritates me, since it feels like it just stifles creativity.

However I can still learn from this.

• There should be something that combines xBL and cSt. I don't know why this doesn't exist yet.
• I would like a short-cut for ne EQ<pac (and its negation e EQ<pac) this determines whether all consecutive elements are unequal. (This was useful for an older version of the answer where I interpreted the challenge differently.)
• There should be a version of ah' with inverted priority. This would prevent me from needing to use Rv.
• There should be a parser that precombines fl with h'.

Answer 12

Uiua, 35 bytes^(SBCS)

⇌⊡⊢⍖⊸⍚⧻▽⊸≡◇(<2/+⧈≠▽⊸⌵±⧈-)/◇⊂⧅(□しろいしかく⧅□しろいしかく⇌)

Try it in the pad!

Takes in an array of numbers, outputs the longest bitonic subarray, □しろいしかく boxed, because unboxing it with ◇ content would be one character longer.

Answer 13

APL(NARS), 114 chars

r←w c i;a;b
r←1⋄b←a←2⋄→3
a←1+b← ×ばつ⍳(≢w)<i+1⋄→a×ばつ⍳0&l×ばつ-/w[i,i+1]⋄i+←1⋄r+←1⋄→3
{i←a⍳m←⌈/a←{k c⍵} ̈⍳≢k←⍵⋄⍵[i..i+m-1]}

-- 11+たす12+たす8+たす44+たす 3+たす 36=わ 114

it is based from 2 functions, the "c" function that return the max lenght of bitonic array start index i from array w. One un-named function that apply the function "c" to each element of array ⍵, it finds one array of lenghts, it finds the max bitonic lenght, return the max lenght sublist that is bitonic. This below is the function "c" with line numbers, useful for see where "→" goes... "→0" means exit from the function.

 r←w c i;a;b
1: r←1⋄b←a←2⋄→3
2: a←1+b← ̄1
3: ×ばつ⍳(≢w)<i+1⋄→a×ばつ⍳0&l×ばつ-/w[i,i+1]⋄i+←1⋄r+←1⋄→3

the test it seems goes well:

 f←{i←a⍳m←⌈/a←{k c⍵} ̈⍳≢k←⍵⋄⍵[i..i+m-1]}
 f , 1
1 
 f ( ̄1,2,1,3,1,4,1,5,1)
 ̄1 2 1 
 f (3,2,3,4,5,3,2,1,5,2,3)
2 3 4 5 3 2 1 
 f (1,2,3,2,3,4,5,3,2,1,5,2,3)
2 3 4 5 3 2 1 
 f 1,2,5,6,3,2,1,0,6,3,2,1,0
1 2 5 6 3 2 1 0 
 f 3,3,2,2,3,3,4,4,4,5,5,5,5,3,3,2,2,1,1,5,5,2,3
2 2 3 3 4 4 4 5 5 5 5 3 3 2 2 1 1 
 f 1,2,3,4,5
1 2 3 4 5 
 f 5,4,3,2,1
5 4 3 2 1