• Re: Lisp Function Problem

    From B. Pym@21:1/5 to All on Thu Sep 26 12:20:29 2024
    XPost: comp.lang.scheme

    Write a Function 'total' that takes an orderd list ie.
    ((itemA quantityA costA)(itemB quantityB costB)....)
    but returns a list giving the total cost plus the overall cost.

    Eg:

    LISP>(total'((book 2 10)(pen 3 2)(notepad 1 12)))
    ((BOOK 20)(PEN 6)(NOTEPAD 12)(TOTAL 38))

    Thank you for your time


    Here are 3 quite different solutions... one recursive, one iterative,
    and one obscure. I won't do ALL your homework, so you will have to
    figure out yourself how they work, which shouldn't be very hard.
    Disclaimer: I'm quite new to Lisp myself, so there may be better and
    more elegant solutions.

    ;;; 1
    (defun total (lst)
    (labels ((total-rec (sublst subtot)
    (if sublst
    (let* ((sub (car sublst))
    (sum (* (cadr sub) (caddr sub))))
    (cons `(,(car sub) ,sum)
    (total-rec (cdr sublst) (+ subtot sum))))
    `((total ,subtot)))))
    (total-rec lst 0)))

    ;;; 2
    (defun total (lst)
    (let ((total 0)
    (ret))
    (dolist (elt lst (nreverse (push `(total ,total) ret)))
    (let ((subtotal (* (cadr elt) (caddr elt))))
    (push `(,(car elt) ,subtotal) ret)
    (incf total subtotal)))))

    ;;; 3
    (defun total (lst)
    (append
    (mapcar #'(lambda (e) (list (car e) (* (cadr e) (caddr e)))) lst)
    `((total ,(apply #'+ (mapcar #'(lambda (elt) (* (cadr elt) (caddr
    elt))) lst))))))

    Gauche Scheme

    (define (proc stuff)
    (let* ((items (map car stuff))
    (costs (map (~>> cdr (apply *)) stuff))
    (total (fold + 0 costs)))
    (append (map list items costs)
    `((total ,total)))))

    Given:

    (define-syntax ->>
    (syntax-rules ()
    [(_ x) x]
    [(_ x (y ...) z ...)
    (->> (y ... x) z ...)]
    [(_ x y z ...)
    (->> (y x) z ...)]))

    (define-syntax ~>>
    (syntax-rules ()
    [(_ (func0 a ...) func ...)
    (lambda xs (->> (apply func0 a ... xs) func ...))]
    [(_ func0 func ...)
    (lambda xs (->> (apply func0 xs) func ...))]))

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)