Умножение двоичного списка в схеме

Question

Я пытаюсь реализовать алгоритм для умножения двух битовых списков 1s и 0s в качестве имитации для двоичного умножения. Он должен возвращать подобный список, но мне сложно строить то, что у меня уже есть. Некоторую помощь была бы оценена ...

;;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)