Умножение чисел произвольной точности в схеме

Ниже приведен код проблемы, над которой я работал несколько дней. Проблема, с которой я столкнулся, заключается в том, что по какой-то причине, когда я звоню:

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

возврат:

'(4 8 9 5 6 8)

Ответ, который он должен вывести,

'(4 4 8 9 5 6 8)

Когда я звоню:

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

Результат:

 '(1 9 1 5 6 8)

что правильно.

Я несколько раз отлаживал свой код и никак не могу понять, в чем проблема (кстати, я знаю, что написанная мной функция "удалить-пусто", скорее всего, не нужна). Может ли кто-нибудь сказать мне, где я ошибаюсь? (Моя цель в этой проблеме — сохранить числа произвольной точности в формате списка, и я не могу создать функцию, которая преобразует числа из list-> num или num->list.) Я считаю, что предоставил весь необходимый код для того, чтобы кто-то понял, к чему я стремился, но если нет, пожалуйста, дайте мне знать. Подсказка, которую я имею для этого, заключается в том, что «Умножение d = dndn−1 ...d1 на e = emem−1 ...e1 может быть выполнено по правилу 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)))

SchemeNoob1000 26.10.2013 источник

comment

Он переворачивает список, я не знал, что в этой схеме уже есть определенная функция реверса для списков. - SchemeNoob1000 27.10.2013

Ответы (2)

arrow_upward
0
arrow_downward

Не уверен, почему это не работает, все эти добавления и реверсы трудно отследить, и не уверен, что происходит со всем этим набором! вещи. Помещение состояния в хвостовой вызов намного проще для отслеживания и обычно более эффективно для загрузки.

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

(апа-мульт '(3 1 2)' (6 1 4)))

;Значение 7: (1 9 1 5 6 8)

(апа-мульт '(2 0 0) '(3 1 2) '(6 1 4))

;Значение 8: (3 8 3 1 3 6 0 0)

(апа-мульт '(7 3 1 2) '(6 1 4))

;Значение 9: (4 4 8 9 5 6 8)

WorBlux 26.10.2013

arrow_upward
1
arrow_downward

Причина, по которой ваш код не работает, заключается в том, что ваш apa-add не работает. Например:

> (apa-add '(7 3 1 2) '(6 1 4))
'(9 2 6)
> (+ 7312 614)
7926

Остальная часть вашего кода, кажется, работает, по крайней мере, для ваших двух примеров, если вы используете работающий apa-add.

Признаюсь, я не пытался полностью понять ваш код; плохое форматирование и набор! процедуры в конце заставили меня хотеть начать с нуля. Так что, даже если бы вы могли просто исправить свой apa-add, возможно, все равно взгляните на мою версию, потому что она намного короче и, вероятно, ее легче понять.

Основываясь на моем предыдущем ответе для умножения apa-add, нужно добавить apa, умножив один список на цифру за раз. время и добавление нулей в конце промежуточных умножений так же, как вы делаете это вручную:

(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 10)))
          (loop (cdr0 l1) (cdr0 l2) (quotient (- ad dn) 10) (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 10)))
          (loop (cdr0 lst) (quotient (- m m0) 10) (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))))))

uselpa 26.10.2013

Умножение чисел произвольной точности в схеме

Ответы (2)

Вопросы по теме