2
\$\begingroup\$

The objective is given a list of items, remove the last occurrence of a specified item from the list using only user-defined functions except for very basic built-in ones like car, cdr, =, - etc. For example, if we've been given the list (A B A C), using our procedure to remove the last occurrence of A from the list should produce a list (A B C). Hope I'm being clear.

The program itself consists of five procedures:

Four helper procedures:

remove-1st
remove-all-occurrences
member?
size

And the one this fuss is all about:

remove-last-occurrence

By the way, you'll have noticed that all procedures are implemented using tail recursion.

If you're using MIT/GNU Scheme, you can use the built-in procedure "load" like this (load "demo.scm") to load the file into your interactive environment. Here's the code itself:

;;
;; Procedure: remove-1st
;; ---------------------
;; Takes in an item and a list and removes the first occurrence of the item in
;; the list.
;;
;; Usage example:
;;     (remove-1st 'A '(B A C A)) => (B C A)
;;

(define remove-1st
    (lambda (x ls)
        (if (null? ls)                     ; If an empty list
            '()                            ; Return an empty list
            (if (equal? x (car ls))        ; Otherwise, if first item in list
                (cdr ls)                   ; Return rest of list, done
                (cons (car ls) (remove-1st x (cdr ls)))))))
                                           ; Otherwise, cons first item and
                                           ; rest of list with our item removed



;;
;; Procedure: remove-all-occurrences
;; ---------------------------------
;; Takes in an item and a list and removes all top-level occurrences of the
;; item in the list.
;;
;; Usage example:
;;     (remove-all-occurrences 'A '(A B A C)) => (B C)
;;

(define remove-all-occurrences
    (lambda (x ls)
        (if (equal? (remove-1st x ls) ls)    ; If list with item removed equals
            ls                               ; itself, return list intact
            (remove-all-occurrences x (remove-1st x ls)))))
                                             ; Otherwise, remove all occurrences
                                             ; of item from list with item
                                             ; removed as first occurrence



;;
;; Procedure: member?
;; ------------------
;; This predicate procedure checks whether an item is present in a list. If
;; there is at least one occurrence of the item in the list, a value of true is
;; returned. Otherwise, the procedure returns false.
;;
;; Usage examples:
;;     (member? 'A '(A B C)) => #t
;;     (member? 'D '(A B C)) => #f
;;

(define member?
    (lambda (x ls)
        (if (null? ls)                   ; If an empty list
            #f                           ; Return false
            (or (equal?  x (car ls))     ; If x is first item in list, done
                (member? x (cdr ls)))))) ; Otherwise, check the rest of items



;;
;; Procedure: size
;; ---------------
;; Takes in a list as argument and returns the number of elements it contains.
;;
;; Usage examples:
;;     (size '(A B C D)) => 4
;;     (size '())        => 0
;;

(define size
    (lambda (ls)
        (if (null? ls)               ; If it's an empty list
             0                       ; Return zero as its size
            (+ 1 (size (cdr ls)))))) ; Otherwise, add one to the size of the
                                     ; list minus the first element



;;
;; Procedure: remove-last-occurrence
;; ---------------------------------
;; This procedure removes only the last occurrence of an item in a list.
;;
;; Usage example:
;;     (remove-last-occurrence 'A '(B A B A C)) => (B A B C)
;;
;; How it works:
;; First of all, if an empty list has been sent to the procedure, we likewise
;; are going to return an empty list too. Otherwise, we check whether the
;; specified item is in the list and if that comes out as true we're going to
;; check if it's the item's last occurrence in the list by removing all
;; occurrences of it from the list and making a comparison between the number
;; of elements when there are zero occurrences of the item in the list plus one
;; and when they're all there. The sizes being equal means that there is one
;; occurrence of the item in the list. So we now can remove it and return the
;; list. Otherwise, we're going to cons the list's first item and the list
;; produced as the result of removing the last occurrence of the item from the
;; list minus the first element.
;;

(define remove-last-occurrence
    (lambda (x ls)
        (if (null? ls)
            '()
            (if (and (member? x ls)
                     (= (+ (size (remove-all-occurrences x ls)) 1)
                           (size ls)))
                (remove-1st x ls)
                (cons (car ls) (remove-last-occurrence x (cdr ls)))))))


;; end of file
\$\endgroup\$
  • \$\begingroup\$ ")))))))" I think I just decided I hate scheme... \$\endgroup\$ – Der Kommissar Oct 17 '16 at 5:03
  • \$\begingroup\$ @EBrown In an (reasonable) editor you don't have to type those ;) And if one's working at the "list level" instead of character-wise editing the code a good editor keeps them correctly balanced. \$\endgroup\$ – Daniel Jour Oct 17 '16 at 7:35
  • \$\begingroup\$ @DanielJour Unfortunately I have a particular hatred for parenthesis, brackets and braces. \$\endgroup\$ – Der Kommissar Oct 17 '16 at 7:37
2
\$\begingroup\$

Youre solution is very inefficient. The classical, efficient solution is simply to reverse the list, remove the first occurrence of the item, than reverse again the list. So, using only your remove-1st function and the primitive reverse function, this is a possible definition:

;;
;; Procedure: remove-last-occurrence
;; ---------------------------------
;; This procedure removes only the last occurrence of an item in a list.
;;
;; Usage example:
;;     (remove-last-occurrence 'A '(B A B A C)) => (B A B C)
;;
;; How it works:
;; The list is first reversed, so the last occurrence is now the first one;
;; remove that occurrence and then reverse again the list

(define remove-last-occurrence
  (lambda (x ls)
    (reverse (remove-1st x (reverse ls))))

If you cannot use the predefined function, then you could define reverse as:

(define reverse
  (lambda (ls)
    (if (null? ls)
        '()
        (append (reverse (cdr ls)) (cons (car ls) '())))))

or, with a tail-recursive definition, like in:

(define reverse
  (lambda (ls)
    (define reverse1
      (lambda (ls acc)
        (if (null? ls)
            acc
            (reverse1 (cdr ls) (cons (car ls) acc)))))
      (reverse1 ls '())))

The first reason for the inefficiency is the definition of remove-all-occurrences, since, instead of visiting the list only once, with a function like this one:

(define remove-all-occurrences
    (lambda (x ls)
        (if (null? ls)
            '()
            (if (equal? x (car ls))
                (remove-all-occurrences x (cdr ls))
                (cons (car ls) (remove-all-occurrences x (cdr ls)))))))

you visit it multiple times, by calling remove-1st 2 times for each element that must be removed, producing a non linear algorithm.

The second reason for the inefficiency is the definition of remove-last-occurrence which again requires multiple recursive passes on the the list through member? and size.

|improve this answer|||||
\$\endgroup\$
  • \$\begingroup\$ Sorry, I forgot to mention that I'm not allowed to use the "reverse" procedure unless I can come up my own version. And what exactly do you mean by inefficiency? \$\endgroup\$ – misha Oct 16 '16 at 15:54
  • \$\begingroup\$ Okay, that'll work I guess, but the book I'm reading, most functions like append etc. have not been introduced yet. Only car, cdr and a bunch of basic predicates. \$\endgroup\$ – misha Oct 16 '16 at 16:13
  • \$\begingroup\$ I've redefined reverse without append. \$\endgroup\$ – Renzo Oct 16 '16 at 16:17
1
\$\begingroup\$

Always tell the truth ;)

By the way, you'll have noticed that all procedures are implemented using tail recursion.

Now that's not correct, is it? The only tail recursive functions in the code you showed are member (thanks to the short circuiting or) and remove-all-occurrences (where the recursive call actually is in tail call position).

In size there's + in tail call position, in remove-1st and remove-last-occurrence it's a cons.

An example of how to transform such linear recursive functions to being tail recursive is shown in Renzo's answer.

"Only car, cdr and a bunch of basic predicates"

If something like that's ever a requirement (for example in a test you have to take), then ignore it at first. Write your code using append, reverse and all the other handy utility functions. Then just write each of the functions you use yourself, using "Only car, cdr and a bunch of basic predicates".

Everything else leads to a nightmare.

Oh, and don't forget to also test the utility functions you wrote yourself (including edge cases)! Nothing's more frustrating than finding a bogus append after hours of debugging ...

Being fast

Renzo already showed the IMO correct approach to such a function. If (and ONLY if) you need a faster solution (e.g. when this is run in an inner loop) then you can also achieve it in a single pass over the list by remembering the cell before the last occurrence and modifying its cdr to point to the cell after the last occurrence.

(define delete-last-occurrence
  (lambda (elements token)
    ;; We're going to scan through the list, keeping a state consisting of
    ;;  - the cons cell *BEFORE* the (currently) last occurrence
    ;;  - the previous cons cell
    (define make-state
      (lambda (cell-b prev-cell)
        (cons cell-b prev-cell)))
    (define cell-before
      (lambda (state)
        (car state)))
    (define previous-cell
      (lambda (state)
        (cdr state)))
    ;; If the head of the current (sub)list is equal to the token,
    ;; then remember the previous cons cell as the cell before the
    ;; (currently) last occurrence.
    ;; Else just update the previous cell.
    (define consume-element
      (lambda (state current)
        (if (eqv? (car current) token)
            (make-state (previous-cell state) current)
            (make-state (cell-before state) current))))
    ;; Handle the easy cases separately.
    (cond ((null? elements) '())
          ((null? (cdr elements))
           (if (eqv? (car elements) token) '() elements))
          (else
           (let ((state
                  (scan-left consume-element 
                             (make-state '() elements)
                             (cdr elements))))
             (if (pair? (cell-before state))
                 ;; We found an occurrence, and the cell-before is the ... well 
                 ;; cell before that last occurrence. Hence we modify it such that
                 ;; its cdr no longer "points" to the cell whose car is the last
                 ;; occurrence but instead "skips" that element.
                 (let ((cell-to-modify (cell-before state)))
                   (set-cdr! cell-to-modify
                         (cdr (cdr (cell-before state))))
                   elements)
                 ;; No occurrence found. Either there is none, or only the first
                 ;; element is equal to the token.
                 (if (eqv? (car elements) token)
                     (cdr elements)
                     elements)))))))

Live example. Note that this may destructively modify the list argument. The helper function scan-left is defined as follows:

(define scan-left
  (lambda (fn initial elements)
    (if (null? elements)
        initial
        (scan-left fn (fn initial elements) (cdr elements)))))

To understand what this does, run:

(scan-left (lambda (state current)
             (display (list 'current 'is current))(newline)
             (display (list 'state 'is state))(newline)
             (cons (car current) state))
           '(INITIAL)
           '(A B C))
|improve this answer|||||
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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