16
\$\begingroup\$

Given a sequence of integers with length \$L\$ and an integer \$1 \le N \le L\$, an "\$N\$-rich" permutation is one whose the longest strictly increasing contiguous subsequence has length exactly \$N\$.

For example, let our sequence be [0, 1, 2, 3]. There is exactly one \$1\$-rich permutation, given by [3, 2, 1, 0]. By contrast, there are sixteen \$2\$-rich permutations:

[0, 2, 1, 3] [0, 3, 1, 2] [0, 3, 2, 1]
[1, 0, 3, 2] [1, 2, 0, 3] [1, 3, 0, 2] [1, 3, 2, 0]
[2, 0, 3, 1] [2, 1, 0, 3] [2, 1, 3, 0] [2, 3, 0, 1] [2, 3, 1, 0]
[3, 0, 2, 1] [3, 1, 0, 2] [3, 1, 2, 0] [3, 2, 0, 1]

Note that [0, 1, 3, 2] is \$3\$-rich and NOT \$2\$-rich, because even though it contains a strictly increasing subsequence of length 2, it also contains a longer strictly increasing subsequence.

The Challenge

Your challenge is to write a function which takes in an integer sequence S with some length \$L\$, and an integer \$1 \le N \le L\$, and returns the number of N-rich permutations of S.

This is code golf, so the shortest valid answer wins.

Test cases

Each row is a sequence along with the expected output for all possible values of L. For example, the first row says that if your function is called f, then f([1, 2, 3, 4, 5], 3) = 41

[1, 2, 3, 4, 5] => 1, 69, 41, 8, 1
[1, 2, 2, 3, 3, 4, 5] => 4, 2612, 2064, 336, 24, 0, 0
[1, 1, 1, 1, 1, 1, 1] => 5040, 0, 0, 0, 0, 0, 0
[1, 2, 3, 1, 2, 3, 4] => 8, 2976, 1864, 192, 0, 0, 0
\$\endgroup\$
2
  • 5
    \$\begingroup\$ oeis.org/A008304 is related. \$\endgroup\$
    – Simd
    Aug 14 at 18:19
  • \$\begingroup\$ @Simd thanks for including that link! :) \$\endgroup\$ Aug 15 at 9:49

17 Answers 17

7
\$\begingroup\$

Husk, 9 bytes

#mȯ▲mLġ>P

Try it online! or Try the test lists with N=2

#mȯ▲mLġ>P
        P  # get all permutations of arg1
 m         # map over each permutation:
  ȯ        #   these 3 composed functions:
      ġ>   #   - group by pairwise greater-than
    mL     #   - get the length of each group
   ▲       #   - maximum
#          # how many times is arg2 present?
\$\endgroup\$
5
\$\begingroup\$

Ruby, 85 79 77 bytes

Misread the prompt at first and was returning the permutations themselves instead of the amount, whoops.

->a,n{a.permutation.count{|r,*b|m=c=1;b.map{m=c if m<c=r<(r=_1)?c+1:1};m==n}}

Attempt This Online!

->a,n{                                 # Lambda definition
  a.permutation                        # Permutations
   .count{                             # Count instances that match the given condition
          |r,*b|                       #  Extract first element as r (pRevious element)
                m=c=1;                 #  Initialize variables
                                       #   (m = max subsequence length)
                                       #   (c = current subsequence length)
                b.map{                 #  Iterate over the rest of the permutation
                      c=r<(r=_1)?c+1:1 #   If prev. element < current, add 1 to c
                                       #    Otherwise, reset c to 1
                                       #   Also reset r here to save bytes
                      m=c if m<c       #   Set max if needed
                     };                #  End map call
          m==n}                        # Match if max == N
}                                      # End lambda
\$\endgroup\$
5
\$\begingroup\$

JavaScript (ES6), 87 bytes

Expects (n)(array).

n=>g=(a,s,m,p)=>a.map((v,i)=>t+=g(a.filter(_=>i--),q=v>p?s+1:1,q<m?m:q,v),t=0)+a?t:m==n

Try it online!

Commented

n =>                 // outer function taking n
g = (                // inner recursive function g taking:
  a,                 //   a[] = input array
  s,                 //   s = size of the strictly increasing sequence
  m,                 //   m = maximum size so far
  p                  //   p = previous value from the permutation
) =>                 //
a.map((v, i) =>      // for each value v at index i in a[]:
  t +=               //   add to t the result of ...
    g(               //     ... a recursive call to g:
      a.filter(_ =>  //       remove from a[]:
        i--          //         the i-th element
      ),             //
      q =            //       q = new value of s, defined as follows:
        v > p ?      //         if v is greater than p:
          s + 1      //           increment s
        :            //         else:
          1,         //           reset to 1
      q < m ? m : q, //       m = max(m, q)
      v              //       pass v as the previous value
    ),               //     end of recursive call
  t = 0              //   start with t = 0
)                    // end of map()
+ a ?                // if a[] is empty:
  t                  //   return t
:                    // else:
  m == n             //   return 1 if the maximum size is n
\$\endgroup\$
5
\$\begingroup\$

Thunno 2 L, 10 bytes

qæƑœØ^ḷG¹=

Try it online! or verify all test cases

Explanation

qæƑœØ^ḷG¹=  # Implicit input
q           # All permutations of the first input
 æ          # Filtered by:
  Ƒ         #  All sublists of this list
   ϯ^      #  Only keep strictly ascending ones
      ḷG    #  Get the maximum length
        ¹=  #  Equals the second input?
            # Implicit output of length
\$\endgroup\$
5
\$\begingroup\$

Wolfram Language (Mathematica), 62 57 bytes

Port of @chunes's Factor code in Mathematica.

Saved 5 bytes thanks to the comment of @ZaMoC


Golfed version. Try it online!

Count[Permutations@#,x_/;Max[Length/@Split[x,#<#2&]]==2]&

Ungolfed version. Try it online!

(* Define function to split a sequence into increasing subsequences *)
SplitIncreasing[list_] := Split[list, #1 < #2 &];

(* Generate all permutations of the sequence *)
perms = Permutations[{1, 2, 3, 4, 5}];

(* Find and count the permutations where the longest increasing subsequence has length 2 *)
Count[perms, perm_ /; Max[Length /@ SplitIncreasing[perm]] == 2] //Print
\$\endgroup\$
1
  • \$\begingroup\$ you can make a function for 57 bytes \$\endgroup\$
    – ZaMoC
    Aug 15 at 5:55
4
\$\begingroup\$

Python, 126 bytes

-19 bytes thanks to @ValueInk and @TheThonnu

+2 bytes, index was off by one

lambda l,i:sum(i==1+max(sum(b)for(_,b)in groupby(a>b for(a,b)in zip(p[1:],p)))for p in permutations(l))
from itertools import*

Attempt This Online!

\$\endgroup\$
4
  • \$\begingroup\$ Some <strike>semi-colons</strike> lambda and you can save a few bytes! \$\endgroup\$
    – Malekai
    Aug 14 at 18:48
  • \$\begingroup\$ 133 bytes \$\endgroup\$
    – The Thonnu
    Aug 14 at 18:53
  • \$\begingroup\$ Some of these functions can take list comprehensions directly, dropping @TheThonnu's suggestion down to 130 bytes \$\endgroup\$
    – Value Ink
    Aug 14 at 18:58
  • \$\begingroup\$ @ValueInk you've got a redundant space - 129 bytes \$\endgroup\$
    – The Thonnu
    Aug 14 at 18:59
3
\$\begingroup\$

Factor + math.combinatorics, 83 72 bytes

[ <permutations> [ [ < ] monotonic-split longest length = ] with count ]

Attempt This Online!

  • <permutations> [ ... ] with count Count permutations of the input sequence using [ ... ] (a predicate quotation/lambda).
  • [ < ] monotonic-split Split into increasing subsequences.
  • longest length Get the length of the longest one.
  • = Is this equal to the numeric input?
\$\endgroup\$
3
\$\begingroup\$

Jelly, 13 bytes

Œ!Ẇ<ƝẠ$ƇṪLƲ€ċ

A dyadic Link that accepts the list of elements, \$L\$, on the left and the number, \$n\$, on the right and yields the count of \$n\$-rich permutations of \$L\$.

Try it online!

Or see the test-suite (count, ċ, has been moved out to the footer to make it more efficient, and so finish within the TIO timeout).

How?

Œ!Ẇ<ƝẠ$ƇṪLƲ€ċ - Link: L, n
Œ!            - all permutations of {L}
           €  - for each:
          Ʋ   -   last four links as a monad:
  Ẇ           -     sublists (from shortest to longest)
       Ƈ      -     filter keep those for which:
      $       -       last two links as a monad:
    Ɲ         -         for neighbouring pairs:
   <          -           less than?
     Ạ        -         all?
        Ṫ     -     tail
         L    -     length
            ċ - count occurrences of {n}
\$\endgroup\$
3
\$\begingroup\$

Jelly, 13 bytes

Œ!ẆIRẠƊƇẈṀƲ€ċ

Try it online!

-1 byte thanks to Jonathan Allan!

Footer runs each sequence test case over a provided \$N\$

Jelly (fork), 10 bytes

Ẇ<ɲƇẈṀƲÐ!ċ

Try it online! (or, rather, don't as it isn't implemented on TIO)

How they work

Œ!ẆIRẠƊƇẈṀƲ€ċ - Main link. Takes S on the left, N on the right
Œ!            - All permutations of S
          Ʋ€  - Over each permutation P:
  Ẇ           -   All contiguous sublists
      ƊƇ      -   Filter sublists on:
   I          -     Increments
     Ạ        -     all
    R         -     have a non-zero range
        Ẉ     -   Lengths
         Ṁ    -   Maximum
            ċ - Count N

Ẇ<ɲƇẈṀƲÐ!ċ - Main link. Takes S on the left and N on the right
      ƲÐ!  - Over the permutations of S:
Ẇ          -   Contiguous sublists
   Ƈ       -   Keep those such that:
  ɲ        -     All neighbours are:
 <         -       In ascending order
    ẈṀ     -   Maximum length
         ċ - Count N
\$\endgroup\$
2
  • 1
    \$\begingroup\$ Snap, well almost. Although you beat me to it, when I was thinking about trying to get mine down to 12 I thought of the same filter but with R rather than >0. \$\endgroup\$ Aug 14 at 20:28
  • 1
    \$\begingroup\$ @JonathanAllan Very nice, didn't think would catch that with R! \$\endgroup\$ Aug 14 at 20:33
2
\$\begingroup\$

Nekomata + -n, 10 bytes

↕∆±ĉᵐ∑çṀ→=

Attempt This Online!

↕∆±ĉᵐ∑çṀ→=
↕           Find a permutation of the first input
 ∆          Delta
  ±         Sign
   ĉ        Split into runs of equal elements
    ᵐ∑      Sum each run
      ç     Prepend 0 to handle the case with no nonnegative runs
       Ṁ    Maximum
        →   Increment
         =  Check if equal to the second input

-n counts the number of solutions.

\$\endgroup\$
2
\$\begingroup\$

05AB1E, 10 bytes

œʒü‹γOà-}g

Try it online or verify all test cases.

Explanation:

œ         # Push all permutations of the first (implicit) input-list
 ʒ        # Filter it by:
  ü       #  For each overlapping pair:
   ‹      #   Check whether the first is smaller than the second
    γ     #  Group the 0s and 1s into adjacent equal groups
     O    #  Sum each inner group
      à   #  Pop and push the maximum
       -  #  Subtract it from the second (implicit) input-integer
          #  (only 1 is truthy in 05AB1E)
 }g       # After the filter: pop and push the length
          # (which is output implicitly as result)
\$\endgroup\$
1
\$\begingroup\$

Arturo, 100 bytes

$=>[n:&enumerate permutate&'x[i:0n=1+??max
map select chunk chop x'y['i+1y<x\[i]]=>sorted?=>size 0]]

Try it!

$=>[                        ; a function where successive inputs are assigned to &
    n:&                     ; assign first input (number) to n
    enumerate permutate&'x[ ; count each permutation x of input seq
        i:0                 ; assign 0 to i
        n=1+                ; does n equal 1 plus
        ?? ... 0            ; if ... is null, evaluate to 0, else to ...
        max                 ; maximum value of
        map...=>size        ; lengths of
        select...=>sorted?  ; sorted blocks of
        chunk chop x'y[     ; split x-sans-last-elt into contiguous blocks by...
            '1+1            ; increment i in place
            y<x\[i]         ; is y less than x[i]? (is it increasing?)
        ]                   ; end chunk
    ]                       ; end enumerate
]                           ; end function
\$\endgroup\$
1
\$\begingroup\$

Vyxal l, 71 bitsv2, 8.875 bytes

Ṗ'ÞS~Þ⇧@G⁰=

Try it Online!

Explained

Ṗ'ÞS~Þ⇧@G⁰=­⁡​‎‎⁡⁠⁡‏⁠‎⁡⁠⁢‏‏​⁡⁠⁡‌⁢​‎‎⁡⁠⁣‏⁠‎⁡⁠⁤‏‏​⁡⁠⁡‌⁣​‎‎⁡⁠⁢⁡‏⁠‎⁡⁠⁢⁢‏⁠‎⁡⁠⁢⁣‏‏​⁡⁠⁡‌⁤​‎‎⁡⁠⁢⁤‏⁠‎⁡⁠⁣⁡‏‏​⁡⁠⁡‌⁢⁡​‎‎⁡⁠⁣⁢‏⁠‎⁡⁠⁣⁣‏‏​⁡⁠⁡‌⁢⁢​‎‏​⁢⁠⁡‌­
Ṗ'           # ‎⁡Filter permutations where:
  ÞS         # ‎⁢  All sublists
    ~Þ⇧      # ‎⁣  that are strictly increasing
       @G    # ‎⁤  has maximum sublist length
         ⁰=  # ‎⁢⁡  equals N
# ‎⁢⁢The l flag gets the length of all the permutations.
💎

Created with the help of Luminespire.

\$\endgroup\$
1
1
\$\begingroup\$

Charcoal, 45 bytes

⊞υ⟦⟧Fθ≔ΣEυE⁻Eθνκ⁺κ⟦μ⟧υI№EυL⌈⪪⭆Φι싧θλ§θ§ιμ0⊖η

Attempt This Online! Link is to verbose version of code. Explanation:

⊞υ⟦⟧Fθ≔ΣEυE⁻Eθνκ⁺κ⟦μ⟧υ

Generate all of the permutations from 0 to L-1. This is based on my answer to 1 to N column and row sums but uses the indices of the input rather than an explicit range.

I№EυL⌈⪪⭆Φι싧θλ§θ§ιμ0⊖η

For each permutation, create a binary string representing strictly increasing consecutive values of the input array, then split that string on 0s and take the length of the longest resulting contiguous substring of 1s. Count the number for which that is N-1.

\$\endgroup\$
1
\$\begingroup\$

Desmos, 189 bytes

f(L,n)=∑_{k=0}^{l^l-1}0^{(I.unique.length-l)^2+([S.length0^{0^{max(0,S[2...]-S)}.total}forb=[1...l],d=[0...l]].max-n)^2}
l=L.length
I=mod(floor(kl/l^{[1...l]}),l)+1
S=L[I][b...min(l,b+d)]

Try It On Desmos!

Try It On Desmos! - Prettified

Probably some of the most horrendous and inefficient Desmos code I have ever written, but at least it gets the job done (disregarding runtime lmao). It is so inefficient that I don't think it can even run a list of length 7 any time soon.

I might write a longer explanation later, but the gist of it is that I iterate through all base-\$l\$ numbers of length \$l\$ where \$l\$ is the length of the input list \$L\$, then check if the resulting digits form a valid permutation of \$0,\ldots,l-1\$, then add \$1\$ to the digits because of 1-indexing. This digit list is then used to permute \$L\$. Then for each permutation I check for the "richness" by further iterating through all sublists of the permutation. Finally with that, I can count the number of permutations that are "\$n\$-rich".

\$\endgroup\$
7
  • 1
    \$\begingroup\$ I absolutely adore Desmos. Thank you for this wonderful answer. \$\endgroup\$ Aug 17 at 1:49
  • \$\begingroup\$ @EphraimRuttenberg Thanks for such a nice comment! I love "code golfing" in Desmos (well, Desmos isn't really code per se, but it is considered a programming language here), and I have written a bunch of other Desmos answers too, some of which I consider even more complex than what is going on in this answer. \$\endgroup\$
    – Aiden Chow
    Aug 17 at 2:42
  • \$\begingroup\$ Also I don't know if you are interested at all in golfing in Desmos, but it's not that hard to learn. Once you learn how to golf the \$\LaTeX\$ syntax you are already half way there! \$\endgroup\$
    – Aiden Chow
    Aug 17 at 2:43
  • \$\begingroup\$ Do you have a resource or comprehensive documentation for writing stuff like this? Information on what Desmos has to offer is kind of scarce. \$\endgroup\$ Aug 17 at 15:30
  • 1
    \$\begingroup\$ There are also unofficial documentation from other people, like desmosgraphunofficial.wordpress.com, as there are many undocumented features in Desmos that many people starting out learning Desmos may find useful. \$\endgroup\$
    – Aiden Chow
    Aug 17 at 15:51
0
\$\begingroup\$

Perl 5, 131 bytes

sub{($r,%s)=pop;$"=",";0+grep{my($l,$f,$m);$m+=($l=$_>$f?$l+1:1)>$m,$f=$_ for@_[/./g];$m==$r}grep!/(.).*\1/,glob"{@{[0..$#_]}}"x@_}

Try it online!

\$\endgroup\$
0
\$\begingroup\$

sclin, 48 bytes

perm";"map = +/
2%`",_ <"map"="pack0"+/ |"fold1+

Try it here! Takes number first, then sequence.

For testing purposes:

3 [1 2 3 4 5] ;
perm";"map = +/
2%`",_ <"map"="pack0"+/ |"fold1+

Explanation

Prettified code:

perm \; map = +/
2%` ( ,_ < ) map \= pack 0 ( +/ | ) fold 1+

Assuming number n and sequence s.

  • perm \; map map over each permutation of s...
    • 2%` ( ,_ < ) map pairwise map with "less than" to get booleans indicating increases
    • \= pack group consecutive runs of booleans
    • 0 ( +/ | ) fold 1+ get maximum sum + 1
      • sum implicitly converts true to 1 and false to 0
  • = +/ vectorized equals to n, sum
    • i.e. count occurrences of n
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.