Aggregating Facts in the CLIPS Expert System to Find a Maximum - expert-system

I'm trying to clarify my understanding of semantics in the Clips expert system, so I'm trying to write some simple rules to aggregate a list of facts to find the fact with the highest slot value. The metaphor I'm using is that of a simple agent trying to decide whether it should eat or sleep. Facts describing the agent's states are expanded into potential actions, and then a rule tries to find the final action with the highest utility.
This is my code:
(clear)
(deftemplate state
(slot name)
(slot level (type NUMBER))
)
(deftemplate action
(slot name)
(slot utility (type NUMBER))
(slot final (type INTEGER) (default 0))
)
(defrule eat-when-hungry ""
(state (name hungry) (level ?level))
=>
(assert (action (name eat) (utility ?level)))
)
(defrule sleep-when-sleepy ""
(state (name sleepy) (level ?level))
=>
(assert (action (name sleep) (utility ?level)))
)
(defrule find-final-action ""
?current_final <- (action (name ?current_final_action) (utility ?
current_final_utility) (final 1))
(action (name ?other_action) (utility ?other_utility) (final 0))
(neq ?current_final_action ?other_action)
(< ?current_final_action ?other_action)
=>
(modify ?current_final (name ?other_action) (utility ?
other_utility))
)
(assert (action (name none) (utility 0.0) (final 1)))
(assert (state (name hungry) (level 0.5)))
(assert (state (name sleepy) (level 0.1)))
(run)
(facts)
After running this, I would expect the final action to be:
(action (name eat) (utility 0.5) (final 1))
However, Clips evaluates it to:
(action (name none) (utility 0.0) (final 1))
indicating the find-final-action rule never activates. Why is this? How would you iterate over a group of facts and find the one with the min/max slot value?

Your rule had a couple of errors in it. Here is the corrected version:
(defrule find-final-action ""
?current_final <- (action (name ?current_final_action)
(utility ?current_final_utility) (final 1))
(action (name ?other_action) (utility ?other_utility) (final 0))
(test (neq ?current_final_action ?other_action))
(test (< ?current_final_utility ?other_utility))
=>
(modify ?current_final (name ?other_action) (utility ?other_utility)))
An alternate method which does not require storing intermediate computations and multiple rule firings is this:
(defrule find-final-action-2 ""
(declare (salience -10)) ; lower salience to allow all actions to be asserted first
(action (name ?action) (utility ?utility))
(not (action (utility ?other_utility&:(> ?other_utility ?utility))))
=>
(printout t "Final action is " ?action crlf))

Related

Petri net encoding into PDDL

I am a beginner in PDDL. I am trying to write a domain file for Petri net with a fire transaction function.
(define (domain newpetri)
(:requirements :strips :typing :fluents)
(:types place transition)
(:predicates
(incoming ?p - place ?t - transition)
(outgoing ?t - transition ?p - place)
)
(:functions
(number-of-tokens ?p)
)
(:action fire-transition
:parameters (?t - transition)
:preconditions
(forall
(?p - place)
(or (not (incoming ?p ?t))
(> (number-of-tokens ?p) 0)))
:effects
(forall
(?p - place)
(when
(incoming ?p ?t)
(decrease (number-of-tokens ?p))))
(forall
(?p - place)
(when
(outgoing ?t ?p)
(increase (number-of-tokens ?p))))
)
it gives me an error in the following part:
(forall
(?p - place)
(or (not (incoming ?p ?t))
(> (number-of-tokens ?p) 0)))
should I define the place and the transition in predicate??
Thanks.
I already wrote a domain and problem
(define (domain petri)
(:requirements :strips :typing :fluents)
(:types
token place
)
(:predicates
(at ?v - token ?p - place)
(connected ?v - token ?p1 ?p2 - place)
)
(:functions
(initial-token ?v - token)
(required-token ?p1 ?p2 - place)
(total-tokens-used)
)
(:action move
:parameters (?v - token ?from ?to - place)
:precondition (and (at ?v ?from)
(connected ?v ?from ?to)
(>= (initial-token ?v) (required-token ?from ?to)))
:effect (and (not (at ?v ?from))
(at ?v ?to)
(decrease
(initial-token ?v)
(required-token ?from ?to))
(increase
(total-tokens-used)
(required-token ?from ?to))
)
)
)
--------------------------------------------------
(define (problem petriproblem)
(:domain petri)
(:objects
token - token
spring summer fall winter - place
)
(:init
(at token spring)
(= (initial-token token) 3)
(connected token spring summer)
(connected token summer fall)
(connected token fall winter)
(connected token winter spring)
(= (required-token spring summer) 1)
(= (required-token summer fall) 1)
(= (required-token fall winter) 1)
(= (total-tokens-used) 0)
)
(:goal
(at token winter)
)
(:metric minimize
(total-tokens-used)
)
)
I am trying to use the same logic, by replacing the total-tokens-used with number-of-tokens and comparing the number-of-tokens between the incoming and outgoing transitions to determine whether the fire transition condition is valid or not. but I didn't know exactly how to do that.

Lisp: `stringtype nil` error trying to get info from a dialogue box and add it with other strings

The program basically gets info from a points description and gets the text from a text item and adds the text item to the points description. The dialogue boxes allow for the user to select some parameters, like is it for lots, lots and blocks, or other. I have been working on this program for multiple days now and it is so close to working. I can get through the dialogue boxes with no problem, and I can get the desired effect with some of the trees (ones where it is simply just getting the info from the point and text item and adding them together like lots). The problem comes when I ask the user to input a number (in this case it is a block number I.E. Block 1) Upon putting in the number and selecting the point and a text item, I get string type nil error. Right now I think it could be due to trying to add a string which contains a space " " or the input on the dialogue box maybe isn't a string
Here is strcat function I am referencing:
(vlax-put-property p_obj 'rawdescription (strcat p_desc " BLOCK " type1 " " obj))
And here is the program getting the info from the box:
(action_tile "type1" "(setq type1 $value)")
Below are the relevant snippets of the code, not the entire program
Here is the combining function
(defun c:txcm_block ( / c_doc p_desc p_obj t_obj t1 t_strg text1 ts obj type1 number)
(vl-load-com)
(while
(setq c_doc (vla-get-ActiveDocument (vlax-get-acad-object))
p_obj (vlax-ename->vla-object (car (entsel "\nSelect Point: ")))
t_strg (vlax-ename->vla-object (car (entsel "\nPick Text.. "))))
(setq obj (vla-get-textstring t_strg))
(setq p_desc(vlax-get p_obj 'rawdescription))
(vlax-put-property p_obj 'rawdescription (strcat p_desc " BLOCK " type1 " " obj))
)
(princ)
)
Here is the Dialogue Function:
(defun c:nest2 ( / dcl_id2 number1 flag2)
(setq dcl_id2 (load_dialog "textcombine(input).dcl"))
(setq flag2 4)
(if (not (new_dialog "nest2" dcl_id2)) (exit))
(while (> flag2 2)
(set_tile "type1" "Enter Block Number")
(mode_tile "type1" 2)
(action_tile "type1" "(setq type1 $value)")
(action_tile
"accept"
"(done_dialog 4)"
)
(action_tile
"cancel"
"(done_dialog 0)
(setq result nil)
(c:txcm)"
)
(setq flag2 (start_dialog))
(if (= flag2 4)
(progn
(setq result T)
(c:txcm_block)
)
)
)
(unload_dialog dcl_id2)
)
And here is the nested DCL Code:
nest2 : dialog {
label = "Block Number";
: edit_box
{
label = "Enter Block Number: ";
mnemonic = "N";
key = "type1";
alighnment = centered;
edit_limit = 30;
edit_width = 30;
}
: button
{
key = "accept";
label = "Ok";
is_default = true;
fixed_width = true;
alignment = right;
allow_accept = true;
}
: button
{
key = "cancel";
label = "Go Back";
fixed_width = true;
alignment = centered;
}
: errtile
{
width = 17;
}
}
Any help would be appreciated! I have been all over the internet, but I feel like I am stuck. If you need more info, let me know!
You do seem to be setting the variable type1 inside your (c:nest2), and you do call (c:txcm_block) from (c:nest2), but (c:txcm_block) declares type1 as its local variable, so type1 is set to NIL on entry to (c:txcm_block).
NIL is not a string, so strcat naturally complains and bails.
Remove type1 from the local variables declaration list in (c:txcm_block) and put it on the local variables declaration list in (c:nest2).
In general, to deal with such situations, use your debugger to "break on error", then inspect the execution trace and check the current values of the variables of interest (like type1) at that point.

Clojure proxy multithreading issue

I'm trying to create a proxy for ArrayBlockingQueue that intercepts calls to it for monitoring
(ns clj-super-bug.core
(:import [java.util.concurrent ArrayBlockingQueue Executors]))
(let [thread-count 10
put-count 100
executor (Executors/newFixedThreadPool thread-count)
puts (atom 0)
queue (proxy [ArrayBlockingQueue] [1000]
(put [el]
(proxy-super put el)
(swap! puts inc)))]
(.invokeAll executor (repeat put-count #(.put queue 0)))
(assert (= (.size queue) put-count) "should have put in put-count items")
(println #puts))
I would expect this code to always print 100, but occaissonally it's something else like 51. Am I using proxy or proxy-super wrong?
I debugged this to the point that it seems that the proxy method is not actually called on some occasions, just the base method (the items show up in the queue, as indicated by the assert). Also, I suppose it's multithreading related because if I have thread-count = 1 it's always 100.
Turns out this is a known issue with proxy-super: https://dev.clojure.org/jira/browse/CLJ-2201
"If you have a proxy with method M, which invokes proxy-super, then while that proxy-super is running all calls to M on that proxy object will immediately invoke the super M not the proxied M." That's exactly what's happening.
I would not do the subclass via proxy.
If you subclass ArrayBlockingQueue, you are saying your code is an instance of ABQ. So, you are making a specialized version of ABQ, and must take responsibility for all of the implementation details of the ABQ source code.
However, you don't need to be an instance of ABQ. All you really need is to use an instance of ABQ, which is easily done by composition.
So, we write a wrapper function which delegates to an ABQ:
(ns tst.demo.core
(:use demo.core tupelo.core tupelo.test)
(:require
[clojure.string :as str]
[clojure.java.io :as io])
(:import [java.util.concurrent ArrayBlockingQueue Executors TimeUnit]) )
(dotest
(let [N 100
puts-done (atom 0)
abq (ArrayBlockingQueue. (+ 3 N))
putter (fn []
(.put abq 0)
(swap! puts-done inc))]
(dotimes [_ N]
(future (putter)))
(Thread/sleep 1000)
(println (format "N: %d puts-done: %d" N #puts-done))
(assert (= N #puts-done)
(format "should have put in puts-done items; N = %d puts-done = %d" N #puts-done))
))
result:
N: 100 puts-done: 100
Using the executor:
(dotest
(let [N 100
puts-done (atom 0)
thread-count 10
executor (Executors/newFixedThreadPool thread-count)
abq (ArrayBlockingQueue. (+ 3 N))
putter (fn []
(.put abq 0)
(swap! puts-done inc))
putters (repeat N #(putter)) ]
(.invokeAll executor putters)
(println (format "N: %d puts-done: %d" N #puts-done))
(assert (= N #puts-done)
(format "should have put in puts-done items; N = %d puts-done = %d" N #puts-done))))
result:
N: 100 puts-done: 100
Update #1
Regarding the cause, I'm not sure. I tried to fix the original version with locking, but no joy:
(def lock-obj (Object.))
(dotest
(let [N 100
puts-done (atom 0)
thread-count 10
executor (Executors/newFixedThreadPool thread-count)
abq (proxy [ArrayBlockingQueue]
[(+ 3 N)]
(put [el]
(locking lock-obj
(proxy-super put el)
(swap! puts-done inc))))]
(.invokeAll executor (repeat N #(.put abq 0)))
with results:
N: 100 puts-done: 46
N: 100 puts-done: 71
N: 100 puts-done: 85
N: 100 puts-done: 83
Update #2
Tried some more tests using a java subclass of ABQ:
package demo;
import java.util.concurrent.ArrayBlockingQueue;
import java.util.concurrent.atomic.AtomicInteger;
public class Que<E> extends ArrayBlockingQueue<E> {
public static AtomicInteger numPuts = new AtomicInteger(0);
public static Que<Integer> queInt = new Que<>( 999 );
public Que(int size) { super(size); }
public void put(E element) {
synchronized (numPuts) {
try {
super.put(element);
numPuts.getAndIncrement();
} catch (Exception ex) {
System.out.println( "caught " + ex);
} } } }
...
(:import [java.util.concurrent Executors TimeUnit]
[demo Que] ) )
(dotest
(let [N 100
puts-done (atom 0)
thread-count 10
executor (Executors/newFixedThreadPool thread-count) ]
(.invokeAll executor (repeat N #(.put Que/queInt 0)))
(println (format "N: %d puts-done: %d" N (.get Que/numPuts)))))
results (repeated runs => accumulation):
N: 100 puts-done: 100
N: 100 puts-done: 200
N: 100 puts-done: 300
N: 100 puts-done: 400
N: 100 puts-done: 500
so it works great with a Java subclass. Get same results with/without the synchronized block.
So, it looks to be something in the Clojure proxy area.

LongAdder Striped64 wasUncontended implementation detail

This is a question not about how LongAdder works, it's about an intriguing implementation detail that I can't figure out.
Here is the code from Striped64 (I've cut out some parts and left the relevant parts for the question):
final void longAccumulate(long x, LongBinaryOperator fn,
boolean wasUncontended) {
int h;
if ((h = getProbe()) == 0) {
ThreadLocalRandom.current(); // force initialization
h = getProbe();
wasUncontended = true;
}
boolean collide = false; // True if last slot nonempty
for (;;) {
Cell[] as; Cell a; int n; long v;
if ((as = cells) != null && (n = as.length) > 0) {
if ((a = as[(n - 1) & h]) == null) {
//logic to insert the Cell in the array
}
// CAS already known to fail
else if (!wasUncontended) {
wasUncontended = true; // Continue after rehash
}
else if (a.cas(v = a.value, ((fn == null) ? v + x : fn.applyAsLong(v, x)))){
break;
}
A lot of things from code are clear to me, except for the :
// CAS already known to fail
else if (!wasUncontended) {
wasUncontended = true; // Continue after rehash
}
Where does this certainty that the following CAS will fail?
This is really confusing for me at least, because this check only makes sense for a single case : when some Thread enters the longAccumulate method for the n-th time (n > 1) and the busy spin is at it's first cycle.
It's like this code is saying : if you (some Thread) have been here before and you have some contention on a particular Cell slot, don't try to CAS your value to the already existing one, but instead rehash the probe.
I honestly hope I will make some sense for someone.
It's not that it will fail, it's more that it has failed. The call to this method is done by the LongAdder add method.
public void add(long x) {
Cell[] as; long b, v; int m; Cell a;
if ((as = cells) != null || !casBase(b = base, b + x)) {
boolean uncontended = true;
if (as == null || (m = as.length - 1) < 0 ||
(a = as[getProbe() & m]) == null ||
!(uncontended = a.cas(v = a.value, v + x)))
longAccumulate(x, null, uncontended);
}
}
The first set of conditionals is related to existence of the long Cells. If the necessary cell doesn't exist, then it will try to accumulate uncontended (as there was no attempt to add) by atomically adding the necessary cell and then adding.
If the cell does exist, try to add (v + x). If the add failed then there was some form of contention, in that case try to do the accumulating optimistically/atomically (spin until successful)
So why does it have
wasUncontended = true; // Continue after rehash
My best guess is that with heavy contention, it will try to give the running thread time to catch up and will force a retry of the existing cells.

Understanding an Error Trail from Spin Modelchecker

I am trying to use Spin Model Checker to modelcheck a Game between two objects (A and B). The objects move on a board, and each location is defined by its (x,y) coordinates. The two objects are supposed to not collide. I have three processes: init, A Model, B Model. I am model checking an ltl property: (liveness property to check if the two objects ever occupy same location)
ltl prop1 { [] (!(x_a == x_b) && !(y_a == y_b)) }
The error trail that I get is:
init -> A Model -> B Model -> init
However, I should not get an error trail (counterexample) based on the data that is shown: x_a=2, x_b=1, y_a=1, y_b=1.
Also the first init does go through all the lines of init process, but the second one only shows to the last line of it.
Also my A Model and B Model only consist of guards and actions in a 'do' block as shown below. However they are more complex and have if blocks on the right of '->'
active proctype AModel(){
do
:: someValue == 1 -> go North
:: someValue == 2 -> go South
:: someValue == 3 -> go East
:: someValue == 4 -> go West
:: else -> skip;
od
}
Do I need to put anything in an atomic block? The reason I am asking is that the line that the error trail is showing does not even go into the 'do' block, and it is just the first line of the two models.
EDIT:
The LTL property was wrong. I changed that to:
ltl prop1 { [] (!((x_a == x_b) && (y_a == y_b))) }
However, I am still getting the exact same error trail.
Your LTL property is wrongly implemented. Essentially, the counter example that SPIN found is a true counter example for the LTL as stated.
[] ( !(x_a == x_b) && !(y_z == y_b) ) =>
[] ( !(2 == 1) && !(1 == 1) ) =>
[] ( !0 && !1) =>
[] ( 1 && 0) =>
[] 0 =>
false
The LTL should be:
always not (same location) =>
[] (! ((x_a == x_b) && (y_a == y_b))) =>
[] (! ((2 == 1) && (1 == 1))) =>
[] (! (0 && 1) =>
[] (! 0) =>
[] 1 =>
true
Regarding your init and tasks. When starting your tasks you want to be sure that initialization is complete before the tasks run. I'll use one of two approaches:
init { ... atomic { run taskA(); run taskB() } where tasks are spawned once all initialization is complete`
or
bool init_complete = false;
init { ...; init_complete = true }
proctype taskA () { /* init local stuff */ ...; init-complete -> /* begin real works */ ... }
Your LTL may be failing during the initialization.
And based on your problem, if you ever change x or y you'd better change both at once in an atomic{}.

Resources