Cleanup and metadata fix
This commit is contained in:
parent
7ce624d4ba
commit
3e820407f3
@ -13,8 +13,8 @@
|
|||||||
(gp/gp
|
(gp/gp
|
||||||
(update-in
|
(update-in
|
||||||
(merge
|
(merge
|
||||||
{:instructions smallest/instructions
|
{:instructions number-io/instructions
|
||||||
:error-function smallest/error-function
|
:error-function number-io/error-function
|
||||||
:max-generations 500
|
:max-generations 500
|
||||||
:population-size 500
|
:population-size 500
|
||||||
:max-initial-plushy-size 100
|
:max-initial-plushy-size 100
|
||||||
|
@ -2,9 +2,8 @@
|
|||||||
(:require [clojure.string]
|
(:require [clojure.string]
|
||||||
[propeller.genome :as genome]
|
[propeller.genome :as genome]
|
||||||
[propeller.variation :as variation]
|
[propeller.variation :as variation]
|
||||||
[propeller.push.core :as push]
|
|
||||||
[propeller.push.instructions.bool]
|
[propeller.push.instructions.bool]
|
||||||
[propeller.push.instructions.chara]
|
[propeller.push.instructions.character]
|
||||||
[propeller.push.instructions.code]
|
[propeller.push.instructions.code]
|
||||||
[propeller.push.instructions.input-output]
|
[propeller.push.instructions.input-output]
|
||||||
[propeller.push.instructions.numeric]
|
[propeller.push.instructions.numeric]
|
||||||
@ -46,7 +45,9 @@
|
|||||||
instructions
|
instructions
|
||||||
max-initial-plushy-size)))]
|
max-initial-plushy-size)))]
|
||||||
(let [evaluated-pop (sort-by :total-error
|
(let [evaluated-pop (sort-by :total-error
|
||||||
(map (partial error-function argmap) population))
|
(#?(:clj pmap
|
||||||
|
:cljs map)
|
||||||
|
(partial error-function argmap) population))
|
||||||
best-individual (first evaluated-pop)]
|
best-individual (first evaluated-pop)]
|
||||||
(report evaluated-pop generation)
|
(report evaluated-pop generation)
|
||||||
(cond
|
(cond
|
||||||
@ -56,7 +57,8 @@
|
|||||||
(print "Checking program on test cases... ")
|
(print "Checking program on test cases... ")
|
||||||
(if (zero? (:total-error (error-function argmap best-individual :test)))
|
(if (zero? (:total-error (error-function argmap best-individual :test)))
|
||||||
(println "Test cases passed.")
|
(println "Test cases passed.")
|
||||||
(println "Test cases failed.")))
|
(println "Test cases failed."))
|
||||||
|
(#?(:clj shutdown-agents)))
|
||||||
;;
|
;;
|
||||||
(>= generation max-generations) nil
|
(>= generation max-generations) nil
|
||||||
:else (recur (inc generation)
|
:else (recur (inc generation)
|
||||||
|
@ -2,7 +2,7 @@
|
|||||||
(:require [propeller.genome :as genome]
|
(:require [propeller.genome :as genome]
|
||||||
[propeller.push.interpreter :as interpreter]
|
[propeller.push.interpreter :as interpreter]
|
||||||
[propeller.push.state :as state]
|
[propeller.push.state :as state]
|
||||||
[propeller.push.utils :refer [get-stack-instructions]]
|
[propeller.push.utils.helpers :refer [get-stack-instructions]]
|
||||||
[propeller.utils :as utils]
|
[propeller.utils :as utils]
|
||||||
[propeller.push.state :as state]
|
[propeller.push.state :as state]
|
||||||
[propeller.tools.math :as math]))
|
[propeller.tools.math :as math]))
|
||||||
|
@ -2,7 +2,7 @@
|
|||||||
(:require [propeller.genome :as genome]
|
(:require [propeller.genome :as genome]
|
||||||
[propeller.push.interpreter :as interpreter]
|
[propeller.push.interpreter :as interpreter]
|
||||||
[propeller.push.state :as state]
|
[propeller.push.state :as state]
|
||||||
[propeller.push.utils :refer [get-stack-instructions]]
|
[propeller.push.utils.helpers :refer [get-stack-instructions]]
|
||||||
[propeller.utils :as utils]
|
[propeller.utils :as utils]
|
||||||
[propeller.push.state :as state]))
|
[propeller.push.state :as state]))
|
||||||
|
|
||||||
|
@ -1,16 +1,7 @@
|
|||||||
(ns propeller.push.core)
|
(ns propeller.push.core)
|
||||||
|
|
||||||
;; =============================================================================
|
;; PushGP instructions are represented as keywords, and stored in an atom. They
|
||||||
;; PushGP Instructions
|
;; can be either constant literals or functions that take and return a Push state
|
||||||
;;
|
|
||||||
;; Instructions are represented as keywords, and stored in an atom.
|
|
||||||
;;
|
|
||||||
;; Instructions must all be either functions that take one Push state and
|
|
||||||
;; return another, or constant literals.
|
|
||||||
;;
|
|
||||||
;; TMH: ERCs?
|
|
||||||
;; =============================================================================
|
|
||||||
|
|
||||||
(def instruction-table (atom (hash-map)))
|
(def instruction-table (atom (hash-map)))
|
||||||
|
|
||||||
;; Number of blocks opened by instructions (default = 0)
|
;; Number of blocks opened by instructions (default = 0)
|
||||||
|
@ -1,8 +1,7 @@
|
|||||||
(ns propeller.push.instructions.bool
|
(ns propeller.push.instructions.bool
|
||||||
#?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction
|
(:require [propeller.push.utils.helpers :refer [make-instruction]]
|
||||||
make-instruction]]))
|
[propeller.push.utils.macros :refer [def-instruction]]))
|
||||||
(:require #?(:clj [propeller.push.utils :refer [def-instruction
|
|
||||||
make-instruction]])))
|
|
||||||
;; =============================================================================
|
;; =============================================================================
|
||||||
;; BOOLEAN Instructions
|
;; BOOLEAN Instructions
|
||||||
;; =============================================================================
|
;; =============================================================================
|
||||||
|
@ -1,10 +1,9 @@
|
|||||||
(ns propeller.push.instructions.chara
|
(ns propeller.push.instructions.character
|
||||||
#?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction
|
|
||||||
make-instruction]]))
|
|
||||||
(:require [propeller.push.state :as state]
|
(:require [propeller.push.state :as state]
|
||||||
[propeller.tools.character :as char]
|
[propeller.push.utils.helpers :refer [make-instruction]]
|
||||||
#?(:clj [propeller.push.utils :refer [def-instruction
|
[propeller.push.utils.macros :refer [def-instruction
|
||||||
make-instruction]])))
|
generate-instructions]]
|
||||||
|
[propeller.tools.character :as char]))
|
||||||
|
|
||||||
;; =============================================================================
|
;; =============================================================================
|
||||||
;; CHAR Instructions
|
;; CHAR Instructions
|
||||||
@ -62,4 +61,4 @@
|
|||||||
state
|
state
|
||||||
(let [top-string (state/peek-stack state :string)
|
(let [top-string (state/peek-stack state :string)
|
||||||
popped-state (state/pop-stack state :string)]
|
popped-state (state/pop-stack state :string)]
|
||||||
(state/push-to-stack-multiple popped-state :char (map char top-string))))))
|
(state/push-to-stack-many popped-state :char (map char top-string))))))
|
@ -1,12 +1,9 @@
|
|||||||
(ns propeller.push.instructions.code
|
(ns propeller.push.instructions.code
|
||||||
#?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction
|
|
||||||
generate-instructions
|
|
||||||
make-instruction]]))
|
|
||||||
(:require [propeller.utils :as utils]
|
(:require [propeller.utils :as utils]
|
||||||
[propeller.push.state :as state]
|
[propeller.push.state :as state]
|
||||||
#?(:clj [propeller.push.utils :refer [def-instruction
|
[propeller.push.utils.helpers :refer [make-instruction]]
|
||||||
generate-instructions
|
[propeller.push.utils.macros :refer [def-instruction
|
||||||
make-instruction]])))
|
generate-instructions]]))
|
||||||
|
|
||||||
;; =============================================================================
|
;; =============================================================================
|
||||||
;; Polymorphic Instructions
|
;; Polymorphic Instructions
|
||||||
@ -188,10 +185,10 @@
|
|||||||
(fn [state]
|
(fn [state]
|
||||||
(if (< (count (:exec state)) 3)
|
(if (< (count (:exec state)) 3)
|
||||||
state
|
state
|
||||||
(let [[a b c] (state/peek-stack-multiple state :exec 3)
|
(let [[a b c] (state/peek-stack-many state :exec 3)
|
||||||
popped-state (state/pop-stack-multiple state :exec 3)
|
popped-state (state/pop-stack-many state :exec 3)
|
||||||
to-push-back (list a c (list b c))]
|
to-push-back (list a c (list b c))]
|
||||||
(state/push-to-stack-multiple popped-state :exec to-push-back)))))
|
(state/push-to-stack-many popped-state :exec to-push-back)))))
|
||||||
|
|
||||||
;; The "Y combinator" - inserts beneath the top item of the EXEC stack a new
|
;; The "Y combinator" - inserts beneath the top item of the EXEC stack a new
|
||||||
;; item of the form "(:exec_y TOP_ITEM)"
|
;; item of the form "(:exec_y TOP_ITEM)"
|
||||||
@ -204,4 +201,4 @@
|
|||||||
(let [top-item (state/peek-stack state :exec)
|
(let [top-item (state/peek-stack state :exec)
|
||||||
popped-state (state/pop-stack state :exec)
|
popped-state (state/pop-stack state :exec)
|
||||||
to-push-back (list top-item (list :exec_y top-item))]
|
to-push-back (list top-item (list :exec_y top-item))]
|
||||||
(state/push-to-stack-multiple popped-state :exec to-push-back)))))
|
(state/push-to-stack-many popped-state :exec to-push-back)))))
|
||||||
|
@ -1,9 +1,8 @@
|
|||||||
(ns propeller.push.instructions.input-output
|
(ns propeller.push.instructions.input-output
|
||||||
#?(:cljs (:require-macros [propeller.push.utils :refer
|
|
||||||
[def-instruction generate-instructions]]))
|
|
||||||
(:require [propeller.push.state :as state]
|
(:require [propeller.push.state :as state]
|
||||||
#?(:clj [propeller.push.utils :refer [def-instruction
|
[propeller.push.utils.helpers :refer [make-instruction]]
|
||||||
generate-instructions]])))
|
[propeller.push.utils.macros :refer [def-instruction
|
||||||
|
generate-instructions]]))
|
||||||
|
|
||||||
;; =============================================================================
|
;; =============================================================================
|
||||||
;; INPUT Instructions
|
;; INPUT Instructions
|
||||||
|
@ -1,11 +1,8 @@
|
|||||||
(ns propeller.push.instructions.numeric
|
(ns propeller.push.instructions.numeric
|
||||||
#?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction
|
(:require [propeller.push.utils.helpers :refer [make-instruction]]
|
||||||
generate-instructions
|
[propeller.push.utils.macros :refer [def-instruction
|
||||||
make-instruction]]))
|
generate-instructions]]
|
||||||
(:require [propeller.tools.math :as math]
|
[propeller.tools.math :as math]))
|
||||||
#?(:clj [propeller.push.utils :refer [def-instruction
|
|
||||||
generate-instructions
|
|
||||||
make-instruction]])))
|
|
||||||
|
|
||||||
;; =============================================================================
|
;; =============================================================================
|
||||||
;; FLOAT and INTEGER Instructions (polymorphic)
|
;; FLOAT and INTEGER Instructions (polymorphic)
|
||||||
|
@ -1,16 +1,14 @@
|
|||||||
(ns propeller.push.instructions.polymorphic
|
(ns propeller.push.instructions.polymorphic
|
||||||
#?(:cljs (:require-macros [propeller.push.utils :refer [generate-instructions
|
|
||||||
make-instruction]]))
|
|
||||||
(:require [propeller.utils :as utils]
|
(:require [propeller.utils :as utils]
|
||||||
[propeller.push.state :as state]
|
[propeller.push.state :as state]
|
||||||
#?(:clj [propeller.push.utils :refer [generate-instructions
|
[propeller.push.utils.helpers :refer [make-instruction]]
|
||||||
make-instruction]])))
|
[propeller.push.utils.macros :refer [def-instruction
|
||||||
|
generate-instructions]]))
|
||||||
|
|
||||||
;; =============================================================================
|
;; =============================================================================
|
||||||
;; Polymorphic Instructions
|
;; Polymorphic Instructions
|
||||||
;;
|
;;
|
||||||
;; (for all stacks, with the exception of non-data ones like auxiliary, input,
|
;; (for all stacks, with the exception of non-data ones like input and output)
|
||||||
;; and output)
|
|
||||||
;; =============================================================================
|
;; =============================================================================
|
||||||
|
|
||||||
;; Duplicates the top item of the stack. Does not pop its argument (since that
|
;; Duplicates the top item of the stack. Does not pop its argument (since that
|
||||||
@ -41,7 +39,7 @@
|
|||||||
top-item (state/peek-stack popped-state stack)
|
top-item (state/peek-stack popped-state stack)
|
||||||
top-item-dup (take (- n 1) (repeat top-item))]
|
top-item-dup (take (- n 1) (repeat top-item))]
|
||||||
(cond
|
(cond
|
||||||
(< 0 n) (state/push-to-stack-multiple popped-state stack top-item-dup)
|
(< 0 n) (state/push-to-stack-many popped-state stack top-item-dup)
|
||||||
:else (state/pop-stack popped-state stack)))
|
:else (state/pop-stack popped-state stack)))
|
||||||
state)))
|
state)))
|
||||||
|
|
||||||
@ -56,7 +54,7 @@
|
|||||||
(let [n (state/peek-stack state :integer)
|
(let [n (state/peek-stack state :integer)
|
||||||
popped-state (state/pop-stack state :integer)
|
popped-state (state/pop-stack state :integer)
|
||||||
top-items (take n (get popped-state stack))]
|
top-items (take n (get popped-state stack))]
|
||||||
(state/push-to-stack-multiple popped-state stack top-items)))))
|
(state/push-to-stack-many popped-state stack top-items)))))
|
||||||
|
|
||||||
;; Pushes TRUE onto the BOOLEAN stack if the stack is empty. Otherwise FALSE
|
;; Pushes TRUE onto the BOOLEAN stack if the stack is empty. Otherwise FALSE
|
||||||
(def _empty
|
(def _empty
|
||||||
@ -89,10 +87,10 @@
|
|||||||
^{:stacks #{}}
|
^{:stacks #{}}
|
||||||
(fn [stack state]
|
(fn [stack state]
|
||||||
(if (<= 3 (count (get state stack)))
|
(if (<= 3 (count (get state stack)))
|
||||||
(let [top-three (state/peek-stack-multiple state stack 3)
|
(let [top-three (state/peek-stack-many state stack 3)
|
||||||
popped-state (state/pop-stack-multiple state stack 3)
|
popped-state (state/pop-stack-many state stack 3)
|
||||||
top-three-rot (take 3 (conj top-three (last top-three)))]
|
top-three-rot (take 3 (conj top-three (last top-three)))]
|
||||||
(state/push-to-stack-multiple popped-state stack top-three-rot))
|
(state/push-to-stack-many popped-state stack top-three-rot))
|
||||||
state)))
|
state)))
|
||||||
|
|
||||||
;; Inserts the top item deeper into the stack, using the top INTEGER to
|
;; Inserts the top item deeper into the stack, using the top INTEGER to
|
||||||
@ -127,9 +125,9 @@
|
|||||||
^{:stacks #{}}
|
^{:stacks #{}}
|
||||||
(fn [stack state]
|
(fn [stack state]
|
||||||
(if (<= 2 (count (get state stack)))
|
(if (<= 2 (count (get state stack)))
|
||||||
(let [top-two (state/peek-stack-multiple state stack 2)
|
(let [top-two (state/peek-stack-many state stack 2)
|
||||||
popped-state (state/pop-stack-multiple state stack 2)]
|
popped-state (state/pop-stack-many state stack 2)]
|
||||||
(state/push-to-stack-multiple popped-state stack (reverse top-two)))
|
(state/push-to-stack-many popped-state stack (reverse top-two)))
|
||||||
state)))
|
state)))
|
||||||
|
|
||||||
;; Pushes an indexed item from deep in the stack, removing it. The top INTEGER
|
;; Pushes an indexed item from deep in the stack, removing it. The top INTEGER
|
||||||
|
@ -1,5 +1,7 @@
|
|||||||
(ns propeller.push.instructions.random
|
(ns propeller.push.instructions.random
|
||||||
#?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction]]))
|
(:require [propeller.push.state :as state]
|
||||||
#?(:clj (:require [propeller.push.utils :refer [def-instruction]])))
|
[propeller.push.utils.helpers :refer [make-instruction]]
|
||||||
|
[propeller.push.utils.macros :refer [def-instruction
|
||||||
|
generate-instructions]]))
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,9 +1,6 @@
|
|||||||
(ns propeller.push.instructions.string
|
(ns propeller.push.instructions.string
|
||||||
#?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction
|
(:require [propeller.push.utils.helpers :refer [make-instruction]]
|
||||||
make-instruction]]))
|
[propeller.push.utils.macros :refer [def-instruction]]))
|
||||||
|
|
||||||
(:require #?(:clj [propeller.push.utils :refer [def-instruction
|
|
||||||
make-instruction]])))
|
|
||||||
|
|
||||||
;; =============================================================================
|
;; =============================================================================
|
||||||
;; STRING Instructions
|
;; STRING Instructions
|
||||||
|
@ -1,16 +1,15 @@
|
|||||||
(ns propeller.push.instructions.vector
|
(ns propeller.push.instructions.vector
|
||||||
#?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction
|
|
||||||
generate-instructions
|
|
||||||
make-instruction]]))
|
|
||||||
(:require [clojure.string]
|
(:require [clojure.string]
|
||||||
[propeller.utils :as utils]
|
[propeller.utils :as utils]
|
||||||
[propeller.push.state :as state]
|
[propeller.push.state :as state]
|
||||||
#?(:clj [propeller.push.utils :refer [def-instruction
|
[propeller.push.utils.helpers :refer [get-vector-literal-type
|
||||||
generate-instructions
|
make-instruction]]
|
||||||
make-instruction]])))
|
[propeller.push.utils.macros :refer [generate-instructions]]))
|
||||||
|
|
||||||
;; =============================================================================
|
;; =============================================================================
|
||||||
;; VECTOR Instructions
|
;; VECTOR Instructions
|
||||||
|
;;
|
||||||
|
;; (common for all vector element subtypes: BOOLEAN, FLOAT, INTEGER, and STRING)
|
||||||
;; =============================================================================
|
;; =============================================================================
|
||||||
|
|
||||||
;; Pushes the butlast of the top item
|
;; Pushes the butlast of the top item
|
||||||
@ -28,9 +27,9 @@
|
|||||||
;; Conj's the top item of the appropriately-typed literal stack onto the vector
|
;; Conj's the top item of the appropriately-typed literal stack onto the vector
|
||||||
;; stack (e.g. pop the top INTEGER and conj it onto the top VECTOR_INTEGER)
|
;; stack (e.g. pop the top INTEGER and conj it onto the top VECTOR_INTEGER)
|
||||||
(def _conj
|
(def _conj
|
||||||
^{:stacks #{}}
|
^{:stacks #{:elem}}
|
||||||
(fn [stack state]
|
(fn [stack state]
|
||||||
(let [lit-stack (utils/get-vector-literal-type stack)]
|
(let [lit-stack (get-vector-literal-type stack)]
|
||||||
(make-instruction state #(conj %2 %1) [lit-stack stack] stack))))
|
(make-instruction state #(conj %2 %1) [lit-stack stack] stack))))
|
||||||
|
|
||||||
;; Pushes TRUE onto the BOOLEAN stack if the top element of the vector stack
|
;; Pushes TRUE onto the BOOLEAN stack if the top element of the vector stack
|
||||||
@ -39,7 +38,7 @@
|
|||||||
(def _contains
|
(def _contains
|
||||||
^{:stacks #{:boolean}}
|
^{:stacks #{:boolean}}
|
||||||
(fn [stack state]
|
(fn [stack state]
|
||||||
(let [lit-stack (utils/get-vector-literal-type stack)]
|
(let [lit-stack (get-vector-literal-type stack)]
|
||||||
(make-instruction state #(contains? (set %2) %1) [lit-stack stack] :boolean))))
|
(make-instruction state #(contains? (set %2) %1) [lit-stack stack] :boolean))))
|
||||||
|
|
||||||
;; Pushes TRUE onto the BOOLEAN stack if the top element is an empty vector.
|
;; Pushes TRUE onto the BOOLEAN stack if the top element is an empty vector.
|
||||||
@ -52,25 +51,25 @@
|
|||||||
;; Pushes the first item of the top element of the vector stack onto the
|
;; Pushes the first item of the top element of the vector stack onto the
|
||||||
;; approrpiately-typed literal stack
|
;; approrpiately-typed literal stack
|
||||||
(def _first
|
(def _first
|
||||||
^{:stacks #{}}
|
^{:stacks #{:elem}}
|
||||||
(fn [stack state]
|
(fn [stack state]
|
||||||
(let [lit-stack (utils/get-vector-literal-type stack)]
|
(let [lit-stack (get-vector-literal-type stack)]
|
||||||
(make-instruction state first [stack] lit-stack))))
|
(make-instruction state first [stack] lit-stack))))
|
||||||
|
|
||||||
;; Pushes onto the INTEGER stack the index of the top element of the
|
;; Pushes onto the INTEGER stack the index of the top element of the
|
||||||
;; appropriately-typed literal stack within the top element of the vector stack
|
;; appropriately-typed literal stack within the top element of the vector stack
|
||||||
(def _indexof
|
(def _indexof
|
||||||
^{:stacks #{:integer}}
|
^{:stacks #{:elem :integer}}
|
||||||
(fn [stack state]
|
(fn [stack state]
|
||||||
(let [lit-stack (utils/get-vector-literal-type stack)]
|
(let [lit-stack (get-vector-literal-type stack)]
|
||||||
(make-instruction state #(utils/indexof %1 %2) [lit-stack stack] :integer))))
|
(make-instruction state #(utils/indexof %1 %2) [lit-stack stack] :integer))))
|
||||||
|
|
||||||
;; Pushes the last item of the top element of the vector stack onto the
|
;; Pushes the last item of the top element of the vector stack onto the
|
||||||
;; approrpiately-typed literal stack
|
;; approrpiately-typed literal stack
|
||||||
(def _last
|
(def _last
|
||||||
^{:stacks #{}}
|
^{:stacks #{:elem}}
|
||||||
(fn [stack state]
|
(fn [stack state]
|
||||||
(let [lit-stack (utils/get-vector-literal-type stack)]
|
(let [lit-stack (get-vector-literal-type stack)]
|
||||||
(make-instruction state last [stack] lit-stack))))
|
(make-instruction state last [stack] lit-stack))))
|
||||||
|
|
||||||
;; Pushes the length of the top item onto the INTEGER stack
|
;; Pushes the length of the top item onto the INTEGER stack
|
||||||
@ -83,9 +82,9 @@
|
|||||||
;; approrpiately-typed literal stack, where N is taken from the INTEGER stack.
|
;; approrpiately-typed literal stack, where N is taken from the INTEGER stack.
|
||||||
;; To insure the index is within bounds, N is taken mod the vector length
|
;; To insure the index is within bounds, N is taken mod the vector length
|
||||||
(def _nth
|
(def _nth
|
||||||
^{:stacks #{:integer}}
|
^{:stacks #{:elem :integer}}
|
||||||
(fn [stack state]
|
(fn [stack state]
|
||||||
(let [lit-stack (utils/get-vector-literal-type stack)]
|
(let [lit-stack (get-vector-literal-type stack)]
|
||||||
(make-instruction state
|
(make-instruction state
|
||||||
#(get %2 (mod %1 (count %2)))
|
#(get %2 (mod %1 (count %2)))
|
||||||
[:integer stack]
|
[:integer stack]
|
||||||
@ -95,9 +94,9 @@
|
|||||||
;; the appropriately-typed literal stack within the top element of the vector
|
;; the appropriately-typed literal stack within the top element of the vector
|
||||||
;; stack
|
;; stack
|
||||||
(def _occurrencesof
|
(def _occurrencesof
|
||||||
^{:stacks #{:integer}}
|
^{:stacks #{:elem :integer}}
|
||||||
(fn [stack state]
|
(fn [stack state]
|
||||||
(let [lit-stack (utils/get-vector-literal-type stack)]
|
(let [lit-stack (get-vector-literal-type stack)]
|
||||||
(make-instruction state
|
(make-instruction state
|
||||||
(fn [lit vect] (count (filter #(= lit %) vect)))
|
(fn [lit vect] (count (filter #(= lit %) vect)))
|
||||||
[lit-stack stack]
|
[lit-stack stack]
|
||||||
@ -105,21 +104,21 @@
|
|||||||
|
|
||||||
;; Pushes every item of the top element onto the appropriately-typed stack
|
;; Pushes every item of the top element onto the appropriately-typed stack
|
||||||
(def _pushall
|
(def _pushall
|
||||||
^{:stacks #{}}
|
^{:stacks #{:elem}}
|
||||||
(fn [stack state]
|
(fn [stack state]
|
||||||
(if (state/empty-stack? state stack)
|
(if (state/empty-stack? state stack)
|
||||||
state
|
state
|
||||||
(let [lit-stack (utils/get-vector-literal-type stack)
|
(let [lit-stack (get-vector-literal-type stack)
|
||||||
top-vector (state/peek-stack state stack)
|
top-vector (state/peek-stack state stack)
|
||||||
popped-state (state/pop-stack state stack)]
|
popped-state (state/pop-stack state stack)]
|
||||||
(state/push-to-stack-multiple popped-state lit-stack top-vector)))))
|
(state/push-to-stack-many popped-state lit-stack top-vector)))))
|
||||||
|
|
||||||
;; Removes all occurrences of the top element of the appropriately-typed literal
|
;; Removes all occurrences of the top element of the appropriately-typed literal
|
||||||
;; stack from the first element of the vector stack
|
;; stack from the first element of the vector stack
|
||||||
(def _remove
|
(def _remove
|
||||||
^{:stacks #{}}
|
^{:stacks #{:elem}}
|
||||||
(fn [stack state]
|
(fn [stack state]
|
||||||
(let [lit-stack (utils/get-vector-literal-type stack)]
|
(let [lit-stack (get-vector-literal-type stack)]
|
||||||
(make-instruction state
|
(make-instruction state
|
||||||
(fn [lit vect] (vec (filter #(not= lit %) vect)))
|
(fn [lit vect] (vec (filter #(not= lit %) vect)))
|
||||||
[lit-stack stack]
|
[lit-stack stack]
|
||||||
@ -129,9 +128,9 @@
|
|||||||
;; literal stack with the top element of the appropriately-typed literal stack
|
;; literal stack with the top element of the appropriately-typed literal stack
|
||||||
;; within the top item of the vector stack
|
;; within the top item of the vector stack
|
||||||
(def _replace
|
(def _replace
|
||||||
^{:stacks #{}}
|
^{:stacks #{:elem}}
|
||||||
(fn [stack state]
|
(fn [stack state]
|
||||||
(let [lit-stack (utils/get-vector-literal-type stack)]
|
(let [lit-stack (get-vector-literal-type stack)]
|
||||||
(make-instruction state
|
(make-instruction state
|
||||||
(fn [lit1 lit2 vect]
|
(fn [lit1 lit2 vect]
|
||||||
(replace {lit1 lit2} vect))
|
(replace {lit1 lit2} vect))
|
||||||
@ -142,9 +141,9 @@
|
|||||||
;; literal stack with the top element of the appropriately-typed literal stack
|
;; literal stack with the top element of the appropriately-typed literal stack
|
||||||
;; within the top item of the vector stack
|
;; within the top item of the vector stack
|
||||||
(def _replacefirst
|
(def _replacefirst
|
||||||
^{:stacks #{}}
|
^{:stacks #{:elem}}
|
||||||
(fn [stack state]
|
(fn [stack state]
|
||||||
(let [lit-stack (utils/get-vector-literal-type stack)]
|
(let [lit-stack (get-vector-literal-type stack)]
|
||||||
(make-instruction state
|
(make-instruction state
|
||||||
(fn [lit1 lit2 vect]
|
(fn [lit1 lit2 vect]
|
||||||
(assoc vect (utils/indexof lit1 vect) lit2))
|
(assoc vect (utils/indexof lit1 vect) lit2))
|
||||||
@ -167,9 +166,9 @@
|
|||||||
;; with the top item from the appropriately-typed literal stack. To insure the
|
;; with the top item from the appropriately-typed literal stack. To insure the
|
||||||
;; index is within bounds, N is taken mod the vector length
|
;; index is within bounds, N is taken mod the vector length
|
||||||
(def _set
|
(def _set
|
||||||
^{:stacks #{:integer}}
|
^{:stacks #{:elem :integer}}
|
||||||
(fn [stack state]
|
(fn [stack state]
|
||||||
(let [lit-stack (utils/get-vector-literal-type stack)]
|
(let [lit-stack (get-vector-literal-type stack)]
|
||||||
(make-instruction state
|
(make-instruction state
|
||||||
(fn [lit n vect]
|
(fn [lit n vect]
|
||||||
(assoc vect (mod n (count vect)) lit))
|
(assoc vect (mod n (count vect)) lit))
|
||||||
@ -202,6 +201,3 @@
|
|||||||
[_butlast _concat _conj _contains _emptyvector _first _indexof _last
|
[_butlast _concat _conj _contains _emptyvector _first _indexof _last
|
||||||
_length _nth _occurrencesof _pushall _remove _replace _replacefirst
|
_length _nth _occurrencesof _pushall _remove _replace _replacefirst
|
||||||
_rest _reverse _set _subvec _take])
|
_rest _reverse _set _subvec _take])
|
||||||
|
|
||||||
;; Manually add extra metadata for _conj
|
|
||||||
|
|
||||||
|
@ -1,8 +1,8 @@
|
|||||||
(ns propeller.push.interpreter
|
(ns propeller.push.interpreter
|
||||||
(:require [propeller.push.core :as push]
|
(:require [propeller.push.core :as push]
|
||||||
[propeller.push.state :as state]
|
[propeller.push.state :as state]
|
||||||
[propeller.push.utils :refer [get-literal-type]]
|
[propeller.push.instructions.input-output :as io]
|
||||||
[propeller.push.instructions.input-output :as io]))
|
[propeller.push.utils.helpers :refer [get-literal-type]]))
|
||||||
|
|
||||||
(defn interpret-one-step
|
(defn interpret-one-step
|
||||||
"Takes a Push state and executes the next instruction on the exec stack."
|
"Takes a Push state and executes the next instruction on the exec stack."
|
||||||
|
@ -1,8 +1,7 @@
|
|||||||
(ns propeller.push.state)
|
(ns propeller.push.state)
|
||||||
|
|
||||||
;; Empty push state - all available stacks are empty
|
;; Empty push state - all available stacks are empty
|
||||||
(defonce empty-state {:auxiliary '()
|
(defonce empty-state {:boolean '()
|
||||||
:boolean '()
|
|
||||||
:char '()
|
:char '()
|
||||||
:code '()
|
:code '()
|
||||||
:exec '()
|
:exec '()
|
||||||
@ -16,71 +15,61 @@
|
|||||||
:vector_integer '()
|
:vector_integer '()
|
||||||
:vector_string '()})
|
:vector_string '()})
|
||||||
|
|
||||||
(def example-push-state
|
;; All stack types available in a Push state
|
||||||
{:exec '()
|
(defonce stacks (set (keys empty-state)))
|
||||||
:integer '(1 2 3 4 5 6 7)
|
|
||||||
:string '("abc")
|
|
||||||
:input {:in1 4}})
|
|
||||||
|
|
||||||
|
;; All vector stack types available in a Push state, with their corresponding
|
||||||
|
;; element types
|
||||||
|
(defonce vec-stacks {:vector_boolean :boolean
|
||||||
|
:vector_float :float
|
||||||
|
:vector_integer :integer
|
||||||
|
:vector_string :string})
|
||||||
|
|
||||||
|
(def example-state {:exec '()
|
||||||
|
:integer '(1 2 3 4 5 6 7)
|
||||||
|
:string '("abc")
|
||||||
|
:input {:in1 4}})
|
||||||
|
|
||||||
|
;; Returns true if the stack is empty
|
||||||
(defn empty-stack?
|
(defn empty-stack?
|
||||||
"Returns true if the stack is empty."
|
|
||||||
[state stack]
|
[state stack]
|
||||||
(empty? (get state stack)))
|
(empty? (get state stack)))
|
||||||
|
|
||||||
|
;; Returns the top item on the stack
|
||||||
(defn peek-stack
|
(defn peek-stack
|
||||||
"Returns the top item on a stack."
|
|
||||||
[state stack]
|
[state stack]
|
||||||
(let [working-stack (get state stack)]
|
(if-let [top-item (first (get state stack))]
|
||||||
(if (empty? working-stack)
|
top-item
|
||||||
:no-stack-item
|
:no-stack-item))
|
||||||
(first working-stack))))
|
|
||||||
|
|
||||||
(defn peek-stack-multiple
|
;; Returns the top n items on the stack, as a chunk. If there are less than n
|
||||||
"Returns the top n items on a stack. If there are less than n items on the
|
;; items on the stack, returns the entire stack
|
||||||
stack, returns the entire stack."
|
(defn peek-stack-many
|
||||||
[state stack n]
|
[state stack n]
|
||||||
(take n (get state stack)))
|
(take n (get state stack)))
|
||||||
|
|
||||||
|
;; Removes the top item of stack
|
||||||
(defn pop-stack
|
(defn pop-stack
|
||||||
"Removes the top item of stack."
|
|
||||||
[state stack]
|
[state stack]
|
||||||
(update state stack rest))
|
(update state stack rest))
|
||||||
|
|
||||||
(defn pop-stack-multiple
|
;; Pops the top n items of the stack. If there are less than n items on the
|
||||||
"Removes the top n items of a stack. If there are less than n items on the
|
;; stack, pops the entire stack
|
||||||
stack, pops the entire stack."
|
(defn pop-stack-many
|
||||||
[state stack n]
|
[state stack n]
|
||||||
(update state stack #(drop n %)))
|
(update state stack #(drop n %)))
|
||||||
|
|
||||||
|
;; Pushes an item onto the stack
|
||||||
(defn push-to-stack
|
(defn push-to-stack
|
||||||
"Pushes an item onto a stack."
|
|
||||||
[state stack item]
|
[state stack item]
|
||||||
(if (nil? item)
|
(if (nil? item)
|
||||||
state
|
state
|
||||||
(update state stack conj item)))
|
(update state stack conj item)))
|
||||||
|
|
||||||
(defn push-to-stack-multiple
|
;; Pushes a collection of items onto the stack, as a chunk (i.e. leaving them in
|
||||||
"Pushes a list of items onto a stack, leaving them in the order they are in."
|
;; the order they are in)
|
||||||
|
(defn push-to-stack-many
|
||||||
[state stack items]
|
[state stack items]
|
||||||
(let [items-list (if (coll? items) items (list items))
|
(let [items (if (coll? items) items (list items))
|
||||||
items-list-no-nil (filter #(not (nil? %)) items-list)]
|
items-no-nil (filter #(not (nil? %)) items)]
|
||||||
(update state stack into (reverse items-list-no-nil))))
|
(update state stack into (reverse items-no-nil))))
|
||||||
|
|
||||||
(defn get-args-from-stacks
|
|
||||||
"Takes a state and a collection of stacks to take args from. If there are
|
|
||||||
enough args on each of the desired stacks, returns a map with keys
|
|
||||||
{:state :args}, where :state is the new state and :args is a list of args
|
|
||||||
popped from the stacks. If there aren't enough args on the stacks, returns
|
|
||||||
:not-enough-args without popping anything."
|
|
||||||
[state stacks]
|
|
||||||
(loop [state state
|
|
||||||
stacks (reverse stacks)
|
|
||||||
args '()]
|
|
||||||
(if (empty? stacks)
|
|
||||||
{:state state :args args}
|
|
||||||
(let [current-stack (first stacks)]
|
|
||||||
(if (empty-stack? state current-stack)
|
|
||||||
:not-enough-args
|
|
||||||
(recur (pop-stack state current-stack)
|
|
||||||
(rest stacks)
|
|
||||||
(conj args (peek-stack state current-stack))))))))
|
|
||||||
|
@ -1,11 +1,26 @@
|
|||||||
(ns propeller.push.utils
|
(ns propeller.push.utils.helpers
|
||||||
(:require [clojure.set]
|
(:require [clojure.set]
|
||||||
[propeller.push.core :as push]
|
[propeller.push.core :as push]
|
||||||
[propeller.push.state :as state]))
|
[propeller.push.state :as state]))
|
||||||
|
|
||||||
(defmacro def-instruction
|
;; Takes a state and a collection of stacks to take args from. If there are
|
||||||
[instruction definition]
|
;; enough args on each of the desired stacks, returns a map with keys
|
||||||
`(swap! push/instruction-table assoc '~instruction ~definition))
|
;; {:state :args}, where :state is the new state and :args is a list of args
|
||||||
|
;; popped from the stacks. If there aren't enough args on the stacks, returns
|
||||||
|
;; :not-enough-args without popping anything
|
||||||
|
(defn get-args-from-stacks
|
||||||
|
[state stacks]
|
||||||
|
(loop [state state
|
||||||
|
stacks (reverse stacks)
|
||||||
|
args '()]
|
||||||
|
(if (empty? stacks)
|
||||||
|
{:state state :args args}
|
||||||
|
(let [current-stack (first stacks)]
|
||||||
|
(if (state/empty-stack? state current-stack)
|
||||||
|
:not-enough-args
|
||||||
|
(recur (state/pop-stack state current-stack)
|
||||||
|
(rest stacks)
|
||||||
|
(conj args (state/peek-stack state current-stack))))))))
|
||||||
|
|
||||||
;; A utility function for making Push instructions. Takes a state, a function
|
;; A utility function for making Push instructions. Takes a state, a function
|
||||||
;; to apply to the args, the stacks to take the args from, and the stack to
|
;; to apply to the args, the stacks to take the args from, and the stack to
|
||||||
@ -13,29 +28,15 @@
|
|||||||
;; given stacks), and pushes the result onto the return-stack
|
;; given stacks), and pushes the result onto the return-stack
|
||||||
(defn make-instruction
|
(defn make-instruction
|
||||||
[state function arg-stacks return-stack]
|
[state function arg-stacks return-stack]
|
||||||
(let [popped-args (state/get-args-from-stacks state arg-stacks)]
|
(let [popped-args (get-args-from-stacks state arg-stacks)]
|
||||||
(if (= popped-args :not-enough-args)
|
(if (= popped-args :not-enough-args)
|
||||||
state
|
state
|
||||||
(let [result (apply function (:args popped-args))
|
(let [result (apply function (:args popped-args))
|
||||||
new-state (:state popped-args)]
|
new-state (:state popped-args)]
|
||||||
(state/push-to-stack new-state return-stack result)))))
|
(state/push-to-stack new-state return-stack result)))))
|
||||||
|
|
||||||
;; Given a sequence of stacks, e.g. [:float :integer], and a sequence of suffix
|
|
||||||
;; function strings, e.g. [_add, _mult, _eq], automates the generation of all
|
|
||||||
;; possible combination instructions, which here would be :float_add, :float_mult,
|
|
||||||
;; :float_eq, :integer_add, :integer_mult, and :integer_eq, also transferring
|
|
||||||
;; and updating the generic function's stack-type metadata
|
|
||||||
(defmacro generate-instructions [stacks functions]
|
|
||||||
`(do ~@(for [stack stacks
|
|
||||||
func functions
|
|
||||||
:let [instruction-name (keyword (str (name stack) func))
|
|
||||||
metadata `(update-in (meta ~func) [:stacks] #(conj % ~stack))
|
|
||||||
new-func `(with-meta (partial ~func ~stack) ~metadata)]]
|
|
||||||
`(def-instruction ~instruction-name ~new-func))))
|
|
||||||
|
|
||||||
;; Given a set of stacks, returns all instructions that operate on those stacks
|
;; Given a set of stacks, returns all instructions that operate on those stacks
|
||||||
;; only. This won't include random or parenthesis-altering instructions unless
|
;; only. Won't include random instructions unless :random is in the set as well
|
||||||
;; :random or :parentheses respectively are in the stacks set
|
|
||||||
(defn get-stack-instructions
|
(defn get-stack-instructions
|
||||||
[stacks]
|
[stacks]
|
||||||
(doseq [[instruction-name function] @push/instruction-table]
|
(doseq [[instruction-name function] @push/instruction-table]
|
||||||
@ -70,7 +71,12 @@
|
|||||||
:when (function data)]
|
:when (function data)]
|
||||||
stack))))
|
stack))))
|
||||||
|
|
||||||
;; Pretty-prints a Push state, for logging or debugging purposes
|
(defn get-vector-literal-type
|
||||||
|
"Returns the literal stack corresponding to some vector stack."
|
||||||
|
[vector-stack]
|
||||||
|
(get state/vec-stacks vector-stack))
|
||||||
|
|
||||||
|
;; Pretty-print a Push state, for logging or debugging purposes
|
||||||
(defn print-state
|
(defn print-state
|
||||||
[state]
|
[state]
|
||||||
(doseq [stack (keys state/empty-state)]
|
(doseq [stack (keys state/empty-state)]
|
31
src/propeller/push/utils/macros.cljc
Normal file
31
src/propeller/push/utils/macros.cljc
Normal file
@ -0,0 +1,31 @@
|
|||||||
|
(ns propeller.push.utils.macros
|
||||||
|
(:require [propeller.push.core :as push]
|
||||||
|
[propeller.push.state :as state]
|
||||||
|
[propeller.push.utils.helpers :refer [get-vector-literal-type]]))
|
||||||
|
|
||||||
|
;; Defines a Push instruction as a keyword-function pair, and adds it to the
|
||||||
|
;; instruction table
|
||||||
|
(defmacro def-instruction
|
||||||
|
[instruction definition]
|
||||||
|
`(swap! push/instruction-table assoc '~instruction ~definition))
|
||||||
|
|
||||||
|
;; Given a sequence of stacks, e.g. [:float :integer], and a sequence of suffix
|
||||||
|
;; function strings, e.g. [_add, _mult, _eq], automates the generation of all
|
||||||
|
;; possible combination instructions, which here would be :float_add, :float_mult,
|
||||||
|
;; :float_eq, :integer_add, :integer_mult, and :integer_eq, also transferring
|
||||||
|
;; and updating the generic function's stack-type metadata. For some vector
|
||||||
|
;; instructions, the placeholder :elem will be replaced with the stack of the
|
||||||
|
;; corresponding element type (e.g. for :vector_integer, with :integer)
|
||||||
|
(defmacro generate-instructions [stacks functions]
|
||||||
|
`(do ~@(for [stack stacks
|
||||||
|
func functions
|
||||||
|
:let [instruction-name (keyword (str (name stack) func))
|
||||||
|
old-stack-data `(:stacks (meta ~func))
|
||||||
|
vec-stack-data `(set
|
||||||
|
(replace
|
||||||
|
{:elem (get-vector-literal-type ~stack)}
|
||||||
|
~old-stack-data))
|
||||||
|
new-stack-data `(conj ~vec-stack-data ~stack)
|
||||||
|
metadata `(assoc-in (meta ~func) [:stacks] ~new-stack-data)
|
||||||
|
new-func `(with-meta (partial ~func ~stack) ~metadata)]]
|
||||||
|
`(def-instruction ~instruction-name ~new-func))))
|
@ -1,10 +1,5 @@
|
|||||||
(ns propeller.utils)
|
(ns propeller.utils)
|
||||||
|
|
||||||
(defn get-vector-literal-type
|
|
||||||
"Returns the literal stack corresponding to some vector stack."
|
|
||||||
[vector-stack]
|
|
||||||
(keyword (clojure.string/replace (str vector-stack) ":vector_" "")))
|
|
||||||
|
|
||||||
(defn indexof
|
(defn indexof
|
||||||
"Returns the first index of an element in a collection. If the element is not
|
"Returns the first index of an element in a collection. If the element is not
|
||||||
present in the collection, returns -1."
|
present in the collection, returns -1."
|
||||||
|
Loading…
x
Reference in New Issue
Block a user