I'm trying to prove the following function true and am having trouble figuring it out, even though it seems so obvious!
(implies (and (listp x)
(listp y))
(equal (app (rev x) (rev y))
(rev (app x y))))
by doing so i just need to show that (app (rev x) (rev y)) is equivalent to (rev (app x y)))), using the functions:
(defunc len (x)
:input-contract t
:output-contract (natp (len x))
(if (atom x)
0
(+ 1 (len (rest x)))))
(defunc atom (x)
:input-contract t
:output-contract (booleanp (atom x))
(not (consp a)))
(defunc not (a)
:input-contract (booleanp a)
:output-contract (booleanp (not a))
(if a nil t))
(defunc listp (l)
:input-contract t
:output-contract (booleanp (listp l))
(or (equal l ())
(consp l)))
(defunc endp (a)
:input-contract (listp a)
:output-contract (booleanp (endp a))
(not (consp a)))
(defunc twice (l)
:input-contract (listp l)
:output-contract (listp (twice l))
(if (endp l)
nil
(cons (first l) (cons (first l) (twice (rest l))))))
(defunc app (a b)
:input-contract (and (listp a) (listp b))
:output-contract (listp (app a b))
(if (endp a)
b
(cons (first a) (app (rest a) b))))
(defunc rev (x)
:input-contract (listp x)
:output-contract (and (listp (rev x)) (equal (len x) (len (rev x))))
(if (endp x)
nil
(app (rev (rest x)) (list (first x)))))
this is how i did another one (hopefully correctly)
(implies (listp y)
(equal (len (rev (cons x y)))
(+ 1 (len (rev y)))))
"reverse append thing"
(rev (app (rev y) (rex x))) = (app x y)
(len (rev (cons x y))
= def of rev
len (app (rev y) (list x))
= output contract of rev
(len (rev (app (rev y) (list x))))
= "reverse append thing"
(len (rev (cons x y))
= output contract of rev
(len (cons x y))
= def of len
(+ 1 (len y))
= output contract of rev
(+ 1 (len (rev y)))
Related
Im trying to write a function called removesub* which accepts two arguments (l1 and l2). The function needs to return the second list with the first occurence of the subsequence removed. So, if the first list is '(a b c), the first a if the second list is removed, the first b that appears after the removed a is removed, and the first c that appears after the removed b is removed - no matter how deep the atoms are nested.
Working Example
Input: (removesub* '(a b) '(w (x b) ((a) ((y z))) b a))
Output: (w (x b) (() ((y z))) a)
My current attempt doesnt seem to work because I have no way of sharing the l1 argument between nested recursive calls i.e. ((pair? (car l2)) (cons (removesub* l1 (car l2)) (removesub* l1 (cdr l2)))) splits l1 into two separate instances resulting in the following result. How can I share the l1 value so every recursive calls knows if the others have found the first instance of a value in l1?
Working Example
Input: (removesub* '(a b) '(w (x b) ((a) ((y z))) b a))
Output: (w (x b) (() ((y z))) b)
Attempted Solution - Scheme
(define removesub*
(lambda (l1 l2)
(cond
((or (null? l1) (null? l2)) l2)
((pair? (car l2)) (cons (removesub* l1 (car l2)) (removesub* l1 (cdr l2))))
((eq? (car l1) (car l2)) (removesub* (cdr l1) (cdr l2)))
(else (cons (car l2) (removesub* l1 (cdr l2)))))))
You need to pass the resulting symbols to search for to the next iteration. THere are many ways to do this.
You can use a compound return in the helper
(define (removesub* elements-in-order haystack)
;; just use a pair to pass result and the
;; elements to continue searching for
(define (result eio h)
(cons eio h))
(cdr
(let rec ((eio elements-in-order)
(h haystack))
(cond ((or (not (pair? eio))
(not (pair? h)))
(result eio h))
((pair? (car h))
(let* ((r (rec eio (car h)))
(r2 (rec (car r) (cdr h))))
(result (car r2) (cons (cdr r) (cdr r2)))))
((eq? (car eio) (car h))
(rec (cdr eio) (cdr h)))
(else
(let ((r (rec eio (cdr h))))
(result (car r) (cons (car h) (cdr r)))))))))
Notice I do car first then use both parts of the result to do the next.
Scheme/Racket can return more than one value with values
(define (removesub* elements-in-order haystack)
(define (helper eio h)
(cond ((or (not (pair? eio))
(not (pair? h)))
(values eio h))
((pair? (car h))
(let*-values ([(eiocar hcar) (helper eio (car h))]
[(eiocdr hcdr) (helper eiocar (cdr h))])
(values eiocdr (cons hcar hcdr))))
((eq? (car eio) (car h))
(helper (cdr eio) (cdr h)))
(else
(let-values ([(eiocdr hcdr) (helper eio (cdr h))])
(values eiocdr (cons (car h) hcdr))))))
(let-values ([(eio result) (helper elements-in-order haystack)])
result))
Not really a semantic difference over the first, but it might be a tad faster since in theory the results can stay on the stack rather than each result having to create a cons that can be GC-ed as fast as the stack unrolls.
You can use continuation passing style:
(define (removesub* elements-in-order haystack)
(let cps ((eio elements-in-order)
(h haystack)
(c (lambda (eio h) h)))
(cond ((or (not (pair? eio))
(not (pair? h)))
(c eio h))
((pair? (car h))
(cps eio
(car h)
(lambda (eio hcar)
(cps eio
(cdr h)
(lambda (eio hcdr)
(c eio (cons hcar hcdr)))))))
((eq? (car eio) (car h))
(cps (cdr eio) (cdr h) c))
(else
(cps eio
(cdr h)
(lambda (eio res)
(c eio (cons (car h) res))))))))
This works by the helper has a continuation argument. This is close to what many Scheme implementations actually do to your code before running.
You can use mutation
Probably the fastest and easiest, but then you need to use #!r6rs or another standard Scheme rather than #!racket as implementation language.
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)
I'm having trouble developing a recursive function that will see if two list's are equal to each other, including looking at the sub list's. So far I have:
(defun are-equal2 (X Y)
(cond
((null X) nil)
((and (listp (first X)) (listp (first Y)))
(are-equal2 (first X) (first Y))
)
((eq (first X) (first Y))
T
)
)
)
It seems to work sometimes. for example (are-equal2 '((A) B) '((A) B)) returns T and (are-equal2 '((A) B) '(A B)) returns nil. but (are-equal2 '(F (A G) B) '(F (T G) B)) returns T..... I think it might have to do with my last conditional. I'm not sure how to re-work it though.
Never mind lol. Did some tinkering waiting for a reply and got it. Did a bunch of nested if statements. Code:
(defun are-equal2 (X Y)
(if (and (listp (first X)) (listp (first Y)))
(are-equal2 (first X) (first Y))
(if (and (eq (first X) (first Y)))
(if (and (endp (rest X)) (endp (rest Y)))
T
(are-equal2 (rest X) (rest Y))
)
nil
)
)
)
I don't think you can get away with a tail-recursive version here.
I am afraid you will have to think of your arguments as trees, not sequences.
E.g.,
(defun are-equal (x y &key (test #'eql))
(or (funcall test x y)
(and (consp x)
(consp y)
(are-equal (car x) (car y))
(are-equal (cdr x) (cdr y)))))
This compares leaves using eql by default (cf. Rules about Test Functions), as opposed to eq in your example:
(are-equal '((1) a) '((1) a))
==> T
(are-equal '((1) a) '((1) b))
==> NIL
(are-equal '((1) a) '((2) a))
==> NIL
(are-equal '(("1") a) '(("1") a))
==> NIL
I'm confused as to how def and let bind variables differently. Can someone explain to me why this works:
(def leven
(memoize
(fn [x y]
(cond (empty? x) (count y)
(empty? y) (count x)
:else (min (+ (leven (rest x) y) 1)
(+ (leven x (rest y)) 1)
(+ (leven (rest x) (rest y)) (if (= (first x) (first y)) 0 1)))))))
But when I try to declare the function as let it fails to compile:
(def leven
(let [l (memoize (fn [x y]
(cond (empty? x) (count y)
(empty? y) (count x)
:else (min (+ (l (rest x) y) 1)
(+ (l x (rest y)) 1)
(+ (l (rest x) (rest y)) (if (= (first x) (first y)) 0 1))))))]
(l x y)))
EDIT: This works, using the technique showed by Ankur.
(defn leven [x y]
(let [l (memoize (fn [f x y]
(cond (empty? x) (count y)
(empty? y) (count x)
:else (min (+ (f f (rest x) y) 1)
(+ (f f x (rest y)) 1)
(+ (f f (rest x) (rest y)) (if (= (first x) (first y)) 0 1))))))
magic (partial l l)]
(magic x y)))
Below is such an example to do what you have asked for. I am using factorial just for the sake of simplicity and added println in factorial to make sure the memoization is working fine
(let [fact (memoize (fn [f x]
(println (str "Called for " x))
(if (<= x 1) 1 (* x (f f (- x 1))))))
magic (partial fact fact)]
(magic 10)
(magic 11))
First calculate factorial of 10 and then 11 in which case it should not again call factorial for 10 till 1 as that has been memoized.
Called for 10
Called for 9
Called for 8
Called for 7
Called for 6
Called for 5
Called for 4
Called for 3
Called for 2
Called for 1
Called for 11
39916800
The let form binds names sequentially so in your second function definition the name l doesn't exist when you try to refer to it. You can either use letfn (with some minor mods) or give the defined function a name and instead refer to that instead, like so:
(def leven
(let [l (memoize (fn SOME-NAME [x y]
(cond
(empty? x) (count y)
(empty? y) (count x)
:else (min (+ (SOME-NAME (rest x) y) 1)
(+ (SOME-NAME x (rest y)) 1)
(+ (SOME-NAME (rest x) (rest y)) (if (= (first x) (first y)) 0 1))))))]
l))
As you might notice I change the return from the let to be l itself since that is what you want leven bound to. The (l x y) was problematic because it referred to bindings only local to the function and not accessible to the let.
Say, that I have a pre-defined function 'sum' elsewhere.
I want to sum two lists after I do (setq a '(4 3 4)) and (setq b '(6 10 9))
And I do (recurse a b).
However, I keep getting 'nil' as the return value. What am I doing wrong with this recursion?
Trace isn't being helpful at the moment.
(defun recurse (x y)
(cond
( (null x) nil) )
(t (sum (car x) (car y) ) (recurse (cdr x) (cdr y)) )
)
)
You need to cons up the results; otherwise they are thrown out.
(defun recurse (x y)
(cond
((null x) nil)
(t (cons (sum (car x) (car y))
(recurse (cdr x) (cdr y))))))