Classic Puzzle: Listing List Prefixes

General
1

Recently I found an archive of the newsletter "LISP Pointers".
The following puzzle was in an article by Olivier Danvy.
Below is the introduction to the puzzle.
I'll post a solution in a week.
Send me a PM if you want a link to the article.

/Jens Axel

Abstract

The Lisp Puzzles feature in Lisp Pointers, Volume 1, Number 6 proposed the following exercise:

Given a list, compute the list of its prefixes.

Surprisingly, the solutions proposed in later issues all used intermediary copies and/or traversed the original list repeatedly.

This ​​note presents a higher-order solution that does not use copies and that traverses the original list only once. Further, this solution can be simply expressed by abstracting control procedurally.

Introduction

Listing list suffixes is a simple exercise in Lisp because it can be done by traversing the source list once [1]:

(maplist (lambda (x) x) '(a b c d))
=> ((a b c d) (b c d) (c d) (d))

The footnote [1] contains:

Given the functional maplist of:

(define maplist
  ;; (List(A) -> B) * List(A) -> List(B)
  (lambda (f l)
    (if (null? l)
        '()
        (cons (f l) (maplist f (cdr l))))))

End of footnote.

On the other hand, listing list prefixes:

(xpl '(a b c d))
=> ((a) (a b) (a b c) (a b c d))

is an interesting exercise because Lisp lists are singly-linked. This means that the beginnings of the source list cannot be shared, and thus successive prefixes must be physically copied.

Using maplist requires reversing the list to have it in the standard order, reversing all of its prefixes, and reversing the result. It seems that xpl was made to be programmed in Scheme:

(define xpl
  ;; List(A) -> List(List(A))
  (lambda (l)
    (reverse
      (maplist reverse
               (reverse l)))))

This solution is a bit luxurious since it wastes 2×length(l)2 \times \text{length}(l)2×length(l) cons-cells for reversing the argument and the result.

Since the tails of the prefixes cannot be shared, it is logical to wonder whether their construction could be shared. This note shows that such sharing is indeed possible.

1 Like
2

This is a fun puzzle! Thank you, @soegaard.

My attempt:

#lang racket/base

(define maplist
  (lambda (f l)
    (if (null? l)
        null
        (cons (f l) (maplist f (cdr l))))))

(define xpl
  (lambda (l)
    (reverse (maplist reverse (reverse l)))))

(xpl '(a b c d))
;=> '((a) (a b) (a b c) (a b c d))

(define ypl
  (lambda (l)
    (if (null? l)
        null
        (map (lambda (y) (cons (car l) y))
             (cons null (ypl (cdr l)))))))

(ypl '(a b c d))
;=> '((a) (a b) (a b c) (a b c d))

Interestingly, even for moderately large lists (~10,000), this solution is almost twice as slow as the maplist one.

3

@bakgatviooldoos

I forgot to post the solution!

https://dl.acm.org/doi/pdf/10.1145/1317258.1317263

1 Like
4

That's great, thanks, @soegaard.

And the statistics they show are exactly correct (although I had to introduce a let to avoid unnecessarily using car too many times); quite a gem:

(define car-n (make-parameter 0))
(define (car* x)
  {car-n (+ 1 {car-n})}
  (car x))

(define cdr-n (make-parameter 0))
(define (cdr* x)
  {cdr-n (+ 1 {cdr-n})}
  (cdr x))

(define cons-n (make-parameter 0))
(define (cons* x y)
  {cons-n (+ 1 {cons-n})}
  (cons x y))

(define null?-n (make-parameter 0))
(define (null?* x)
  {null?-n (+ 1 {null?-n})}
  (null? x))

(define ypl
  (lambda (l)
    (if (null?* l)
        null
        (let ([fst (car* l)])
          (map (lambda (y) (cons* fst y))
               (cons* null (ypl (cdr* l))))))))

(void
 (ypl (build-list 100 values)))
{car-n}
{cdr-n}
{cons-n}
{null?-n}
;=> 100 100 5150 101

Edit: I thought this was a particularly "lucid" demonstration of the principle,

(define ((put x) y) (cons x y))
(define  (new y) (cons null y))

(define (pre l)
  (if (null? l) null (map (put (car l)) (new (pre (cdr l))))))

(pre '(a b c d))
;=> '((a) (a b) (a b c) (a b c d))

At each step in the recursion, we save the head of the list in a put, and we cons an empty list onto the result of recurring on the tail, using new.

Assuming we reach the end of our list, the null after the final d, the recursion begins to telescope back in:

'()
new:   '(())
put d: '((d))

'((d))
new:   '(()  (d))
put c: '((c) (c d))

'((c) (c d))
new:   '(()  (c)   (c d))
put b: '((b) (b c) (b c d))

'((b) (b c) (b c d))
new:   '(()  (b)   (b c)   (b c d))
put a: '((a) (a b) (a b c) (a b c d))

At each return, the saved item is consed onto each of the items in the result of the return. In this way, we never have to use any data redundantly or in an order which needs to be resolved afterward.