I am unable to successfully utilize the seq.fold_left function.
(declare-const s (Seq Int))
(declare-const t (Seq Int))
(declare-fun f (Int Int) Int)
(define-fun sum_seq ((s (Seq Int)))
(seq.fold_left (lambda (acc x) (+ acc x)) 0 s)
)
(assert (= t (seq.fold_left f s 0)))
(check-sat)
(get-model)
Can you identify the problem as I have encountered some errors?
(error "line 6 column 3: unknown sort 'seq.fold_left'")
(error "line 9 column 33: unknown constant seq.fold_left ((Array Int Int Int) Int (Seq Int)) ")
A couple of issues here.
The function is actually called seq.foldl, though I see your confusion since the documentation advertises it as seq.fold_left. Probably a matter of the code not matching the documentation, hopefully they'll fix it. You might want to file a ticket at https://github.com/Z3Prover/z3/issues to alert the developers to the discrepancy.
Your lambda-expression isn't right. In SMTLib, you have to annotate each variable with its type. So it should be something like (lambda ((acc Int) (x Int)) (+ acc x))
In your assert, you're using the arguments in the incorrect order. Should be 0 s, not s 0. Also, the result is an Int, not a Seq Int, so equating that to t is type-incorrect.
So, here's an example that actually works:
(declare-const s (Seq Int))
(declare-const t Int)
(define-fun sum_seq ((s (Seq Int))) Int
(seq.foldl (lambda ((acc Int) (x Int)) (+ acc x)) 0 s)
)
(assert (= t (sum_seq s)))
(assert (> (seq.len s) 3))
(check-sat)
(get-model)
This prints:
sat
(
(define-fun s () (Seq Int)
(seq.++ (seq.unit 5) (seq.unit 6) (seq.unit 7) (seq.unit 8)))
(define-fun t () Int
26)
)
which is a correct model for the given constraints. Hope this helps you sort out your own code.
Related
I am using a function from an external library returning a vector of four numbers and I want to access these values directly like it would be possible with destructuring-bind. See this pointless example:
(defun a-vector ()
(vector 1 2 3 4))
(defun a-list ()
(list 1 2 3 4))
(destructuring-bind (a b c d)
(a-list)
(format t "~D ~D ~D ~D~%" a b c d))
(destructuring-bind (a b c d)
(coerce (a-vector) 'list)
(format t "~D ~D ~D ~D~%" a b c d))
If I coerce the vector into a list it is possible and as performance isn't a problem here, it is maybe fine. But I was wondering if there is a more simple way?
You can bind variables to each cell as follows:
(defmacro with-aref ((&rest indices) array &body body)
(let ((a (gensym)))
`(let ((,a ,array))
(symbol-macrolet
,(loop
for n from 0
for i in indices
collect (list i `(aref ,a ,n)))
,#body))))
You would use it as follows:
(with-aref (w x y z) vec
(setf w (+ x y z)))
With a bit more work, you can also support indices and different categories of accessors. Let's say each binding is a triple (i n k) where i is an identifier, n a number (or nil) that represents the numerical index and k is either :place, :value or nil; :place binds the symbol with symbol-macrolet, :value just binds it with let.
First, let's help the user by providing shortcut notations:
x stands for (x nil nil)
(x o) either stands for (x o nil) or (x nil o), depending on whether option o is a number or a symbol (at macroexpansion time).
Besides, we may want to automatically ignore the nil identifier, the empty symbol || or symbols starting with an underscore (e.g. _, _var).
Here is the normalization function:
(defun normalize-index (index)
(flet ((ret (i n k)
(let ((ignored (or (null i)
(string= i "")
(char= #\_ (char (string i) 0)))))
(list (if ignored (gensym) i) n k ignored))))
(let ((index (alexandria:ensure-list index)))
(typecase index
(null (ret nil nil nil))
(cons (destructuring-bind (i &optional n (k nil kp)) index
(if kp
(ret i n k)
(etypecase n
(symbol (ret i nil n))
((integer 0) (ret i n nil))))))))))
We can apply this normalization to a list of indices, and keep track of ignored symbols:
(defun normalize (indices)
(loop
for i in indices
for norm = (normalize-index i)
for (index number kind ignore) = norm
collect norm into normalized
when ignore
collect index into ignored
finally (return (values normalized ignored))))
Then, we take care of nil numbers in normalized entries. We want the indices to increase from the last used index, or be given explicitly by the user:
(defun renumber (indices)
(loop
for (v n k) in indices
for next = nil then (1+ index)
for index = (or n next 0)
collect (list v index k)))
For example:
(renumber (normalize '(a b c)))
((A 0 NIL) (B 1 NIL) (C 2 NIL))
(renumber (normalize '((a 10) b c)))
((A 10 NIL) (B 11 NIL) (C 12 NIL))
(renumber (normalize '((a 10) (b 3) c)))
((A 10 NIL) (B 3 NIL) (C 4 NIL))
We do the same for the kind of variable we bind:
(defun rekind (indices)
(loop
for (v n k) in indices
for next = nil then kind
for kind = (or k next :place)
collect (list v n kind)))
For example:
(rekind (normalize '(a b c)))
((A NIL :PLACE) (B NIL :PLACE) (C NIL :PLACE))
(rekind (normalize '(a (b :value) c)))
((A NIL :PLACE) (B NIL :VALUE) (C NIL :VALUE))
Finally, all those steps are combined in parse-indices:
(defun parse-indices (indices)
(multiple-value-bind (normalized ignored) (normalize indices)
(values (rekind (renumber normalized))
ignored)))
Finally, the macro is as follows:
(defmacro with-aref ((&rest indices) array &body body)
(multiple-value-bind (normalized ignored) (parse-indices indices)
(labels ((ignored (b) (remove-if-not #'ignoredp (mapcar #'car b)))
(ignoredp (s) (member s ignored)))
(loop
with a = (gensym)
for (i n k) in normalized
for binding = `(,i (aref ,a ,n))
when (eq k :value) collect binding into values
when (eq k :place) collect binding into places
finally (return
`(let ((,a ,array))
(let ,values
(declare (ignore ,#(ignored values)))
(symbol-macrolet ,places
(declare (ignore ,#(ignored places)))
,#body))))))))
For example:
(let ((vec (vector 0 1 2 3 4 5 6 7 8 9 10)))
(prog1 vec
(with-aref ((a 2) (b :value) c _ _ d (e 0) (f 1)) vec
(setf a (list a b c d e f)))))
The above is macroexpanded as:
(LET ((VEC (VECTOR 0 1 2 3 4 5 6 7 8 9 10)))
(LET ((#:G1898 VEC))
(LET ((#:G1901 VEC))
(LET ((B (AREF #:G1901 3))
(C (AREF #:G1901 4))
(#:G1899 (AREF #:G1901 5))
(#:G1900 (AREF #:G1901 6))
(D (AREF #:G1901 7))
(E (AREF #:G1901 0))
(F (AREF #:G1901 1)))
(DECLARE (IGNORE #:G1899 #:G1900))
(SYMBOL-MACROLET ((A (AREF #:G1901 2)))
(DECLARE (IGNORE))
(LET* ((#:G19011902 #:G1901)
(#:NEW1 (LIST (AREF #:G1901 2) B C D E F)))
(FUNCALL #'(SETF AREF) #:NEW1 #:G19011902 2)))))
#:G1898))
It produces the following result
#(0 1 (2 3 4 7 0 1) 3 4 5 6 7 8 9 10)
coredump's answer is lovely. This is a variant of it which binds variables rather than accessors, and also lets you optionally specify indices. So
(with-vector-elements ((a 3) b) x
...)
will bind a to the result of (aref x 3) and b to the result of (aref x 4), for instance.
This is really only useful over coredump's answer if you're intending to (a) not write back to the vector and (b) use the bindings a lot, so you want to avoid a lot of possible arefs (which I don't think compilers can generally optimize away without some fairly strong assumptions).
(defmacro with-vector-elements ((&rest indices) vector &body forms)
(let ((canonical-indices
(loop with i = 0
for index in indices
collect (etypecase index
(symbol
(prog1
`(,index ,i)
(incf i)))
(cons
(destructuring-bind (var idx) index
(assert (and (symbolp var)
(typep idx '(and fixnum (integer 0))))
(var idx) "Invalid index spec")
(prog1
index
(setf i (1+ idx))))))))
(vname (gensym "V")))
`(let ((,vname ,vector))
(let ,(loop for (var index) in canonical-indices
collect `(,var (aref ,vname ,index)))
,#forms))))
There is also a package called metabang-bind - with nickname bind - in which the function bind can handle much more destructuring situations:
(ql:quickload :metabang-bind)
(in-package :metabang-bind)
(bind ((#(a b c) #(1 2 3)))
(list a b c))
;; => (1 2 3)
If not using in-package, you can call the function as bind:bind.
The function bind you can think of roughly as a destructuring-let* (similar idea to clojure's let, however not so clean in syntax but understandable because it has also to handle structs and classes and also values).
All the other use cases it can handle are described here.
I'm pretty new to Common Lisp. And I try to build my own operator functions.
In the first function I tried to add one to the given number.
The second function we do a recursive use of the first in the frequency of m.
When I enter totaladd ( 5 3 ) I expect an 8.
What can I do about the undefined funciton k?
(defun add1(n)
(+ n 1)
)
(write (add1 5))
(defun totaladd (k m)
(if (eq m 0)
0
(totaladd(add1(k) (- m 1)))
)
)
(write (totaladd 5 3))
There are three errors in the next line:
(totaladd(add1(k) (- m 1)))
Let's look at it:
(totaladd ; totaladd is a function with two parameters
; you pass only one argument -> first ERROR
(add1 ; add1 is a function with one parameter
; you pass two arguments -> second ERROR
(k) ; K is a variable, but you call it as a function,
; but the function K is undefined -> third ERROR
(- m 1)))
(defun add1 (n) (+ n 1))
(defun totaladd (k m)
(if (= m 0)
k
(add1 (totaladd k (- m 1)))))
There is a extra function for (= ... 0) called zerop which asks whether a number os zero or not. Very frequently used when recursing over numbers as the break condition out of the recursion.
There is also an extra function for (- ... 1) or (+ ... 1) because these are common steps when recursing with numbers: (1- ...) and (1+ ...), respectively.
(Their destructive forms are (incf ...) and (decf ...), but these are not needed for recursion.)
So, using this, your form becomes:
(defun totaladd (k m)
(if (zerop m)
k
(add1 (totaladd k (1- m)))))
I would like to do something similar to matplotlib.pyplot.matshow with racket. I understand this is a trivial question and maybe I'm just being stupid, but I was unsuccessful after reading the Racket plotting documentation.
An example matrix that would be translated into the image of a circle:
#lang typed/racket
(require math/array)
(require plot)
(: sq (-> Integer Integer))
(define (sq [v : Integer])
(* v v))
(: make-2d-matrix (-> Integer Integer (Array Boolean)))
(define (make-2d-matrix [s : Integer] [r : Integer])
(let ([center : Integer (exact-round (/ s 2))])
(let ([a (indexes-array ((inst vector Integer) s s))])
(let ([b (inline-array-map (λ ([i : (Vectorof Index)])
(+
(sq (- (vector-ref i 0) center))
(sq (- (vector-ref i 1) center))))
a)])
(array<= b (array (sq r)))
))))
(array-map (λ ([i : Boolean]) (if (eq? i #f) 0 1)) (make-2d-matrix 20 6))
Can someone give me a hint?
Totally not a dumb question. This is one of those areas where it's hard to compete with an army of python library programmers. Here's how I'd do it in Racket:
#lang racket
(require 2htdp/image
math/array)
;; a 10x10 array
(define a
(build-array #(10 10)
(λ (e)
(match e
[(vector x y)
(cond [(= x y) x]
[else 0])]))))
;; map a value to a color
(define (cmap v)
(color (floor (* 255 (/ v 10)))
0
(floor (* 255 (- 1 (/ v 10))))))
(apply
above
(for/list ([y (in-range 10)])
(apply
beside
(for/list ([x (in-range 10)])
(rectangle 10 10 'solid (cmap (array-ref a (vector x y))))))))
Depending on you situation, you might be interested in flomaps:
http://docs.racket-lang.org/images/flomap_title.html?q=flbitmap
I'm not sure exactly what you want to plot. The plot library is designed around plotting functions, but I don't know what function you want to express.
Here are two ways of plotting a matrix:
(plot (points (cast (array->vector* m) (Vectorof (Vectorof Real)))
(plot3d (points3d (cast (array->vector* m) (Vectorof (Vectorof Real)))
The cast is needed because the type of array->vector* is not specific enough.
Some time ago I asked how I could use Z3 to get models for constraints involving sets (Is there a way to use Z3 to get models for constraints involving sets?). For this the extended array theory works well in my case.
Now I have got the same issue with sequences (with operations length, membership, (in-)equality, perhaps slicing) and maps. I.e. axiomatization leads to the same problem as for sets. I have been thinking of encoding sequences and maps using the extended array theory as well but I have not yet been able to come up with a good way to do this.
Does anyone have an idea on how sequences and maps could be encoded to get accurate models?
In Z3, arrays are essentially maps. Here is an example on how to create an "array" from list of integers to integers.
(declare-const a (Array (List Int) Int))
(declare-const l1 (List Int))
(declare-const l2 (List Int))
(assert (= (select a l1) 0))
(assert (= (select a l2) 0))
(check-sat)
(get-model)
For sequences, we can encode them using quantifiers. Z3 is complete for many decidable fragments.
Most of them are described in the Z3 tutorial. Here is a possible encoding.
;; In this example, we are encoding sequences of T.
;; Let us make T == Int
(define-sort T () Int)
;; We represent a sequence as a pair: function + length
(declare-fun S1-data (Int) T)
(declare-const S1-len Int)
(declare-fun S2-data (Int) T)
(declare-const S2-len Int)
(declare-fun S3-data (Int) T)
(declare-const S3-len Int)
;; This encoding has one limitation, we can't have sequences of sequences; nor have sequences as arguments of functions.
;; Here is how we assert that the sequences S1 and S2 are equal.
(push)
(assert (= S1-len S2-len))
(assert (forall ((i Int)) (=> (and (<= 0 i) (< i S1-len)) (= (S1-data i) (S2-data i)))))
;; To make the example more interesting, let us assume S1-len > 0
(assert (> S1-len 0))
(check-sat)
(get-model)
(pop)
;; Here is how we say that sequence S3 is the concatenation of sequences S1 and S2.
(push)
(assert (= S3-len (+ S1-len S2-len)))
(assert (forall ((i Int)) (=> (and (<= 0 i) (< i S1-len)) (= (S3-data i) (S1-data i)))))
(assert (forall ((i Int)) (=> (and (<= 0 i) (< i S2-len)) (= (S3-data (+ i S1-len)) (S2-data i)))))
;; let us assert that S1-len and S2-len > 1
(assert (> S1-len 1))
(assert (> S2-len 1))
;; let us also assert that S3(0) != S3(1)
(assert (not (= (S3-data 0) (S3-data 1))))
(check-sat)
(get-model)
(pop)
;; Here is how we encode that sequence S2 is sequence S1 with one extra element a
(push)
(declare-const a T)
(assert (> a 10))
(assert (= S2-len (+ 1 S1-len)))
(assert (= (S2-data S1-len) a))
(assert (forall ((i Int)) (=> (and (<= 0 i) (< i S1-len)) (= (S2-data i) (S1-data i)))))
;; let us also assert that S1-len > 1
(assert (> S1-len 1))
(check-sat)
(get-model)
(pop)
I'm a beginner to scheme and I'm trying to learn some arithmetic recursion. I can't seem to wrap my head around doing this using scheme and producing the correct results. For my example, I'm trying to produce a integer key for a string by doing arithmetic on each character in the string. In this case the string is a list such as: '(h e l l o). The arithmetic I need to perform is to:
For each character in the string do --> (33 * constant + position of letter in alphabet)
Where the constant is an input and the string is input as a list.
So far I have this:
(define alphaTest
(lambda (x)
(cond ((eq? x 'a) 1)
((eq? x 'b) 2))))
(define test
(lambda (string constant)
(if (null? string) 1
(* (+ (* 33 constant) (alphaTest (car string))) (test (cdr string)))
I am trying to test a simple string (test '( a b ) 2) but I cannot produce the correct result. I realize my recursion must be wrong but I've been toying with it for hours and hitting a wall each time. Can anyone provide any help towards achieving this arithmetic recursion? Please and thank you. Keep in mind I'm an amateur at Scheme language :)
EDIT
I would like to constant that's inputted to change through each iteration of the string by making the new constant = (+ (* 33 constant) (alphaTest (car string))). The output that I'm expecting for input string '(a b) and constant 2 should be as follows:
1st Iteration '(a): (+ (* 33 2) (1)) = 67 sum = 67, constant becomes 67
2nd Iteration '(b): (+ (* 33 67) (2)) = 2213 sum = 2213, constant becomes 2213
(test '(a b) 2) => 2280
Is this what you're looking for?
(define position-in-alphabet
(let ([A (- (char->integer #\A) 1)])
(λ (ch)
(- (char->integer (char-upcase ch)) A))))
(define make-key
(λ (s constant)
(let loop ([s s] [constant constant] [sum 0])
(cond
[(null? s)
sum]
[else
(let ([delta (+ (* 33 constant) (position-in-alphabet (car s)))])
(loop (cdr s) delta (+ sum delta)))]))))
(make-key (string->list ) 2) => 0
(make-key (string->list ab) 2) => 2280
BTW, is the procedure supposed to work on strings containing characters other than letters—like numerals or spaces? In that case, position-in-alphabet might yield some surprising results. To make a decent key, you might just call char->integer and not bother with position-in-alphabet. char->integer will give you a different number for each character, not just each letter in the alphabet.
(define position-in-alphabet
(let ([A (- (char->integer #\A) 1)])
(lambda (ch)
(- (char->integer (char-upcase ch)) A))))
(define (test chars constant)
(define (loop chars result)
(if (null? chars)
result
(let ((r (+ (* 33 result) (position-in-alphabet (car chars)))))
(loop (rest chars) (+ r result)))))
(loop chars constant))
(test (list #\a #\b) 2)
Here's a solution (in MIT-Gnu Scheme):
(define (alphaTest x)
(cond ((eq? x 'a) 1)
((eq? x 'b) 2)))
(define (test string constant)
(if (null? string)
constant
(test (cdr string)
(+ (* 33 constant) (alphaTest (car string))))))
Sample outputs:
(test '(a) 2)
;Value: 67
(test '(a b) 2)
;Value: 2213
I simply transform the constant in each recursive call and return it as the value when the string runs out.
I got rid of the lambda expressions to make it easier to see what's happening. (Also, in this case the lambda forms are not really needed.)
Your test procedure definition appears to be broken:
(define test
(lambda (string constant)
(if (null? string)
1
(* (+ (* 33 constant)
(alphaTest (car string)))
(test (cdr string)))
Your code reads as:
Create a procedure test that accepts two arguments; string and constant.
If string is null, pass value 1, to end the recursion. Otherwise, multiply the following values:
some term x that is = (33 * constant) + (alphaTest (car string)), and
some term y that is the output of recursively passing (cdr string) to the test procedure
I don't see how term y will evaluate, as 'test' needs two arguments. My interpreter threw an error. Also, the parentheses are unbalanced. And there's something weird about the computation that I can't put my finger on -- try to do a paper evaluation to see what might be getting computed in each recursive call.