Unique Order of Instance Binding - clips

I am attempting to trigger a rule exactly once for any unique pair of distinct instances.
A trivial example follows:
(defclass USER_THING (is-a USER))
(definstances KNOWN_THINGS
(thing-a of USER_THING)
(thing-b of USER_THING)
(thing-c of USER_THING))
(defrule match-things
?thing0 <- (object (is-a USER_THING))
?thing1 <- (object (is-a USER_THING))
=>
(printout t "-------" crlf)
(printout t "thing0 " (instance-name ?thing0) crlf)
(printout t "thing1 " (instance-name ?thing1) crlf))
Clearly, we'd expect the Cartesian product of KNOWN_THINGS with itself, which is exactly what we get:
CLIPS> (reset)
CLIPS> (run)
-------
thing0 [thing-c]
thing1 [thing-c]
-------
thing0 [thing-c]
thing1 [thing-b]
-------
thing0 [thing-c]
thing1 [thing-a]
-------
thing0 [thing-a]
thing1 [thing-c]
-------
thing0 [thing-b]
thing1 [thing-c]
-------
thing0 [thing-b]
thing1 [thing-b]
-------
thing0 [thing-b]
thing1 [thing-a]
-------
thing0 [thing-a]
thing1 [thing-b]
-------
thing0 [thing-a]
thing1 [thing-a]
While my desired output is more akin to:
CLIPS> (reset)
CLIPS> (run)
-------
thing0 [thing-a]
thing1 [thing-b]
-------
thing0 [thing-a]
thing1 [thing-c]
-------
thing0 [thing-b]
thing1 [thing-c]
I have experience with Apache Jena's forward-chaining inference system, wherein I'd simply add a rule clause to enforce an arbitrary ordering on the instance names:
(defrule match-things
?thing0 <- (object (is-a USER_THING))
?thing1 <- (object (is-a USER_THING))
(> (str-compare (instance-name ?thing0) (instance-name ?thing1)) 0)
=>
(printout t "-------" crlf)
(printout t "thing0 " (instance-name ?thing0) crlf)
(printout t "thing1 " (instance-name ?thing1) crlf))
This is not a proper CLIPS rule. What could I do to achieve my desired effect? I can add information to the instances (such as an arbitrary numeric or string identifier) as necessary to facilitate this.

Use the test conditional element:
(defrule match-things
?thing0 <- (object (is-a USER_THING))
?thing1 <- (object (is-a USER_THING))
(test (> (str-compare (instance-name ?thing0) (instance-name ?thing1)) 0))
=>
(printout t "-------" crlf)
(printout t "thing0 " (instance-name ?thing0) crlf)
(printout t "thing1 " (instance-name ?thing1) crlf))

Related

Why does this error occur when creating an expert system in Python using clipspy?

When I run the code I get this error:
clips.common.CLIPSError: [CSTRNCHK1] test.CLP, Line 7: A literal restriction value found in CE #1 does not match the allowed types for slot 'Presencia'. ERROR: (defrule MAIN::r1 ?d <- (dormitorio (Presencia Si) (Iluminación Apagada)) => (printout t "Encender la iluminación del dormitorio." crlf) (modify ?d (Iluminación Encendida))).
Python code:
import clips
DEFTEMPLATE_STRING = """
(deftemplate dormitorio
(slot Presencia (type STRING))
(slot Iluminación (type STRING)))
"""
env = clips.Environment()
env.build(DEFTEMPLATE_STRING)
env.load('test.CLP')
Dormitorio = env.find_template('dormitorio')
fact_Dormitorio = Dormitorio.assert_fact(Presencia = 'Si',
Iluminación = 'Apagada')
env.run()
Clips file:
(defrule r1
?d <- (dormitorio
(Presencia Si)
(Iluminación Apagada))
=>
(printout t "Encender la iluminación del dormitorio." crlf)
(modify ?d (Iluminación Encendida)))
Why does this error occur?
Si and Apagada are symbols. Strings are enclosed in quotation marks. Declare the types in the deftemplate as SYMBOL.
As Gary Riley said, your rule is expecting SYMBOL type but your deftemplate is declaring the type as STRING.
Either you modify the rule to match a string:
(defrule r1
?d <- (dormitorio
(Presencia "Si")
(Iluminación "Apagada"))
=>
(printout t "Encender la iluminación del dormitorio." crlf)
(modify ?d (Iluminación Encendida)))
Or you pass the values as SYMBOL.
DEFTEMPLATE_STRING = """
(deftemplate dormitorio
(slot Presencia (type SYMBOL))
(slot Iluminación (type SYMBOL)))
"""
...
fact_Dormitorio = Dormitorio.assert_fact(Presencia = clips.Symbol('Si'),
Iluminación = clips.Symbol('Apagada'))

How to make functions respect buffer local variables

In the (amateurish, convoluted) code below, I am trying create an environment where there may be multiple serial-term buffers/windows at the same time. I am doing everything I can think of (and just random desperate things) to make the variables local to the buffer running the terminal to which they pertain. For instance, there may be a buffer "serial-1a2b-buffer" with the terminal "serial-1a2b-term" running in it while at the same time there's a buffer "serial-3c4d-buffer" with the terminal "serial-3crd-term" running in it.
I can get the buffers/terminals setup and running with defun setupserial, but defun killserial and defun resetserial don't get the right value for "termname" and "buffname". It might be the values in the other buffer or it may be past values for buffers and terminals that no longer exist.
(In case anyone is wondering, I do a lot of work with microcontrollers. If the serial connection to them is interrupted, like with a hardware reset, then the serial process dies. The idea was to have a quick way to reset the connection - like with a function bound to a key sequence.)
(defvar serialspeed "115200")
(defvar serialport "/dev/ttyACM0")
(defvar serialbasename "serial")
(require 'term)
(defun setupserial (serialport serialspeed)
(interactive
(list
(read-string
(format "Serial Port (%s): "
serialport)
nil nil
serialport)
(read-string
(format "Speed (%s): "
serialspeed)
nil nil
serialspeed)))
(setq uniqueid (format "%04x" (random (expt 16 4))))
(setq serialid (concat serialbasename "-" uniqueid))
(setq buffname (concat serialid "-buffer"))
(setq termname (concat serialid "-term"))
(setq bufferid (get-buffer-create buffname))
(setq procid (make-serial-process
:speed (string-to-number serialspeed)
:port serialport
:name termname
:buffer buffname))
(switch-to-buffer bufferid)
(make-local-variable 'serialid)
(make-local-variable 'buffname)
(make-local-variable 'bufferid)
(make-local-variable 'termname)
(make-local-variable 'procid)
(make-local-variable 'serialspeed)
(make-local-variable 'serialport)
(term-mode)
(term-char-mode)
(local-set-key (kbd "M-r") #'resetserial)
(local-set-key (kbd "M-k") #'killserial)
(local-set-key (kbd "M-x") #'execute-extended-command)
(local-set-key (kbd "M-o") #'ace-window)
(message "Started Serial Terminal"))
(defun resetserial ()
(interactive)
(make-serial-process
:speed (string-to-number serialspeed)
:port serialport
:name termname
:buffer bufferid)
(message "Restarted Serial Terminal"))
(defun killserial ()
(interactive)
(delete-process termname))
(global-set-key (kbd "C-c s") #'setupserial)
(provide 'setup-serial)
Your problems are sequential. Having created all of your buffer-local variables, you are then destroying them all by calling a new major mode.
The section on "Derived modes, and mode hooks" in this answer might be useful reading, but the key point is that the first thing that happens when you call a major mode is kill-all-local-variables.
Because you are setting global values too, in the absence of local values your other commands will end up using whatever the most-recent global value happened to be.
Set the major mode first.

Export Selected Text From AutoCad

I am wondering if any of you fine people can point me in the right direction. I came up with an ssget function that selects the text I'm looking for but I'm not quite sure where to go from there to extract the text to either a txt or csv file.
Here is the ssget function that is working for me
(ssget "_X" '((0 . "TEXT,MTEXT")(1 . "ETCH*,MARK*,STAMP*")))
I need to grab this text from a folder full of drawings and export it to preferably a csv file where I can easily read.
Thanks in advance!
Allan
As per your question, you are extracting text from all drawings of the respective folder you can use ObjectODBX method here you can run this code directly and it extract text from drawing and create csv file with drawing name in the same folder try it you can add filter condition if you required.
(Defun C:ExtractFolderToCSV( / dwgfile filelist textstring f doc LM:GetDocumentObject FolderBox folderpath)
;; Get Document Object - Lee Mac
;; Retrieves the VLA Document Object for the supplied filename.
;; The Document Object may be present in the Documents collection, or obtained through ObjectDBX.
;; It is the callers responsibility to release such object.
;;This function I collect from Lee-Mac Thanks lee
(defun LM:GetDocumentObject (dwg / app dbx dwl err vrs)
(cond
((not (setq dwg (findfile dwg))) nil)
((cdr
(assoc
(strcase dwg)
(vlax-for doc
(vla-get-documents (setq app (vlax-get-acad-object)))
(setq dwl
(cons (cons (strcase (vla-get-fullname doc)) doc) dwl)
)
)
)
)
)
((progn
(setq dbx
(vl-catch-all-apply
'vla-getinterfaceobject
(list app
(if (< (setq vrs (atoi (getvar 'acadver))) 16)
"objectdbx.axdbdocument"
(strcat "objectdbx.axdbdocument." (itoa vrs))
)
)
)
)
(or (null dbx) (vl-catch-all-error-p dbx))
)
(prompt "\nUnable to interface with ObjectDBX.")
)
((vl-catch-all-error-p
(setq err (vl-catch-all-apply 'vla-open (list dbx dwg)))
)
(prompt (strcat "\n" (vl-catch-all-error-message err)))
)
(dbx)
)
)
;This function for select folder
(defun FolderBox (message directory flag / folder sh)
;;I found thiscode on web I am not remember website. sorry for that
;; Arguments:
;; message: the message displayed in th dialog box
;; directory: the directory to browse
;; flag values:
;; 0 = Default
;; 1 = Only file system folders can be selected. If this bit is set, the OK button is disabled if the user selects a folder that doesn't belong to the file system (such as the Control Panel folder).
;; 2 = The user is prohibited from browsing below the domain within a network (during a computer search).
;; 4 = Room for status text is provided under the text box.
;; 8 = Returns file system ancestors only.
;; 16 = Shows an edit box in the dialog box for the user to type the name of an item.
;; 32 = Validate the name typed in the edit box.
;; 512 = None "New folder" button
;; 4096 = Enables the user to browse the network branch of the shell's namespace for computer names.
;; 8192 = Enables the user to browse the network branch of the shell's namespace for printer names.
;; 16384 = Allows browsing for everything.
(vl-load-com)
(setq shell (vlax-create-object "Shell.Application"))
(if (setq
folder (vlax-invoke shell 'browseforfolder 0 message flag directory)
)
(setq folder (vlax-get-property (vlax-get-property folder 'self) 'path))
(setq folder nil)
)
(vlax-release-object shell)
folder
)
(setq folderpath (FolderBox "Select Folder" "D:/" 0))
(if (setq filelist (vl-directory-files (strcat folderpath "/") "*.dwg" 1))
(foreach dwgfile filelist
(setq
f (open
(strcat folderpath
"/"
(vl-string-subst ".CSV" ".DWG" (strcase dwgfile))
)
"w"
)
) ;create csv file in same folder with replaceing .dwg to .csv
(if (setq doc (LM:GetDocumentObject (strcat folderpath "/" dwgfile)))
(progn
(vlax-for lyt (vla-get-layouts doc)
(vlax-for obj (vla-get-block lyt)
(if
(or
(= "AcDbMText" (vla-get-objectname obj));select onlly m_text and text
(= "AcDbText" (vla-get-objectname obj))
)
(progn
(setq textstring
(vla-get-TextString obj)
)
(if
(or (= (vl-string-search "ETCH" textstring) 0) ;your test condition
(= (vl-string-search "MARK" textstring) 0)
(= (vl-string-search "STAMP" textstring) 0)
)
(write-line textstring f)
)
)
)
)
)
(vlax-release-object doc)
)
)
(close f)
)
)
);close defun
Hope this helps

WebSocket error in common lisp

I want to make slack bot.
I can not solve this error.
(ql:quickload '(:cl-slack
:event-emitter
:websocket-driver
:jonathan
:cl-async
)
:silent t)
(defconstant +token+ "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
(defconstant +channel+ "xxx")
(defvar *client* (make-instance 'cl-slack.core:slack-client
:token +token+))
(let ((url (getf (jonathan:parse (cl-slack.rtm:start *client* nil)) :|url|)))
(format t url)
(defparameter *slack-bot* (wsd:make-client url)))
(defun params (id type channel text)
(jonathan:to-json (list :|id| id
:|type| type
:|channel| channel
:|text| text)))
(wsd:on :message *slack-bot*
(lambda (message)
(let ((data (jonathan:parse message)))
(format t "~A~%" data)
(when (string= (getf data :|type|) "message")
(wsd:send *slack-bot*
(params 1
"message"
(getf data :|channel|)
(getf data :|text|)))))))
(as:with-event-loop (:catch-app-errors t)
(wsd:start-connection *slack-bot*))
error is
[20:42:25] cl-async-util - handle-error: SSL verify error: 20 X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY

ELISP: How to trap display-completion-list to a variable

I have a list of targets and I want to write a function where you can choose the
current target. My code looks like that below.
The problem is that when I do "M-x my-test", current_target is set as nil and the chosen
address is printed on the current buffer.
How do I trap the buffer output to current_target? Or my whole approach is wrong?
Please advice? Which doc to read?
Thanx
-Siddhartha
(defvar target-list '( ("10.25.110.113" " -> target-1")
("10.25.110.114" " -> target-2")) "List of Target boxes")
(defvar current-target "0.0.0.0" "Current target")
(defun my-test ()
(interactive)
(with-output-to-temp-buffer "*Target List*"
(princ "\nPlease click on IP address to choose the target\n\n")
(setq current-target (display-completion-list target-list))))
Not sure exactly what behavior you want. But if you just want to let a user choose one of your strings, then try using completing-read:
(defun my-test ()
(interactive)
(setq current-target (completing-read "Target: " target-list nil t)))
Or if you want to return the associated target then look up the string chosen in your alist:
(defun my-test ()
(interactive)
(let (target)
(setq current-target (completing-read "Target: " target-list nil t)
target (cdr (assoc current-target target-list)))
(message "Target: %s" target)))
You get the idea.
;; The code for the question after the reply from Drew is as follows
;; The idea is to present to the user names to choose from.
;; Thanx Drew for "giving the idea"
(defvar target-assoc-list '( ("Fire" . "10.25.110.113") ("Earth" . "10.25.110.114")
("Water" . "10.25.110.115") ("Air" . "10.25.110.116"))
"The assoc list of (name . ip-addr) so that user chooses by name
and current-target is assigned the ip address")
(defvar current-target "0.0.0.0")
(defun my-select-target ()
(interactive)
(let (name)
(setq name (completing-read "Enter Target (TAB for list): "
target-assoc-list nil t)
current-target (cdr (assoc name target-assoc-list)))
(message "Chosen current-target IP address: %s name: %s" current-target name)))

Resources