I have this problem in Common Lisp.
I need to manipulate existential variables introducing the rule of skolemization.
For example I need to buid a function which turns
(exist ?x (p ?x)) in (p sk00042).
sk00042 is a variable. Note that this function becomes a bit harder when universal variables are involved.
For example, the function given the expression (forall ?y (exist ?x (p ?x ?y)) turns it into (forall ?y (p (sf666 ?y) ?y).
The idea is that the existencial variable tells me that there is something that satisfies the formulae. If this existential quantifier is the outer , then this quantifier does not depend on anything and the variable ?x in the first example above should be replaced with the constant skoo42 which is generated by this function :
(defun skolem-variable () (gentemp "SV-")).
If the harder (second) case takes place and there's a universal quantifier "out" of the existential one, then that something that exists depends on variables universally quantified, meaning that the function must take care of this dependence and the universal variables become incorporated in the constant, like in the example :
(forall ?y (exist ?x (p ?x ?y)) ----> (forall ?y (p (sf666 ?y) ?y)
For this also serves the function:
(defun skolem-function* (&rest args) (cons (gentemp "SF-") args))
(defun skolem-function (args) (apply #'skolem-function* args))
Here are some examples to get more familiar with the idea :
(skolemize '(forall ?y (exist ?x (p ?x ?y))))
;=> (forall ?y (P (SF-1 ?Y) ?Y))
(skolemize '(exist ?y (forall ?x (p ?x ?y))))
;=> (for all ?x (P ?X SV-2)
(skolemize '(exist ?y (and (p ?x) (f ?y))))
;=> (AND (P ?X) (F SV-4))
(skolemize '(forall ?x (exist ?y (and (p ?x) (f ?y)))))
;=> (forall ?x (AND (P ?X) (F (SF-5 ?X)))
I need to build the function (using skolem-variable and skolem-function above) that given
an expression controls if the outer is exist, then replaces the variable with skolem-variable. If the outer is a forall followed by and exist, the function does what i've explained above.
I just skimmed the Wikipedia article on the skolem normal form, but if I get it right, every existential becomes a skolem function invocation with the bound universals as arguments (or a skolem constant if no universals are in scope). One simple approach would be having a stack of bound universals while walking the expression tree recursively:
(defun skolemize (form &optional (universals nil))
(cond ((null form) nil) ; subtree done
((consp (car form)) ; walk branches
(cons (skolemize (car form) universals)
(skolemize (cdr form) universals)))
((eq (car form) 'forall) ; universal binding
(list 'forall
(cadr form)
(skolemize (caddr form) ; skolemize body
(cons (cadr form) universals)))) ; new var on the stack
((eq (car form) 'exist) ; existential binding
(subst (if universals ; substitute variables
(cons (gentemp "SF-") universals) ; with skolem function
(gentemp "SV-")) ; with skolem constant
(cadr form)
(skolemize (caddr form) universals)))
(t (cons (car form) (skolemize (cdr form) universals)))))
Note that this is just to get you started – I neither delved into this topic, nor is this really tested or optimized for performance or elegance. Also, it will accept malformed input, e.g. (skolemize '(forall (foo bar))).
Your examples:
CL-USER> (skolemize '(exist ?x (p ?x)))
(P SV-16)
CL-USER> (skolemize '(forall ?y (exist ?x (p ?x ?y))))
(FORALL ?Y (P (SF-17 ?Y) ?Y))
CL-USER> (skolemize '(exist ?y (forall ?x (p ?x ?y))))
(FORALL ?X (P ?X SV-18))
CL-USER> (skolemize '(exist ?y (and (p ?x) (f ?y))))
(AND (P ?X) (F SV-19))
CL-USER> (skolemize '(forall ?x (exist ?y (and (p ?x) (f ?y)))))
(FORALL ?X (AND (P ?X) (F (SF-20 ?X))))
Testing a more complex expression:
CL-USER> (skolemize '(exist ?a
(forall ?b
(exist ?c
(forall ?d
(exist ?e (and (or (and (f ?a) (g ?b))
(and (f ?c) (g ?d)))
(or (and (f ?c) (g ?e))
(and (f ?d) (g ?e))))))))))
(FORALL ?B
(FORALL ?D (AND (OR (AND (F SV-15) (G ?B))
(AND (F (SF-16 ?B)) (G ?D)))
(OR (AND (F (SF-16 ?B)) (G (SF-17 ?D ?B)))
(AND (F ?D) (G (SF-17 ?D ?B)))))))
Related
I am coding a function where I need to create a new list by inserting a certain value into the list after position N. Here is the code:
(DEFUN insertNth (L N insValue)
(cond ((NULL L) NIL)
((NULL (CDR L)) (CONS (CAR L) (insValue)))
(T (CONS (CAR L) (insertNth (CDR L) N insValue)))
)
)
When I try to test the code, I receive this error: *** - EVAL: undefined function INSVALUE. Is there a step or a piece of the function I may be missing?
(defun insertNth (l N insValue &optional (acc '()) (counter 0))
(cond ((null l) (nreverse acc))
((= N counter) (nconc (nreverse acc) (list insValue) l))
(t (insertNth (cdr l) N insValue (cons (car l) acc) (1+ counter)))))
I took the destructive functions nreverse and nconc due to performance reasons.
Destructive functions here have no danger, but improve performance.
You can, however, use the non-destructive functions reverse and append instead which will be more familiar to you.
I wanted to square all elements in a list by the Scheme programming language.
my code is:
(define (square n) (* n *n))
(define (fun items factor)
(if (null? items)
0
(cons (* (fun (car items)
factor))
(fun (cdr items)
factor) ) ) ) )
(display (fun '( 1 2 3 4) square))
I'm showing these errors:
ERROR: In procedure car:
ERROR: In procedure car:
Wrong type (expecting pair): 1
You have a couple of errors:
The square procedure has an extra * that shouldn't be there
If we're building a list as output, then the base case should return the empty list '(), not 0.
The part where you operate on the current element of the list is incorrect, you should simply call the factor procedure on the car of the list, and there's no need to multiply again, square will take care of that.
This should fix them:
(define (square n) (* n n))
(define (fun items factor)
(if (null? items)
'()
(cons (factor (car items))
(fun (cdr items) factor))))
In real life, you don't need to implement this procedure yourself, map is already built-in and it's as simple to use as this:
(map square '(1 2 3 4))
=> '(1 4 9 16)
Here is other method:
(define factor-list
(lambda (l factor return)
(if (null? l)
(return '())
(factor-list (cdr l)
factor
(lambda (rest)
(return (cons (factor (car l))
rest)))))))
(define input '(1 2 3 4))
(factor-list input (lambda (x) (* x x)) (lambda (x) x))
Tail recursive implementation of map (to not to overwrite built-in map I called it *map).
(define (square x) (* x x))
(define (*map func lst (acc '()))
"Apply func on each element of the list."
(cond ((null? lst) (reverse acc))
(else (*map func (cdr lst) (cons (func (car lst)) acc)))))
Run it by:
(*map square '(1 2 3)) ;; '(1 4 9)
how would i create the function apply in scheme?
A my-apply function that does the same thing as it.
(define (my-apply fn lst)
(if (null? lst)
I'm not sure where to go from here or how to start.
I think apply is "more fundamental" than eval, so the following is cheating:
(define (my-apply func args)
(eval `(,func ,#args)))
I don't think you can do it without eval.
I created a lisp interpreter a while back and it has eval and macros, but it didn't have apply. I wondered if there was a way I could make my interpreter support apply so made an effort to try this. Here is my first attempt:
(define (my-apply proc args)
(eval (cons proc args)))
This clearly doesn't work since the function and the list of arguments gets evaluated twice. eg. (my-apply cons '(a b)) will give you (cons a b) and not (cons 'a 'b). I then thought that this might be a job for a macro but threw the idea away since the list of arguments are not known at macro expansion time. Procedure it needs to be so I though I could quote the list before I pass it to eval.
(define (my-apply proc args)
(define (q v)
(list 'quote v))
(eval (cons proc (map q args))))
This actually works, but this does a lot more work than a native apply would do to undo the job eval does.
If you are not allowed to use eval you are truely out of luck. It cannot be done. The same goes for implementing eval without using apply since then you have no way of doing primitives.
(define (my-two-arg-apply f a)
(let ((l (length a)))
(cond ((= l 0) (f))
((= l 1) (f (car a)))
((= l 2) (f (car a) (cadr a))
...
((= l 5) (f (car a) (cadr a) ... (caddddr a)))
...
((= l 7) (f (car a) (cadr a) ... (caddddr a)
(list-ref a 5) (list-ref a 6)))
... ;; lots more cases
(else (error "argument passing limit exceeded")))))
A macro could be used to generate the large quantity of code needed.
error was introduced in R6RS. Amazingly, Scheme programs had no reasonable way to report errors before that.
Don't even think about making a pop macro and using the pattern (f (pop a) (pop a) ... (pop a)); Scheme doesn't have a defined evaluation order for function arguments unlike some other Lisp dialects like ANSI CL.
I have the filter-function and the reverse-function done out in my own code
(define reverse_
(lambda (xs)
(if (null? xs)
xs
(append (reverse_ (cdr xs))
(list (car xs))))))
and
(define filter_
(lambda (p? xs)
(if (null? xs)
xs
(append (if (p? (car xs))
(list (car xs))
(list))
(filter_ p? (cdr xs))))))
I want to combine the two functions into the (reverse-filter) function i.e you could type (reverse-filter symbol? '(1 2 3 a b c)) and it would return -> c b a.
It works now by simply typing (reverse_ (filter_ symbol? '(1 2 3 a b c))) -> c b a but I just want to combine the two.
Any help on doing this in the general case and in this specific one would be much appreciated
For the general case, we can use the curry and compose procedures (which hopefully are available in your interpreter), they allow us to manipulate other procedures:
((compose (curry filter_ symbol?) reverse_)
'(1 2 3 a b c))
=> '(c b a)
For illustrative purposes, here's a naive implementation of both procedures, to understand what they're doing under the hood:
(define (curry f x)
(lambda (y) (f x y)))
(define (compose f g)
(lambda (x) (f (g x))))
compose is the right and lazy thing to do, however since lists are iterated from head to tail but created from tail to head creating the reverse result is actually more efficient when done in one go:
(define (reverse-filter p? xs)
(define (helper lst acc)
(if (null? lst)
acc
(helper (cdr lst)
(let ((a (car lst)))
(if (p? a)
(cons a acc)
acc)))))
(helper xs '()))
(reverse-filter symbol? '(1 2 3 a b c))
; ==> (c b a)
How to realize a function that takes as input an any number of procedures with one argument and returns another function is the composition of these procedures in Scheme.
For example:
(define (f x) (* x 2))
(define (g x) (* x 3))
(define (h x) (- x))
((comp-func f g h) 1) => -6
((comp-func f g) 1) => 6
((comp-func h) 1) => -1
((comp-func) 1) => 1
As written, the question is ambiguous, because we can't tell in which order you're composing the functions. That is, we can't tell whether
((comp-func f g h) 1) computes (f (g (h 1))) or (h (g (f 1))), since both would work out to -6 in this case.
That said, this problem can be solved by a (left to right) fold a.k.a. reduction; once you know how to compose two functions, you can reduce that binary composition over a list of functions.
First, composing two functions is easy:
(define (compose2 f g)
;; Returns a function that computes (g (f x)).
(lambda (x)
(g (f x))))
Now, to reduce (a.k.a. fold left to right) a function f over a list (x1 x2 ... xn) with an initial value i means computing
(f ... (f (f (f i x1) x2) x3 ...) xn)
(by definition). Composing a list of functions (f1 f2 f3 f4) is then just folding the compose2 function with an initial value that is the identity function.
(define (identity x)
x)
(define (compose . functions)
(reduce compose2 identity functions))
reduce is a built-in function that does the (left to right) folding.
I'll use some functions where the order matters, so that we can see the difference in results:
(define (f x) (* x x))
(define (g x) (+ x 3))
(display ((compose f g) 3))
;=> 12 == (g (f 3)) == (3^2)+3
(display ((compose g f) 3))
;=> 36 == (f (g 3)) == (3+3)^2
A clean solution would be
(define (comp-func . procs)
(define (comp-rec arg procs)
(if (null? procs)
arg
((car procs) (comp-rec arg (cdr procs)))))
comp-rec)
However with this solution you need to call it like this ((comp-func f g h) 1 (list f g h)).
Here is a solution that will work if you call it like in your examples, however it is a bit uglier because we need to use set! to change procs argument.
(define (comp-func . procs)
(define (comp-rec arg)
(if (null? procs)
arg
(let ((proc (car procs))
(rest (cdr procs)))
(set! procs rest)
(proc (comp-rec arg)))))
comp-rec)
In addition to #Kevin's nice recursive solution, I would like to add that there's no need to use set!. Inside comp-func you can simply return a lambda function that calls comp-rec with the list of procedures as the extra argument.
(define (comp-func . procs)
(define (comp-rec arg procs)
(if (null? procs)
arg
((car procs) (comp-rec arg (cdr procs)))))
(lambda (arg) (comp-rec arg procs )))
No need for any intermediate define or let or set or what ever.
We stay pure functional and need no variables.
(define (comp-func . procs)
(lambda (arg)
(if (null? procs)
arg
((car procs) ((apply comp-func (cdr procs)) arg)))))