.Re: Confused about Scheme...???

17 views
Skip to first unread message

Robert L.

unread,
Mar 27, 2022, 6:54:12 AMMar 27
to
> In short, 'reduce-list', is take a list of variable length, 'b',
> below and reduce it if the (caar ls) and (caadr ls) are equal...this
> is the first atom within the pair of consecutive sublists and if this
> is true contruct a list, (list (caar ls) (+ (cadar ls) (cadadr ls)))
> , and add second atom of the consective pairs. For example,
> (reduce-list b) ==> ((4 3) (3 7) (2 1) (1 2) (0 1)). I can get it to
> work for the first two terms without using recursion, produces (4 3),
> but when I implement recursion it barfs. Could some one tell me what
> I'm doing wrong because I know that I'm trying to do to much at once?
>
>
> -Conrad
>
>
> (define (reduce-list ls)
> (cond ((null? ls) ls)
> (else
> (cond ((null? (cadr ls)) ls)
> (else
> (cond ((eq? (caar ls) (caadr ls))
> (list (caar ls) (+ (cadar ls) (cadadr ls)))
> (reduce-list (cdr ls)))
> (else (list (car ls) (reduce-list (cdr ls)))))))))))
>
>
> (define b '((4 1) (4 2) (3 3) (3 4) (2 1) (1 2) (0 1)))
>
> (reduce-list b)


Gauche Scheme or Racket:

(use srfi-1) ;; span for Gauche
or
(require srfi/1) ;; span for Racket
(require srfi/8) ;; receive for Racket

(define b '((4 1) (4 2) (4 80) (3 3) (3 4) (2 1) (1 2) (0 1)))

(define (reduce-list xs)
(if (null? xs)
'()
(let ((k (caar xs)))
(receive (these those)
(span (lambda (ys) (equal? (car ys) k)) xs)
(cons (list k (apply + (map cadr these)))
(reduce-list those))))))

(reduce-list b)
===>
((4 83) (3 7) (2 1) (1 2) (0 1))

Robert L.

unread,
Mar 27, 2022, 3:35:08 PMMar 27
to
On 3/27/2022, Robert L. wrote:

> (define b '((4 1) (4 2) (4 80) (3 3) (3 4) (2 1) (1 2) (0 1)))
>
> (define (reduce-list xs)
> (if (null? xs)
> '()
> (let ((k (caar xs)))
> (receive (these those)
> (span (lambda (ys) (equal? (car ys) k)) xs)
> (cons (list k (apply + (map cadr these)))
> (reduce-list those))))))
>
> (reduce-list b)
> ===>
> ((4 83) (3 7) (2 1) (1 2) (0 1))

Using pattern-matching.

Gauche Scheme:

(use util.match)

(define (kons xs accum)
(match `(,xs ,accum)
[((a b) ((c d) z ...)) (=> no)
(if (equal? a c)
(cons (list a (+ b d)) z)
(no))]
[(y z) (cons y z)]))

(define (reduce-list xs) (fold-right kons '() xs))

(define b '((4 1) (4 2) (4 80) (3 3) (3 4) (2 1) (1 2) (0 1)))

Reply all
Reply to author
Forward
0 new messages