1

Here is the question from Mitchell Wand's Essentials of Programming Language:

Exercise 1.19 [⋆ ⋆] (list-set lst n x) returns a list like lst, except that the n-th element, using zero-based indexing, is x.

> (list-set ’(a b c d) 2 ’(1 2))
(a b (1 2) d)
> (list-ref (list-set ’(a b c d) 3 ’(1 5 10)) 3)
(1 5 10)

According to what the book says, I analyze

  • the contract of this procedure, and
  • the inductive data types involved in this procedure, which are List-of-(SchemeValue) and Nat.

Below are some test-cases:

(write (list-set '(a b c d) 2 '(1 2)))
(newline)
;; should output (a b (1 2) d)
(write (list-ref (list-set '(a b c d) 3 '(1 5 10)) 3))
(newline)
;; should output (1 5 10)
(write (list-set '(a b c d e) 0 '(x y)))
(newline)
;; should output ((x y) b c d e)
(write (list-set '(a b c d e) 4 '(x y)))
(newline)
;; should output (a b c d (x y))

Here is my first try with racket, and it works:

#lang eopl
;; Contract : list-set : List-of-(SchemeValue) × Nat × SchemeValue   → List-of-(SchemeValue)
;; Usage    : (list-set           lst             n        x     )   = replace the nth element of lst by x
;; Syntax 1 :                                    Nat               ::= 0  | 1 + Nat
;; Syntax 2 :            List-of-(SchemeValue)                     ::= () | (SchemeValue . List-of-(SchemeValue))
(define (list-set lst n x)
  (if (null? lst) '()
      (let ([proc (lambda (tail)
                    (cons x tail))]
            [head (car lst)]
            [tail (cdr lst)])
        (if (zero? n) (proc tail)
            (let ([procN head]
                  [pred (- n 1)])
              (cons procN
                    (list-set tail pred x)))))))

Here is my second try, it also works:

#lang eopl
;; Contract : list-set : List-of-(SchemeValue) × Nat × SchemeValue   → List-of-(SchemeValue)
;; Usage    : (list-set           lst             n        x     )   = replace the nth element of lst by x
;; Syntax 1 :                                    Nat               ::= 0  | 1 + Nat
;; Syntax 2 :            List-of-(SchemeValue)                     ::= () | (SchemeValue . List-of-(SchemeValue))
(define (list-set lst n x)
  (if (null? lst) '()
      (let ([proc (lambda (tail)
                    (cons x tail))]
            [head (car lst)]
            [tail (cdr lst)])
        (if (zero? n) (proc tail)
            (let ([proc2R (lambda (tail)
                            (cons head tail))]
                  [pred (- n 1)])
              (proc2R (list-set tail pred x)))))))

I thought it might be possible to re-implement the 2nd version of code with foldrNat, which is a foldr function for the Nat inductive data type. However, the result is not satisfied. Here is my third try:

#lang eopl
;; Contract : list-set : List-of-(SchemeValue) × Nat × SchemeValue   → List-of-(SchemeValue)
;; Usage    : (list-set           lst             n        x     )   = replace the nth element of lst by x
;; Syntax 1 :                                    Nat               ::= 0  | 1 + Nat
;; Syntax 2 :            List-of-(SchemeValue)                     ::= () | (SchemeValue . List-of-(SchemeValue))
(define (list-set lst n x)
  (if (null? lst) '()
      (letrec ([proc (lambda (tail)
                       (cons x tail))]
               [head (car lst)]
               [tail (cdr lst)]
               [proc2R (lambda (tail)
                         (cons head tail))]
               [i (proc tail)])
        (foldrNat proc2R i n))))

;; contract : foldrNat : (1 -> B -> B) × B × Nat   → B
;; usage    : (foldrNat      proc2R      i    n)   = ...
;; syntax   :                                Nat ::= 0 | 1 + Nat
(define (foldrNat proc2R i n)
  (if (zero? n) i
      (let ([pred (- n 1)])
        (proc2R (foldrNat proc2R i pred)))))

;; contract : foldrLst : (A -> B -> B) × B × List-of-(A)  -> B
;; uage     : (foldrLst      proc2R      i      lst    )   = ...
;; syntax   :                                List-of-(A) ::= () | (A . List-of-(A))
(define (foldrLst proc2R i lst)
  (if (null? lst) i
      (let ([head (car lst)]
            [tail (cdr lst)])
        (proc2R head (foldrLst proc2R i tail)))))

I am still frustrated by the problem: why doesn't the 3rd attempt not work, and how can I fix it?

I would appreciate if you can analyze this from Haskeller's perspective, i.e., Algebra, co-Algebra, foldable, etc. — because I feel like this involves the foldr for a product of inductive type List-of-(SchemeValue) × Nat.

Improve this question
New contributor
YCH817 is a new contributor to this site. Take care in asking for clarification, commenting, and answering. Check out our Code of Conduct.
0

2 Answers 2

Reset to default
2

Certainly it is possible to write this function using foldrNat, and you don't need to know anything about algebras or coalgebras to do so. To see what's wrong with your implementation, consider that (foldrNat f x n) just means "apply the function f to x, n times". Since the f you use is just (lambda (tail) (cons head tail)), the result will be that you cons n copies of head onto the front of i.

You need a smarter function. In particular, you don't want to call the same function on your input list n times: you want to do some computation to determine what function to even call on the list. So, you need to pass foldrNat a function which takes a function as input and produces another function as output. The initial value will be a function which replaces the 0th item of the input list; and the function you fold with must update that function to look one item deeper before replacing an item. Since foldrNat will ensure that this update happens n times, the end result will be a function that looks n items deep before replacing an item with x. Then you can simply call that function on the input list.

You asked for a Haskell perspective, so first, here is a solution in Haskell:

listSet :: Int -> a -> [a] -> [a]
listSet n x xs = foldrNat skipOne replaceFirst n xs
  where replaceFirst [] = [] -- trying to replace past the end
        replaceFirst (y:ys) = x:ys
        skipOne f [] = []
        skipOne f (x:xs) = x : f xs

foldrNat :: (a -> a) -> a -> Int -> a
foldrNat _ x 0 = x
foldrNat f x n = foldrNat f (f x) (n - 1)

Then a translation of the same idea into Racket, with Shawn's help. With your existing foldrNat, list-set could be implemented like this:

(define (list-set lst n x)
  (define (replace-first xs)
            (if (null? xs) '()
                (cons x (cdr xs))))
  (define (skip-one f)
            (lambda (xs)
              (if (null? xs) '()
                  (cons (car xs) (f (cdr xs))))))
  ((foldrNat skip-one replace-first n) lst))
Improve this answer
Sign up to request clarification or add additional context in comments.

3 Comments

Isn't that more of a foldlNat? I'd expect foldrNat f x n = f (foldrNat f x (n - 1)) so that the strictness properties of f control when the recursive call is evaluated.
That would be a better implementation, though I don't think it's the difference between a left and right fold. There's only really one order to fold an Int, and my implementation just does that with bad memory properties. It would be the right idea in Racket, though, where tail recursion is preferable to guarded recursion.
Despite the names, the difference isn't left or right. It's whether the recursive case reduces to a recursive call, or a call to f. Though yeah, that difference doesn't matter much in racket, it's really important in Haskell.
2

I'm not familiar with EoPL, so all the following is just based on normal Racket.

Your first go at list-set seems overly complicated and noisy. I'd write it something like

#lang racket/base

;;; Note: Racket already defines list-set in #lang racket and the racket/list module
(define (my-list-set list n val)
  (if (zero? n)
      (cons val (cdr list))
      (cons (car list) (my-list-set (cdr list) (sub1 n) val))))

(module+ test
  (require rackunit)
  (check-equal? (my-list-set '(a b c d) 2 '(1 2)) '(a b (1 2) d))
  (check-equal? (list-ref (my-list-set '(a b c d) 3 '(1 5 10)) 3) '(1 5 10))
  (check-equal? (my-list-set '(a b c d e) 0 '(x y)) '((x y) b c d e))
  (check-equal? (my-list-set '(a b c d e) 4 '(x y)) '(a b c d (x y))))

(Though in practice I'd consider adding error checking to give better error messages in the case where n is larger than the list's length)

You can write a version using a standard right fold, but a normal list-set reuses the rest of the original list after the n-th element, which you'd lose - a fold version would traverse and re-cons the entire list, making it take more memory and time. There's also having to count elements from the left when a right fold processes them from right to left. A variation of foldr that passes the current index to the callback function along with the current element and accumulator value would simplify that a lot:

(define (foldr/index f init list)
  (define (do-fold list i accum)
    (if (null? list)
        accum
        (f (car list) i (do-fold (cdr list) (add1 i) accum))))
  (do-fold list 0 init))

(define (my-list-set list n val)
  (foldr/index (lambda (elem i accum)
                 (if (= i n)
                     (cons val accum)
                     (cons elem accum)))
               '() list))

Your foldrNat with a fixed-up version of @amalloy's list-set from their answer also works, and if I'm tracing it right, actually re-uses the tail and doesn't have to traverse the entire list so it addresses the issues I brought up in the previous section, but feels overly clever for something you'd use in the real world, especially when Racket has its own implementation of list-set. Could be a useful technique for other problems, though.

Improve this answer

1 Comment

You've traced it right: it reuses the tail and doesn't traverse past the insertion point. Notably, though, it's not tail-recursive, so it uses O(n) stack space. And I agree, it's not a solution you'd use in practical programs when so many simpler approaches exist. But it seems appropriate for someone learning from a book with a title like "Essentials of Programming Language" who's interested in folds.

Your Answer

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

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.