...
 
Commits (3)
......@@ -6,7 +6,7 @@
[subrepo]
remote = gitlab@gitlab.ai.vub.ac.be:ehai/irl.git
branch = master
commit = b7ecd33fa870931104e88632ef77db3402d1437c
commit = c0e623fc1b8e8cf00e2f0c0b7d508f4d5568f83c
parent = a12cfd3d2f041569c99cea62a4accd0d78cef077
cmdver = 0.4.0
method = merge
......@@ -148,6 +148,13 @@
(when (string= v1 v2)
frame))
(defmethod find-map-function ((v1 number) (v2 number)
&optional (frame (make-map-frame))
&key (extension-test #'function-frame))
(declare (ignore extension-test))
(when (= v1 v2)
frame))
;; ############################################################################
......
......@@ -283,7 +283,6 @@ div.ipen > div > div.ipen-details:last-child { margin-bottom:-15px; }
(bad-node . "#500")
(solution . "#050")))
(defun irl-program-evaluation-node->title (node)
(cond
((eq (status node) 'initial)
......@@ -296,8 +295,7 @@ div.ipen > div > div.ipen-details:last-child { margin-bottom:-15px; }
(if (primitives-evaluated node)
(format nil "~(~a~)" (caar (primitives-evaluated node)))
(symbol-name (status node))))
(t "UNKNOWN STATUS")
))
(t "UNKNOWN STATUS")))
(defun new-binding-p (child-binding parent-node)
"Check if the value of the binding has changed between parent and child"
......@@ -305,7 +303,80 @@ div.ipen > div > div.ipen-details:last-child { margin-bottom:-15px; }
(if (typep (value child-binding) 'entity)
(not (equal-entity (value child-binding) (value parent-binding)))
(not (eql (value child-binding) (value parent-binding))))))
(defmethod make-html ((node irl-program-evaluation-node)
&key (expand/collapse-all-id (make-id 'ipen))
(expand-initially nil))
(let* ((element-id (make-id 'ipen))
(status (status node))
(node-color
(or (assqv status *irl-program-evaluation-node-status-colors*)
(error "no status color defined for status ~a" status)))
(title-div
`((div :class "ipen-title"
:style ,(mkstr "color:" node-color ";"
(cond ((member status '(initial inconsistent bad-node
no-primitives-remaining))
"font-style:italic")
((member status '(solution))
"font-weight:bold")
(t ""))))))
(title
`((span :style ,(mkstr "color:" node-color))
,(irl-program-evaluation-node->title node))))
(draw-node-with-children
(make-expandable/collapsable-element
element-id expand/collapse-all-id
;; collapsed element
`((div :class "ipen")
(,@title-div
((a ,@(make-expand/collapse-link-parameters element-id t)) ,title)))
;; expanded element
(lambda ()
(flet ((show-primitives (list title)
(if list
`((div :class "ipen-details") ,title ":  "
((br))
((div :style "display:inline-table;") ,(html-pprint list)))
"")))
(let ((expand-status-id (make-id 'ipen)))
`((div :class "ipen" :style ,(mkstr "border:1px dotted " node-color))
(,@title-div
((a ,@(make-expand/collapse-link-parameters element-id nil))
,title))
((div :style ,(mkstr "border-top:1px dotted " node-color))
((div :class "ipen-details")
,(make-expand/collapse-all-link
expand-status-id
(format nil "status: ~a" (downcase status))
"show primitives" "hide primitives"))
,(make-expandable/collapsable-element
(make-id) expand-status-id
`((div))
`((div)
,(show-primitives (primitives-evaluated node)
"evaluated primitives")
,(show-primitives (primitives-remaining node)
"remaining primitives")
,(show-primitives (primitives-evaluated-w/o-result node)
"primitives evaluated w/o result")))
((div :class "ipen-details")
((table)
,@(loop for b in (bindings node)
collect `((tr)
((td) ((div :class "binding") ,(html-pprint (var b))))
((td) ((div :class "binding")
,(if (value b)
(make-html (value b)
:expand-initially expand-initially
:expand/collapse-all-id expand/collapse-all-id)
'((div :class "unbound-value") "unbound")))))))))))))
:expand-initially expand-initially)
(loop for child in (children node)
collect (make-html child :expand/collapse-all-id expand/collapse-all-id))
:color "#aaa")))
#|
(defmethod make-html ((node irl-program-evaluation-node)
&key (expand/collapse-all-id (make-id 'ipen))
(expand-initially nil))
......@@ -340,9 +411,9 @@ div.ipen > div > div.ipen-details:last-child { margin-bottom:-15px; }
(lambda ()
(flet ((show-primitives (list title)
(if list
`((div :class "ipen-details") ,title ":  "
((div :style "display:inline-table;") ,(html-pprint list)))
"")))
`((div :class "ipen-details") ,title ":  "
((div :style "display:inline-table;") ,(html-pprint list)))
"")))
(let ((status `((span :style ,(mkstr "color:" node-color))
,(format nil "status: ~(~a~)" (status node))))
(id (make-id 'ipen))
......@@ -390,6 +461,7 @@ div.ipen > div > div.ipen-details:last-child { margin-bottom:-15px; }
(loop for child in (children node)
collect (make-html child :expand/collapse-all-id expand/collapse-all-id))
:color "#aaa")))
|#
(defmethod make-html ((tree irl-program-evaluator)
&key (expand/collapse-all-id (make-id 'ipen))
......
......@@ -6,7 +6,7 @@
[subrepo]
remote = gitlab@gitlab.ai.vub.ac.be:ehai/plot-raw-data.git
branch = master
commit = 9bc03bd55e436e79e8c6278404e5c5e59bb1e16d
commit = 3560c8031269eb0d053d54fceeef21c86ca20eff
parent = e9dc721d26aa44aa71dfdcf30a912933f8f1ded2
method = merge
cmdver = 0.4.0
......@@ -299,7 +299,7 @@ x-axis."
(if points
"with points 3"
(format nil "with lines lw ~a" line-width))
(+ 2 (mod source-number 8)) color
(+ 2 (mod source-number 8)) color
(< source-number (- (length data) 1))))
(when (member :filled error-bar-modes)
......
(in-package :plot-raw-data)
(export '(create-function-plot))
(defun create-function-plot (equations
&key
(function-definitions nil)
(title nil) (captions nil)
(plot-file-name nil)
(plot-directory nil)
(graphic-type "pdf")
(key-location "below")
(x-min 0) (x-max 1)
(y-min -1) (y-max 1)
(colors *great-gnuplot-colors*)
(draw-y1-grid t)
(x-label "Number of games played")
(y1-label nil)
(grid-line-width 0.5)
(open t) (dashed nil)
(fsize 10)
(typeface "Helvetica"))
"Plot several functions using gnuplot. This function expects a list
of function definitions (in a list of strings) specified with x as the variable
and in a format that can be handled by gnuplot (e.g. f(x)=4*x instead of f(x)=4x).
See examples in the comments below."
(let ((colors (loop for color in colors
for other-color in *great-gnuplot-colors*
collect (or color other-color)))
(captions (loop for f in equations
for i from 0
collect (or (nth i captions) f)))
(file-path (babel-pathname :name (or plot-file-name "function-plot")
:type (if (equal graphic-type "postscript") "ps" graphic-type)
:directory (or plot-directory '(".tmp")))))
(ensure-directories-exist file-path)
(with-open-stream
(stream (monitors::pipe-to-gnuplot))
(set-gnuplot-parameters stream
:output file-path :terminal graphic-type :title (or title "")
:draw-y1-grid draw-y1-grid :grid-line-width grid-line-width
:key-location key-location :x-label x-label :y1-label y1-label
:y2-label nil :y1-min y-min :y1-max y-max
:y2-min nil :y2-max nil
:dashed dashed :fsize fsize :typeface typeface)
(set-range stream "x" x-min x-max)
(format stream "~cset grid back noxtics" #\linefeed)
(format stream "~cset ytics nomirror" #\linefeed)
(format stream "~cset style fill transparent solid 0.20 border" #\linefeed)
(when function-definitions
(loop for def in function-definitions
do (format stream "~c~a" #\linefeed def)))
(loop for f in equations
do (format stream "~c~a" #\linefeed f))
(format stream "~cplot " #\linefeed)
(loop for f in equations
for source-number from 0
for function-name = (when (find #\= f)
(remove-spurious-spaces (first (split f #\=))))
for color = (nth (mod source-number (length colors)) colors)
do (format stream "~a title ~s dt ~a lc rgb ~s ~:[~;, ~]"
(or function-name f)
(nth source-number captions) ;; caption
(+ 2 (mod source-number 8)) ;; dash type
color ;; color
(< source-number (- (length equations) 1)) ;; adding , to the end or not
))
(format stream "~cexit~c" #\linefeed #\linefeed)
(finish-output stream)
;(close-pipe stream)
(when open
(sleep 0.5)
(open-file-in-os file-path)))))
;; creating two simple functions
;(create-function-plot '("f1(x)=2*x" "f2(x)=3*x"))
;; creating two functions using an additional function definition
;(create-function-plot '("normal(x,0,1)") :function-definitions '("normal(x, mu, sd) = (1/(sd*sqrt(2*pi)))*exp(-(x-mu)**2/(2*sd**2))") :x-min -3 :x-max 3 :y-min 0 :y-max nil)
;(create-function-plot '("f(x)=normal(x,0,1)") :function-definitions '("normal(x, mu, sd) = (1/(sd*sqrt(2*pi)))*exp(-(x-mu)**2/(2*sd**2))") :x-min -3 :x-max 3 :y-min 0 :y-max nil)
\ No newline at end of file
......@@ -24,4 +24,5 @@
(:file "gnuplot-utils")
(:file "evo-plots")
(:file "bar-plots")
(:file "blackboard-plots")))
(:file "blackboard-plots")
(:file "function-plots")))
......@@ -6,7 +6,7 @@
[subrepo]
remote = gitlab@gitlab.ai.vub.ac.be:ehai/utils.git
branch = master
commit = 09d2352ff278b599f28bd59b2e3512d283a27aa1
commit = 15d4224cf3a8c7597ccd7f07e170c4ed50b186c5
parent = 970fd717771177df6fd351041d3b12974fd1942c
cmdver = 0.4.0
method = merge
......@@ -270,7 +270,8 @@ nil."
collect-ignore-nils
remove-first
remove-nth
cartesian-product))
cartesian-product
group-by))
(defun insert-after (lst index newelt)
"Insert an elt into a list after a certain position."
......@@ -536,6 +537,25 @@ element for which the sought value satisfies the test"
;; (sublist-position '(c d) '(a b c d))
;; ==> 2
(defun group-by (sequence fn &key (test #'eql))
"applies fn to each elem of sequence. the elems for which fn
yields the same value are grouped together. use :test to
compare the results of applying fn to each elem."
(loop with result = nil
for elem in sequence
for key = (funcall fn elem)
if (assoc key result :test test)
do (push elem (cdr (assoc key result :test test)))
else
do (push (cons key (list elem)) result)
finally
(return result)))
;; (group-by '((3) (1 2) (1) (1 3) (2) (1 2 3) (2 3)) #'length :test #'=)
;; ==> ((3 (1 2 3))
;; (2 (2 3) (1 3) (1 2))
;; (1 (2) (1) (3)))
;; ############################################################################
;; list randomize utilities:
......