23
\$\begingroup\$

The goal of this challenge is to take a positive integer n and output (in lexicographic order) all sequences \$S = [a_1, a_2, ..., a_t]\$ of distinct positive integers such that \$\max(S) = n\$.

For example, for an input n = 3 your program should output the following eleven sequences in the following order:

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

(In general, for an input n, your program should output \$A001339(n-1)\$ sequences.)


This is a challenge, so the shortest code wins.

\$\endgroup\$
2
  • 2
    \$\begingroup\$ Or, in other words, all permutations of the range [1,n] that include n, is that correct? \$\endgroup\$
    – Shaggy
    Oct 14, 2020 at 21:17
  • 5
    \$\begingroup\$ @Shaggy Subsets of that range too. \$\endgroup\$
    – xnor
    Oct 14, 2020 at 21:18

20 Answers 20

8
\$\begingroup\$

Python 2, 78 bytes

f=lambda n,l=[]:sum([f(n,l+[i+1])for i in range(n)if~-(i+1in l)],[l]*(n in l))

Try it online!

Python 3 lets us save some bytes with set unpacking.

Python 3, 74 bytes

f=lambda n,l=[]:sum([f(n,l+[i])for i in{*range(1,n+1)}-{*l}],[l]*(n in l))

Try it online!

\$\endgroup\$
7
\$\begingroup\$

Husk, 9 bytes

Of€¹umu´π

Try it online!

Explanation

Of€¹umu´π
       ´π     All length n combinations of 1..n
     mu       Get the unique values of each list
    u         Get the unique lists
 f€¹          Filter by those that contain n
O             And sort lexographically
\$\endgroup\$
4
\$\begingroup\$

Brachylog, 10 bytes

{⟦₆⊇,?p}ᶠo

Try it online!

  • {…}ᶠo: order all results of:
  • ⟦₆: from [1,2,…,N-1]
  • : try a subset (e.g. [1,2] then [2] then [1] then [])
  • ,?: append the input [1,2,3]
  • p: permute the list
\$\endgroup\$
4
\$\begingroup\$

Haskell, 60 bytes

n!b=[[]|all(<n)b]++[k:c|k<-b,c<-n!filter(/=k)b]
f n=n![1..n]

Try it online!

Very much like xnor's Python approach, but my b is the complement of their l.

Explanation

Definition: an n-SDPI is a sequence of distinct positive integers 1 ≤ i ≤ n, among which is n.

We can think about "using up" numbers as we write such a sequence: if n=5 and we start by writing down a 2, only [1,3,4,5] are left at our disposal (we can't reuse 2).

n!b computes all of the continuations of an n-SDPI where we have only the numbers in b left at our disposal. Let's call b our "bag" of numbers that could still go in the sequence.

For example: 4![1,3] returns all the ways we can continue if we've already written down a 2 and a 4 (in some order), and we have a 1 and a 3 left in our bag.

Which continuations are there?

Either we stop here (yielding []), or we turn to our bag (yielding some non-empty continuations).

  1. If n is no longer in our bag (all(<n)b), then we've made a valid n-SDPI, so we're happy ending the list here and yield [] as a possible continuation.

  2. Furthermore, for every k in our bag, we can place k, followed by every continuation c from n!filter(/=k)b (removing k from the bag).

Since b is always sorted, and we yield [] before non-empty lists, the result is also lexicographically sorted.

Finally, f asks which n-SDPIs we can make with a full bag ([1..n]).

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

Jelly, 10 9 8 7 bytes

œ!RẎṢiƇ

Try it online!

-1 byte thanks to Sisyphus

-1 more byte thanks to Sisyphus

How it works

œ!RẎṢiƇ - Main link. Takes n on the left
  R     - Yield [1, 2, ..., n]
œ!      - For each i = 1, 2, ..., n, yield all length-n permutations of [1, 2, ..., n]
   Ẏ    - Join into a single list
    Ṣ   - Sort
      Ƈ - Keep those where
     i  -   The 1-based index of n is non-zero (i.e n is in the list)
\$\endgroup\$
4
  • \$\begingroup\$ There's œ!Ɱ`ẎṢṀÐṀ for 9, although it still feels too long... \$\endgroup\$
    – Sisyphus
    Oct 14, 2020 at 22:19
  • \$\begingroup\$ @Sisyphus Nice! I always forget about ÐṀ \$\endgroup\$ Oct 14, 2020 at 22:21
  • 1
    \$\begingroup\$ ...and down to 7. I think this may be the limit: œ!RẎṢiƇ \$\endgroup\$
    – Sisyphus
    Oct 15, 2020 at 3:49
  • \$\begingroup\$ @Sisyphus Very nice, using R to replace `Ɱ! \$\endgroup\$ Oct 15, 2020 at 13:18
3
\$\begingroup\$

K (ngn/k), 24 bytes

{t@<t:(x=|/)#??'1++!x#x}

Try it online!

\$\endgroup\$
3
\$\begingroup\$

Scala, 132 124 117 bytes

n=>1.to(n-1).toSet.subsets().flatMap(_.+(n).toSeq.permutations).toSeq.sorted(Ordering.Implicits.seqOrdering[Seq,Int])
  • Thanks to user for -7 characters!

Try it online!

\$\endgroup\$
3
  • 1
    \$\begingroup\$ Nice, I never thought of later adding n. You can get 115 bytes by moving the map into the flatMap and not using parens for subsets \$\endgroup\$
    – user
    Oct 15, 2020 at 12:58
  • 2
    \$\begingroup\$ I don't like having ⚠️ in my code :) \$\endgroup\$ Oct 15, 2020 at 13:03
  • 1
    \$\begingroup\$ Having warnings and terrible optimization is all usual stuff in golfing. \$\endgroup\$
    – Razetime
    Oct 15, 2020 at 13:18
3
\$\begingroup\$

JavaScript (ES6),  89  82 bytes

This started as a port of @xnor's method and then was golfed the JS way from there.

f=(n,s=[],i)=>i>n?[]:[...!i^s.includes(i||n)?[]:i?f(n,[...s,i]):[s],...f(n,s,-~i)]

Try it online!

Commented

f = (                      // f is a recursive function taking:
  n,                       //   n   = input
  s = [],                  //   s[] = current sequence
  i                        //   i   = counter, initially undefined
) =>                       //
  i > n ?                  // if i is greater than n:
    []                     //   stop the recursion and return an empty array
  :                        // else:
    [                      //   build a new array:
      ...                  //     append the following values:
      !i ^                 //       if i = 0 and s[] does not include n
      s.includes(i || n) ? //       OR i > 0 and s[] includes i:
        []                 //         append nothing
      :                    //       else:
        i ?                //         if i > 0:
          f(n, [...s, i])  //           append all the values returned by a
                           //           recursive call with i appended to s[]
        :                  //         else:
          [s],             //           append s[]
      ...                  //     append all the values returned
      f(n, s, -~i)         //     by a recursive call with i + 1
    ]                      //   end of new array
\$\endgroup\$
3
\$\begingroup\$

SageMath, 93 bytes

lambda n:sorted(sum([[*Permutations(l)]for l in Subsets(range(1,n+1))if n in l],[]),key=list)

Try it online!

Inputs \$n\$ and returns a list of all permutations of every \$s\$ in \$\{s\subseteq\{1,2,\dots,n\} \mid n\in s\}\$ sorted lexicographically.

Explanation

lambda n:                           # function taking integer n  
                                    # returning a list of  
  [*Permutations(l)]for l in        # all permutations  
     Subsets(range(1,n+1))          # of all subsets of {1,2,...,n}  
       if n in l                    # that have n as an element  
         sum( . . . ,[])            # flattened  
           sorted( . . . ,key=list) # and sorted lexicographically     
\$\endgroup\$
3
\$\begingroup\$

Wolfram Language (Mathematica), 55 45 bytes

Do[i!=##2&&##~#0~i,{i,0!=##||Print@{##2};#}]&

Try it online!

Inspired by xnor's python solution, and borrows from my answers to some prior problems.

Prints the list of sequences.

Recursively traverses through all permutations of subsequences of 1..n in lexicographic order, printing those which contain n.

0!=##||             (* If n is in the current sequence, *)
  Print@{##2};      (*   output. *)
{i, % ;#}           (* for i=1..n: *)
Do[i!=##2&&         (*   if i is not in the current sequence, *)
    ##~#0~i, % ]&   (*     append it and recurse. *)
\$\endgroup\$
3
\$\begingroup\$

Scala, 87 bytes

n=>1.to(n-1).toSet.subsets.toSeq.flatMap(_.toSeq:+n permutations)sortBy(_ mkString " ")

Try it online!

\$\endgroup\$
2
  • \$\begingroup\$ This is a brilliant answer! You can also get this down to 99 bytes by leaving out the map and rearranging some stuff. \$\endgroup\$
    – user
    Oct 31, 2020 at 17:52
  • \$\begingroup\$ Actually, make that 87 bytes by adding the n afterwards and leaving out the filter. \$\endgroup\$
    – user
    Oct 31, 2020 at 17:58
3
\$\begingroup\$

Scala 3, 130 bytes

| =>(for< <-1 to|;> <-1 to|combinations<if>toSet|;? <- >permutations yield?)sortBy(_.map("%10s"format _ replace(' ','0'))mkString)

Try it online!

Readable variable names are so overrated. Who needs n when you can have |?

Scala, 140 137 bytes

| =>(for{< <-1 to|
> <-1 to|combinations<if>toSet|
? <- >permutations}yield?)sortBy(_.map("%10s"format _ replace(' ','0')).mkString)

Wow, this got long.

Try it online

Ungolfed, with comments and sensible variable names:

n => 
 (for {
    i <- 1 to n                //For every i in the range [1..n]
    c <- 1 to n combinations i //Every subset of [1..n] of size i
    if c contains n            //Make sure the max is n first
    p <- c.permutations        //For every permutation of that subset
  } yield p                    //Yield that permutation
 ) sortBy( //Sort it with this function
     _.map(                    //For every number in the sublist
       "%10s"format _ replace(' ','0') //Pad it on the right to a width of ten using 0
      ).mkString //Smoosh it into one string
   )

```
\$\endgroup\$
1
2
\$\begingroup\$

Charcoal, 46 bytes

Nθ≔⟦υ⟧ηFθ«≔ηζ≔⟦υ⟧ηF⊕ιFζ⊞η⁺⟦κ⟧Eλ⁺쬋μκ»IΦ⊕η⁼θ⌈ι

Try it online! Link is to verbose version of code. Directly generates all sequences containing values up to n in lexicographical order and then prints those containing n. Outputs values on separate lines with sequences double-spaced. Explanation:

Nθ

Input n.

≔⟦υ⟧η

Start off with a list containing an empty sequence.

Fθ«

Loop n times.

≔ηζ

Save the previous list of sequences.

≔⟦υ⟧η

Start a new list containing an empty sequence.

F⊕ι

Loop from 0 to i inclusive.

Fζ

Loop over the previous list of sequences.

⊞η⁺⟦κ⟧Eλ⁺쬋μκ

Make a space in the sequence for the inner index and add that at the beginning of the sequence. For example, if current sequence was 1 0, then an inner index of 0 would give 0 2 1, an inner index of 1 would give 1 2 0 and an inner index of 2 would give 2 1 0. This is required so that the sequences are generated in lexicographical order. (Charcoal doesn't have an easy way to sort.)

»IΦ⊕η⁼θ⌈ι

Increment the sequences and print those containing n.

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

Wolfram Language, 109 bytes

{a_,b___}~p~{c_,d___}:=If[a==c,{b}~p~{d},a~Order~c]
Sort[Join@@Permutations/@Append@#/@Subsets@Range[#-1],p]&

Try it online!

Thanks to @att for a suggestion that saves four bytes.

The first line of this answer is actually a lexicographic ordering function since the default sorting is not lexicographic. It checks if the first two terms of two lists are equal: if so it recurses on the remainder of the lists, and if not it returns the ordering of the two first elements. I expected to need to provide special cases for when one arrives at empty lists, but it appears that in the case of not returning a proper value, Sort falls back to the default Order function, which works fine.

The function itself generates all subsets of {1,2,...,n-1}, appends n to each, then generates the permutations of each. These are then sorted into lexicographic ordering using the function defined.

att's impressive 74-byte answer: (it feels improper to take credit for it, but I think it deserves recognition)

SortBy[Join@@Permutations/@Append@#/@Subsets@Range[#-1],aa~PadRight~#]&

is \[Function].

\$\endgroup\$
4
  • \$\begingroup\$ @J42161217 Thanks for pointing that out! There was actually a simpler fix that took 8 bytes off the answer. \$\endgroup\$
    – DanTheMan
    Oct 14, 2020 at 23:02
  • \$\begingroup\$ 66 bytes \$\endgroup\$
    – att
    Oct 15, 2020 at 0:52
  • 1
    \$\begingroup\$ 74 bytes \$\endgroup\$
    – att
    Oct 15, 2020 at 2:31
  • \$\begingroup\$ Filtering approach can go down to 66 bytes again with much more substantial changes. (#&@@@Split is shorter than DeleteDuplicates) \$\endgroup\$
    – att
    Oct 15, 2020 at 4:53
1
\$\begingroup\$

05AB1E, 10 bytes

Lœ€æ€`êʒIå

Try it online.

Explanation:

L           # Push a list in the range [1,(implicit) input]
 œ          # Get all permutations of this list
  €         # Map each permutation to:
   æ        #  Get its powerset
    €`      # Flatten it one level down
      ê     # Sort and uniquify this list of lists
       ʒ    # Filter it by:
        Iå  #  Check if the current list contains the input
            # (after which the result is output implicitly)
\$\endgroup\$
1
\$\begingroup\$

APL (Dyalog Extended), 36 bytes

{∧∪{⍵/⍨w∊¨⍵}⊃,/⊃¨(⊢,,¨)/¨↓⌂pmat⊢w←⍵}

Try it online!

Uses Bubbler's APL tip for generating subsequences of a vector.

Explanation

{∧∪{⍵/⍨w∊¨⍵}⊃,/⊃¨(⊢,,¨)/¨↓⌂pmat⊢w←⍵}
                                w←⍵  assign input to w for later
                          ⌂pmat⊢     generate matrix of all permutations of 1..input
                                     (⌂ is an extended symbol)
                         ↓           convert matrix to list of vectors
                 (⊢,,¨)/¨            generate all subsequences of each,
                                     which include the last item
            ⊃,/⊃¨                    remove nesting for each, and join into a list of vectors
    ⍵/⍨                              filter the vectors by:
       w∊¨⍵                          whether the input exists in them
  ∪                                  remove duplicates
 ∧                                   Sort lexicographically (Extended symbol)
\$\endgroup\$
1
\$\begingroup\$

Perl 5, 52 bytes

$n=$_;map/(.).*\1|[^1-$n]/|!/$n/||say,sort 1..$n x$n

Try it online!

Can run like this for n=3:

echo 3 | perl -nlE'$n=$_;map/(.).*\1|[^1-$n]/|!/$n/||say,sort 1..$n x$n'

But doesn't work for n > 9. For n=7 it used twelve seconds on my humble laptop and then about ten minutes for n=8.

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

Gaia, 9 bytes

┅zf¦e¦Ė⁇ȯ

Try it online!

Generate all permutations of subsets of [1..n], filter out those not containing n, and sort.

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

Japt -h, 12 11 bytes

õ à cá ÍüøU

Try it

õ à cá ÍüøU     :Implicit input of integer U
õ               :Range [1,U]
  à             :Combinations
    c           :Flat map
     á          :  Permutations
       Í        :Sort
        ü       :Group and sort by
         øU     :  Contains U?
\$\endgroup\$
0
\$\begingroup\$

Perl 5 -MList::Util=uniq -na, 106 bytes

It's twice as long as the other Perl 5 answer, but it works (slowly) for any n;

map/\b@F\b/&&!/\b(\d+),.*\b\1\b/&&say,uniq sort map{s/,+/,/g;s/^,+|,+$//gr}glob join',',("{",1..$_,"}")x$_

Try it online!

\$\endgroup\$

Your Answer

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

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