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)))
The reason your code does not work is because your apa-add is broken. For example:
> (apa-add '(7 3 1 2) '(6 1 4))
'(9 2 6)
> (+ 7312 614)
7926
The rest of your code seems to work, at least for your 2 examples, if you use a working apa-add.
I admit I did not try to understand your code fully; the poor formatting and the set! procedures at the end made me want to start from scratch. So even if you could simple correct your apa-add, maybe have a look at my version anyway, because it is way shorter and probably easier to understand.
Building on my previous answer for apa-add multiplication is a matter of apa-adding, multiplying one list by a digit at a time, and adding zeroes at the end of the intermediary multiplications just as you'd do it manually:
(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))))))
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)
Related
last-non-zero takes a list of numbers and return the last cdr whose car is 0.
So, I can implement it using continuations, but how do I do this with natural recursion.
(define last-non-zero
(lambda (ls)
(let/cc return
(letrec
((lnz
(lambda (ls)
(cond
((null? ls) '())
((zero? (car ls)) ;; jump out when we get to last 0.
(return (lnz (cdr ls))))
(else
(cons (car ls) (lnz (cdr ls))))))))
(lnz ls)))))
Here's an obvious version which is not tail-recursive:
(define (last-non-zero l)
;; Return the last cdr of l which does not contain zero
;; or #f if there is none
(cond
((null? l)
#f)
((zero? (car l))
(let ((lnzc (last-non-zero (cdr l))))
;; This is (or lnzc (cdr l)) but that makes me feel bad
(if lnzc
lnzc
(cdr l))))
(else
(last-non-zero (cdr l)))))
Here is that version turned into a tail-recursive equivalent with also the zero test moved around a bit.
(define (last-non-zero l)
(let lnzl ([lt l]
[r #f])
(if (null? lt)
r
(lnzl (cdr lt) (if (zero? (car lt)) (cdr lt) r)))))
It's much clearer in this last version that the list is traversed exactly once.
Please indicate if I have correctly understood the problem:
#lang scheme
; returns cdr after last zero in lst
(define (last-non-zero lst)
; a helper function with 'saved' holding progress
(define (lnz-iter lst saved)
(if (null? lst)
saved
(if (zero? (car lst))
(lnz-iter (cdr lst) (cdr lst))
(lnz-iter (cdr lst) saved))))
(lnz-iter lst '()))
(last-non-zero '(1 2 3 0 7 9)) ; result (7 9)
Racket's takef-right can do it:
> (takef-right '(1 2 0 3 4 0 5 6 7) (lambda (n) (not (zero? n))))
'(5 6 7)
But assuming you have an assignment where you're supposed to write the logic yourself instead of just using a built in function, one easy if not very efficient approach is to reverse the list, build a new list out of everything up to the first zero, and return that. Something like:
(define (last-non-zero ls)
(let loop ([res '()]
[ls (reverse ls)])
(if (or (null? ls) (zero? (car ls)))
res
(loop (cons (car ls) res) (cdr ls)))))
Using your implementation where you return the argument in the event there are no zero you can just have a variable to keep the value you think has no zero values until you hit it and then update both:
(define (last-non-zero lst)
(let loop ((lst lst) (result lst))
(cond ((null? lst) result)
((zero? (car lst)) (loop (cdr lst) (cdr lst)))
(else (loop (cdr lst) result)))))
(last-non-zero '()) ; ==> ()
(last-non-zero '(2 3)) ; ==> (2 3)
(last-non-zero '(2 3 0)) ; ==> ()
(last-non-zero '(2 3 0 1 2)) ; ==> (1 2)
(define last-non-zero
(lambda (l)
((lambda (s) (s s l (lambda (x) x)))
(lambda (s l* ret)
(if (null? l*)
(ret '())
(let ((a (car l*))
(r (cdr l*)))
(if (zero? a)
(s s r (lambda (x) x))
(s s r
(lambda (r)
(ret (cons a r)))))))))))
Also possible, to use foldr:
(define (last-non-zero l)
(reverse (foldl (lambda (e res) (if (zero? e) '() (cons e res))) 0 l)))
Or use recursion:
(define (last-non-zero l (res '()))
(cond ((empty? l) res)
((zero? (car l)) (last-non-zero (cdr l) (cdr l)))
(else (last-non-zero (cdr l) res))))
I'm trying to teach myself functional language thinking and have written a procedure that takes a list and returns a list with duplicates filtered out. This works, but the output list is sorted in the order in which the last instance of each duplicate item is found in the input list.
(define (inlist L n)
(cond
((null? L) #f)
((= (car L) n) #t)
(else (inlist (cdr L) n))
))
(define (uniquelist L)
(cond
((null? L) '())
((= 1 (length L)) L)
((inlist (cdr L) (car L)) (uniquelist (cdr L)))
(else (cons (car L) (uniquelist (cdr L))))
))
So..
(uniquelist '(1 1 2 3)) => (1 2 3)
...but...
(uniquelist '(1 2 3 1)) => (2 3 1)
Is there a simple alternative that maintains the order of the first instance of each duplicate?
The best way to solve this problem would be to use Racket's built-in remove-duplicates procedure. But of course, you want to implement the solution from scratch. Here's a way using idiomatic Racket, and notice that we can use member (another built-in function) in place of inlist:
(define (uniquelist L)
(let loop ([lst (reverse L)] [acc empty])
(cond [(empty? lst)
acc]
[(member (first lst) (rest lst))
(loop (rest lst) acc)]
[else
(loop (rest lst) (cons (first lst) acc))])))
Or we can write the same procedure using standard Scheme, as shown in SICP:
(define (uniquelist L)
(let loop ((lst (reverse L)) (acc '()))
(cond ((null? lst)
acc)
((member (car lst) (cdr lst))
(loop (cdr lst) acc))
(else
(loop (cdr lst) (cons (car lst) acc))))))
The above makes use of a named let for iteration, and shows how to write a tail-recursive implementation. It works as expected:
(uniquelist '(1 1 2 3))
=> '(1 2 3)
(uniquelist '(1 2 3 1))
=> '(1 2 3)
I am trying to add two numbers (from lists) together in scheme while preserving list format. However, when the numbers being used for calculations add to something greater than or equal to 10 I get an undesired result. For example:
(define (reverse lst)
(if (null? lst)
'()
(append (reverse (cdr lst))
(list (car lst)))))
(define (apa-add lst1 lst2)
(cond ((null? lst1) lst2)
((null? lst2) lst1)
((>= (+ (car lst1) (car lst2)) 10)
(append (apa-add (cdr lst1) (cdr lst2))
(list (quotient(+ (car lst1) (car lst2)) 10))
(list (modulo (+ (car lst1) (car lst2)) 10))))
(else
(append (apa-add (cdr lst1) (cdr lst2))
(list (+ (car lst1) (car lst2)))))))
(apa-add (reverse '(4 4 5)) (reverse'(3 5 8)))
returns
'(7 9 1 3)
How can I modify my code to fix this error? I wanted to use a let statement so I could add the evaluation of (quotient (+ (car lst1) (car lst2)) 10) to (list (+ (car lst1) (car lst2))) of the next call, but I couldn't think of how to do this.
Making this into a tail call simplifies things a bit.
(define (apa-add lst1 lst2)
(let loop ((carry 0) (L1 (reverse lst1)) (L2 (reverse lst2)) (sum '()))
(cond ((and (null? l1) (null? l2))
(if (zero? carry) sum (cons carry sum)))
((null? L1)
(loop (quotient (+ carry (car l2)) 10)
'()
(cdr L2)
(cons (modulo (+ carry (car l2)) 10) sum)))
((null? L2)
(loop (quotient (+ carry (car l1)) 10)
(cdr l1)
'()
(cons (modulo (+ carry (car l1)) 10) sum)))
(else
(loop (quotient (+ carry (car l1) (car l2)) 10)
(cdr l1)
(cdr l2)
(cons (modulo (+ carry (car l1) (car l2)) 10) sum))))))
(apa-add (list 4 4 5) (list 3 5 8))
;Value 4: (8 0 3)
probably wouldnt be too hard to convert to an n-arity function.
(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)))))
(apa-add (list 4 4 5) (list 3 5 8) (list 1 0 2 7))
;Value 11: (1 8 3 0)
(apa-add (list 4 4 5) (list 3 5 8))
;Value 12: (8 0 3)
What I'm trying to do is take two lists and add them together like each list is a whole number.
(define (reverse lst)
(if (null? lst)
'()
(append (reverse (cdr lst))
(list (car lst)))))
(define (apa-add l1 l2)
(define (apa-add-help l1 l2)
(cond ((and (null? l1) (null? l2)) '())
((null? l1) (list (+ (apa-add-help '() (cdr l2)))))
((null? l2) (list (+ (apa-add-help (cdr l1) '()))))
((>= (+ (car l1) (car l2)) 10)
(append (apa-add-help (cdr l1) (cdr l2))
(list (quotient (+ (car l1) (car l2)) 10))
(list (modulo (+ (car l1) (car l2)) 10)))) ;this is a problem
(else (append (apa-add-help (cdr l1) (cdr l2))
(list (+ (car l1) (car l2)))))))
(apa-add-help (reverse l1) (reverse l2)))
(apa-add '(4 7 9) '(7 8 4))
>'(1 1 1 5 1 3)
I know that the problem is revolved around my recursion, I reversed the order of the lists to allow for easier process, however I can't seem to understand how to add my modulo value (carried over value) to the next object in the list. How can I do this?
reverse is already defined in Racket so there's no need to redefine it.
I have rewritten your code for a version that is clearer (to me, at least):
(define (apa-add l1 l2)
(define (car0 lst) (if (empty? lst) 0 (car lst)))
(define (cdr0 lst) (if (empty? lst) empty (cdr lst)))
(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))))))
such as
-> (apa-add '(4 7 9) '(7 8 4))
'(1 2 6 3)
-> (+ 479 784)
1263
car0and cdr0 are functions that help me to continue processing empty lists as a list of zeroes.
I introduced a new variable, carry, which is used to carry a value from iteration to iteration, just as you do it manually.
EDIT 1
The named let is equivalent to the following code:
(define (apa-add l1 l2)
(define (car0 lst) (if (empty? lst) 0 (car lst)))
(define (cdr0 lst) (if (empty? lst) empty (cdr lst)))
(define (apa-add-helper l1 l2 carry 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)))
(apa-add-helper (cdr0 l1) (cdr0 l2) (quotient (- ad dn) 10) (cons dn res)))))
(apa-add-helper (reverse l1) (reverse l2) 0 '()))
EDIT 2
The non tail-recursive version would be
(define (apa-add l1 l2)
(define (car0 lst) (if (empty? lst) 0 (car lst)))
(define (cdr0 lst) (if (empty? lst) empty (cdr lst)))
(define (apa-add-helper l1 l2 carry)
(if (and (null? l1) (null? l2) (= 0 carry))
'()
(let* ((d1 (car0 l1))
(d2 (car0 l2))
(ad (+ d1 d2 carry))
(dn (modulo ad 10)))
(cons dn (apa-add-helper (cdr0 l1) (cdr0 l2) (quotient (- ad dn) 10))))))
(reverse (apa-add-helper (reverse l1) (reverse l2) 0)))
If my input is a list of lists, then I want to output a list with elements from the input so that they are shuffled like a deck of playing cards.
For example, if input is '((1 2 3) (4 5)) then I want output to show up as '(1 4 2 5 3).
My idea is to first remove an element from the first list inside of a list, and then move that list of a list to the back of the list. This way, the first element of the next list of a list can then be appended.
Here is my code so far:
(define (shuffle ls)
(if (null? ls) '()
(cond ((null? car (ls)) (append (cdr (ls)) (list (cdr(car(ls)))))))
(else (car (car (ls)))
(append (cdr (ls)) (list (cdr (car (ls))))
(shuffle (cdr (ls)))))))
[All the code snippets here require SRFI 1 to be loaded first.]
What you seem to be wanting is to zip the lists:
> (zip '(1 2 3) '(4 5))
((1 4) (2 5))
However, as you can see, this stops when it gets to the end of the shortest list. Maybe you can write a custom zip that will stop after all elements are exhausted:
(define (my-zip l1 l2)
(cond ((and (null? l1) (null? l2)) '())
((null? l1) (cons (car l2) (my-zip l1 (cdr l2))))
((null? l2) (cons (car l1) (my-zip (cdr l1) l2)))
(else (cons* (car l1) (car l2) (my-zip (cdr l1) (cdr l2))))))
Let's try it out!
> (my-zip '(1 2 3) '(4 5))
(1 4 2 5 3)
> (my-zip '(1 2 3) '(4 5 6 7))
(1 4 2 5 3 6 7)
this would work too... i use chicken scheme so i have to "import" filter from srfi-1.
(use srfi-1)
(define *deck* '((1 2 3 4) (5 6 7) (9 10 11 12)))
(define nullcar?
(lambda (x)
(if (not (null? x))
(null? (car x)))))
(define nullcdr?
(lambda (x)
(if (not (null? x))
(null? (cdr x)))))
(define notnulls
(lambda (x)
(filter (lambda (e)
(not (null? e)))
x)))
(define firsts
(lambda (l)
(if (not (null? l))
(map (lambda (x)
(if (not (null? x))
(car x)
'()))
l))))
(define shuf
(lambda (d)
(notnulls
(append (firsts d)
(if (not (nullcar? d))
(if (not (nullcdr? d))
(shuf (map cdr (notnulls d)))
'())
'())))))
cheers!