Distributive Law Simplification - scheme

I'm trying to write a procedure that makes use of the distributive property of an algebraic expression to simplify it:
(dist '(+ x y (exp x) (* x 5) y (* y 6)))
=> (+ (* x (+ 1 5))
(* y (+ 1 1 6))
(exp x))
(dist '(+ (* x y) x y))
=> (+ (* x (+ y 1))
y)
; or
=> (+ (* y (+ x 1))
x)
As the second example shows, there can be more than one possible outcome, I don't need to enumerate them all, just a valid one. I'm wondering if someone could provide me with at least a qualitative description of how they would start attacking this problem? Thanks :)

Oleg Kiselyov's pmatch macro makes distributing a factor across terms pretty easy:
(define dist
(λ (expr)
(pmatch expr
[(* ,factor (+ . ,addends))
`(+ ,#(map (λ (addend)
(list factor addend))
addends))]
[else
expr])))
(dist '(* 5 (+ x y))) => (+ (5 x) (5 y))
The main trick is to match a pattern and extract elements from the expression from the corresponding slots in the pattern. This requires a cond and let with tricky expressions to cdr to the right place in the list and car out the right element. pmatch writes that cond and let for you.
Factoring out common terms is harder because you have to look at all the subexpressions to find the common factors and then pull them out:
(define factor-out-common-factors
(λ (expr)
(pmatch expr
[(+ . ,terms) (guard (for-all (λ (t) (eq? '* (car t)))
terms))
(let ([commons (common-factors terms)])
`(* ,#commons (+ ,#(remove-all commons (map cdr terms)))))]
[else
expr])))
(define common-factors
(λ (exprs)
(let ([exprs (map cdr exprs)]) ; remove * at start of each expr
(fold-right (λ (factor acc)
(if (for-all (λ (e) (member factor e))
exprs)
(cons factor acc)
acc))
'()
(uniq (apply append exprs))))))
(define uniq
(λ (ls)
(fold-right (λ (x acc)
(if (member x acc)
acc
(cons x acc)))
'()
ls)))
(factor-out-common-factors '(+ (* 2 x) (* 2 y)))
=> (* 2 (+ (x) (y)))
The output could be cleaned up some more, this doesn't cover factoring out a 1, and remove-all is missing, but I'll leave all that to you.

A very general approach:
(dist expr var-list)
=> expr factored using terms in var-list
dist would have to know about "distributable" functions like +,-,*,/,etc and how each of them behave. If, say, it only knew about the first four, then :
(dist expr var-list
(if (empty? var-list) expr
(let* ([new-expr (factor expr (first var-list))])
(return "(* var " (dist new-expr (rest var-list)))))
That "return "(* var " " is not correct syntax, but you probably already knew that. I'm not a racket or lisp expert by any means, but basically this comes down to string processing? In any case, factor needs to be fleshed out so that it removes a single var from * functions and all of the var from + functions (replacing them with 1). It also needs to be smart enough to only do it when there are at least two replacements (otherwise we haven't actually done anything).

Related

Pair? function applying on Quote in Racket

In order to implement derivative of given polynomial, I need to factorize the polynomial, i.e., (* 3 x y) should be the product of 3 and (* x y).
So I implemented a function multiplicand to get the second factor of a product:
(define (multiplicand p)
(let ((second-factor (cdr (cdr p))))
(if (pair? second-factor) (cons '* second-factor)
second-factor)))
and the test code is
(multiplicand '(* x y))
But the output is '(* y). It seems that the condition (pair? second-factor) equals #true with second-factor values 'y.
Can anybody help me with this, thanks a lot.
Bear in mind that (cdr (cdr ...)) is returning a list (not an element!), so pair? will return true if the list has enough elements (three or more). Perhaps you were aiming for something like this?
(define (multiplicand p)
(if (null? (cdddr p)) ; assuming list has at least 3 elements
p
`(* ,(second p) (* ,(third p) ,(fourth p)))))
(multiplicand '(* x y))
=> (* x y)
(multiplicand '(* 3 x y))
=> (* 3 (* x y))
Manipulating symbolic expressions is what match is made for:
(define (multiplicand p)
(match p
[(list '* m n) n]
[_ (error 'multiplicand (~a "expected product, got: " p))]))

Elegant Way Of Accounting For "A" When Converting Strings To 26-Ary And Back?

I need to convert strings to 26-ary and then be able to convert them back.
My current code is:
(define (26-ary-word s)
(let ([len (string-length s)])
(let f ([n 0]
[acc (+
(- (char->integer (string-ref s 0)) 97)
1)]) ; adding 1 so that all strings start with 'b'
(if (< n len)
(f (add1 n) (+ (* acc 26) (- (char->integer (string-ref s n)) 97)))
acc))))
(define (word-ary-26 n)
(let f ([n (/ (- n (modulo n 26)) 26)]
[acc (cons (integer->char (+ (modulo n 26) 97)) '())])
(if (> n 0)
(f (/ (- n (modulo n 26)) 26) (cons (integer->char (+ (modulo n 26) 97)) acc))
(list->string (cdr acc))))) ; remove "b" from front of string
I add 1 to acc to start with, and remove the "b" at the end. This is because multiplying "a" - 97 by 26 is still 0.
This is already ugly, but it doesn't even work. "z" is recorded as "701" when it's in the first position (26^2), which is translated back as "az".
I can add another if clause detecting if the first letter is z, but that's really ugly. Is there any way to do this that sidesteps this issue?
(if (and (= n 0) (= acc 26))
(f (add1 n) 51)
(f (add1 n) (+ (* acc 26) (- (char->integer (string-ref s n)) 97))))
This is the ugly edge case handling code I've had to use.
Honestly, I'm not entirely sure what your code is doing, but either way, it's far more complicated than it needs to be. Converting a base-26 string to an integer is quite straightforward just by using some higher-order constructs:
; (char-in #\a #\z) -> (integer-in 0 25)
(define (base-26-char->integer c)
(- (char->integer c) (char->integer #\a)))
; #rx"[a-z]+" -> integer?
(define (base-26-string->integer s)
(let ([digits (map base-26-char->integer (string->list s))])
(for/fold ([sum 0])
([digit (in-list digits)])
(+ (* sum 26) digit))))
By breaking the problem into two functions, one that converts individual characters and one that converts an entire string, we can easily make use of Racket's string->list function to simplify the implementation.
The inverse conversion is actually slightly trickier to make elegant using purely functional constructs, but it becomes extremely trivial with an extra helper function that "explodes" an integer into its digits in any base.
; integer? [integer?] -> (listof integer?)
(define (integer->digits i [base 10])
(reverse
(let loop ([i i])
(if (zero? i) empty
(let-values ([(q r) (quotient/remainder i base)])
(cons r (loop q)))))))
Then the implementation of the string-generating functions becomes obvious.
; (integer-in 0 25) -> (char-in #\a #\z)
(define (integer->base-26-char i)
(integer->char (+ i (char->integer #\a))))
; integer? -> #rx"[a-z]+"
(define (integer->base-26-string i)
(list->string (map integer->base-26-char (integer->digits i 26))))

Why Scheme requires apply in Y-combinator implementation, but Racket doesn't?

Here is the Y-combinator in Racket:
#lang lazy
(define Y (λ(f)((λ(x)(f (x x)))(λ(x)(f (x x))))))
(define Fact
(Y (λ(fact) (λ(n) (if (zero? n) 1 (* n (fact (- n 1))))))))
(define Fib
(Y (λ(fib) (λ(n) (if (<= n 1) n (+ (fib (- n 1)) (fib (- n 2))))))))
Here is the Y-combinator in Scheme:
(define Y
(lambda (f)
((lambda (x) (x x))
(lambda (g)
(f (lambda args (apply (g g) args)))))))
(define fac
(Y
(lambda (f)
(lambda (x)
(if (< x 2)
1
(* x (f (- x 1))))))))
(define fib
(Y
(lambda (f)
(lambda (x)
(if (< x 2)
x
(+ (f (- x 1)) (f (- x 2))))))))
(display (fac 6))
(newline)
(display (fib 6))
(newline)
My question is: Why does Scheme require the apply function but Racket does not?
Racket is very close to plain Scheme for most purposes, and for this example, they're the same. But the real difference between the two versions is the need for a delaying wrapper which is needed in a strict language (Scheme and Racket), but not in a lazy one (Lazy Racket, a different language).
That wrapper is put around the (x x) or (g g) -- what we know about this thing is that evaluating it will get you into an infinite loop, and we also know that it's going to be the resulting (recursive) function. Because it's a function, we can delay its evaluation with a lambda: instead of (x x) use (lambda (a) ((x x) a)). This works fine, but it has another assumption -- that the wrapped function takes a single argument. We could just as well wrap it with a function of two arguments: (lambda (a b) ((x x) a b)) but that won't work in other cases too. The solution is to use a rest argument (args) and use apply, therefore making the wrapper accept any number of arguments and pass them along to the recursive function. Strictly speaking, it's not required always, it's "only" required if you want to be able to produce recursive functions of any arity.
On the other hand, you have the Lazy Racket code, which is, as I said above, a different language -- one with call-by-need semantics. Since this language is lazy, there is no need to wrap the infinitely-looping (x x) expression, it's used as-is. And since no wrapper is required, there is no need to deal with the number of arguments, therefore no need for apply. In fact, the lazy version doesn't even need the assumption that you're generating a function value -- it can generate any value. For example, this:
(Y (lambda (ones) (cons 1 ones)))
works fine and returns an infinite list of 1s. To see this, try
(!! (take 20 (Y (lambda (ones) (cons 1 ones)))))
(Note that the !! is needed to "force" the resulting value recursively, since Lazy Racket doesn't evaluate recursively by default. Also, note the use of take -- without it, Racket will try to create that infinite list, which will not get anywhere.)
Scheme does not require apply function. you use apply to accept more than one argument.
in the factorial case, here is my implementation which does not require apply
;;2013/11/29
(define (Fact-maker f)
(lambda (n)
(cond ((= n 0) 1)
(else (* n (f (- n 1)))))))
(define (fib-maker f)
(lambda (n)
(cond ((or (= n 0) (= n 1)) 1)
(else
(+ (f (- n 1))
(f (- n 2)))))))
(define (Y F)
((lambda (procedure)
(F (lambda (x) ((procedure procedure) x))))
(lambda (procedure)
(F (lambda (x) ((procedure procedure) x))))))

Convert lists into functions

I have a little noob question. I have to do a homework on genetic programming in scheme and the first step is to finish some given functions.
I got to a point where i have to execute a randomly generated function with all the possible parameters in a range (using map). The "function" is list like '(* (+ 1 x) (- x (* 2 3))).
How can i execute it with a given parameter? (for example x = 2). By the way, the generated function has a maximum of 1 parameter (it's x or none).
Thanks!
Here's my solution:
(define (execute expr)
(lambda (x)
(let recur ((expr expr))
(case expr
((x) x)
((+) +)
((-) -)
((*) *)
((/) /)
(else
(if (list? expr)
(apply (recur (car expr)) (map recur (cdr expr)))
expr))))))
Example usage:
> (define foo (execute '(* (+ 1 x) (- x (* 2 3)))))
> (foo 42)
=> 1548

How do I use a pair to find which of two functions will evaluate the largest value? Scheme

Basically there is a pair made up of two functions and the code has to take the pair input x to find the highest evaluation for x and print that evaluation.
I receive the error:
car: contract violation expected: pair? given: 4
define (max x)
(lambda (x) ;I wanted lambda to be the highest suitable function
(if (> (car x) (cdr x))
(car x)
(cdr x))))
(define one-function (lambda (x) (+ x 1)))
(define second-function (lambda (x) (+ (* 2 x) 1))) ;my two functions
((max (cons one-function second-function)) 4)
And where are the functions being called? And you have two parameters called x, they must have different names. Try this:
(define (max f) ; you must use a different parameter name
(lambda (x)
(if (> ((car f) x) ((cdr f) x)) ; actually call the functions
((car f) x)
((cdr f) x))))
Now it'll work as expected:
((max (cons one-function second-function)) 4)
=> 9

Resources