Scheme程序将列表中的所有元素相乘

Question

程序的目的是将数组中的所有元素在scheme中相乘并输出总数，但到目前为止，它只返回0作为输出。

(define (mult-list lst)
(if (null? lst)
0
(* (car lst) 
(mult-list (cdr lst)))) )

Answer 1

问题是0 * <anything>仍然是0，并且乘以0会在函数调用中传播，因为最后一个函数调用将始终返回0(然后乘以下一个数字，仍然是0，下一个仍然是0，等等)。

这个问题的解决方案是返回1而不是0，因为1是乘法单位，就像0是加法单位一样。因为任何乘以1的东西都是它自己，这意味着列表中的最后一项乘以1(仍然等于最后一项)，然后乘以倒数第二项，等等。

或者，当列表为空时，您可以返回列表中唯一的一项((car lst))，当列表中还剩下一项((null? (cdr lst)))时。

Answer 2

我更喜欢教会数字，这些数字以及对它们进行的算术运算，在优雅而基本的lambda微积分中被表示为函数的应用。注意没有*。

(define (mult-list lst)
(letrec ((mul (lambda (m n) (lambda (f) (lambda (x) ((m (n f)) x)))))
(church (lambda (n)
(if (= n 0)
(lambda (f) (lambda (x) x))
(lambda (f) (lambda (x) (f (((church (- n 1)) f) x)))))))
(unchurch (lambda (cn) ((cn (lambda (x) (+ x 1))) 0))))
(let loop ((lst (map church lst))
(acc (church 1)))
(if (null? lst)
(unchurch acc)
(loop (cdr lst) (mul (car lst) acc))))))
(write (mult-list '(2 3 4)) ; 24

您可能还对使用命名let来表示递归而不是直接调用顶级函数感兴趣。对于更复杂的函数非常有用。

Answer 3

(define mul1 (lambda (l) (apply * l)))
(define mul2 (lambda (l) (reduce-left * 1 l)))
(define mul3
(lambda (l)
((lambda (s) (s s l))
(lambda (s l)
(or (and (null? l) 1)
(* (car l) (s s (cdr l))))))))

这里我写的Peano乘法看起来更复杂，但实际上它更简单，因为它通过递归加法进行乘法!它只使用操作符suc、谓词EQUALP和构造函数ZERO。

(define mul/peano
(lambda (l)
(define SUCC (lambda (x) (+ x 1)))
(define EQUALP =)
(define ZERO 0)
;; Peano Axioms
(define ZEROP (lambda (x) (EQUALP x ZERO)))
(define ONE (SUCC ZERO))
(define SUB1 (lambda (x)
((lambda (s)
(if (ZEROP x) ZERO (s s ONE)))
(lambda (s x+)
(if (EQUALP x x+)
ZERO
(SUCC (s s (SUCC x+))))))))
(define ADD
(lambda (a b r)
((lambda (s) (s s a r))
(lambda (s a c)
(or (and (ZEROP a) (c b))
(s s (SUB1 a)
(lambda (x)
(c (SUCC x)))))))))
((lambda (s) (s s l (lambda (total) total)))
(lambda (s l ret)
(or (and (null? l) (ret ONE))
(and (ZEROP (car l)) (ret ZERO))
(s s (cons (SUB1 (car l)) (cdr l))
(lambda (r1)
(s s (cdr l)
(lambda (r2)
(ADD r1 r2 ret))))))))))

注意，我定义了0-1=0，因为这是Peano的做法。

Answer 4

如果我们愿意像其他答案一样用一元数计算，我们也可以用一元数计算——用length:

(define (mult-list lst)
(length
(crossProduct
(map mkList lst))))
(define (mkList n)
(cond ((> n 0) (cons n (mkList (- n 1))))
(else (list))))
(define (crossProduct xs)
(cond
((null? xs) (list (list)))
(else
(let* ((a (car xs))
(d (cdr xs))
(p (crossProduct d)))
(apply append
(map (lambda (x)
(map (lambda (q) (cons x q))
p))
a))))))

测试:

> (mult-list '(2 3 4))
24
> (crossProduct (map mkList '(2)))
'((2) (1))
> (crossProduct (map mkList '(2 3)))
'((2 3) (2 2) (2 1) (1 3) (1 2) (1 1))
> (crossProduct (map mkList '(2 0 3)))
'()