Search code examples
recursionschemesetappendarbitrary-precision

"Multiplication of Arbitrary Precision Numbers" in Scheme


The following is code to a problem that I have been working on for a few days. The problem I encountered is that for some reason when I call:

(apa-multi '(7 3 1 2) '(6 1 4))

the return is:

'(4 8 9 5 6 8)

The answer that it should output is

'(4 4 8 9 5 6 8)

When I call:

(apa-multi '(3 1 2) '(6 1 4))

The output is:

 '(1 9 1 5 6 8)

which is correct.

I have debugged my code multiple times, and I can't seem to find out what the problem is (by the way, I know that the "remove-empty" function that I wrote is most likely unnecessary). Can anyone tell me where I am going wrong here? (My goal for this problem is to keep the arbitrary precision numbers in list format, and I can not create a function that converts numbers from list->num or num->list.) I believe that I have provided all of the necessary code for someone to work out what I was going for, but if not please let me know. The hint that I have for this is that " Multiplication of d = dndn−1 ...d1 by e = emem−1 ...e1 can be carried out by the rule de=d∗e1 +10∗(d∗em em−1...e2).)"

(define (remove-empty L)
 (define (remove-empty-h L accum)
   (cond ((null? L) accum)
      ((null? (car L)) 
      (remove-empty (cdr L)))
      (else (cons (car L) (remove-empty-h (cdr L) accum)))))
 (remove-empty-h L '()))

(define (apa-add lst1 lst2)
 (define (apa-add-h lst1 lst2 carry)
  (cond ((and (null? lst1) (null? lst2)) 
             (if (not (= 0 carry)) 
                 (list carry)
                 '()))
       ((null? lst1)  (append (apa-add-h lst1 '() carry)
                              (list (+ (car (reverse-l lst2)) carry))
                              (reverse-l(cdr (reverse-l lst2)))))
       ((null? lst2)  (append (apa-add-h '() lst2 carry)
                              (list (+ (car (reverse-l lst1)) carry)))
                              (reverse-l(cdr (reverse-l lst1))))
       (else 
          (append (apa-add-h (cdr lst1) (cdr lst2) (quotient (+ (car lst1) (car lst2) carry) 10)) 
                 (list (modulo (+ (car lst1) (car lst2) carry) 10))))))
   (apa-add-h (reverse-l lst1) (reverse-l lst2) 0))

(define (d-multiply lst factor)
  (define (d-multiply-h lst factor carry)
    (cond ((null? lst) (if (= carry 0)
                        '()
                        (list carry)))
       ((>= (+ (* (car lst) factor) carry) 10)
        (append  ;(list (check-null-and-carry-mult lst carry))
                 (d-multiply-h (cdr lst) factor (quotient (+ (* (car lst) factor) carry) 10))
                 (list (modulo (+ (* (car lst) factor) carry) 10))))         

       (else (append   ;(list (check-null-and-carry-mult lst carry))
                      (d-multiply-h (cdr lst) factor (quotient(+ (* (car lst) factor) carry) 10))
                      (list (+ (* (car lst) factor) carry))))))
  (remove-empty (d-multiply-h (reverse-l lst) factor 0)))

   (define (nlength l)
     (if (null? l)
       0
       (+ 1 (nlength (cdr l)))))


(define (apa-multi d e)
 (define temp '())
  (cond ((= (max (nlength e) (nlength d)) (nlength e))
      (set! temp e)
      (set! e d)
      (set! d temp))
     (else
      (set! temp d)
      (set! d e)
      (set! e temp)))

(define (apa-multi-h d e)
  (cond ((null? e) (list 0))
       (else (append  (apa-add (d-multiply d (car e)) 
                       (append (apa-multi-h d (cdr e)) (list 0)))))))
 (apa-multi-h d (reverse-l e)))

Solution

  • Not sure why it doesn't work, all those appends and reverses are hard to follow, and not sure what's going on with all that set! stuff. Putting the state into a tail call is a lot easier to follow and usually more efficient to boot.

       (define (apa-add . Lists)
          (define (cdrs-no-null L)
                       (cond ((null? L) '())
                             ((null? (cdar l)) (cdrs-no-null (cdr L)))
                             (else (cons (cdar l) (cdrs-no-null (cdr l))))))
            (let loop ((carry 0) (Lists (map reverse Lists)) (sum '()))
                  (if (null? Lists)
                      (if (zero? carry) sum (cons carry sum))
                      (loop (quotient (fold + carry (map car Lists)) 10)
                            (cdrs-no-null Lists)
                            (cons (modulo  (fold + carry (map car Lists)) 10) sum)))))
    
    
    
           (define (apa-mult . Lists)
                (define (mult-by-factor n order L)
                  (let loop ((order order) (L (reverse L)) (carry 0) (sum '()))
                    (cond ((> order 0) (loop (- order 1) L carry (cons 0 sum)))
                          ((null? L) (if (zero? carry) 
                                         sum 
                                         (cons carry sum))) ;;bug here if carry > 9
                          (else (loop 0 
                                      (cdr L) 
                                      (quotient (+ carry (* n (car L))) 10) 
                                      (cons (modulo (+ carry (* n (car L))) 10) sum))))))
                 (define (apa-mult2 L1 L2)
                   (let ((rL1 (reverse L1))
                         (rL2 (reverse L2))
                         (zip-with-order
                            (lambda (L) 
                              (let loop ((order 0) (L L) (accum '()))
                                 (if (null? L) 
                                     accum
                                     (loop (+ 1 order) 
                                           (cdr L)  
                                           (cons (cons (car L) order) accum)))))))
                       (fold apa-add '(0) (map (lambda (x) 
                                                  (mult-by-factor (car x) (cdr x) L2))
                                               (zip-with-order rl1)))))
                (fold apa-mult2 '(1) Lists)))
    

    (apa-mult '(3 1 2) '(6 1 4)))

    ;Value 7: (1 9 1 5 6 8)

    (apa-mult '(2 0 0) '(3 1 2) '(6 1 4))

    ;Value 8: (3 8 3 1 3 6 0 0)

    (apa-mult '(7 3 1 2) '(6 1 4))

    ;Value 9: (4 4 8 9 5 6 8)