1
\$\begingroup\$

I've been practicing my folds and tail-call recursive programming, and I wanted to work on unzip for the general case as opposed to just pairs. This was very easy to do with standard tail call recursion. However, I was also told that any time you can use tail call recursion on a list, you could also use a fold. I was eventually able to figure out an algorithm that only uses folds, but it wasn't nearly as simple as, or even exactly a translation of, the tail recursive version. Are there any improvements or changes I could make to either of these algorithms?

Tail-call recursive

; Unzip a list of equally lengthed lists
; Takes car of every list and conses it to acc, then reverses acc at the end
; (unzip '((1 4 7 10) (2 5 8 11) (3 6 9 12))) => '((1 2 3) (4 5 6) (7 8 9) (10 11 12)
(define (unzip lst [acc '()])
  (if (or (empty? lst) (empty? (car lst)))
      (reverse acc)
      (unzip (map cdr lst) (cons (map car lst) acc))))

Folds only:

; Takes the last element and turns it into a list of singletons as a seed
; For each remaining element, it conses each element onto its respective list
(define (unzip lst)
  (define (list->singletons lst)
    (foldl (λ (x acc) (cons `(,x) acc)) '() (reverse lst)))
  (define (cons* heads tails)
    (foldr (λ (hd tl acc) (cons (cons hd tl) acc)) '() heads tails))
  (if (empty? lst)
      lst
      (foldl (λ (x acc) (cons* x acc))
             (list->singletons (car (reverse lst))) (cdr (reverse lst)))))
\$\endgroup\$

2 Answers 2

Reset to default
3
\$\begingroup\$

Doing it with folds pretty much begs you to create a custom accumulator and recursive function or fold within a fold like that.

A couple notes. I don't think foldr is tail-recursive. Also (λ (x acc) (cons* x acc)) is redundant. You can just use cons*

You're also using (reverse lst) in a few different places. You could create a separate definition here, or refactor. 

(define (unzip lst)
  (define (template lst) ;;a list of null lists 
    (if (null? lst)      ;;of the proper length
        '()
        (foldl (λ (x acc) (cons '() acc)) '() (car lst))))
  (define (cons* heads tails)
    (reverse (foldl (λ (hd tl acc) 
                       (cons (cons hd tl) acc)) 
                    '() heads tails)))
  (reverse 
      (foldl cons* template lst)))

Not much chage, but perhaps a bit easier to see what's going on. If your wanting to do it with a single fold, thats a bit tricker.

(define (unzip L)
 (define (mangle glob) 
   (let loop ((news '()) (acc glob))
      (if (or (null? (car acc)) (pair? (car acc))) 
          (cons (reverse news) (car acc))
          (loop (cons (car acc) news) (cdr acc)))))
  (reverse (apply foldl (lambda z (mangle z))'() L)))

Notice the lambda is just grabbing a list off all arguments, and we are applying foldl to the lists of lists, as if we are folding multiple lists. However arity is unknown so I've got to take all the arguments as a list, and figure out what is new and what was the accumulator on each round. As is this will choke on a list of lists of lists, but maybe an interesting approach.

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

The apply+foldl approach in WorBlux's answer can be simplified by using the split-at-right function from racket/list to get the last argument passed to the callback function instead of manually finding it:

(require racket/list)
(define (unzip lol)
  (define (helper . args)
    (let-values ([(vals result) (split-at-right args 1)])
      (cons vals (car result))))
  (reverse (apply foldl helper '() lol)))
\$\endgroup\$

You must log in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.