binary - Scheme 中二进制列表的乘法

Question

我正在尝试实现一种算法，将两个 1 和 0 的位列表相乘，以模拟二进制乘法。它应该返回一个喜欢的列表，但我很难在已有的基础上进行构建。一些帮助将不胜感激...

;;Function designed to accept two bit-list binary numbers (reverse order) and produce their product, a bitlist in reverse order.  
;;Example: (multiply '(0 1 1 0 1) '(1 0 1)) should produce '(0 1 1 1 0 1 1)
  (define (multiply x y) 
  (cond 
  ;[(= null? y) 0]
  [(zero? y) 0]
  (#t (let ((z (multiply  x (rest y )))) (cond 
                                              [(num_even? y) (cons 0 z)]
                                              (#t (addWithCarry x (cons 0 z) 1)))))))

;This is to check if the current value of parameter x is the number 0 
    (define (zero? x)
    (cond
    ((null? x) #t)
    ((=(first x) 1) #f)
    (#t (zero? (rest x)))))

;This is to check if the current parameter x is 0 (even) or not. 
    (define (num_even? x)
      (cond
        [(null? x) #t]
        [(=(first x) 0)#t]
        [#t (num_even? (rest x))]))
;To add two binary numbers
    (define(addWithCarry x y carry)
        (cond
        ((and (null? x) (null? y)) (if (= carry 0) '( ) '(1)))
        ((null? x) (addWithCarry '(0) y carry))
        ((null? y) (addWithCarry x '(0) carry))
        (#t (let ((bit1 (first x))
        (bit2 (first y)))
        (cond
        ((=(+ bit1 bit2 carry) 0) (cons 0 (addWithCarry (rest x)(rest y) 0)))
        ((=(+ bit1 bit2 carry) 1) (cons 1 (addWithCarry (rest x)(rest y) 0)))
        ((=(+ bit1 bit2 carry) 2) (cons 0 (addWithCarry (rest x)(rest y) 1)))
        (#t (cons 1 (addWithCarry (rest x) (rest y) 1))))))))

Answer 1

基于 my previous answer for a base-10 multiplication ，这是一个适用于二进制数的解决方案(以正确的顺序):

(define base 2)

(define (car0 lst) 
  (if (empty? lst) 
      0 
      (car lst)))

(define (cdr0 lst) 
  (if (empty? lst) 
      empty 
      (cdr lst)))

(define (apa-add l1 l2) ; apa-add (see https://stackoverflow.com/a/19597007/1193075)
  (let loop ((l1 (reverse l1)) 
             (l2 (reverse l2)) 
             (carry 0) 
             (res '()))
    (if (and (null? l1) (null? l2) (= 0 carry)) 
        res
        (let* ((d1 (car0 l1)) 
               (d2 (car0 l2)) 
               (ad (+ d1 d2 carry)) 
               (dn (modulo ad base)))
          (loop (cdr0 l1) 
                (cdr0 l2) 
                (quotient (- ad dn) base) 
                (cons dn res))))))

(define (mult1 n lst) ; multiply a list by one digit
  (let loop ((lst (reverse lst)) 
             (carry 0) 
             (res '()))
    (if (and (null? lst) (= 0 carry))
        res
        (let* ((c (car0 lst)) 
               (m (+ (* n c) carry)) 
               (m0 (modulo m base)))
          (loop (cdr0 lst) 
                (quotient (- m m0) base) 
                (cons m0 res))))))

(define (apa-multi l1 l2) ; full multiplication
  (let loop ((l2 (reverse l2)) 
             (app '()) 
             (res '()))
    (if (null? l2) 
        res
        (let* ((d2 (car l2)) 
               (m (mult1 d2 l1)) 
               (r (append m app)))
          (loop (cdr l2) 
                (cons '0 app) 
                (apa-add r res))))))    

这样

(apa-multi '(1 0 1 1 0) '(1 0 1))
=> '(1 1 0 1 1 1 0)