Ascending Unique Permutations

:: programming, racket, puzzle

Advent of Code 2020

Some Racketeers mentioned the Advent of Code 2020, and I thought it would be fun to give it a shot this year. I’ll be discussing my solution to Day 1 Part 2, so if you haven’t completed it yet, you may want to hold off on reading further.

I added a advent-of-code–2020 directory within my LearningRacket repository where I’ll be adding my solutions.

The Puzzle

The crux of the Day 1 puzzle is to search through a list of numbers to obtain N distinct numbers that satisfy some criteria. For Part 1, N is 2, and for Part 2, N is 3. However, I think the spirit of Part 2 is to generalize Part 1, so I decided to solve for N instead of a specific number.

The Permutations

I don’t have the math knowledge to be able to accurately name the type of permutation I’m referring to, so maybe a couple examples will suffice.

For the list ’(foo bar foo baz), the 2-permutations we’re looking for are:

(foo bar)
(foo foo)
(foo baz)
(bar foo)
(bar baz)
(foo baz)

Using a position value (starting at 1), this corresponds to the following list elements:

(1 2)
(1 3)
(1 4)
(2 3)
(2 4)
(3 4)

3-permutations would be:

(foo bar foo) e.g. (1 2 3)
(foo bar baz) e.g. (1 2 4)
(foo foo baz) e.g. (1 3 4)
(bar foo baz) e.g. (2 3 4)

Notice the positions will always be in increasing order, so this is not a cartesian product. If you know what to call this, email me!

Solutions

My first solution was the following. It returns the first permutation that satisfies the predicate:

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
;; (find-n pred? n lst result) -> (or/c list? #f)
;; pred?  : procedure?
;; n      : exact-nonnegative-integer?
;; lst    : (listof number?)
;; result : (listof number?)
;;
;; Searches for n distinct numbers in a list that satisfy the
;; specified predicate. If found, returns (list n1 n2 ... nn);
;; otherwise, returns #f
(define (find-n pred? n lst [ result '() ])
  (if (= n 0)
      (if (pred? result)
          (reverse result)
          #f)
      (if (null? lst)
          #f
          (let* ([ num (car lst) ]
                 [ ans (find-n pred? (sub1 n) (cdr lst) (cons num result)) ])
            (if ans
                ans
                (find-n pred? n (cdr lst) result))))))

(define (find-3 pred? lst)
  (find-n pred? 3 lst))

It seemed ugly & unsatisfying to me, so I thought about it more, and I finally came up with a general function that returns all ascending N-permutations of the list that satisfy a predicate. I added the filtering aspect for efficiency, but maybe a better way would be to make the function be a generator, and let the caller filter, so I’ll explore that next.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
;; (filter-ascending-permutations pred? n lst) -> list?
;; pred?  : procedure?
;; n      : exact-nonnegative-integer?
;; lst    : (listof number?)
;;
;; Return a list of permutations that satisfy the specified
;; predicate. For example, the list '(foo bar foo baz) produces the
;; following list of 2-tuple ascending permutations:
;; '((foo bar) (foo foo) (foo baz) (bar foo) (bar baz) (foo baz))
(define (filter-ascending-permutations pred? n lst)
  (reverse
   (let loop ([ lst lst ][ n n ][ stack '() ][ result '() ])
     (if (= n 0)
         (let ([ s (reverse stack) ])
           (if (pred? s) (cons s result) result))
         (if (null? lst)
             result
             (loop (cdr lst)
                   n
                   stack
                   (loop (cdr lst) (sub1 n) (cons (car lst) stack) result)))))))

(define (find-3 pred? lst)
  (let ([ tuple (filter-ascending-permutations pred? 3 lst) ])
    (if (null? tuple)
        #f
        (first tuple))))

The following solution uses a generator to yield all the permutations, so the caller applies the predicate and returns the first solution:

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
(define (ascending-permutations-generator n lst)
  (generator ()
    (let loop ([ lst lst ][ n n ][ stack '() ])
      (if (= n 0)
          (yield (reverse stack))
          (if (null? lst)
              #f
              (begin
                (loop (cdr lst) (sub1 n) (cons (car lst) stack))
              (loop (cdr lst) n stack)))))))

(define (find-3 pred? lst)
  (define g (ascending-permutations-generator 3 lst))

  (let loop ([ tuple (g) ])
    (if (not tuple)
        #f
        (if (pred? tuple)
            tuple
            (loop (g))))))

Update 12/2/2020:

I created a more functional solution, but it doesn’t seem to allow for filtering very easily:

1
2
3
4
5
6
7
(define (ascending-permutations n lst)
  (cond [ (null? lst) '()                        ]
        [ (= n 1)     (map (λ (e) (list e)) lst) ]
        [ else        (append (foldr (λ (e result) (cons (cons (car lst) e) result))
                                     '()
                                     (ascending-permutations (sub1 n) (cdr lst)))
                              (ascending-permutations n (cdr lst))) ]))