Count N-Rich Permutations of an Integer Sequence

Question

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

Answer 1

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?

Answer 2

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

Answer 3

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

Answer 4

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

Answer 5

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

Answer 6

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!

Answer 7

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?

Answer 8

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}

Answer 9

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

Answer 10

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.

Answer 11

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)

Answer 12

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

Answer 13

Vyxal l, 71 bits^v2, 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.

Answer 14

Charcoal, 45 bytes

⊞υ⟦⟧Ｆθ≔ΣＥυＥ⁻Ｅθνκ⁺κ⟦μ⟧υＩ№ＥυＬ⌈⪪⭆Φι싧θλ§θ§ιμ0⊖η

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

⊞υ⟦⟧Ｆθ≔ΣＥυＥ⁻Ｅθνκ⁺κ⟦μ⟧υ

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.

Ｉ№ＥυＬ⌈⪪⭆Φι싧θλ§θ§ιμ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.

Answer 15

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".

Answer 16

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!

Answer 17

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