I have to use multinomial-dist in order to express the following distribution:
x
P(x)
red
0.5
blue
0.05
green
0.4
black
0.05
Where P(x) refers to the probability of x.
I implemented the following solution in Dr.Racket using Gamble:
(define color '("red" "blue" "green" "black"))
(define (color-probability color)
(cond
[(equal? "red") 0.5]
[(equal? "blue") 0.05]
[(equal? "green") 0.4]
[else 0.05]))
(define my-color (multinomial-dist color color-probability))
(dist-sample my-color)
But it returns an error:
make-multinomial-dist: contract violation
expected: natural?
given: '("red" "blue" "green" "black")
in: the 1st argument of
(->
natural?
(vectorof (>=/c 0))
multinomial-dist?)
I'm new in Racket and i'm still learning the basics and i don't understand what the compiler didn't like!
Thank you all!
The documentation entry for multinomial-dist, viewed from DrRacket by selecting multinomial-dist, right clicking on it, choosing Search in Help Desk for "multinomial-dist" (do this for each new function in what follows) is:
(struct multinomial-dist (n weights))
n : exact-nonnegative-integer?
weights : (vectorof (>=/c 0))
Represents a multinomial distribution. The support consists of vectors of the same length as weights representing counts of n iterated samples from the corresponding categorical distribution with weights for weights.
So a multinomial-dist can be constructed by an expression, for example, like:
(multinomial-dist 100 (vector 49 51))
(the (vector 49 51) could be the result of 100 iterated samples from a
categorical distribution with weights (vector 50 50) eg representing a coin toss)
The P(x) values in the question are categorical distribution (sometimes called
discrete distribution) weights, so start with this:
#lang racket
(require Gamble)
(define color-dist (categorical-dist (vector 0.5 0.05 0.4 0.05)))
To try this out, sample the distribution a few times in DrRacket's interaction area:
> (sample color-dist)
0
> (sample color-dist)
2
> (sample color-dist)
0
>
One way to construct iterated samples in Racket is with build-list:
(define samples (build-list 100 (lambda (x) (sample color-dist))))
> samples
'(3 0 0 2 2 0 2 0 0 0 0 0 2 0 2 0 1 2 2 2 0 2 0 2 1 0 2 0 2 0 0 0 0 2 1 0 0 2 2 2 0 1 2 0 2 2 2 0 2 0 2 2 0 0 0 0 0 0 0 0 0 2 2 0 2 2 0 0 0 2 2 2 2 1 1 0 3 0 2 2 2 0 0 2 0 2 0 0 0 0 0 2 2 2 0 0 0 2 3 0)
>
Counts of these samples are required (when needing a function, one can just type in a likely name and use "Search in Help Desk"...); try it out:
> (count (lambda (n) (= n 0)) samples)
51
>
The weights are required as a vector, so add:
(define weights
(vector (count (lambda (n) (= n 0)) samples)
(count (lambda (n) (= n 1)) samples)
(count (lambda (n) (= n 2)) samples)
(count (lambda (n) (= n 3)) samples)))
> weights
'#(51 6 40 3)
>
(After learning Scheme/Racket basics, one can eliminate the repetition in the definition above)
And then, finally,
> (multinomial-dist 100 weights)
(multinomial-dist 100 '#(51/100 3/50 2/5 3/100))
>
The distribution you're supposed to represent is not a multinomial distribution, which is a distribution over vectors.
I think you need to use discrete-dist instead.
Related
I understand how to turn a vector into a list with vector->list but I was wondering if there was a way to create a function in order to do so. For example:
(define test-board (vector
(vector 1 0 1 0 0 1)
(vector 0 0 0 1 0 1)
(vector 1 0 0 0 1 1)))
I know that I can go line by line and do this:
(define test-board (vector->list(vector
(vector->list(vector 1 0 1 0 0 1))
(vector->list(vector 0 0 0 1 0 1))
(vector->list(vector 1 0 0 0 1 1))
)
)
)
But is there a way to create a function to do this without having to go line by line?
This should work:
(vector->list
(vector-map vector->list test-board))
I'm doing an algorithm that randomizes a TSP (array of citys) based on 1 TSP.
(do ((i 0 (+ i 1)))
((= i n-population))
(setf (aref population i) (shuffle TSP 100))
)
And as far as I know im filling up i positions of the array population with (shuffle TSP 100) that is beeing called each iteration, but the algorithm is setting all array positions and not just i position.
[Note. An earlier version of this answer contained a mistake which would badly alter the statistics of the shuffling: please check below for the corrected version and a note as to what the problem was.]
Given your code, slightly elaborated to turn it into a function:
(defun fill-array-with-something (population n-population TSP)
(do ((i 0 (+ i 1)))
((= i n-population))
(setf (aref population i) (shuffle TSP 100))))
Then each element of population from 0 to (1- n-population) will be set to the result of (shuffle TSP 100). There are then two possibilities:
(shuffle TSP 100) returns a fresh object from each call;
(shuffle TSP 100) returns the same object – probably TSP – from each call.
In the first case, each element of the array will have a distinct value. In the second case, all elements below n-population will have the same value.
Without knowing what your shuffle function does, here is an example of one which will give the latter behaviour:
(defun shuffle (vec n)
;; shuffle pairs of elts of VEC, N times.
(loop with max = (length vec)
repeat n
do (rotatef (aref vec (random max))
(aref vec (random max)))
finally (return vec)))
And we can test this:
> (let ((pop (make-array 10))
(tsp (vector 0 1 2 3 4 5 6 7 8 9 )))
(fill-array-with-something pop (length pop) tsp)
pop)
#(#(2 8 7 1 3 9 5 4 0 6) #(2 8 7 1 3 9 5 4 0 6) #(2 8 7 1 3 9 5 4 0 6)
#(2 8 7 1 3 9 5 4 0 6) #(2 8 7 1 3 9 5 4 0 6) #(2 8 7 1 3 9 5 4 0 6)
#(2 8 7 1 3 9 5 4 0 6) #(2 8 7 1 3 9 5 4 0 6) #(2 8 7 1 3 9 5 4 0 6)
#(2 8 7 1 3 9 5 4 0 6))
As you can see all the elements are mysteriously the same thing, which is because my shuffle simply returned its first argument, having modified it in place.
You can check this by either explicitly checking the result of shuffle, or by, for instance, using *print-circle* to see the sharing. The latter approach is pretty neat:
> (let ((*print-circle* t)
(pop (make-array 10))
(tsp (vector 0 1 2 3 4 5 6 7 8 9 )))
(fill-array-with-something pop (length pop) tsp)
(print pop)
(values))
#(#1=#(4 6 7 0 1 2 5 9 3 8) #1# #1# #1# #1# #1# #1# #1# #1# #1#)
And now it's immediately apparent what the problem is.
The solution is to make sure either that shuffle returns a fresh object, or to copy its result. With my shuffle this can be done like this:
(defun fill-array-with-something (population n-population tsp)
(do ((i 0 (+ i 1)))
((= i n-population))
(setf (aref population i) (shuffle (copy-seq TSP) 100))))
Note that a previous version of this answer had (copy-seq (shuffle TSP 100)): with my version of shuffle this is a serious mistake, as it means that the elements in population are related to each other but get increasingly shuffled as you go along. With (shuffle (copy-seq TSP) 100) each element gets the same amount of shuffling, independently.
And now
> (let ((*print-circle* t)
(pop (make-array 10))
(tsp (vector 0 1 2 3 4 5 6 7 8 9 )))
(fill-array-with-something pop (length pop) tsp)
(print pop)
(values))
#(#(8 3 4 1 6 9 2 5 0 7) #(8 6 5 1 3 0 4 2 9 7) #(5 0 4 7 1 6 9 3 2 8)
#(3 0 7 6 2 9 4 5 1 8) #(8 2 5 1 7 3 9 0 4 6) #(0 5 6 3 8 7 2 1 4 9)
#(4 1 3 7 8 0 5 2 9 6) #(6 9 1 5 0 7 4 2 3 8) #(2 7 5 8 0 9 6 3 4 1)
#(5 4 8 9 6 7 2 0 1 3))
I suspect that the problem is in OP function SHUFFLE which has not yet been shared; my suspicion is that SHUFFLE is shuffling the *TSP* array itself in place instead of creating a shuffled copy of that array. The POPULATION values are then all referencing the same shuffled *TSP* array.
To solve this problem, SHUFFLE should return a shuffled array instead of shuffling the array in place. Here is a function that performs a Fisher-Yates shuffle on a vector:
(defun shuffle-vector (vect)
"Takes a vector argument VECT and returns a shuffled vector."
(let ((result (make-array (length vect) :fill-pointer 0)))
(labels ((shuffle (v)
(if (zerop (length v))
result
(let* ((i (random (length v)))
(x (elt v i)))
(vector-push x result)
(shuffle (concatenate 'vector
(subseq v 0 i)
(subseq v (1+ i))))))))
(shuffle vect))))
Testing in the REPL:
CL-USER> (defvar *TSP* #("Village" "Town" "City" "Metropolis" "Megalopolis"))
*TSP*
CL-USER> (defvar *n-population* 5)
*N-POPULATION*
CL-USER> (defvar *population* (make-array *n-population*))
*POPULATION*
CL-USER> (dotimes (i *n-population*)
(setf (aref *population* i) (shuffle-vector *TSP*)))
NIL
CL-USER> *population*
#(#("Megalopolis" "City" "Metropolis" "Town" "Village")
#("Megalopolis" "Metropolis" "Town" "City" "Village")
#("City" "Megalopolis" "Town" "Village" "Metropolis")
#("City" "Megalopolis" "Village" "Metropolis" "Town")
#("Megalopolis" "Town" "Metropolis" "City" "Village"))
I build a 2-dimensional array (a matrix) consisting of a vector of vectors:
(setq zero-row [0 0 0 0 0])
=> [0 0 0 0 0]
(setq zero-mat (make-vector 4 zero-row))
=> [[0 0 0 0 0] [0 0 0 0 0] [0 0 0 0 0] [0 0 0 0 0]]
I'll set the element in row 2, column 3 (0-indexed) to 42 by replacing row 2 with a vector containing the changed element:
(aset zero-mat 2 [0 0 0 42 0])
=> [0 0 0 42 0]
zero-mat
=> [[0 0 0 0 0] [0 0 0 0 0] [0 0 0 42 0] [0 0 0 0 0]]
It works.
Next I try to build a function which takes this approach to set the (i,j)-th element in such a 2-dimensional array:
(defun matrix-set (mat i j elt)
"Set the (i, j)-th element of mat to elt. mat is a vector of the row vectors. Indexing is 0-based in each component."
(let ((vect (aref mat i)))
(aset vect j elt)
(aset mat i vect)
mat))
But this doesn't work:
(setq zero-row [0 0 0 0 0])
=> [0 0 0 0 0]
(setq zero-mat (make-vector 4 zero-row))
=> [[0 0 0 0 0] [0 0 0 0 0] [0 0 0 0 0] [0 0 0 0 0]]
(matrix-set zero-mat 2 3 42)
=> [[0 0 0 42 0] [0 0 0 42 0] [0 0 0 42 0] [0 0 0 42 0]]
It looks like all the rows of the array are linked to the same vector, so changing that vector changes all the rows.
So two questions: (1) Why is this happening in the second case, but not the first? (2) How can I fix this (so I can access the (i, j)-th entry of a 2-dim. array represented this way)?
(I was originally writing a little routine to add two matrices, represented as vectors of vectors as above, and ran into the same problem. I think the stripped-down example above may make the problem clearer.)
In the first case you are replacing an element in the "outer" vector by another vector (while other three "inner" vectors still point all to the same element). In the second case you replace an element in the "inner" vector (and you have only one inner vector duplicated four times, as per your example. A simple way to initialize vector to different distinct vectors would be something like this:
(let ((i 0) (new-vector (make-vector 4 nil))
(while (< (progn (aset new-vector i (make-vector 5 0))
(incf i))
(length new-vector)))
Sorry if there are any typos, was writing it in-place. But the idea should be simple enough to figure it out.
I am working on a Clojure macro to help build GridBagLayout-based JPanels. I can get Java classes in a defaults map inside the macro to namespace-qualify, but not those passed in as arguments. What magic combination of backquotes, quotes, tildas, or something else do I need?
(import [java.awt GridBagConstraints GridBagLayout Insets]
[javax.swing JButton JPanel])
(defmacro make-constraints [gridx gridy & constraints]
(let [defaults
{:gridwidth 1 :gridheight 1 :weightx 0 :weighty 0
:anchor 'GridBagConstraints/WEST :fill 'GridBagConstraints/NONE
:insets `(Insets. 5 5 5 5) :ipadx 0 :ipady 0}
values
(assoc (merge defaults (apply hash-map constraints))
:gridx gridx :gridy gridy)]
`(GridBagConstraints. ~#(map (fn [value]
(if
(or
(number? value)
(string? value)
(char? value)
(true? value)
(false? value)
(nil? value))
value
`~value))
(map values
[:gridx :gridy :gridwidth :gridheight
:weightx :weighty :anchor :fill
:insets :ipadx :ipady])))))
When I use the Insets defined in the defaults map, it gets qualified (not "symbol-captured") as (java.awt.Insets ...):
user=> (macroexpand-1 '(make-constraints 0 0 :weightx 1))
(java.awt.GridBagConstraints.
0 0 1 1 1 0
GridBagConstraints/WEST GridBagConstraints/NONE
(java.awt.Insets. 5 5 5 5) 0 0)
but when I pass it as an argument, it does not:
user=> (macroexpand-1 '(make-constraints 1 1 :insets (Insets. 2 2 2 2)))
(java.awt.GridBagConstraints.
1 1 1 1 0 0
GridBagConstraints/WEST GridBagConstraints/NONE
(Insets. 2 2 2 2) 0 0)
I'm not just trying to be a stickler. I am getting compiler errors that it cannot find a proper GridBagConstraints constructor.
I don't know GridBagLayout, but the following should basically work similar to your macro. If you have a component with a :height bigger than 1, you have to add nil in the column(s) below it to keep the column counter in sync. Say, your arrive-text-field would have a height of 2, than you'd have to add a row of nil before the depart-label row in order to keep the counters correct. It's just a quick hack.
(def default-opts
{:insets (Insets. 0 0 0 0)
:width 1
:height 1
:weight-x 0.0
:weight-y 0.0
:fill GridBagConstraints/NONE
:anchor GridBagConstraints/WEST
:ipadx 0
:ipady 0})
(defn grid-bag-constraints
[x y global-opts opts]
(let [{:keys [insets width height weight-x weight-h
fill anchor ipadx ipady]}
(merge default-opts global-opts opts)]
(GridBagConstraints. x y width height weight-x weight-h
anchor fill insets ipadx ipady)))
(defn grid-bag-container
[panel global-opts & rows]
(doseq [[row-idx row] (map-indexed identity rows)
[col-idx [target & {:as opts}]] (map-indexed identity row)
:when target]
(let [constraints (grid-bag-constraints col-idx row-idx global-opts opts)]
(.add panel target constraints))))
Usage just as before.
Here is my solution. I am using it in a Swing application that I am writing. It has already saved me many lines of code writing (for two different panels) and will be as fast as hand-written code.
(defmacro grid-bag-container [container & args]
"Fill and return a java.awt.Container that uses the GridBagLayout.
The macro defines a set of default constraints for the GridBagConstraints:
:gridwidth 1
:gridheight 1
:weightx 0
:weighty 0
:anchor :WEST
:fill :NONE
:insets (Insets. 5 5 5 5)
:ipadx 0
:ipady 0
These defaults can be overridden in the call to the macro in two way:
- If the first argument is a hash-map of constraint names and values
(e.g.: {:weightx 1}), these will override the defaults for the
entire container.
- Each individual item (see below) can override the global defaults
and container defaults for itself.
The constraints consist of constraint name (as a keyword with the same
name as the GridBagConstraints field), and a value, which can also be
a keyword, in which case the appropriate constant from GridBagConstraints
will be substituted (e.g.: :NONE == GridBagConstraints.NONE), or the value
can be an expression (e.g.: 0 or (Insets. 2 2 2 2)).
Following the optional container default overrides hash-map are one or
more row specification vectors. Each vector represents one row and
increments gridy (starting from 0). Each vector contains one or more
item vectors representing the individual components to be added to the
container. Each item vector has the component as its first value,
followed by zero or more constraint overrides as keyword-value pairs.
(e.g.: [myButton :gridwidth 2 :weightx 1]). The values may be keywords
and are expanded to GridBagConstraints constants as described above.
Each item vector gets the next value of gridx (starting with 0) in that
row.
For example:
(grid-bag-container panel
{:insets (Insets. 1 1 1 1)}
[[button :gridwidth 2 :weightx 1.0 :fill :HORIZONTAL]]
[[check-box :gridwidth 2 :weightx 1.0 :anchor :CENTER]]
[[arrive-label] [arrive-text-field :fill :HORIZONTAL]]
[[depart-label] [depart-text-field :fill :HORIZONTAL]])
will expand to the hand-written equivalent:
(doto panel
(.add button
(GridBagConstraints. 0 0 2 1 1.0 0 ; gridx: 0 gridy: 1
GridBagConstraints/WEST
GridBagConstraints/HORIZONTAL
(Insets. 1 1 1 1) 0 0))
(.add check-box
(GridBagConstraints. 0 1 2 1 1.0 0 ; gridx: 0 gridy: 1
GridBagConstraints/CENTER
GridBagConstraints/NONE
(Insets. 1 1 1 1) 0 0))
(.add arrive-label
(GridBagConstraints. 0 2 1 1 0 0 ; gridx: 0 gridy: 2
GridBagConstraints/WEST
GridBagConstraints/NONE
(Insets. 1 1 1 1) 0 0))
(.add arrive-text-field
(GridBagConstraints. 1 2 1 1 0 0 ; gridx: 1 gridy: 2
GridBagConstraints/WEST
GridBagConstraints/HORIZONTAL
(Insets. 1 1 1 1) 0 0))
(.add depart-label
(GridBagConstraints. 0 3 1 1 0 0 ; gridx: 0 gridy: 3
GridBagConstraints/WEST
GridBagConstraints/NONE
(Insets. 1 1 1 1) 0 0))
(.add depart-text-field
(GridBagConstraints. 1 3 1 1 0 0 ; gridx: 1 gridy: 3
GridBagConstraints/WEST
GridBagConstraints/HORIZONTAL
(Insets. 1 1 1 1) 0 0))
#param container the java.awt.Container to fill
#param args the components and GridBagContraints speicifcations
#returns the filled Container"
(let [global-defaults
{:gridwidth 1
:gridheight 1
:weightx 0
:weighty 0
:anchor :WEST
:fill :NONE
:insets `(Insets. 5 5 5 5)
:ipadx 0
:ipady 0}
[defaults rows]
(if (map? (first args))
[(into global-defaults (first args)) (rest args)]
[global-defaults args])]
`(doto ~container
~#(loop [gridy 0 rows rows ret []]
(if (seq rows)
(recur (inc gridy) (rest rows)
(into ret
(let [row (first rows)]
(loop [gridx 0 row row ret []]
(if (seq row)
(recur (inc gridx) (rest row)
(conj ret
(let [item
(first row)
component
(first item)
constraints
(assoc (merge defaults
(apply hash-map (rest item)))
:gridx gridx :gridy gridy)
constraint-values
(map (fn [value]
(if (keyword? value)
`(. GridBagConstraints
~(symbol (name value)))
`~value))
(map constraints
[:gridx :gridy :gridwidth :gridheight
:weightx :weighty :anchor :fill
:insets :ipadx :ipady]))]
`(.add ~component (new GridBagConstraints
~#constraint-values)))))
ret)))))
ret)))))
Thanks to amalloy, user100464, and kotarak for the help.
When I do (/ 7 2), what should I do to get the result 3? If I do (/ 7 2.0), I get 3.5, which is as expected.
(floor 7 2)
Ref: http://rosettacode.org/wiki/Basic_integer_arithmetic#Common_Lisp
See FLOOR, CEILING and TRUNCATE in ANSI Common Lisp.
Examples (see the positive and negative numbers):
CL-USER 218 > (floor -5 2)
-3
1
CL-USER 219 > (ceiling -5 2)
-2
-1
CL-USER 220 > (truncate -5 2)
-2
-1
CL-USER 221 > (floor 5 2)
2
1
CL-USER 222 > (ceiling 5 2)
3
-1
CL-USER 223 > (truncate 5 2)
2
1
Usually for division to integer TRUNCATE is used.
You can use the floor function:
(floor 7 2)
3
1
Note that it returns multiple values, and you only need the first one. Since floor returns multiple values, that can be done with multiple-value-bind as follows:
(multiple-value-bind (q r) (floor 7 2) q)
=> 3
Edit: As Rainer notes in his comment, you can just pass the result of floor as an argument if all you need is the quotient.
[1]> (floor 7 2)
3 ;
1
[2]> (+ (floor 7 2) 5)
8
[3]>
I'm leaving the reference to multiple-value-bind in the answer, since it's an important function to be familiar with.
Use the floor function. In SBCL:
* (floor (/ 7 2))
3
1/2
Two values are returned, the integer part and the fractional part.