├── .classpath ├── .gitignore ├── .project ├── CSNePS.iml ├── Demo ├── andor.sneps ├── basic-demo.sneps ├── changedemo.sneps ├── condact-rules.sneps ├── dissertation-examples.sneps ├── equivalence.sneps ├── finddemo.sneps ├── focusedinfer.sneps ├── genericinfer.sneps ├── index.clj ├── inferdemo.sneps ├── mappingrulesdemo.sneps ├── match.sneps ├── natural-deduction-derivable-test.sneps ├── natural-deduction-derivable.sneps ├── negbyfail.sneps ├── pb-inference.sneps ├── pb-inference.sneps~ ├── recursion.sneps ├── refcl.sneps ├── sbConnectives.sneps ├── snere.sneps ├── sort-based-derivable.sneps ├── subsumption.sneps ├── threshelim.sneps ├── unification.sneps ├── varRels.sneps ├── vardemo.sneps └── xor.sneps ├── LICENSE.pdf ├── README.md ├── csneps.sh ├── csnepsgui.sh ├── doc ├── bib.bib ├── manual.pdf └── manual.tex ├── local_maven_repo ├── jpedal │ └── jpedal │ │ └── 1.0.0 │ │ ├── jpedal-1.0.0.jar │ │ └── jpedal-1.0.0.pom └── net │ └── xeon │ └── jspf.core │ ├── 1.0.2 │ ├── jspf.core-1.0.2.jar │ ├── jspf.core-1.0.2.jar.md5 │ ├── jspf.core-1.0.2.jar.sha1 │ ├── jspf.core-1.0.2.pom │ ├── jspf.core-1.0.2.pom.md5 │ └── jspf.core-1.0.2.pom.sha1 │ ├── maven-metadata-local.xml │ ├── maven-metadata.xml │ ├── maven-metadata.xml.md5 │ └── maven-metadata.xml.sha1 ├── project.clj ├── src ├── clj │ └── csneps │ │ ├── .#snip_inference_graph.clj.1.30 │ │ ├── configuration.clj │ │ ├── core.clj │ │ ├── core │ │ ├── arithmetic.clj │ │ ├── build.clj │ │ ├── build_assert.clj │ │ ├── build_channel.clj │ │ ├── build_rewrite.clj │ │ ├── build_rules.clj │ │ ├── build_semantic_types.clj │ │ ├── build_substitution.clj │ │ ├── build_subsumption.clj │ │ ├── build_unification.clj │ │ ├── build_utils.clj │ │ ├── caseframes.clj │ │ ├── contexts.clj │ │ ├── find.clj │ │ ├── find_utils.clj │ │ ├── initialize.clj │ │ ├── printer.clj │ │ ├── relations.clj │ │ ├── semantic_types.clj │ │ ├── snuser.clj │ │ └── unify │ │ │ └── treenode.clj │ │ ├── core_semantic_types.clj │ │ ├── core_syntactic_types.clj │ │ ├── debug.clj │ │ ├── demo.clj │ │ ├── gui.clj │ │ ├── snip.clj │ │ ├── snip │ │ ├── .#path_based.clj.1.4 │ │ ├── inference_graph │ │ │ ├── concurrent.clj │ │ │ └── util.clj │ │ ├── linear_message_set.clj │ │ ├── message.clj │ │ ├── message_compat.clj │ │ ├── messagestructure.clj │ │ ├── originset.clj │ │ ├── passthrough_message_set.clj │ │ ├── ptree.clj │ │ ├── sindex.clj │ │ └── util.clj │ │ ├── snip_acting.clj │ │ ├── snip_beliefrevision.clj │ │ ├── snip_inference_graph.clj │ │ ├── snip_path_based.clj │ │ ├── snip_rnode.clj │ │ ├── snip_slot_based.clj │ │ ├── snip_sort_based.clj │ │ ├── test │ │ ├── .#benchmark.clj.1.3 │ │ ├── benchmark.clj │ │ ├── mapper_benchmark.clj │ │ └── unification.clj │ │ ├── util.clj │ │ └── utils │ │ ├── coreutils.clj │ │ ├── dotgraph.clj │ │ └── ontology.clj └── jvm │ └── csneps │ ├── api │ ├── CSNePS.java │ ├── ICaseframe.java │ ├── IContext.java │ ├── ISemanticType.java │ ├── ISlot.java │ └── ITerm.java │ ├── gui │ ├── AddToKBPanel.java │ ├── AdoptRuleForm.java │ ├── CaseframeBasedShowHideDialog.java │ ├── CaseframeTableModel.java │ ├── CaseframesPanel.java │ ├── ComparableTreeNode.java │ ├── ContextsPanel.java │ ├── CreateContextForm.java │ ├── DefineCaseframeForm.java │ ├── DemoMode.java │ ├── FindQuery.java │ ├── FindQuery3.java │ ├── Frame.java │ ├── FrameSlotDialog.java │ ├── GUI2.java │ ├── GlobalGraphFilter.java │ ├── GlobalGraphFilterDialog.java │ ├── JTableRE.java │ ├── JungGraphPanel.java │ ├── LazyLayout.java │ ├── NodeFind.java │ ├── NodeFindPath.java │ ├── PairLR.java │ ├── PluginPanel.java │ ├── QBEBasePanel.java │ ├── RDockComponent.java │ ├── RDockPanel.java │ ├── REPLPanel.java │ ├── RowEditorModel.java │ ├── SNePSEditor.java │ ├── SemanticTypeForm.java │ ├── SemanticTypesPanel.java │ ├── ShowInGraphQueryPanel.java │ ├── SlotForm.java │ ├── VectorTable.java │ ├── addfile_sneps3.sh │ ├── business │ │ ├── Caseframe.java │ │ ├── Channel.java │ │ ├── Context.java │ │ ├── FnInterop.java │ │ ├── IView.java │ │ ├── InteropUtils.java │ │ ├── SemanticType.java │ │ ├── Slot.java │ │ ├── Term.java │ │ └── repl │ │ │ ├── IREPLView.java │ │ │ └── REPLView.java │ ├── dataaccess │ │ ├── Controller.java │ │ └── Model.java │ ├── graph │ │ ├── ArrowFillTransformer.java │ │ ├── ArrowShapeTransformer.java │ │ ├── ChannelEdge.java │ │ ├── CollapsedEdge.java │ │ ├── DependencyEdge.java │ │ ├── Edge.java │ │ ├── IEdge.java │ │ ├── ITermNode.java │ │ ├── RestrictionEdge.java │ │ ├── SnepsGraph.java │ │ ├── SnepsModalGraphMouse.java │ │ ├── TermNode.java │ │ └── algorithms │ │ │ ├── UndirectedBFSDistanceLabeler.java │ │ │ ├── UndirectedDijkstraDistance.java │ │ │ ├── UndirectedDijkstraShortestPath.java │ │ │ └── UndirectedUnweightedShortestPath.java │ ├── pdfViewer.java │ └── util │ │ ├── ClojureTools.java │ │ ├── OSTools.java │ │ └── SortedComboBoxModel.java │ └── util │ ├── BlockingLifoQueue.java │ └── CountingLatch.java └── test └── csneps ├── api └── test │ └── APITester.java └── test ├── arithmetic.clj ├── combined_inference.clj ├── core.clj ├── find.clj ├── inference_graph.clj ├── snere.clj └── wh_question.clj /.classpath: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | pom.xml 2 | /lib/ 3 | /classes/ 4 | /.lein-plugins/ 5 | /.settings/ 6 | .lein-failures 7 | .lein-deps-sum 8 | /target/ 9 | -------------------------------------------------------------------------------- /.project: -------------------------------------------------------------------------------- 1 | 2 | 3 | CSNePS 4 | SNePS 3 5 | 6 | 7 | 8 | 9 | ccw.builder 10 | 11 | 12 | 13 | 14 | ccw.leiningen.builder 15 | 16 | 17 | 18 | 19 | org.eclipse.jdt.core.javabuilder 20 | 21 | 22 | 23 | 24 | 25 | org.eclipse.jdt.core.javanature 26 | ccw.leiningen.nature 27 | ccw.nature 28 | 29 | 30 | -------------------------------------------------------------------------------- /Demo/andor.sneps: -------------------------------------------------------------------------------- 1 | ;;; Demonstration of use of Andor and Thresh Introduction 2 | (in-ns 'csneps.core.snuser) 3 | 4 | ;;; Too many arguments asserted: 6 5 | (clearkb) 6 | (assert 'a) 7 | (assert 'b) 8 | (assert 'c) 9 | (assert 'd) 10 | (assert 'e) 11 | (assert 'f) 12 | (assert '(not g)) 13 | ;;; Should derive (thresh (3 5) b! d! f! a! c! e! g) 14 | (ask '(andor (3 5) a b c d e f g)) 15 | 16 | ;;; Too many negated arguments asserted: 5 17 | (clearkb) 18 | (assert '(not a)) 19 | (assert '(not b)) 20 | (assert '(not c)) 21 | (assert '(not d)) 22 | (assert '(not e)) 23 | ;;; Should derive (thresh (3 5) e f g a b c d) 24 | (ask '(andor (3 5) a b c d e f g)) 25 | 26 | ;;; The correct number of negated (2) arguments 27 | ;;; but not enough arguments asserted (2) 28 | ;;; and too many (3) unknowns. 29 | (clearkb) 30 | (assert 'a) 31 | (assert 'b) 32 | (assert '(not f)) 33 | (assert '(not g)) 34 | ;;; Should not derive anything. 35 | (ask '(andor (3 5) a b c d e f g)) 36 | 37 | ;;; The correct number of arguments asserted (3), 38 | ;;; but not enough arguments negated (1) 39 | ;;; and too many (3) unknowns. 40 | (clearkb) 41 | (assert 'a) 42 | (assert 'b) 43 | (assert 'c) 44 | (assert '(not g)) 45 | ;;; Should not derive anything. 46 | (ask '(andor (3 5) a b c d e f g)) 47 | 48 | ;;; The correct number of asserted (3) and negated (2) arguments 49 | ;;; and some (2) unknowns. 50 | (clearkb) 51 | (assert 'a) 52 | (assert 'b) 53 | (assert 'c) 54 | (assert '(not f)) 55 | (assert '(not g)) 56 | ;;; Should derive (andor (3 5) b! f g d a! c! e) 57 | (ask '(andor (3 5) a b c d e f g)) 58 | 59 | ;;; Too many arguments derived: 6 60 | (clearkb) 61 | (assert '(if p a)) 62 | (assert 'p) 63 | (assert 'b) 64 | (assert 'c) 65 | (assert 'd) 66 | (assert 'e) 67 | (assert 'f) 68 | (assert '(not g)) 69 | ;;; Should derive (thresh (3 5) f! c! e! g a! b! d!) 70 | (ask '(andor (3 5) a b c d e f g)) 71 | 72 | ;;; Too many negated arguments derived: 5 73 | (clearkb) 74 | (assert '(nand p a)) 75 | (assert 'p) 76 | (assert '(not b)) 77 | (assert '(not c)) 78 | (assert '(not d)) 79 | (assert '(not e)) 80 | ;;; Should derive (thresh (3 5) g a b c d e f) 81 | (ask '(andor (3 5) a b c d e f g)) 82 | 83 | ;;; The correct number of derived (3) and negated (2) arguments 84 | ;;; and some (2) unknowns. 85 | (clearkb) 86 | (assert '(if p a)) 87 | (assert 'p) 88 | (assert 'b) 89 | (assert 'c) 90 | (assert '(nand q f)) 91 | (assert 'q) 92 | (assert '(not g)) 93 | ;;; Should derive (andor (3 5) g d b! a! e c! f) 94 | (ask '(andor (3 5) a b c d e f g)) 95 | -------------------------------------------------------------------------------- /Demo/basic-demo.sneps: -------------------------------------------------------------------------------- 1 | ;;; Basic Demo of CSNePS Facilities 2 | ;;; ================================ 3 | 4 | ;;; The contents of this file are subject to the University at Buffalo 5 | ;;; Public License Version 1.0 (the "License"); you may not use this file 6 | ;;; except in compliance with the License. You may obtain a copy of the 7 | ;;; License at http://www.cse.buffalo.edu/sneps/Downloads/ubpl.pdf. 8 | ;;; 9 | ;;; Software distributed under the License is distributed on an "AS IS" 10 | ;;; basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 11 | ;;; the License for the specific language governing rights and limitations 12 | ;;; under the License. 13 | ;;; 14 | ;;; The Original Code is CSNePS. 15 | ;;; 16 | ;;; The Initial Developer of the Original Code is Research Foundation of 17 | ;;; State University of New York, on behalf of University at Buffalo. 18 | ;;; 19 | ;;; Portions created by the Initial Developer are Copyright (C) 2007 20 | ;;; Research Foundation of State University of New York, on behalf of 21 | ;;; University at Buffalo. All Rights Reserved. 22 | ;;; 23 | ;;; Contributor(s): ______________________________________. 24 | 25 | (in-ns 'csneps.core.snuser) 26 | ;; Initialize KB completely 27 | (clearkb true) 28 | ;;; Initial set of semantic types 29 | (showTypes) 30 | ;;; Initial set of contexts 31 | (listContexts) 32 | ;;; The current context 33 | (currentContext) 34 | ;;; Can use Propositional Logic 35 | ;;; =========================== 36 | ;;; Assert p 37 | (assert 'p) 38 | ;;; Query p 39 | (ask 'p) 40 | ;;; Go to a new child context 41 | (setCurrentContext (defineContext 'CT2 :parents '(DefaultCT))) 42 | ;;; Assert q in this context 43 | (assert 'q) 44 | ;;; See terms 45 | (list-terms) 46 | ;;; Go to a sibling context 47 | (setCurrentContext (defineContext 'CT3 :parents '(DefaultCT) :hyps '(r))) 48 | ;;; See the terms here 49 | (list-terms) 50 | ;;; Query some terms 51 | (ask 'p) 52 | (ask 'q) 53 | (ask 'r) 54 | ;;; 55 | ;;; Predicate Logic 56 | ;;; =============== 57 | ;;; Reinitialize 58 | (clearkb true) 59 | ;;; Initial set of slots 60 | (list-slots) 61 | ;;; Initial set of caseframes 62 | (list-caseframes) 63 | ;;; Terms can be symbols, strings, or numbers 64 | (assert '(Isa Fido Dog)) 65 | (assert '(Isa "Lake Erie" Lake)) 66 | (assert '(Isa 3 Integer)) 67 | (assert '(Isa 3.1415932 Transcendental)) 68 | ;;; A term can also be a wft name 69 | (assert '(Isa wft17 Proposition)) 70 | ;;; Type of input term is irrelevant 71 | (assert '(Isa "3" Integer)) 72 | ;;; *PRECISION* determines round-off of floating point numbers 73 | *PRECISION* 74 | (assert '(Isa 3.1415943219 Transcendental)) 75 | ;;; Reinitialize 76 | (clearkb) 77 | ;;; Set arguments 78 | (assert '(Isa (setof Fido Rover) Dog)) 79 | ;;; Sets can be written two ways 80 | (assert '(Isa #{Rover Fido} Dog)) 81 | ;;; A bigger set is different 82 | (assert '(Isa (setof Fido Rover Lassie) Dog)) 83 | ;;; A smaller set is different 84 | (assert '(Isa (setof Fido) Dog)) 85 | ;;; A single argument is the same as a singleton 86 | (assert '(Isa Fido Dog)) 87 | ;;; Now let's see all the terms 88 | (list-terms) 89 | ;;; Let's see just the asserted terms. 90 | (list-terms :asserted true) 91 | ;;; and describe the asserted ones. 92 | (describe-terms wft19 wft17 wft18) 93 | ;;; 94 | ;;; A caseframe with unquoted function symbol 95 | ;;; 96 | (clearkb true) 97 | (defineType Action (Thing) "The category of actions") 98 | (defineSlot object :type Thing 99 | :docstring "The object argument of an act." 100 | :posadjust none :negadjust none 101 | :min 1 :max 1) 102 | ;;; Note that the actions slot is predefined. 103 | (defineCaseframe 'Act '(action object) 104 | :docstring "[action] [object]" 105 | :fsymbols '(senseFor go)) 106 | (assert '(Isa (senseFor smell) Act)) 107 | (assert '(Isa (go left) Act)) 108 | (sameFrame 'say 'go) 109 | (assert '(Isa (say Hello) Act)) 110 | (list-terms) 111 | (describe-terms wft19 wft21 wft23) 112 | ;;; 113 | ;;; Negations 114 | ;;; 115 | (clearkb true) 116 | (assert '(not (Isa Fido Cat))) 117 | (assert '(nor (Isa Fluffy Dog) (Isa Tweety Penguin) (Isa Rover Cat))) 118 | (list-terms) 119 | ;;; 120 | ;;; Violating the min/max slot restrictions 121 | ;;; 122 | (clearkb true) 123 | (assert '(Equiv (setof Superman "Clark Kent"))) 124 | (assert '(Equiv UniqueMan)) 125 | (defineSlot min3 :type Entity :min 3) 126 | (defineSlot max3 :type Entity :max 3) 127 | (defineCaseframe 'Proposition '('MinMax min3 max3)) 128 | (assert '(MinMax (setof a b) (setof 1 2 3 4))) 129 | (assert '(MinMax (setof a b c) (setof 1 2 3 4))) 130 | (assert '(MinMax (setof a b c) (setof 1 2 3))) -------------------------------------------------------------------------------- /Demo/condact-rules.sneps: -------------------------------------------------------------------------------- 1 | ;;; Demonstrates condition-action rules. 2 | 3 | (in-ns 'csneps.core.snuser) 4 | 5 | ;; Simple rule. 6 | 7 | (clearkb true) 8 | 9 | (defineType POS (Thing) 10 | "A part of speech tag.") 11 | (defineType Token (Thing) 12 | "Start off as tokens created by GATE, later used for other thing.") 13 | (defineType Word (Thing) 14 | "Words that appear in the messages.") 15 | 16 | (defineSlot Category :type POS 17 | :docstring "The POS of some word.") 18 | (defineSlot Dependent :type Token 19 | :docstring "The dependent in a dependency relation.") 20 | (defineSlot Governor :type Token 21 | :docstring "The head in a dependency relation.") 22 | (defineSlot Token :type Token :docstring "Some token.") 23 | (defineSlot Type :type Word 24 | :docstring "The dependency relation in a dependency graph.") 25 | 26 | (defineCaseframe 'Proposition '(Type Governor Dependent) 27 | :docstring "[Dependent] is a [Type] dependent of [Governor]" 28 | :fsymbols '(appos)) 29 | (defineCaseframe 'Proposition '('SyntacticCategoryOf Category Token) 30 | :docstring "the syntactic category of [Token] is [Category]") 31 | 32 | (defrule apposCoref 33 | (appos (every tok1 (Isa tok1 Token)) (every tok2 (Isa tok2 Token) (notSame tok1 tok2))) 34 | => 35 | (unassert `(~'appos ~tok1 ~tok2)) 36 | (when-not (setAnd (askif `(~'SyntacticCategoryOf ~'NNP ~tok1)) 37 | (askif `(~'SyntacticCategoryOf ~'NNP ~tok2))) 38 | (assert `(~'Equiv #{~tok1 ~tok2})))) 39 | 40 | (assert '(appos n1 n2)) 41 | (assert '(Isa n1 Token)) 42 | (assert '(Isa n2 Token)) 43 | (assert '(SyntacticCategoryOf NN n1)) 44 | (assert '(SyntacticCategoryOf JJ n2)) 45 | (assert '(Isa NN POS)) 46 | (assert '(Isa JJ POS)) 47 | (adopt-rule 'apposCoref) 48 | 49 | 50 | ;; Simple rule: 51 | 52 | (clearkb true) 53 | (krnovice true) 54 | 55 | (defrule simplerule 56 | (Isa (every x) Animal) 57 | => 58 | (assert `(~'Alive ~x))) 59 | 60 | (assert '(Isa Ren Animal)) 61 | (assert '(Isa Ren Entity)) 62 | (adopt-rule 'simplerule) 63 | 64 | ;; Subrules: 65 | 66 | (clearkb true) 67 | 68 | (defrule subruletest 69 | (Isa (every x) Animal) 70 | => 71 | (:subrule 72 | (Isa x Beast) 73 | => 74 | (assert `(~'Isa ~x ~'ScaryThing)))) 75 | 76 | (assert '(Isa Adam Animal)) 77 | (assert '(Isa Adam Beast)) 78 | (assert '(Isa Adam Entity)) 79 | (adopt-rule 'subruletest) 80 | (list-terms) 81 | 82 | ;; test 2 83 | 84 | 85 | (clearkb) 86 | 87 | (defrule subruleTest 88 | (RootOf pick (every tok (Isa tok Token))) 89 | => 90 | (:subrule 91 | (TextOf (every pickwd (Isa pickwd Word)) tok) 92 | => 93 | (unassert `(~'TextOf ~pickwd ~tok)))) 94 | 95 | (assert '(RootOf pick n21)) 96 | (assert '(TextOf picked n21)) 97 | (assert '(Isa n21 Token)) 98 | (assert '(Isa picked Word)) 99 | 100 | (adopt-rule 'subruleTest) -------------------------------------------------------------------------------- /Demo/equivalence.sneps: -------------------------------------------------------------------------------- 1 | ;;; Basic Demo of CSNePS Equivalence Elimination and Introduction 2 | ;;; ================================ 3 | 4 | (in-ns 'csneps.core.snuser) 5 | ;; Initialize KB completely 6 | (clearkb true) 7 | 8 | 9 | ;; equivalence elimination 10 | 11 | (assert '(iff a b c)) 12 | 13 | (assert 'a) 14 | 15 | (ask 'b) 16 | 17 | 18 | (clearkb true) 19 | 20 | 21 | (assert '(iff a b c)) 22 | 23 | (assert '(not a)) 24 | 25 | (ask 'b) 26 | 27 | 28 | (clearkb true) 29 | 30 | 31 | ;; equivalence introduction 32 | 33 | (assert '(and a b c)) 34 | 35 | (ask '(iff a b c d)) 36 | 37 | (ask '(iff a b c)) 38 | 39 | (ask '(iff a b)) 40 | 41 | 42 | (clearkb true) 43 | 44 | 45 | (assert '(and (not a) (not b) (not c))) 46 | 47 | (ask '(iff a b c d)) 48 | 49 | (ask '(iff a b c)) 50 | 51 | (ask '(iff a b)) 52 | 53 | -------------------------------------------------------------------------------- /Demo/finddemo.sneps: -------------------------------------------------------------------------------- 1 | (in-ns 'csneps.core.snuser) 2 | 3 | (clearkb true) 4 | 5 | ;;; Define Types 6 | (defineType Agent (Thing) "Individuals that have agency") 7 | (defineType Action (Thing) "Actions that Agents can perform.") 8 | 9 | ;;; Define Slots 10 | (defineSlot agent :type Agent) 11 | (defineSlot actions :type Action) 12 | (defineSlot object :type Thing 13 | :docstring "Non-agentive objects of actions.") 14 | (defineSlot property :type Thing) 15 | (defineSlot life :type Thing) 16 | (defineSlot whole :type Thing) 17 | (defineSlot part :type Thing) 18 | (defineSlot group :type Thing) 19 | 20 | ;;; Caseframes 21 | (defineCaseframe 'Proposition '(actions agent object) 22 | :docstring "[agent] [actions] [object]" 23 | :fsymbols '(Owns Buys)) 24 | 25 | ;;; Assert some propositions to find 26 | (assert '(Isa Fido Dog)) 27 | (assert '(Isa Rover Dog)) 28 | (assert '(Isa Fluffy Cat)) 29 | (assert '(Isa Glacier Cat)) 30 | 31 | ;;; Test if a base proposition can be found. 32 | (find '(Isa Rover Dog)) 33 | 34 | ;;; Demonstrate proper use of variables 35 | (find '(Isa x Dog)) 36 | (find '(Isa x Dog) '(x)) 37 | 38 | ;;; Demonistrates auto-detected variables 39 | (find '(Isa ?x Dog)) 40 | 41 | ;;; Find all terms, mostly ungrounded expression 42 | (find '(Isa x y) '(x y)) 43 | 44 | ;;; Demonstrate variable binding property that a variable can only 45 | ;;; bind one term 46 | (find '(Isa x x) '(x)) 47 | 48 | ;;; Assert a meta-proposition 49 | (assert '(Isa (Isa Clark Man) Proposition)) 50 | 51 | ;;; Demonstarte a find on that proposition 52 | (find '(Isa (Isa Clark x) y) '(x y)) 53 | 54 | ;;; Assert a more complex proposition 55 | (assert '(Isa (Isa (Isa Clark Man) Proposition) Proposition)) 56 | 57 | ;;; Demonstrate properties of meta-propositions with variables 58 | (find '(Isa (Isa x y) z) '(x y z)) 59 | (find '(Isa (Isa x y) y) '(x y)) 60 | 61 | ;;; Demonstrate that mtching works with unquoted caseframes 62 | (assert '(Buys Mike Dog)) 63 | (assert '(Buys Mike Cat)) 64 | (find '(Buys Mike x) '(x)) 65 | 66 | ;;; Assert some propositions with sets 67 | (assert '(Isa (setof Fido Rover Lassie Rags) Dog)) 68 | (assert '(Isa (setof Fluffy Scratch) (setof Cat Mammal))) 69 | (assert '(Isa (setof Frog Amphibian) Amphibian)) 70 | 71 | ;;; Check ground propositions 72 | (find '(Isa (setof Lassie Rags Fido Rover) Dog)) 73 | 74 | ;;; Check that whole sets can be bound 75 | (find '(Isa x Dog) '(x)) 76 | 77 | ;;; Check various combinations of single variables in sets 78 | (find '(Isa (setof Lassie Rover Fido x) Dog) '(x)) 79 | (find '(Isa (setof Rags x Rover Lassie) Dog) '(x)) 80 | (find '(Isa (setof x Rover Lassie) Dog) '(x)) 81 | (find '(Isa (setof x Fluffy) (setof Mammal Cat)) '(x)) 82 | 83 | ;;; Check various combinations of multiple variables in sets 84 | (find '(Isa (setof y Rover Fido x) Dog) '(x y)) 85 | (find '(Isa (setof Rags x z Lassie) y) '(x y z)) 86 | (find '(Isa (setof x Rover Lassie) y) '(x y)) 87 | (find '(Isa (setof x Fluffy) (setof Mammal y)) '(x y)) 88 | 89 | ;;; Check variable binding in and out of sets 90 | (find '(Isa (setof Frog x) x) '(x)) 91 | (find '(Isa (setof y x) z) '(x y z)) 92 | (find '(Isa (setof y x) x) '(x y)) 93 | 94 | ;;; Assert some sets with propositions 95 | (assert '(Isa 96 | (setof (Isa Fido Dog) (Isa Fluffy Cat) 97 | (Isa Frog Amphibian)) 98 | Proposition)) 99 | 100 | ;;; Can we find ground proposition sets? 101 | (find '(Isa (setof (Isa Fluffy Cat) (Isa Frog Amphibian) 102 | (Isa Fido Dog)) Proposition)) 103 | 104 | ;;; Check binding and matching of propositions in sets 105 | (find '(Isa (setof x (Isa Fluffy Cat) y) Proposition) '(x y)) 106 | 107 | ;;; Variables in propositions in sets? Oh My! 108 | (find '(Isa (setof x (Isa y Cat) z) Proposition) '(x y z)) 109 | 110 | ;;; Even more variables! 111 | (find '(Isa (setof x (Isa y w) z) Proposition) '(x y z w)) 112 | 113 | ;;; More still! 114 | (find '(Isa (setof x (Isa y w) (Isa u v)) Proposition) '(x y u v w)) 115 | 116 | ;;; This is just craziness! 117 | (find '(Isa (setof (Isa u v) (Isa w x) (Isa y z)) t) '(t u v w 118 | x y z )) 119 | -------------------------------------------------------------------------------- /Demo/focusedinfer.sneps: -------------------------------------------------------------------------------- 1 | ;;; focusedinfer.sneps 2 | ;;; Demos for Focused Inference 3 | ;;; By: Daniel R. Schlegel 4 | ;;; Created: 11/7/2013 5 | ;;; Modified: 11/1/2021 6 | 7 | (clearkb true) 8 | 9 | ;;; Simple example. 10 | (assert '(if p q)) 11 | (assert '(xor q r s)) 12 | ;; Ask question which can't be answered, but opens channels. 13 | (ask 'r) 14 | ;; A focused reasoning task should have been started for both r and (not r) 15 | (list-focused-inference-tasks) 16 | ;; Assert information to flow forward. 17 | (assert 'p) 18 | ;; Focused inference should have been cancelled, as the intended 19 | ;; result was derived. 20 | (list-focused-inference-tasks) 21 | (list-terms :originsets true) 22 | 23 | ;;; Backward-in-Forward Reasoning 24 | (clearkb true) 25 | (assert! 'q) 26 | (list-focused-inference-tasks) 27 | (assert '(if p (if q r))) 28 | (list-terms :originsets true) 29 | (list-focused-inference-tasks) 30 | (assert 'p) 31 | (list-terms :originsets true) 32 | 33 | ;;; Examples from Schlegel's dissertation: 34 | 35 | (clearkb true) 36 | (krnovice true) 37 | 38 | ;; Forward-in-backward 39 | 40 | ;; Azam is a person 41 | (assert '(Isa Azam Person)) 42 | 43 | ;; If a person is arrested, they are detained. 44 | (assert '(if (Arrested (every x (Isa x Person))) (Detained x))) 45 | 46 | ;; A person is either detained or free. 47 | (assert '(xor (Detained (every x (Isa x Person))) (Free x))) 48 | 49 | (askif '(Detained Azam)) 50 | 51 | (assert '(Arrested Azam)) 52 | 53 | (list-terms) 54 | 55 | ;; It should now be derived that Azam is detained. 56 | 57 | ;; Forward 58 | 59 | ;(clearkb true) 60 | 61 | ;; A person is either detained or free. 62 | ;(assert '(xor (Detained (every x (Isa x Person))) (Free x))) 63 | 64 | ;; Azam is a Person 65 | ;(assert! '(Isa Azam Person)) 66 | 67 | ;; Azam is arrested 68 | ;(assert! '(Arrested Azam)) 69 | 70 | ;; If a person is arrested, they are detained. 71 | ;(assert '(if (Arrested (every x (Isa x Person))) (Detained x))) 72 | 73 | ;; This should derive (not (Free Azam)) 74 | 75 | ;; Backward-in-Forward 76 | 77 | (clearkb true) 78 | 79 | ;; Ahmad is a person. 80 | (assert '(Isa Ahmad Person)) 81 | 82 | ;; If a person is a person of interest (POI), 83 | ;; they are either under surveillance, or 84 | ;; being sought out. 85 | (assert '(if (POI (every x (Isa x Person))) 86 | (xor (UnderSurveillance x) 87 | (BeingSoughtOut x)))) 88 | 89 | ;; If a person is a POI, they are of 90 | ;; interest to INSCOM 91 | (assert '(if (POI (every x (Isa x Person))) (ofInterestTo x INSCOM))) 92 | 93 | ;; Ahmad is not under surveillance 94 | (assert! '(not (UnderSurveillance Ahmad))) 95 | 96 | ;; Ahmad is a POI 97 | (assert '(POI Ahmad)) 98 | 99 | ;; It should now be derived that Azam is being sought out. 100 | (list-terms :originsets true) -------------------------------------------------------------------------------- /Demo/genericinfer.sneps: -------------------------------------------------------------------------------- 1 | ;;; Demo of inference on generics. 2 | ;;; Daniel R. Schlegel 3 | ;;; Created 1/2/2014 4 | 5 | ;;; Generics can be used in three different ways. 6 | ;;; 1) As a rule of inference. (asserted) 7 | ;;; 2) As the antecedent of a deductive rule. (unasserted, usually) 8 | ;;; 3) As the "antecedent" of a quantified term. (asserted, AnalyticGeneric) 9 | ;;; Theoretically, a generic can be all three of these, but: 10 | ;;; a) 3 combined with 1 or 2 would be silly, and might as well not be there, 11 | ;;; since AnalyticGenerics are tautologies. 12 | 13 | ;;; Case 1a: As a rule of inference (asserted). 14 | (clearkb true) 15 | (defineSlot actNoAgent :type Thing) 16 | (defineSlot theme :type Entity) 17 | (defineCaseframe 'Propositional '(actNoAgent theme) :fsymbols '(Scare Carry)) 18 | 19 | (assert '(Carry (every x (Isa x Dog) (Scare x)))) 20 | (assert '(Isa Fido Dog)) 21 | (assert '(Isa Lassie Dog)) 22 | (assert '(Scare Fido)) 23 | (askwh '(Carry (?x (Isa ?x Dog)))) 24 | 25 | ;;; Case 1b: As a rule of inference, with embedded generics. 26 | (clearkb true) 27 | (defineSlot entity1 :type Entity) 28 | (defineSlot entity2 :type Entity) 29 | (defineCaseframe 'Entity '('Parent entity1)) 30 | (defineCaseframe 'Propositional '('Ancestor entity1 entity2)) 31 | 32 | (assert '(Ancestor (Parent (every x)) x)) 33 | (assert '(Isa Alex Entity)) 34 | (askwh '(Ancestor ?x Alex)) 35 | 36 | ;;; Case 2: As a rule antecedent (unasserted). 37 | (clearkb true) 38 | (defineSlot actNoAgent :type Thing) 39 | (defineSlot theme :type Entity) 40 | (defineCaseframe 'Propositional '(actNoAgent theme) 41 | :fsymbols '(Scare Carry)) 42 | 43 | (assert '(if (Scare (every x (Isa x Dog))) (Carry x))) 44 | (assert '(Isa Fido Dog)) 45 | (assert '(Isa Lassie Dog)) 46 | (assert '(Scare Fido)) 47 | (askwh '(Carry (?x (Isa ?x Dog)))) 48 | 49 | ;;; Case 2a: Fully Generic version of Case 2. 50 | (clearkb true) 51 | (defineSlot actNoAgent :type Thing) 52 | (defineSlot theme :type Entity) 53 | (defineCaseframe 'Propositional '(actNoAgent theme) 54 | :fsymbols '(Scare Carry)) 55 | 56 | (assert '(Carry (every x (Isa x Dog) (Scare x)))) 57 | (assert '(Isa Fido Dog)) 58 | (assert '(Isa Lassie Dog)) 59 | (assert '(Scare Fido)) 60 | (askwh '(Carry (?x (Isa ?x Dog)))) 61 | 62 | ;;; Case 2b: A more interesting connective. 63 | (clearkb true) 64 | (defineSlot actNoAgent :type Thing) 65 | (defineSlot theme :type Entity) 66 | (defineCaseframe 'Propositional '(actNoAgent theme) 67 | :fsymbols '(Carry Walk)) 68 | 69 | (assert '(xor (Walk (every x (Isa x Dog))) (Carry x))) 70 | (assert '(Isa Fido Dog)) 71 | (assert '(Isa Lassie Dog)) 72 | (assert '(not (Carry Fido))) 73 | (assert '(Carry Lassie)) 74 | (askif '(not (Walk Lassie))) 75 | (askif '(Carry Fido)) 76 | 77 | (askwh '(Carry (?x (Isa ?x Dog)))) -------------------------------------------------------------------------------- /Demo/index.clj: -------------------------------------------------------------------------------- 1 | ;;; Index of CSNePS Demo Files 2 | 3 | ;;; The contents of this file are subject to the University at Buffalo 4 | ;;; Public License Version 1.0 (the "License"); you may not use this file 5 | ;;; except in compliance with the License. You may obtain a copy of the 6 | ;;; License at http://www.cse.buffalo.edu/sneps/Downloads/ubpl.pdf. 7 | ;;; 8 | ;;; Software distributed under the License is distributed on an "AS IS" 9 | ;;; basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 10 | ;;; the License for the specific language governing rights and limitations 11 | ;;; under the License. 12 | ;;; 13 | ;;; The Original Code is CSNePS. 14 | ;;; 15 | ;;; The Initial Developer of the Original Code is Research Foundation of 16 | ;;; State University of New York, on behalf of University at Buffalo. 17 | ;;; 18 | ;;; Portions created by the Initial Developer are Copyright (C) 2007 19 | ;;; Research Foundation of State University of New York, on behalf of 20 | ;;; University at Buffalo. All Rights Reserved. 21 | ;;; 22 | ;;; Contributor(s): ______________________________________. 23 | 24 | (in-ns 'csneps.demo) 25 | 26 | (def demoindex [["Demonstration of basic CSNePS functionality." "basic-demo.sneps"], 27 | ["Example of function-valued functions." "refcl.sneps"], 28 | ["Demonstration of contextually determining, and changing semantic types." "changedemo.sneps"], 29 | ["Demonstration of sort-based inference" "sort-based-derivable.sneps"], 30 | ["Demonstration of path-based inference" "pb-inference.sneps"], 31 | ["Demonstration of natural deduction" "natural-deduction-derivable.sneps"], 32 | ["Demonstration of natural deduction with xor" "xor.sneps"], 33 | ["Demonstration of andor and thresh introduction" "andor.sneps"], 34 | ["Demonstration of thresh elimination" "threshelim.sneps"], 35 | ["Demonstration of equivalence elimination and introduction" "equivalence.sneps"], 36 | ["Demonstration of combined slot-based inference and and elimination" "inferdemo.sneps"], 37 | ["Using Slot-Based Inference to derive rules" "sbConnectives.sneps"], 38 | ["Cutting Infinite Recursion" "recursion.sneps"], 39 | ["Negation by Failure" "negbyfail.sneps"], 40 | ["SNeRE" "snere.sneps"], 41 | ["Demonstration of using find (for SNePS Developers)." "finddemo.sneps"], 42 | ["Demonstration of building arbitrary individuals." "vardemo.sneps"] 43 | ["Demonstration of condition-action rules." "condact-rules.sneps"] 44 | ["Demonstration of focused inference." "focusedinfer.sneps"] 45 | ["Demonstration of inference using generics." "genericinfer.sneps"] 46 | ["Demonstration of subsumption inference." "subsumption.sneps"] 47 | ["Demonstration of production rules." "production-rules.sneps"] 48 | ["Demonstration of modeling with krnovice." "dissertation-examples.sneps"]]) 49 | 50 | -------------------------------------------------------------------------------- /Demo/inferdemo.sneps: -------------------------------------------------------------------------------- 1 | ;;; Demonstration of Some Inference Methods 2 | ;;; 3 | ;;; Currently, if we ask if a term, A, is asserted, the following is tried: 4 | ;;; 1. Is A already asserted? 5 | ;;; 2. Is A derivable by sort-based inference? 6 | ;;; 3. Is A derivable by slot-based inference? 7 | ;;; 4. Is A derivable by natural deduction? 8 | ;;; a. Is A derivable by some Elimination rule? 9 | ;;; i. Is A a conjunct of some term, and derivable by And Elimination? 10 | ;;; b. Is A derivable by the Introduction rule of its main connective? 11 | ;;; 5. Is (not A) derivable? Try 1--4. 12 | 13 | (in-ns 'csneps.core.snuser) 14 | 15 | (clearkb true) 16 | (assert '(and (Isa (setof Fido Rover Lassie) (setof Dog Pet)) 17 | (Isa (setof Fluffy Tom) (setof Cat Pet)) 18 | (not (Isa (setof Fido Rover) Cat)) 19 | (not (Isa (setof Fluffy Tom) Dog)))) 20 | 21 | ;;; These require And Elimination and Slot-Based inference: 22 | (ask '(Isa (setof Fido Lassie) Dog)) 23 | (ask '(Isa Tom Dog)) 24 | 25 | ;;; This is an example that would require 26 | ;;; a kind of And Introduction with the elements of a set argument. 27 | ;;; In general, it would require a combinatorial number of checks. 28 | ;;; It doesn't work as yet. Should it be implemented? 29 | (ask '(Isa (setof Fido Fluffy) Pet)) 30 | 31 | 32 | -------------------------------------------------------------------------------- /Demo/match.sneps: -------------------------------------------------------------------------------- 1 | ;;; Demo of match, using unification, type checking, and subsumption. 2 | ;;; Daniel R. Schlegel 3 | ;;; Created 12/9/2013 4 | 5 | (in-ns 'csneps.core.snuser) 6 | 7 | (clearkb true) 8 | 9 | (defineType Animal (Thing)) 10 | (defineType Mammal (Animal)) 11 | (defineType Dog (Mammal)) 12 | (defineType Cat (Mammal)) 13 | (defineType Fish (Animal)) 14 | (defineType Pike (Fish)) 15 | (defineType Bass (Fish)) 16 | 17 | (defineSlot child :type Animal) 18 | (defineSlot parent :type Animal) 19 | (defineSlot mother :type Animal) 20 | (defineSlot father :type Animal) 21 | 22 | (defineSlot dog :type Dog) 23 | 24 | (defineSlot object :type Thing 25 | :docstring "Non-agentive objects of actions.") 26 | (defineSlot property :type Thing) 27 | 28 | (defineCaseframe 'Proposition '('Property object property) 29 | :docstring "[object] has property [property]") 30 | 31 | (defineCaseframe 'Proposition '('Parent parent child)) 32 | (defineCaseframe 'Proposition '('Mother mother child)) 33 | (defineCaseframe 'Proposition '('Father father child)) 34 | 35 | (defineCaseframe 'Proposition '('Dog dog)) 36 | 37 | ;; Easy case. 38 | ; TODO: Fix bug in unifying this set with the arb! 39 | ;(assert '(Dog #{Fido Lassie})) 40 | (assert '(Dog Fido)) 41 | (assert '(Dog Lassie)) 42 | 43 | (assert '(Parent Fido (every x (Father x Fido) (Dog x)))) ;; wft3 44 | 45 | (assert '(Parent Fido Lassie)) ;; wft4 46 | 47 | (list-terms :types true) 48 | 49 | ;; An i-channel should be created from wft3 -> wft4 50 | ;; and another from wft4 -> wft3. 51 | (snip/ig-status) 52 | 53 | ;; Subsumption case. 54 | (clearkb) 55 | 56 | (assert '(Property 57 | (every x (Isa x Elephant) (Isa x Animal)) 58 | Large)) 59 | 60 | (assert '(Property 61 | (every x (Isa x Elephant) (Property x Albino) (Isa x Animal)) 62 | Large)) 63 | 64 | (snip/ig-status) 65 | -------------------------------------------------------------------------------- /Demo/natural-deduction-derivable-test.sneps: -------------------------------------------------------------------------------- 1 | ;;; Demonstration of Natural Deduction Rules of Inference 2 | 3 | (clearkb) 4 | 5 | ;;; And Elimination and Disjunctive Syllogism 6 | (assert '(and (not a) (not b))) 7 | (assert '(or a b c)) 8 | (snip/backward-infer (find-term 'c)) 9 | 10 | ;;; OR introduction 11 | (snip/backward-infer (defineTerm '(or c d))) 12 | 13 | ;;; Can't use Disjunctive Syllogism 14 | ;;; if the disjunction is not derivable. 15 | (clearkb) 16 | (assert '(if a (or b c))) 17 | (assert '(not b)) 18 | (snip/backward-infer (find-term 'c)) 19 | 20 | ;;; Disjuctive Syllogism version of Modus Tollens 21 | (assert '(or (not p) q)) 22 | (assert '(not q)) 23 | (snip/backward-infer (find-term 'p)) 24 | 25 | ;;; AND introduction 26 | (assert 'a) 27 | (snip/backward-infer (defineTerm '(and a (not b) (not q)))) 28 | 29 | ;;; Implication Elimination Chaining 30 | (clearkb) 31 | (assert 'a) 32 | (assert '(if a b)) 33 | (assert '(if b c)) 34 | (assert '(if c d)) 35 | (snip/backward-infer (find-term 'd)) 36 | (list-terms) 37 | 38 | ;;; Don't get into an infinite loop. 39 | (clearkb) 40 | (assert '(if a b)) 41 | (assert '(if b c)) 42 | (assert '(if c a)) 43 | (snip/backward-infer (find-term 'a)) 44 | 45 | ;;; Implication Elimination Chaining 46 | ;;; with sets of antecedents and consequents 47 | (clearkb) 48 | (assert 'a) 49 | (assert 'b) 50 | (assert '(if (setof a b) (setof c d))) 51 | (assert '(if a e)) 52 | (assert '(if (setof d e) g)) 53 | (snip/backward-infer (find-term 'g)) 54 | (list-terms) 55 | 56 | ;;; Using explicit conjunctions instead of sets 57 | (clearkb) 58 | (assert 'a) 59 | (assert 'b) 60 | (assert '(if (and a b) (and c d))) 61 | (assert '(if a e)) 62 | (assert '(if (and d e) g)) 63 | (snip/backward-infer (find-term 'g)) 64 | (list-terms) 65 | 66 | ;;; Using 67 | ;;; And Introduction 68 | ;;; Implication Elimination 69 | ;;; And Elimination 70 | ;;; Or Introduction 71 | (clearkb) 72 | (assert 'a) 73 | (assert 'b) 74 | (assert '(if (and a b) (and c d))) 75 | (snip/backward-infer (defineTerm '(or c d)) 76 | 77 | -------------------------------------------------------------------------------- /Demo/natural-deduction-derivable.sneps: -------------------------------------------------------------------------------- 1 | ;;; Demonstration of Natural Deduction Rules of Inference 2 | 3 | (clearkb) 4 | 5 | ;;; And Elimination and Disjunctive Syllogism 6 | (assert '(and (not a) (not b))) 7 | (assert '(or a b c)) 8 | (ask 'c) 9 | 10 | ;;; OR introduction 11 | (ask '(or c d)) 12 | 13 | ;;; Can't use Disjunctive Syllogism 14 | ;;; if the disjunction is not derivable. 15 | (clearkb) 16 | (assert '(if a (or b c))) 17 | (assert '(not b)) 18 | (ask 'c) 19 | 20 | ;;; Disjuctive Syllogism version of Modus Tollens 21 | (assert '(or (not p) q)) 22 | (assert '(not q)) 23 | (ask 'p) 24 | 25 | ;;; AND introduction 26 | (assert 'a) 27 | (ask '(and a (not b) (not q))) 28 | 29 | ;;; Implication Elimination Chaining 30 | (clearkb) 31 | (assert 'a) 32 | (assert '(if a b)) 33 | (assert '(if b c)) 34 | (assert '(if c d)) 35 | (ask 'd) 36 | (list-terms) 37 | 38 | ;;; Don't get into an infinite loop. 39 | (clearkb) 40 | (assert '(if a b)) 41 | (assert '(if b c)) 42 | (assert '(if c a)) 43 | (ask 'a) 44 | 45 | ;;; Implication Elimination Chaining 46 | ;;; with sets of antecedents and consequents 47 | (clearkb) 48 | (assert 'a) 49 | (assert 'b) 50 | (assert '(if (setof a b) (setof c d))) 51 | (assert '(if a e)) 52 | (assert '(if (setof d e) g)) 53 | (ask 'g) 54 | (list-terms) 55 | 56 | ;;; Using explicit conjunctions instead of sets 57 | (clearkb) 58 | (assert 'a) 59 | (assert 'b) 60 | (assert '(if (and a b) (and c d))) 61 | (assert '(if a e)) 62 | (assert '(if (and d e) g)) 63 | (ask 'g) 64 | (list-terms) 65 | 66 | ;;; Using 67 | ;;; And Introduction 68 | ;;; Implication Elimination 69 | ;;; And Elimination 70 | ;;; Or Introduction 71 | (clearkb) 72 | (assert 'a) 73 | (assert 'b) 74 | (assert '(if (and a b) (and c d))) 75 | (ask '(or c d)) 76 | 77 | -------------------------------------------------------------------------------- /Demo/negbyfail.sneps: -------------------------------------------------------------------------------- 1 | ;;; Demonstration of Negation by Failure 2 | 3 | (in-ns 'csneps.core.snuser) 4 | 5 | (clearkb) 6 | ;;; A kind of bird that is not known not to fly flies. 7 | (assert '(if (setof bird (thnot (not flies))) flies)) 8 | ;;; Canaries are birds. 9 | (assert '(if canary bird)) 10 | ;;; Penguins are birds that don't fly. 11 | (assert '(if penguin (setof bird (not flies)))) 12 | ;;; It's a canary. 13 | (assert 'canary) 14 | ;;; It should fly. 15 | (ask 'flies) 16 | 17 | (clearkb) 18 | ;;; A kind of bird that is not known not to fly flies. 19 | (assert '(if (setof bird (thnot (not flies))) flies)) 20 | ;;; Canaries are birds. 21 | (assert '(if canary bird)) 22 | ;;; Penguins are birds that don't fly. 23 | (assert '(if penguin (setof bird (not flies)))) 24 | ;;; It's a penguin. 25 | (assert 'penguin) 26 | ;;; It should not fly. 27 | (ask 'flies) 28 | -------------------------------------------------------------------------------- /Demo/pb-inference.sneps: -------------------------------------------------------------------------------- 1 | ;;; Demonstration of SNePS 3 Path-Based Inference 2 | ;;; Stuart C. Shapiro 3 | ;;; January 30, 2012 4 | 5 | (in-ns 'csneps.core.snuser) 6 | (clearkb true) 7 | 8 | (defineSlot subclass :type Category :negadjust reduce 9 | :path (compose ! subclass (kstar (compose superclass- ! subclass))) 10 | :docstring "Subcategories of some category/ies.") 11 | (defineSlot superclass :type Category :negadjust reduce 12 | :path (compose ! superclass (kstar (compose subclass- ! superclass))) 13 | :docstring "Supercategories of some category/ies.") 14 | 15 | (definePath 'class '(compose ! class (kstar (compose subclass- ! superclass)))) 16 | 17 | (definePath 'member '(compose ! member (kstar (compose equiv- ! equiv)))) 18 | 19 | (defineCaseframe 'Proposition '('Ako subclass superclass) 20 | :docstring "every [subclass] is a [superclass]") 21 | 22 | (showproofs) 23 | (assert '(Isa Fido Dog)) 24 | (assert '(Ako Dog Mammal)) 25 | (assert '(Ako (setof Mammal Fish) Vertebrate)) 26 | (assert '(Ako Vertebrate Animal)) 27 | (assert '(not (Ako Mammal Fish))) 28 | (assert '(Ako Fish SeaCreature)) 29 | 30 | ;; Mammals are Vertebrates, and Vertebrates are Animals, so Mammals are Animals. 31 | (ask '(Ako Mammal Animal)) 32 | 33 | ;; SeaCreatures are Fish, but Fish are not Animals. 34 | ;; Should this derive (not (Ako Mammal SeaCreature))? 35 | (ask '(Ako Mammal SeaCreature)) 36 | 37 | ;; Fido is a Dog, Dogs are Mammals, and Mammals are Animals, so Fido is an Animal. 38 | (ask '(Isa Fido Animal)) 39 | 40 | ;; Fido is a Dog, Dogs are Mammals. Mammals aren't known to be SeaCreatures, so neither is Fido. 41 | (ask '(Isa Fido SeaCreature)) 42 | (assert '(Equiv (setof Fido mydog))) 43 | 44 | ;; mydog is Equiv to Fido, and Fido is an Animal, so mydog is an Animal. 45 | (ask '(Isa mydog Animal)) 46 | (assert '(Equiv (setof mydog wifesdog))) 47 | 48 | ;; Fido is equiv to mydog, and mydog is equiv to wifesdog, so Fido is equiv to wifesdog. 49 | (ask '(Equiv (setof Fido wifesdog))) 50 | 51 | ;;; Demonstration of path constructs using pathsfrom 52 | ;; Without requiring the term to be asserted, the result is (Animal Dog SeaCreature). 53 | (pathsfrom 'Fido '(compose member- class)) 54 | (pathsfrom 'Fido '(compose member- ! class)) 55 | 56 | ;; irreflexive-restrict should remove Fido from the result set. 57 | (pathsfrom 'Fido '(compose equiv- equiv)) 58 | (pathsfrom 'Fido '(irreflexive-restrict (compose equiv- equiv))) 59 | -------------------------------------------------------------------------------- /Demo/pb-inference.sneps~: -------------------------------------------------------------------------------- 1 | ;;; Demonstration of SNePS 3 Path-Based Inference 2 | ;;; Stuart C. Shapiro 3 | ;;; January 30, 2012 4 | 5 | (in-ns 'csneps.core.snuser) 6 | (clearkb true) 7 | 8 | (defineSlot subclass :type Category :negadjust reduce 9 | :path (compose ! subclass (kstar (compose superclass- ! subclass))) 10 | :docstring "Subcategories of some category/ies.") 11 | (defineSlot superclass :type Category :negadjust reduce 12 | :path (compose ! superclass (kstar (compose subclass- ! superclass))) 13 | :docstring "Supercategories of some category/ies.") 14 | 15 | (definePath 'class '(compose ! class (kstar (compose subclass- ! superclass)))) 16 | 17 | (definePath 'member '(compose ! member (kstar (compose equiv- ! equiv)))) 18 | 19 | (defineCaseframe 'Proposition '('Ako subclass superclass) 20 | :docstring "every [subclass] is a [superclass]") 21 | 22 | (showproofs) 23 | (assert '(Isa Fido Dog)) 24 | (assert '(Ako Dog Mammal)) 25 | (assert '(Ako (setof Mammal Fish) Vertebrate)) 26 | (assert '(Ako Vertebrate Animal)) 27 | (assert '(not (Ako Mammal Fish))) 28 | (assert '(Ako Fish SeaCreature)) 29 | 30 | ;; Mammals are Vertebrates, and Vertebrates are Animals, so Mammals are Animals. 31 | (ask '(Ako Mammal Animal)) 32 | 33 | ;; SeaCreatures are Fish, but Fish are not Animals. 34 | ;; Should this derive (not (Ako Mammal SeaCreature))? 35 | (ask '(Ako Mammal SeaCreature)) 36 | 37 | ;; Fido is a Dog, Dogs are Mammals, and Mammals are Animals, so Fido is an Animal. 38 | (ask '(Isa Fido Animal)) 39 | 40 | ;; Fido is a Dog, Dogs are Mammals. Mammals aren't known to be SeaCreatures, so neither is Fido. 41 | (ask '(Isa Fido SeaCreature)) 42 | (assert '(Equiv (setof Fido mydog))) 43 | 44 | ;; mydog is Equiv to Fido, and Fido is an Animal, so mydog is an Animal. 45 | (ask '(Isa mydog Animal)) 46 | (assert '(Equiv (setof mydog wifesdog))) 47 | 48 | ;; Fido is equiv to mydog, and mydog is equiv to wifesdog, so Fido is equiv to wifesdog. 49 | (ask '(Equiv (setof Fido wifesdog))) 50 | 51 | ;;; Demonstration of path constructs using pathsfrom 52 | (pathsfrom 'Fido '(compose member- class)) 53 | (pathsfrom 'Fido '(compose member- ! class)) 54 | 55 | (pathsfrom 'Fido '(compose equiv- equiv)) 56 | (pathsfrom 'Fido '(irreflexive-restrict (compose equiv- equiv))) 57 | -------------------------------------------------------------------------------- /Demo/recursion.sneps: -------------------------------------------------------------------------------- 1 | ;;; Demonstration of SNePS not getting into infinite recursive loops. 2 | 3 | (showproofs :goals t) 4 | 5 | ;;; Circular implication with no base case could lead to infinite recursion. 6 | (clearkb) 7 | (assert '(if a b)) 8 | (assert '(if b c)) 9 | (assert '(if c a)) 10 | (ask 'a) 11 | 12 | ;;; One important part of cutting recursion 13 | ;;; is not working on the same goal multiple times. 14 | ;;; Storing lemmas in the KB is one way to do this, 15 | ;;; and is equivalent to tabling. 16 | ;;; This example was the motivating example for the acting system, 17 | ;;; because performing the same act multiple times does make sense. 18 | (clearkb) 19 | (assert '(if (setof q1 q2) q)) 20 | (assert '(if (setof p s) q1)) 21 | (assert '(if (setof r s) q2)) 22 | (assert '(if t s)) 23 | (assert 'p) 24 | (assert 'r) 25 | (assert 't) 26 | ;;; Note that the derivation t, t=>s |- s is done only once, 27 | ;;; then s! is stored. 28 | (ask 'q) 29 | 30 | ;;; To be continued once variables are added. 31 | -------------------------------------------------------------------------------- /Demo/refcl.sneps: -------------------------------------------------------------------------------- 1 | ;; Initialize KB completely 2 | (clearkb t) 3 | ;;; Demonstrate function-valued functions with the reflexive closure of binary slots. 4 | (defineType Relation (Thing)) 5 | (defineType BinaryRelation (Relation)) 6 | (defineType SnepsFunction (Relation)) 7 | (defineSlot relarg :type BinaryRelation 8 | :docstring "Filler is a binary relation used as an argument." 9 | :posadjust none 10 | :negadjust none 11 | :min 1 12 | :max 1) 13 | (defineSlot relational :type SnepsFunction 14 | :docstring "Filler is a relation-valued function." 15 | :posadjust none 16 | :negadjust none 17 | :min 1 18 | :max 1) 19 | (defineSlot relation :type Relation 20 | :docstring "Filler is a relation." 21 | :posadjust none 22 | :negadjust none 23 | :min 1 24 | :max 1) 25 | (defineSlot arg1 :type Entity 26 | :docstring "Filler is the first argument of some relation." 27 | :posadjust none 28 | :negadjust none 29 | :min 1 30 | :max 1) 31 | (defineSlot arg2 :type Entity 32 | :docstring "Filler is the second argument of some relation." 33 | :posadjust none 34 | :negadjust none 35 | :min 1 36 | :max 1) 37 | (defineCaseframe 'BinaryRelation '(relational relarg) 38 | :docstring "the [relational] of [relarg]" 39 | :fsymbols '(refClose)) 40 | (defineCaseframe 'Proposition '(relation arg1 arg2) 41 | :docstring "[arg1] has the relation [relation] to [arg2]" 42 | :fsymbols '(< (refClose))) 43 | ;;; < holds between 3 and 5. 44 | (assert '(< 3 5)) 45 | 46 | ;;; The reflexive closure of < holds between 3 and 3. 47 | (assert '((refClose <) 3 3)) 48 | 49 | ;;; See all the terms 50 | (list-terms) 51 | 52 | ;;; The relation wft2 is the reflexive closure of <, 53 | ;;; and it holds between 5 and 5. 54 | (assert '(wft24 5 5)) 55 | -------------------------------------------------------------------------------- /Demo/sbConnectives.sneps: -------------------------------------------------------------------------------- 1 | ;;; Demonstration of Using Slot-Based Inference to Derive Rules 2 | ;;; In each example, 3 | ;;; the first ask should succeed by Slot-Based Inference 4 | ;;; and the next ask(s) should not succeed. 5 | 6 | (showproofs) 7 | 8 | ;;; and 9 | ;;; === 10 | ;;; conjunctions are stored only with at least 2 arguments. 11 | ;;; (and a b c) |- (and a b) 12 | (clearkb) 13 | (assert '(and a b c)) 14 | (ask '(and a b)) 15 | (ask '(and a b c d)) 16 | 17 | ;;; (not (and a b c)) |- (not (and a b c d)) 18 | ;;; However, (not (and a b c)) = (nand a b c) 19 | (clearkb) 20 | (assert '(not (and a b c))) 21 | (ask '(not (and a b c d))) 22 | (ask '(not (and a b))) 23 | 24 | ;;; nor 25 | ;;; === 26 | ;;; negations are stored with at least 1 argument. 27 | ;;; (nor a b c) |- (nor a b) 28 | (clearkb) 29 | (assert '(nor a b c)) 30 | (ask '(nor a b)) 31 | (ask '(nor a b c d)) 32 | 33 | ;;; (not (nor a b c)) |- (not (nor a b c d)) 34 | ;;; However, (not (nor a b c)) = (or a b c) 35 | (clearkb) 36 | (assert '(not (nor a b c))) 37 | (ask '(not (nor a b c d))) 38 | (ask '(not (nor a b))) 39 | 40 | ;;; or 41 | ;;; == 42 | ;;; disjunctions are stored only with at least 2 arguments. 43 | ;;; (or a b c) |- (or a b c d) 44 | (clearkb) 45 | (assert '(or a b c)) 46 | (ask '(or a b c d)) 47 | (ask '(or a b)) 48 | 49 | ;;; (not (or a b c)) |- (not (or a b)) 50 | ;;; However (not (or a b c)) = (nor a b c) 51 | (clearkb) 52 | (assert '(not (or a b c))) 53 | (ask '(not (or a b))) 54 | (ask '(not (or a b c d))) 55 | 56 | ;;; nand 57 | ;;; ==== 58 | ;;; negatedconjunctions are stored only with a least 2 arguments 59 | ;;; (nand a b c) |- (nand a b c d) 60 | (clearkb) 61 | (assert '(nand a b c)) 62 | (ask '(nand a b c d)) 63 | (ask '(nand a b)) 64 | 65 | ;;; (not (nand a b c)) |- (not (nand a b)) 66 | ;;; However (not (nand a b c)) = (and a b c) 67 | (clearkb) 68 | (assert '(not (nand a b c))) 69 | (ask '(not (nand a b))) 70 | (ask '(not (nand a b c d))) 71 | 72 | ;;; iff 73 | 74 | ;;; xor 75 | 76 | ;;; andor 77 | 78 | ;;; thresh 79 | 80 | ;;; if 81 | ;;; == 82 | ;;; implications are stored 83 | ;;; with at least 1 antecedent and at least one consequent. 84 | ;;; (if (setof a b c) (setof p q r)) |- (if (setof a b c d) (setof p q)) 85 | (clearkb) 86 | (assert '(if (setof a b c) (setof p q r))) 87 | (ask '(if (setof a b c d) (setof p q))) 88 | (ask '(if (setof a b) (setof p q r))) 89 | (ask '(if (setof a b c) (setof p q r s))) 90 | 91 | ;;; (not (if (setof a b c) (setof p q r))) 92 | ;;; |- (not (if (setof a b) (setof p q r s))) 93 | (clearkb) 94 | (assert '(not (if (setof a b c) (setof p q r)))) 95 | (ask '(not (if (setof a b) (setof p q r s)))) 96 | (ask '(not (if (setof a b c d) (setof p q r)))) 97 | (ask '(not (if (setof a b c) (setof p q)))) 98 | 99 | ;;; v=> 100 | 101 | ;;; i=> 102 | -------------------------------------------------------------------------------- /Demo/snere.sneps: -------------------------------------------------------------------------------- 1 | ;;; Demonstration of SNeRE 2 | 3 | (in-ns 'csneps.core.snuser) 4 | (clearkb true) 5 | 6 | ;;; Action functions that need no arguments may be attached to Acts. 7 | (attach-primaction (defineTerm 'helloWorld :Act) 8 | (define-primaction helloWorldfn [] 9 | (cl-format true "~&Hello world.~%"))) 10 | (perform 'helloWorld) 11 | 12 | ;;; An Act with an action of no arguments. 13 | ;;; Define a caseframe with just an action slot, 14 | ;;; and give it a function symbol. 15 | (defineCaseframe 'Act '(action) :fsymbols '(sayHello)) 16 | 17 | ;;; Attach a primitive action function to the action function symbol. 18 | (attach-primaction (defineTerm 'sayHello :Action) 19 | (define-primaction sayHellofn [] 20 | (cl-format true "~&Hello.~%"))) 21 | ;;; Now, can perform it. 22 | (perform '(sayHello)) 23 | 24 | ;;; Associate another action function symbol to the same caseframe, 25 | (sameFrame 'sayHiThere 'sayHello) 26 | ;;; attach another action function of no arguments to it, 27 | (attach-primaction (defineTerm 'sayHiThere :Action) 28 | (define-primaction sayHiTherefn [] 29 | (cl-format true "~&Hi there.~%"))) 30 | ;;; and perform it. 31 | (perform '(sayHiThere)) 32 | 33 | ;;; Attach an existing primitive action function to another action symbol. 34 | (sameFrame 'sayHi 'sayHiThere) 35 | (attach-primaction (defineTerm 'sayHi :Action) 36 | 'sayHiTherefn) 37 | (perform '(sayHi)) 38 | 39 | ;;; An action with one argument 40 | (defineType Person (Thing)) 41 | (defineSlot addressee :type Person :posadjust none :negadjust none) 42 | (defineCaseframe 'Act '(action addressee) :fsymbols '(Greet)) 43 | (attach-primaction (defineTerm 'Greet :Action) 44 | (define-primaction greetfn [addressee] 45 | (for [person addressee] 46 | (cl-format true "~&Hello ~S.~%" person)))) 47 | (perform '(Greet (setof Stu Bill))) 48 | 49 | ;;; SNePS 2 demo examples 50 | ;; (define-primaction sayfn ) -------------------------------------------------------------------------------- /Demo/sort-based-derivable.sneps: -------------------------------------------------------------------------------- 1 | 2 | ;;; Basic Demo of SNePS 3 Sort-Based Inference 3 | ;;; ================================ 4 | 5 | (in-package :snuser) 6 | ;; Initialize KB completely 7 | (clearkb t) 8 | 9 | ;;; Two new types: 10 | (defineType Animal (Thing)) 11 | (defineType Dog (Animal)) 12 | 13 | ;;; One new slot with sort dog: 14 | (defineSlot dogs :type Dog) 15 | 16 | ;;; One caseframe to assert dog sort: 17 | (defineCaseframe 'Proposition '('Dog dogs) 18 | :docstring "[dogs] is a dog.") 19 | 20 | ;; Assert the proposition that Fido and Dolly are both dogs: 21 | (assert '(Dog (setof Fido Dolly))) 22 | 23 | ;; Ask if Fido is an Animal: 24 | (ask '(Isa Fido Animal)) 25 | 26 | ;; Ask if both Fido and Dolly are Animal and Dog: 27 | (ask '(Isa (setof Dolly Fido) (setof Animal Dog))) 28 | 29 | 30 | -------------------------------------------------------------------------------- /Demo/subsumption.sneps: -------------------------------------------------------------------------------- 1 | ;; Subsumption examples from the old version of SNePS 3. 2 | 3 | (in-ns 'csneps.core.snuser) 4 | 5 | (clearkb true) 6 | 7 | ;;; Define Types 8 | (defineType Agent (Thing) "Individuals that have agency") 9 | (defineType Action (Thing) "Actions that Agents can perform.") 10 | 11 | ;;; Define Slots 12 | (defineSlot agent :type Agent) 13 | (defineSlot object :type Thing 14 | :docstring "Non-agentive objects of actions.") 15 | (defineSlot property :type Thing) 16 | (defineSlot life :type Thing) 17 | (defineSlot whole :type Thing) 18 | (defineSlot part :type Thing) 19 | (defineSlot group :type Thing) 20 | (defineSlot entity1 :type Agent) 21 | (defineSlot entity2 :type Agent) 22 | 23 | ;;; Caseframes 24 | 25 | (defineCaseframe 'Proposition '('Owns agent object) 26 | :docstring "[agent] owns [object]") 27 | 28 | (defineCaseframe 'Proposition '('Beats agent life) 29 | :docstring "[agent] beats [object]") 30 | 31 | (defineCaseframe 'Proposition '('Property object property) 32 | :docstring "[object] has property [property]") 33 | 34 | (defineCaseframe 'Proposition '('isPartOf part whole) 35 | :docstring "[part] is part of [whole]") 36 | 37 | (defineCaseframe 'Proposition '(rel entity1 entity2) 38 | :fsymbols '(Parent Son) 39 | :docstring "[entity1] bears the relation [rel] to [entity2].") 40 | 41 | ;;; Every elephant is large. 42 | (assert '(Property 43 | (every x (Isa x Elephant)) 44 | Large)) 45 | 46 | ;;; Every albino elephant should be large. 47 | (ask '(Property 48 | (every x (Isa x Elephant) (Property x Albino)) 49 | Large)) 50 | 51 | ;;; Every elephant has a trunk 52 | (assert '(isPartOf 53 | (some y(x) (Isa y Trunk)) 54 | (every x (Isa x Elephant) (Isa x Agent)))) 55 | 56 | ;;; Albino elephants are valuable 57 | (assert '(Property 58 | (every x (Isa x Elephant) (Property x Albino) (Isa x Agent)) 59 | Valuable)) 60 | 61 | ;;; A trunk of every elephant is flexible 62 | (assert '(Property (some y(x) (Isa y Trunk) 63 | (isPartOf y (every x (Isa x Elephant) (Isa x Agent)))) 64 | Flexible)) 65 | 66 | ;;; Grey elephants are common 67 | (assert '(Property 68 | (every x (Isa x Elephant) (Property x Grey) (Isa x Agent)) 69 | Common)) 70 | 71 | ;;; Some grey elephant should be large. 72 | (ask '(Property 73 | (some x() (Isa x Elephant) (Property x Grey) (Isa x Agent)) 74 | Large)) 75 | 76 | ;;; Some elephant should be valuable. 77 | (ask '(Property 78 | (some x() (Isa x Elephant)) 79 | Valuable)) 80 | 81 | ;;; Every animal that has a trunk is an elephant. 82 | ;;; This example involves arbitrary objects 83 | ;;; with indefinite objects in their restrictions 84 | (assert '(Isa 85 | (every x (Isa x Animal) (Isa x Agent) 86 | (isPartOf (some y(x) (Isa y Trunk)) 87 | x)) 88 | Elephant)) 89 | 90 | ;;; Every animal that has a long trunk is amazing. 91 | (assert '(Property 92 | (every x (Isa x Animal) (Isa x Agent) 93 | (isPartOf (some y(x) (Isa y Trunk) 94 | (Property y Long)) 95 | x)) 96 | Amazing)) 97 | 98 | ;;; The arbitrary animal with a long trunk should be an elephant 99 | ;;; This requires subsumption among arbitrary objects 100 | ;;; with indefinite objects in their restrictions. 101 | (ask '(Isa 102 | (every x (Isa x Animal) (Isa x Agent) 103 | (isPartOf (some y(x) (Isa y Trunk) 104 | (Property y Long)) 105 | x)) 106 | Elephant)) 107 | 108 | ;;; Woods' example: 109 | ;;; [person whose sons are professionals] 110 | ;;; subsumes [woman whose sons are doctors] 111 | ;;; For structural subsumption, a woman is a person who's female, 112 | ;;; and a doctor is a professional who's a doctor. 113 | ;;; 114 | ;;; Any person whose sons are professionals is proud. 115 | (assert '(Property 116 | (every x (Isa x Person) (Isa x Agent) 117 | (Isa (every y (Son y x)) Professional)) 118 | Proud)) 119 | 120 | ;;; Any woman whose sons are doctors should be proud. 121 | (ask '(Property 122 | (every x (Isa x Person) (Isa x Agent) 123 | (Property x Female) 124 | (Isa (every y (Son y x)) Professional) 125 | (Isa y Doctor)) 126 | Proud)) 127 | 128 | 129 | -------------------------------------------------------------------------------- /Demo/threshelim.sneps: -------------------------------------------------------------------------------- 1 | ;;; Demonstrations of Thresh Elimination 2 | 3 | ;;; Deriving positive instances of arguments of thresh 4 | 5 | ;;; If no argument is derivable, 6 | ;;; and no negation of an argument is derivable, 7 | ;;; then nothing can be derived. 8 | (clearkb) 9 | (assert '(thresh (3 5) p1 p2 p3 p4 p5 p6)) 10 | ;;; Should not derive anything. 11 | (ask 'p1) 12 | 13 | ;;; If fewer than min arguments are derivable 14 | ;;; and no negation of an argument is derivable, 15 | ;;; then nothing can be derived. 16 | (clearkb) 17 | (assert '(thresh (3 5) p1 p2 p3 p4 p5 p6)) 18 | (assert 'p1) 19 | (assert '(if a p2)) 20 | (assert 'a) 21 | ;;; Should not derive anything. 22 | (ask 'p3) 23 | 24 | ;;; If more than tot-min negations are derivable, 25 | ;;; then nothing can be derived. 26 | (clearkb) 27 | (assert '(thresh (3 5) p1 p2 p3 p4 p5 p6)) 28 | (assert '(not p1)) 29 | (assert '(not p2)) 30 | (assert '(if a (not p3))) 31 | (assert 'a) 32 | ;;; Should not derive anything. 33 | (ask 'p4) 34 | 35 | ;;; If at least min args can be derived, 36 | ;;; and tot-max-1 negations can be derived, 37 | ;;; then can derive another argument. 38 | (clearkb) 39 | (assert '(thresh (3 5) p1 p2 p3 p4 p5 p6)) 40 | (assert 'p1) 41 | (assert 'p2) 42 | (assert '(if a p3)) 43 | (assert 'a) 44 | ;;; Should derive p4. 45 | (ask 'p4) 46 | 47 | ;;; Retry with tot > 6 48 | ;;; If at least min args can be derived, 49 | ;;; and tot-max-1 negations can be derived, 50 | ;;; then can derive another argument. 51 | (clearkb) 52 | (assert '(thresh (3 5) p1 p2 p3 p4 p5 p6 p7)) 53 | (assert 'p1) 54 | (assert 'p2) 55 | (assert '(if a p3)) 56 | (assert 'a) 57 | (assert '(not p4)) 58 | ;;; Should derive p5 59 | (ask 'p5) 60 | 61 | ;;; But one fewer negation being derivable, 62 | ;;; causes it not to fire. 63 | (clearkb) 64 | (assert '(thresh (3 5) p1 p2 p3 p4 p5 p6 p7)) 65 | (assert 'p1) 66 | (assert 'p2) 67 | (assert '(if a p3)) 68 | (assert 'a) 69 | ;;; Should not derive anything 70 | (ask 'p5) 71 | 72 | ;;; Deriving negative instances of arguments of thresh 73 | ;;; If min-1 arguments are derived 74 | ;;; and at least tot-max negations of arguments are derived 75 | ;;; then the negation of another argument is derivable. 76 | (clearkb) 77 | (assert '(thresh (3 5) p1 p2 p3 p4 p5 p6 p7)) 78 | (assert 'p1) 79 | (assert 'p2) 80 | (assert '(not p3)) 81 | (assert '(if a (not p4))) 82 | (assert 'a) 83 | ;;; Should derive (not p5) 84 | (ask 'p5) 85 | -------------------------------------------------------------------------------- /Demo/unification.sneps: -------------------------------------------------------------------------------- 1 | ;;; Demo of unification, including on sets. 2 | ;;; Daniel R. Schlegel 3 | ;;; Created 12/20/2013 4 | 5 | ;; Simple test of sets in substitutions. 6 | ;; The result should be a single substitution with the 7 | ;; source binding empty, and the target binding containing 8 | ;; #{Lassie Fido} substituted for arb1. 9 | (clearkb true) 10 | (assert '(Isa #{Lassie Fido} Dog)) ;; wft1 11 | (assert '(Isa (every x) Dog)) ;; wft3 12 | (build/unify? (find-term 'wft1) (find-term 'wft3)) 13 | 14 | ;; A case where sets should not be used in substitutions, 15 | ;; namely, where the variable portion is a set. 16 | ;; Two substitutions should be returned - one substituting 17 | ;; Lassie for arb1, and the other Lassie for arb2. 18 | (clearkb true) 19 | (assert '(Isa Lassie Pet)) ;; wft1 20 | (assert '(Isa #{(every x (Isa x Dog)) (every y (Isa y Cat))} Pet)) ;; wft6 21 | (build/unify? (find-term 'wft1) (find-term 'wft6)) -------------------------------------------------------------------------------- /Demo/varRels.sneps: -------------------------------------------------------------------------------- 1 | ;;; Demonstration of a variable in function position 2 | ;;; Use the definition of a transitive relation 3 | ;;; Stuart C. Shapiro 4 | ;;; April 23, 2013 5 | 6 | (in-ns 'csneps.core.snuser) 7 | 8 | (clearkb true) 9 | 10 | (defineType Relation (Thing) 11 | "The class of relations.") 12 | 13 | (defineType UnaryRelation (Relation) 14 | "The class of unary relations.") 15 | 16 | (defineType BinaryRelation (Relation) 17 | "The class of binary relations.") 18 | 19 | (defineType MetaRelation (UnaryRelation) 20 | "The class of properties of relations.") 21 | 22 | (defineSlot brel :type BinaryRelation :posadjust reduce :negadjust reduce 23 | :docstring "Fillers are binary relations") 24 | 25 | (defineSlot arg1 :type Entity :posadjust reduce :negadjust reduce 26 | :docstring "Fillers are entities in the first position of a relation") 27 | 28 | (defineSlot arg2 :type Entity :posadjust reduce :negadjust reduce 29 | :docstring "Fillers are entities in the second position of a relation") 30 | 31 | (defineCaseframe 'Proposition '('Transitive brel) 32 | :docstring "[brel] is transitive") 33 | 34 | (defineCaseframe 'Proposition '(brel arg1 arg2) 35 | :docstring "[arg1] has the relation [brel] to [arg2]" 36 | :fsymbols '(R Bigger)) 37 | 38 | ;;; The definition of transitivity 39 | ;;; (all R (if (Transitive R) (all (x z) (if (some (y) (and (R x y) (R y z))) (R x z))))) 40 | (assert '((every R (Transitive R)) 41 | (every x (R x (some y (R x z) (R x y) (R y (every z (Isa z Entity)))))) 42 | z)) 43 | 44 | (assert '(Transitive Bigger)) 45 | 46 | (assert '(Bigger Clyde Trigger)) 47 | (assert '(Bigger Trigger Lassie)) -------------------------------------------------------------------------------- /Demo/vardemo.sneps: -------------------------------------------------------------------------------- 1 | (in-ns 'csneps.core.snuser) 2 | 3 | (clearkb true) 4 | 5 | ;;; Define Types 6 | (defineType Agent (Thing) "Individuals that have agency") 7 | (defineType Action (Thing) "Actions that Agents can perform.") 8 | 9 | ;;; Define Slots 10 | (defineSlot agent :type Agent) 11 | (defineSlot object :type Thing :docstring "Non-agentive objects of actions.") 12 | (defineSlot property :type Thing) 13 | (defineSlot life :type Thing) 14 | (defineSlot whole :type Thing) 15 | (defineSlot part :type Thing) 16 | (defineSlot group :type Thing) 17 | 18 | ;;; Caseframes 19 | 20 | (defineCaseframe 'Proposition '('Owns agent object) 21 | :docstring "[agent] owns [object]") 22 | 23 | 24 | (defineCaseframe 'Proposition '('Beats agent life) 25 | :docstring "[agent] beats [object]") 26 | 27 | 28 | (defineCaseframe 'Proposition '('Property object property) 29 | :docstring "[object] has property [property]") 30 | 31 | 32 | (defineCaseframe 'Proposition '('isPartOf part whole) 33 | :docstring "[part] is part of [whole]") 34 | 35 | 36 | 37 | ;;;(defineCaseframe 'Proposition '('Hates group)) 38 | ;;; Assertions 39 | 40 | 41 | ;;; Every man is mortal 42 | (assert '(Property (every x (Isa x Man) (Isa x Agent)) Mortal)) 43 | 44 | 45 | ;;; Albino elephants are valuable 46 | 47 | (assert '(Property (every x (Isa x Elephant) (Property x Albino) (Isa x Agent)) Valuable)) 48 | 49 | 50 | 51 | ;;; Every elephant has a trunk 52 | (assert '(isPartOf 53 | (some y(x) (Isa y Trunk)) 54 | (every x (Isa x Elephant) (Isa x Agent)))) 55 | 56 | 57 | ;;; Every man is human 58 | (assert '(Isa (every x (Isa x Man) (Isa x Agent)) Human)) 59 | 60 | ;;; Albino Elephants are white 61 | (assert '(Property (every x (Isa x Elephant) (Property x Albino) (Isa x Agent)) White)) 62 | 63 | ;;; Every elephant is large 64 | (assert '(Property (every x (Isa x Elephant) (Isa x Agent)) Large)) 65 | 66 | ;;; Every farmer that owns a donkey beats it 67 | (assert '(Beats (every x (Isa x Farmer) (Isa x Agent) 68 | (Owns x (some y(x) (Isa y Donkey) (Isa y Agent)))) 69 | y)) 70 | 71 | 72 | ;;; A trunk of every elephant is flexible 73 | (assert '(Property (some y(x) (Isa y Trunk) (Isa y Thing) 74 | (isPartOf y (every x (Isa x Elephant) (Isa x Agent)))) 75 | Flexible)) 76 | 77 | 78 | (list-terms) 79 | 80 | 81 | 82 | -------------------------------------------------------------------------------- /Demo/xor.sneps: -------------------------------------------------------------------------------- 1 | ;;; Demonstration of use of xor 2 | 3 | ;;; Xor Introduction 4 | ;;; ================ 5 | ;;; No arguments asserted. 6 | (clearkb) 7 | (assert '(not c)) 8 | (ask '(xor a b c)) 9 | 10 | ;;; One argument asserted. 11 | ;;; but one is unknown. 12 | (clearkb) 13 | (assert 'a) 14 | (assert '(not c)) 15 | (ask '(xor a b c)) 16 | 17 | ;;; One argument asserted. 18 | ;;; and the negation of the others are asserted. 19 | (clearkb) 20 | (assert 'a) 21 | (assert '(not b)) 22 | (assert '(not c)) 23 | (ask '(xor a b c)) 24 | 25 | ;;; Too many arguments are asserted 26 | ;;; and the negation of the others are asserted. 27 | (clearkb) 28 | (assert 'a) 29 | (assert 'b) 30 | (assert '(not c)) 31 | (ask '(xor a b c)) 32 | 33 | ;;; One argument is asserted, 34 | ;;; one is derived, 35 | ;;; and the negation of the other is asserted. 36 | (clearkb) 37 | (assert '(if p a)) 38 | (assert 'p) 39 | (assert 'b) 40 | (assert '(not c)) 41 | (ask '(xor a b c)) 42 | 43 | ;;; One argument is asserted, 44 | ;;; the negation of one is derived, 45 | ;;; and the negation of the other is asserted. 46 | (clearkb) 47 | (assert '(if p a)) 48 | (assert 'p) 49 | (assert '(nand q b)) 50 | (assert 'q) 51 | (assert '(not c)) 52 | (ask '(xor a b c)) 53 | -------------------------------------------------------------------------------- /LICENSE.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SNePS/CSNePS/5ca67a41babe9d41e237250523545c7bacdcb122/LICENSE.pdf -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | CSNePS - Concurrent SNePS 2 | ====== 3 | 4 | CSNePS is an implementation (and extension of) of the SNePS 3 knowledge representation and reasoning system specification. CSNePS is written in the Clojure programming language, and is designed to utilize concurrency during inference. 5 | 6 | ## Running CSNePS 7 | 8 | CSNePS should be run using [Leiningen](https://leiningen.org/) for the best experience. Once you've installed Leiningen you can run CSnePS by changing into the CSNePS directory and typing either: 9 | 10 | ```lein run``` 11 | 12 | to launch CSNePS with its GUI, or 13 | 14 | ```lein run -c``` 15 | 16 | to launch the command line interface for CSNePS. 17 | 18 | ## Further Documentation 19 | 20 | While CSNePS is still under heavy development, the version available here should be usable. There is some documentation provided in the manual.pdf file in the doc folder, but most documentation is currently in the form of papers written about SNePS 3 and portions of CSNePS. 21 | 22 | If you intend to use CSNePS it is best to first acquaint yourself with the SNePS 3 specification: 23 | 24 | Stuart C. Shapiro, An Introduction to SNePS 3. 26 | In Bernhard Ganter & Guy W. Mineau, Eds. Conceptual 27 | Structures: Logical, Linguistic, and Computational Issues. Lecture Notes in Artificial 29 | Intelligence 1867. Springer-Verlag, Berlin, 2000, 510-524. 30 | 31 | Daniel R. Schlegel and Stuart C. Shapiro, Visually Interacting with a Knowledge 33 | Base Using Frames, Logic, and Propositional Graphs. In Madalina Croitoru, 34 | Sebastian Rudolph, Nic Wilson, John Howse and Olivier Corby, Eds., 35 | Graph Structures for Knowledge Representation and Reasoning, Lecture Notes in 36 | Artificial Intelligence 7205, Springer-Verlag, Berlin, 2012, 188-207. 37 | 38 | Next, you should aquiant yourself with Inference Graphs, which provide the natural deduction and subsumption reasoning abilities of CSNePS. 39 | 40 | Daniel R. Schlegel, Concurrent 41 | Inference Graphs, PhD Dissertation, Department of Computer Science and 42 | Engineering, State University of New York at Buffalo, September 3, 2014. 43 | 44 | Daniel R. Schlegel and Stuart C. Shapiro, Inference Graphs: Combining Natural 46 | Deduction and Subsumption Inference in a Concurrent Reasoner. In 47 | Proceedings of the Twenty-Ninth Conference on Artificial Intelligence 48 | (AAAI-15), in press. 49 | 50 | 51 | -------------------------------------------------------------------------------- /csneps.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Capture the dir this script is in. 4 | DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" 5 | 6 | # Change into that dir. 7 | cd "$DIR" 8 | 9 | # Run the project with the -c argument (for CLI) 10 | lein run -c 11 | -------------------------------------------------------------------------------- /csnepsgui.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Capture the dir this script is in. 4 | DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" 5 | 6 | # Change into that dir. 7 | cd "$DIR" 8 | 9 | # Make sure the dependencies are all downloaded. 10 | lein deps 11 | 12 | # Start the GUI. 13 | lein run 14 | -------------------------------------------------------------------------------- /doc/bib.bib: -------------------------------------------------------------------------------- 1 | @MISC{clipsref07, 2 | author = {Riley, Gary and Dantes, Brian}, 3 | title = {{CLIPS} Reference Manual}, 4 | note = {http://clipsrules.sourceforge.net/documentation/v630/bpg.pdf}, 5 | year = 2007 6 | } 7 | 8 | @article{ShaBon10, 9 | author = {Stuart C. Shapiro and Jonathan P. Bona}, 10 | title = {The {GLAIR} Cognitive Architecture}, 11 | journal = {International Journal of Machine Consciousness}, 12 | volume = {2}, 13 | number = {2}, 14 | pages = {307-332}, 15 | year = {2010}, 16 | doi = {10.1142/S1793843010000515}} 17 | 18 | @PhdThesis{sch14, 19 | author = {Daniel R. Schlegel}, 20 | title = {Concurrent Inference Graphs}, 21 | school = {State University of New York at Buffalo, Department of Computer Science}, 22 | address = {Buffalo, NY, USA}, 23 | year = {2014}, 24 | note = {Forthcoming} 25 | } 26 | 27 | @Manual{ISO24707, 28 | title = {Information technology --- {C}ommon {L}ogic ({CL}): a 29 | framework for a family of logic-based languages, 30 | ISO/IEC 24707:2007(E)}, 31 | author = {{ISO/IEC}}, 32 | organization = {ISO/IEC}, 33 | address = {Switzerland}, 34 | edition = {{F}irst}, 35 | month = {October}, 36 | year = 2007, 37 | note = {available from \url{http://standards.iso/ittf/license.html}} 38 | } -------------------------------------------------------------------------------- /doc/manual.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SNePS/CSNePS/5ca67a41babe9d41e237250523545c7bacdcb122/doc/manual.pdf -------------------------------------------------------------------------------- /local_maven_repo/jpedal/jpedal/1.0.0/jpedal-1.0.0.jar: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SNePS/CSNePS/5ca67a41babe9d41e237250523545c7bacdcb122/local_maven_repo/jpedal/jpedal/1.0.0/jpedal-1.0.0.jar -------------------------------------------------------------------------------- /local_maven_repo/jpedal/jpedal/1.0.0/jpedal-1.0.0.pom: -------------------------------------------------------------------------------- 1 | 2 | 4 | 4.0.0 5 | jpedal 6 | jpedal 7 | 1.0.0 8 | POM was created from install:install-file 9 | 10 | -------------------------------------------------------------------------------- /local_maven_repo/net/xeon/jspf.core/1.0.2/jspf.core-1.0.2.jar: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SNePS/CSNePS/5ca67a41babe9d41e237250523545c7bacdcb122/local_maven_repo/net/xeon/jspf.core/1.0.2/jspf.core-1.0.2.jar -------------------------------------------------------------------------------- /local_maven_repo/net/xeon/jspf.core/1.0.2/jspf.core-1.0.2.jar.md5: -------------------------------------------------------------------------------- 1 | a2a12cf3b1e83c8f585568eb81e2b50e -------------------------------------------------------------------------------- /local_maven_repo/net/xeon/jspf.core/1.0.2/jspf.core-1.0.2.jar.sha1: -------------------------------------------------------------------------------- 1 | 77bc77911c8fcf16df51b1166fad87aae27874f4 -------------------------------------------------------------------------------- /local_maven_repo/net/xeon/jspf.core/1.0.2/jspf.core-1.0.2.pom: -------------------------------------------------------------------------------- 1 | 2 | 4 | 4.0.0 5 | net.xeon 6 | jspf.core 7 | 1.0.2 8 | 9 | -------------------------------------------------------------------------------- /local_maven_repo/net/xeon/jspf.core/1.0.2/jspf.core-1.0.2.pom.md5: -------------------------------------------------------------------------------- 1 | e04f3318d8386c34fc958384d523ae7d -------------------------------------------------------------------------------- /local_maven_repo/net/xeon/jspf.core/1.0.2/jspf.core-1.0.2.pom.sha1: -------------------------------------------------------------------------------- 1 | 98b4331b9a82edfa042f0b7cdd89e25e7f78454b -------------------------------------------------------------------------------- /local_maven_repo/net/xeon/jspf.core/maven-metadata-local.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | net.xeon 4 | jspf.core 5 | 1.0.2 6 | 7 | 8 | 1.0.2 9 | 10 | 20130220184024 11 | 12 | 13 | -------------------------------------------------------------------------------- /local_maven_repo/net/xeon/jspf.core/maven-metadata.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | net.xeon 4 | jspf.core 5 | 6 | 1.0.2 7 | 8 | 1.0.2 9 | 10 | 20140829150700 11 | 12 | 13 | -------------------------------------------------------------------------------- /local_maven_repo/net/xeon/jspf.core/maven-metadata.xml.md5: -------------------------------------------------------------------------------- 1 | ff2d9921422221d7026a28bb8ab6fd88 -------------------------------------------------------------------------------- /local_maven_repo/net/xeon/jspf.core/maven-metadata.xml.sha1: -------------------------------------------------------------------------------- 1 | 358d3d0f8ea2e82b5ead76cd465f1a33099744f8 -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (require 'cemerick.pomegranate.aether) 2 | (cemerick.pomegranate.aether/register-wagon-factory! 3 | "http" #(org.apache.maven.wagon.providers.http.HttpWagon.)) 4 | (defproject CSNePS "1.0.0-SNAPSHOT" 5 | :description "CSNePS Knowledge Representation and Reasoning System" 6 | :dependencies [[org.clojure/clojure "1.11.3"] 7 | [org.clojure/core.match "0.2.1"] 8 | [org.clojure/core.memoize "0.5.9"] 9 | [org.clojure/math.numeric-tower "0.0.4"] 10 | [org.clojure/math.combinatorics "0.1.4"] 11 | [org.clojure/tools.trace "0.7.9"] 12 | [org.clojure/tools.nrepl "0.2.3"] 13 | [net.sf.jung/jung-graph-impl "2.1.1"] 14 | [net.sf.jung/jung-api "2.1.1"] 15 | [net.sf.jung/jung-visualization "2.1.1"] 16 | [net.sf.jung/jung-io "2.1.1"] 17 | [net.sf.jung/jung-algorithms "2.1.1"] 18 | ;[net.sf.jung/jung-jai "2.0.1"] 19 | ;[net.sf.jung/jung-3d "2.0.1"] 20 | [junit/junit "3.8.2"] 21 | [jdom/jdom "1.0"] 22 | [org.freehep/freehep-graphics2d "2.4"] 23 | [org.freehep/freehep-graphicsio "2.4"] 24 | [org.freehep/freehep-graphicsbase "2.4"] 25 | [org.freehep/freehep-io "2.2.2"] 26 | [org.freehep/freehep-graphicsio-emf "2.4"] 27 | [org.freehep/freehep-graphicsio-java "2.4"] 28 | [org.freehep/freehep-graphicsio-pdf "2.4"] 29 | [org.freehep/freehep-graphicsio-ps "2.4"] 30 | [org.freehep/freehep-graphicsio-svg "2.4"] 31 | [org.freehep/freehep-graphicsio-swf "2.4"] 32 | ;[org.jpedal/jpedal-lgpl "4.74b27"] 33 | [org.swinglabs/swingx "1.6.1"] 34 | [net.xeon/jspf.core "1.0.2"] 35 | [org.clojure/tools.cli "0.4.1"] 36 | [reply/reply "0.4.4"] 37 | [aleph "0.4.6"] 38 | [gloss "0.2.6"]] 39 | :dev [[org.clojure/tools.namespace "0.2.4"]] 40 | :repositories {"FreeHEP" "http://java.freehep.org/maven2" 41 | "mvnrepo" "https://mvnrepository.com" 42 | "jpedal" "http://maven.geomajas.org" 43 | "local" ~(str (.toURI (java.io.File. "local_maven_repo")))} 44 | :plugins [[lein-swank "1.4.5"]] 45 | :source-paths ["src/clj/"] 46 | :source-path "src/clj/" 47 | :java-source-paths ["src/jvm/"] ;leiningen 2 compat. 48 | :java-source-path "src/jvm/" ;leiningen 1.x compat. 49 | ;:project-init (require 'clojure.pprint) 50 | :repl-options [:print clojure.core/println] ;[:print clojure.pprint/pprint] 51 | ;:jvm-opts ["-server"] 52 | :main csneps.core.snuser 53 | :profiles {:uberjar {:aot :all}}) 54 | -------------------------------------------------------------------------------- /src/clj/csneps/configuration.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.configuration) 2 | 3 | ;; Inference Graph Configuration 4 | (def ig-cpus-to-use (/ (.availableProcessors (Runtime/getRuntime)) 2)) 5 | ;(def ig-cpus-to-use 1) 6 | 7 | ;; Experimental support for using the object language for semantic types. 8 | (def semtype-objectlang-experimental false) 9 | -------------------------------------------------------------------------------- /src/clj/csneps/core.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.core 2 | (:require [clojure.pprint] 3 | [clojure.set] 4 | [clojure.string :as st] 5 | [clojure.set :as set]) 6 | (:use [csneps.util])) 7 | 8 | ;;;;;;;;;;;;;;;;;;;;;;;;; 9 | ;;; CSNePS Data Model ;;; 10 | ;;;;;;;;;;;;;;;;;;;;;;;;; 11 | 12 | ;; Terms and their counts. 13 | (def TERMS 14 | "A map from term names to the actual terms" 15 | (ref (hash-map))) 16 | 17 | (def ARBITRARIES 18 | "The set of all arbitrary individual nodes." 19 | (ref #{})) 20 | 21 | (def INDEFINITES 22 | "The set of all arbitrary individual nodes." 23 | (ref #{})) 24 | 25 | (def QVARS 26 | "The set of all question-mark nodes." 27 | (ref #{})) 28 | 29 | (def WFTCOUNT (ref 0)) 30 | (def ARBCOUNT (ref 0)) 31 | (def INDCOUNT (ref 0)) 32 | (def QVARCOUNT (ref 0)) 33 | 34 | ;; Propositional Graph 35 | (def up-cablesetw (ref {})) 36 | (def down-cableset (ref {})) 37 | (def restriction-set (ref {})) 38 | 39 | ;; Properties of terms in the graph 40 | (def term-caseframe-map (ref {})) 41 | (def support (ref {})) 42 | (def dependencies (ref {})) 43 | 44 | (def property-map 45 | "Maps the term to its set of properties." 46 | (ref (hash-map))) 47 | 48 | (def support-set 49 | "Maps the term name to it's support set." 50 | (ref (hash-map))) 51 | 52 | (def supported-nodes-set 53 | "Maps the term name to its supported node set." 54 | (ref (hash-map))) 55 | 56 | (def primaction 57 | "Maps a term to it's primaction (Act/Actor only)." 58 | (ref (hash-map))) 59 | 60 | ;; Inference Graph extensions to the Propositional Graph 61 | (def i-channels (ref {})) 62 | (def u-channels (ref {})) 63 | (def g-channels (ref {})) 64 | (def ant-in-channels (ref {})) 65 | 66 | ;; Inference graph data 67 | (def future-fw-infer (ref {})) 68 | (def msgs (ref {})) 69 | (def lattice-node (ref {})) 70 | (def instances (ref {})) 71 | (def expected-instances (ref {})) 72 | 73 | ;; Semantic types in the object language 74 | (def semtype-in-channels (ref {})) ;; Like the other channel maps. 75 | (def semtype-to-channel-map (ref {})) ;; Maps semtypes to the channel for that type. 76 | (def semtype-to-arb-map (ref {})) ;; Maps semtypes to the arbitrary for that type. 77 | 78 | (def type-support 79 | "Maps the term name to a map with a vector of usages for each semantic type." 80 | (ref (hash-map))) 81 | 82 | ;; Syntactic Types 83 | (def TopSyntacticType 84 | "The root of the syntactic type hierarchy." 85 | ::Term) 86 | 87 | ;; Semantic Types 88 | (def TOP-SEMANTIC-TYPE :Entity) 89 | 90 | (def semantic-type-hierarchy (ref nil)) 91 | 92 | ;; Goal is to eliminate this with putting the types in the object language. 93 | (def type-map 94 | "Maps the term name to the semantic type." 95 | (ref (hash-map))) 96 | 97 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 98 | ;;; Utility Functions on Data Model ;;; 99 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 100 | 101 | (defn caseframe-for 102 | "Returns the caseframe for term." 103 | [term] 104 | (@term-caseframe-map term)) 105 | 106 | (defn part-of-terms 107 | "Returns the terms which a given term is part of." 108 | [term] 109 | (apply set/union (map deref (vals (@up-cablesetw term))))) 110 | 111 | ;; Load the rest of the csneps.core namespace. 112 | (load "core_syntactic_types") 113 | (load "core_semantic_types") -------------------------------------------------------------------------------- /src/clj/csneps/core/arithmetic.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.core.arithmetic 2 | (:require [csneps.core.build :as build]) 3 | (:refer-clojure :exclude [+ - * / < <= > >= == not=]) 4 | (:use [csneps.core :only (term?)] 5 | [csneps.util])) 6 | 7 | (defn box 8 | "Returns a term whose name looks like n." 9 | [n] 10 | (build/build n :Entity {} #{})) 11 | 12 | (defn unbox 13 | "If term is a number, return it; 14 | if term's name looks like a number, return the number; 15 | else throw an error." 16 | [term] 17 | (if (number? term) 18 | term 19 | (let [read-term (read-string (str term))] 20 | (if (number? read-term) 21 | read-term 22 | (let [n (ignore-errors (read-string (str (:name term))))] 23 | (if (number? n) 24 | n 25 | (error (str term " does not look like a number.")))))))) 26 | 27 | (defn + 28 | "Returns a term whose name looks like the sum of the numbs, 29 | which can be boxed or unboxed numbers." 30 | [& numbs] 31 | (if (some term? numbs) 32 | (box (apply clojure.core/+ (map unbox numbs))) 33 | (apply clojure.core/+ numbs))) 34 | 35 | (defn - 36 | "Returns a term whose name looks like the difference of the numbs, 37 | which can be boxed or unboxed numbers." 38 | [& numbs] 39 | (if (some term? numbs) 40 | (box (apply clojure.core/- (map unbox numbs))) 41 | (apply clojure.core/- numbs))) 42 | 43 | (defn * 44 | "Returns a term whose name looks like the product of the numbs, 45 | which can be boxed or unboxed numbers." 46 | [& numbs] 47 | (if (some term? numbs) 48 | (box (apply clojure.core/* (map unbox numbs))) 49 | (apply clojure.core/* numbs))) 50 | 51 | (defn / 52 | "Returns a term whose name looks like the quotient of the numbs, 53 | which can be boxed or unboxed numbers." 54 | [& numbs] 55 | (if (some term? numbs) 56 | (box (apply clojure.core// (map unbox numbs))) 57 | (apply clojure.core// numbs))) 58 | 59 | (defn < 60 | "Returns t if each num is less than the next, 61 | nil otherwise." 62 | [& numbs] 63 | (apply clojure.core/< (map unbox numbs))) 64 | 65 | (defn <= 66 | "Returns t if each num is less than or equal to the next, 67 | nil otherwise." 68 | [& numbs] 69 | (apply clojure.core/<= (map unbox numbs))) 70 | 71 | (defn > 72 | "Returns t if each num is greater than the next, 73 | nil otherwise." 74 | [& numbs] 75 | (apply clojure.core/> (map unbox numbs))) 76 | 77 | (defn >= 78 | "Returns t if each num is greater than or equal to the next, 79 | nil otherwise." 80 | [& numbs] 81 | (apply clojure.core/>= (map unbox numbs))) 82 | 83 | (defn == 84 | "Returns t if each num is equal to the next, 85 | nil otherwise." 86 | [& numbs] 87 | (apply clojure.core/== (map unbox numbs))) 88 | 89 | (defn not= 90 | "Returns t if none of the numbs are equal, 91 | nil otherwise." 92 | [& numbs] 93 | (apply clojure.core/not= (map unbox numbs))) 94 | -------------------------------------------------------------------------------- /src/clj/csneps/core/build_rewrite.clj: -------------------------------------------------------------------------------- 1 | (in-ns 'csneps.core.build) 2 | 3 | ;;; This portion of csneps.core.build contains several 4 | ;;; rewrite rules. 5 | 6 | (defn add-rewrite 7 | [expr1 expr2] 8 | (assert (list 'iff expr1 expr2) (ct/find-context 'BaseCT))) 9 | 10 | (defn reverse-quantifier 11 | [expr var] 12 | (let [vg (gensym var)] 13 | (match/match [expr] 14 | [(['every v & r] :seq)] (when (= var v) (list* 'some vg '() (prewalk-replace {v vg} r))) 15 | [(['some v dep & r] :seq)] (when (= var v) (list* 'every vg (prewalk-replace {v vg} r))) 16 | :else nil))) 17 | 18 | (defn find-and-reverse-quantifier 19 | [subexpr var] 20 | (list 'not (prewalk #(do (if-let [rewrite (and (seq? %) (reverse-quantifier % var))] 21 | rewrite 22 | %)) 23 | subexpr))) 24 | 25 | (defn match-propositional-expr 26 | [expr] 27 | (match/match [expr] 28 | [(['close v r] :seq)] r 29 | [(['not (['thresh pn & r] :seq)] :seq)] (list* 'andor pn r) 30 | [(['not (['andor pn & r] :seq)] :seq)] (list* 'thresh pn r) 31 | [(['not (['close v r] :seq)] :seq)] (find-and-reverse-quantifier r v) 32 | :else nil)) 33 | 34 | (defn rewrite-propositional-expr 35 | [expr] 36 | (prewalk #(do (when (seq? %) 37 | (when-let [rewrite (match-propositional-expr %)] 38 | (add-rewrite % rewrite))) 39 | %) 40 | expr)) 41 | 42 | ;(defn generate-rewrites 43 | ; "Given a term, generates a set of rewrites, which 44 | ; are all asserted using an if-and-only-if in the 45 | ; base context." 46 | ; [sexpr] 47 | ; (let [rewrite-set #{}] 48 | ; (when-not (empty? rewrite-set) 49 | ; (assert (list 'thresh '(1 1) (conj rewrite-set sexpr)) (ct/find-context 'BaseCT))))) 50 | 51 | -------------------------------------------------------------------------------- /src/clj/csneps/core/build_rules.clj: -------------------------------------------------------------------------------- 1 | (in-ns 'csneps.core.build) 2 | 3 | (declare defrule) 4 | 5 | (defn lhsrhs [body] 6 | (loop [body body 7 | lhs []] 8 | (if (= (first body) '=>) 9 | [lhs (rest body)] 10 | (recur (rest body) 11 | (conj lhs (first body)))))) 12 | 13 | (defn formorsub [rhs] 14 | (loop [rhs rhs 15 | forms [] 16 | subrules []] 17 | (cond 18 | (empty? rhs) 19 | [forms subrules] 20 | (= (ffirst rhs) :subrule) 21 | (recur (rest rhs) 22 | forms 23 | (conj subrules (first rhs))) 24 | :else 25 | (recur (rest rhs) 26 | (conj forms (first rhs)) 27 | subrules)))) 28 | 29 | (defn defrule-helper [rulename body substitutions] 30 | (let [[lhs rhs] (lhsrhs body) 31 | [forms subrules] (formorsub rhs) 32 | [_ vars local-substitutions] (check-and-build-variables lhs :additional-subs substitutions) 33 | all-substitutions (merge local-substitutions substitutions)] 34 | ;(print (list 'rule rulename lhs forms subrules) "\n --" all-substitutions) 35 | (build (list 'rule rulename lhs forms subrules) :Policy all-substitutions #{}))) 36 | 37 | (defmacro defrule [rulename & body] 38 | `(defrule-helper '~rulename '~body {})) -------------------------------------------------------------------------------- /src/clj/csneps/core/build_substitution.clj: -------------------------------------------------------------------------------- 1 | ; Originally based on the ACL SNePS 3 implementation by Dr. Stuart C. Shapiro. 2 | 3 | (in-ns 'csneps.core.build) 4 | 5 | (declare structurally-subsumes-varterm parse-vars-and-rsts check-and-build-variables notsames pre-build-vars build-vars build-quantterm-channels) 6 | 7 | (defn apply-sub-to-term 8 | ([term subst] 9 | (apply-sub-to-term term subst nil)) 10 | ([term subst ignore-type] 11 | (term-prewalk #(subst % %) term :with-restrictions true :ignore-type ignore-type))) 12 | 13 | ;; Ex: subs1: {arb2: (every x (Isa x Cat)) arb1: (every x (Isa x Entity))} 14 | ;; subs2: {arb1: (every x (Isa x Entity)) cat!} 15 | ;; Result: {arb2: (every x (Isa x Cat)) cat!, arb1: (every x (Isa x Entity)) cat!} 16 | (defn substitution-application 17 | "Apples the substitution subs2 to subs1" 18 | [subs1 subs2] 19 | (let [compose (map (fn [[k v]] [k (apply-sub-to-term v subs2)]) subs1)] 20 | (into subs2 compose))) 21 | ;(clojure.core/merge subs2 (into {} compose)))) 22 | 23 | ;; Ex: subs2: {arb1: (every x (Isa x Cat)) cat} 24 | ;; subs1: {arb2: (every x (Isa x BlahBlah)) arb1: (every x (Isa x Cat))} 25 | ;; Result: {arb2: (every x (Isa x BlahBlah)) cat} 26 | (defn substitution-application-nomerge 27 | [subs1 subs2] 28 | (into {} (map (fn [[k v]] [k (apply-sub-to-term v subs2)]) subs1))) 29 | 30 | (defn subst-occurs-helper 31 | "Returns true if when compare-subst contains a substitution for any variable inside var, 32 | it also binds var, unless there's an identical binding already in var-subst." 33 | ;; TODO: Must it bind ALL of the inner vars? 34 | [var var-subs compare-subs] 35 | (let [inner-vars (get-vars var :inner-vars? true) 36 | binds (set (keys compare-subs)) 37 | shared-binds (set/intersection binds inner-vars)] 38 | (if-not (empty? shared-binds) 39 | (or (binds var) 40 | (every? #(= (var-subs %) (compare-subs %)) shared-binds)) 41 | true))) 42 | 43 | (defn substitution-occurs-check 44 | "Ensures that whenever a variable is used in a substitution, the substitution 45 | it is combined with does not contain bindings for inner variables without a 46 | binding for the parent, or, if it does, that the inner variable binding isn't 47 | identical between the two substitutions." 48 | [subs1 subs2] 49 | (and (every? #(subst-occurs-helper % subs2 subs1) (keys subs2)) 50 | (every? #(subst-occurs-helper % subs1 subs2) (keys subs1)))) 51 | 52 | (defn compatible-substitutions? 53 | "Returns true if no variable is bound to two different terms." 54 | [subs1 subs2] 55 | ;; Verify no single variable is bound to different terms, and 56 | ;; no notSame variables are assigned the same term. 57 | (and (every? #(or (= (subs1 %) (subs2 %)) 58 | (nil? (subs2 %))) 59 | (keys subs1)) 60 | (substitution-occurs-check subs1 subs2) 61 | (every? true? (for [var (set/union (keys subs1) (keys subs2)) 62 | :let [notsames @(:not-same-as var) 63 | binding (or (subs1 var) (subs2 var))]] 64 | (every? #(not= binding (or (subs1 %) (subs2 %))) notsames))))) 65 | 66 | (defn subsumption-compatible? 67 | "Returns true if: 68 | 1) No variable is bound to two different terms. 69 | 2) A variable is bound by two different terms, of which one of them is 70 | a variable, and they are compatible by structural subsumption." 71 | [subs1 subs2] 72 | (every? #(or (= (% subs1) (% subs2)) 73 | (nil? (% subs2)) 74 | (and (variable? (% subs1)) 75 | (structurally-subsumes-varterm (% subs1) (% subs2))) 76 | (and (variable? (% subs2)) 77 | (structurally-subsumes-varterm (% subs2) (% subs1)))) 78 | (keys subs1))) 79 | 80 | ;(defn subset? 81 | ; "Returns true if subs1 is a subset of subs2" 82 | ; [subs1 subs2] 83 | ; (every? #(= (subs1 %) (subs2 %)) (keys subs1))) 84 | 85 | (defn expand-substitution 86 | "Given a term and a substitution, examines the term for embedded vars 87 | which use terms in the substitution. Builds a new substitution with those 88 | terms substituted for." 89 | [term subst] 90 | (let [term-vars (set/difference (get-vars term) (set (keys subst)))] 91 | (if-not (empty? term-vars) 92 | (into {} (map #(vector % (apply-sub-to-term % subst)) term-vars))))) -------------------------------------------------------------------------------- /src/clj/csneps/core/build_utils.clj: -------------------------------------------------------------------------------- 1 | (in-ns 'csneps.core.build) 2 | 3 | (defn term-walk 4 | [inner outer termpart & {:keys [ignore-type with-restrictions]}] 5 | (cond 6 | (molecularTerm? termpart) (outer (build 7 | (if-let [fsym (or ((type-of termpart) syntype-fsym-map) 8 | (let [p (:print-pattern (@term-caseframe-map termpart))] 9 | (when (and (seq? (first p)) (= (first (first p)) 'quote)) 10 | (second (first p)))))] 11 | (conj (doall (map inner (@down-cableset termpart))) fsym) 12 | (doall (map inner (@down-cableset termpart)))) 13 | (if ignore-type :Entity (st/semantic-type-of termpart)) 14 | {} 15 | #{})) 16 | (atomicTerm? termpart) (outer termpart) 17 | (set? termpart) (set (doall (map inner termpart))) 18 | :else (error (str "Term contains unknown parts (" termpart ")")))) 19 | 20 | (defn term-recur 21 | [inner outer termpart] 22 | (cond 23 | (molecularTerm? termpart) (outer (build (conj (doall (map inner (@down-cableset termpart))) (term-predicate termpart)) 24 | :Propositional 25 | {} 26 | #{})) 27 | ;(arbitraryTerm? termpart) (outer (build-variable (list 'every (:var-label termpart) (map inner @(:restriction-set termpart))))) 28 | (atomicTerm? termpart) (outer termpart) 29 | (set? termpart) (set (doall (map inner termpart))) 30 | :else (error (str "Term contains unknown parts (" termpart ")")))) 31 | 32 | (defn term-prewalk 33 | [f term & {:keys [ignore-type with-restrictions]}] 34 | (term-walk 35 | (fn [t] (term-prewalk f t :ignore-type ignore-type :with-restrictions with-restrictions)) 36 | identity (f term) :ignore-type ignore-type :with-restrictions with-restrictions)) 37 | 38 | 39 | (defn term-prewalk-test 40 | [term] 41 | (term-prewalk (fn [x] (print "Walked: ") (prn x) x) term :with-restrictions true)) 42 | 43 | (defn term-prewalk-test2 44 | [term] 45 | (term-prewalk (fn [x] (when (term? x) (print "Walked: ") (prn x)) x) term)) 46 | 47 | (defn get-antecedents 48 | [term] 49 | (let [slot-map (cf/dcsRelationTermsetMap term)] 50 | (case (type-of term) 51 | :csneps.core/Conjunction 52 | (get slot-map (slot/find-slot 'and)) 53 | (:csneps.core/Andor 54 | :csneps.core/Disjunction 55 | :csneps.core/Xor 56 | :csneps.core/Nand) 57 | (get slot-map (slot/find-slot 'andorargs)) 58 | (:csneps.core/Thresh 59 | :csneps.core/Equivalence) 60 | (get slot-map (slot/find-slot 'threshargs)) 61 | (:csneps.core/Numericalentailment 62 | :csneps.core/Implication) 63 | (get slot-map (slot/find-slot 'ant)) 64 | nil))) 65 | 66 | (defn get-vars 67 | "Returns the vars in the given term, or, if the term is a rule 68 | returns the intersection of variables in its antecedents. Optionally 69 | traverses inside variables looking for inner variables." 70 | [term & {:keys [inner-vars?] :or {inner-vars? false}}] 71 | (if-let [ants (get-antecedents term)] 72 | (apply set/intersection (map #(set (filter variable? (flatten-term % :vars? inner-vars?))) ants)) 73 | (set (filter variable? (flatten-term term :vars? inner-vars?))))) 74 | -------------------------------------------------------------------------------- /src/clj/csneps/core/find_utils.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.core.find-utils 2 | (:use [csneps.core] 3 | [csneps.util]) 4 | (:require [csneps.core.relations :as slot] 5 | [clojure.test :refer [is]])) 6 | 7 | (defn findto 8 | "Returns the set of nodes to which a slot, r, goes from n, including 9 | possibly the empty set." 10 | [n r] 11 | (let [rel (if (symbol? r) 12 | (slot/find-slot r) 13 | r)] 14 | (when (isa? (type-of n) :csneps.core/Molecular) 15 | (let [pos (first (positions #{rel} (:slots (@term-caseframe-map n))))] 16 | (if pos 17 | (nth (seq (@down-cableset n)) pos) 18 | #{}))))) 19 | 20 | (defn findfrom 21 | "Returns the set of nodes 22 | from which a slot r, or a slot named r, goes to m." 23 | [m r] 24 | {:pre [(is (term? m) "m is not a term.")]} 25 | (let [res (get (@up-cablesetw m) (if (= (type r) csneps.core.relations.Slot) r (slot/find-slot r)))] 26 | (if res @res (hash-set)))) -------------------------------------------------------------------------------- /src/clj/csneps/core/relations.clj: -------------------------------------------------------------------------------- 1 | 2 | (ns csneps.core.relations 3 | (:use [csneps.util]) 4 | (:require [csneps.core])) 5 | 6 | (def SLOTS (ref (hash-map))) 7 | 8 | (defrecord2 Slot 9 | [name (gensym "rel") ;the name of the slot 10 | type :Entity ;the type of terms it points to 11 | docstring "" ;A documentation string for the slot 12 | posadjust 'reduce ;for slot-based inference: reduce, expend, or none 13 | negadjust 'expand ;for slot-based inference of negative instances 14 | min 1 ;minimum number of slot fillers 15 | max nil ;maximum number of slot fillers, nil means infinite 16 | path (ref nil) ;the path that implies this slot 17 | f-pathfn (ref nil) ;"forward" path function 18 | b-pathfn (ref nil)]) ;"backward" path function 19 | 20 | (defmethod print-method csneps.core.relations.Slot [o w] 21 | (.write ^java.io.Writer w (str "name: " (:name o) 22 | "\n\tdocstring: " (:docstring o) 23 | "\n\ttype: " (:type o) 24 | "\n\tmin: " (:min o) " max: " (:max o) "\tposadjust: " (:posadjust o) " negadjust: " (:negadjust o) "\n"))) 25 | 26 | (defn find-slot 27 | "If rname is a slot, returns it; 28 | if it is the name of a slot, returns the slot object; 29 | else if errorp is True, raises an errorr 30 | else returns nil." 31 | [rname & {:keys [errorp] :or {errorp true}}] 32 | (typecase rname 33 | Slot rname 34 | clojure.lang.Symbol 35 | (let [slot (get @SLOTS rname)] 36 | (if (nil? slot) 37 | (when errorp (error (str "There is no slot named " rname))) 38 | slot)))) 39 | 40 | (defn define-slot 41 | "Defines a slot" 42 | [name & {:keys [type docstring posadjust negadjust min max path] 43 | :or {type :Entity, 44 | docstring "", 45 | posadjust 'reduce, 46 | negadjust 'expand, 47 | min 1 48 | path (ref nil)}}] 49 | {:pre [(symbol? name)]} ;"Slot name must be a symbol." 50 | (cond 51 | (find-slot name :errorp false) 52 | (do 53 | (println "A slot with name: " name " is already defined. Using existing definition.") 54 | (find-slot name)) 55 | (= name 'restriction) 56 | (error (str "'" name "' is a reserved word and not a valid name for a slot.")) 57 | :else 58 | (do 59 | (assert (csneps.core/semantic-type-p (keyword type))) ;"The type given is not a valid semantic type" 60 | (assert (string? docstring)) 61 | (assert (some (hash-set posadjust) '(reduce expand none))) 62 | (assert (some (hash-set negadjust) '(reduce expand none))) 63 | (assert (and (integer? min) (>= min 0))) 64 | (assert (or (nil? max) 65 | (and (integer? max) (>= max min)))) 66 | (let [newslot (new-slot {:name name :type (keyword type) :docstring docstring :posadjust posadjust :negadjust negadjust :min min :max max :path (ref path)})] 67 | (dosync 68 | (alter SLOTS assoc name newslot)) 69 | newslot)))) 70 | 71 | (defn list-slots 72 | "Prints a list of all the SNePS slots" 73 | [] 74 | (doseq [s (vals @SLOTS)] 75 | (println s))) -------------------------------------------------------------------------------- /src/clj/csneps/core/semantic_types.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.core.semantic-types 2 | (:use [csneps.util] 3 | [csneps.configuration]) 4 | (:require [csneps.core :as csneps] 5 | [csneps.core.contexts :as ct])) 6 | 7 | (declare add-type-support) 8 | 9 | ;; This is old code which seems to only be used for variables. I'm not sure why we really need it to be separate 10 | ;; and I think we should integrate it somehow. 11 | 12 | (defn instantiate-sem-type 13 | [term type] 14 | (let [termname (:name term) 15 | newtypekey (keyword type)] 16 | (dosync (alter csneps/type-map assoc termname newtypekey)) 17 | (when semtype-objectlang-experimental 18 | (add-type-support term type [])) 19 | ;;If the type is a descendent of Proposition it has a support set, hcontext set, and supported 20 | ;;nodes set. 21 | (when (csneps/subtypep newtypekey :Proposition) 22 | (dosync 23 | (alter csneps/support-set assoc termname (ref (hash-set))) 24 | (alter csneps/supported-nodes-set assoc termname (ref (hash-set))))) 25 | ;;If the type is an Act or Action, it has a nil primaction to start. 26 | (when (or (csneps/subtypep newtypekey :Act) (isa? @csneps/semantic-type-hierarchy newtypekey :Action)) 27 | (dosync 28 | (alter csneps/primaction assoc termname nil))) 29 | newtypekey)) 30 | 31 | ;;;;;;;;;;;;;;;;;;;;;;;;; 32 | ;;; Term type support ;;; 33 | ;;;;;;;;;;;;;;;;;;;;;;;;; 34 | 35 | (defn add-type-support 36 | "Adds a vector of terms supporting a semantic type of a term to the type-support map." 37 | [term sem-type supporting-terms] 38 | (let [types (@csneps/type-support (:name term)) 39 | new-supports (set (conj (sem-type types) supporting-terms))] 40 | (dosync (alter csneps/type-support assoc (:name term) (assoc types sem-type new-supports))))) 41 | 42 | (defn supported-type? 43 | "Returns true if the type is directly supported in the provided context. No inference is 44 | used to get less specific type support." 45 | [term sem-type context] 46 | (let [supports (sem-type (@csneps/type-support (:name term)))] 47 | (some #(every? (fn [t] (ct/asserted? t context)) %) supports))) 48 | 49 | (defn supported-types 50 | "Returns the list of supported semantic types of a term in the provided context." 51 | [term context] 52 | (filter #(supported-type? term % context) (keys (@csneps/type-support (:name term))))) 53 | 54 | ;; When does gcsubtype really return >1 item? is that ever OK? How do we choose? 55 | (defn semtype-in-context 56 | "Returns the current type of a term in the given context." 57 | [term context] 58 | (let [firstgcsubtype (fn [t1 t2] (first (csneps/gcsubtype t1 t2))) 59 | types (supported-types term context) 60 | type (cond 61 | (> (count types) 1) (reduce firstgcsubtype types) 62 | (= (count types) 1) (first types) 63 | :default (error (str "Term " (:name term) " has no type in context " (:name context))))] 64 | (if type 65 | type 66 | (error (str "Term " (:name term) " has inconsistent type in context " (:name context)))))) 67 | 68 | (defn semantic-type-of 69 | "Returns the current semantic type of a term." 70 | [term] 71 | (if semtype-objectlang-experimental 72 | (semtype-in-context term (ct/currentContext)) 73 | (if (isa? (csneps/type-of term) :csneps.core/Term) 74 | (get @csneps/type-map (:name term)) 75 | (get @csneps/type-map term)))) -------------------------------------------------------------------------------- /src/clj/csneps/core_semantic_types.clj: -------------------------------------------------------------------------------- 1 | (in-ns 'csneps.core) 2 | 3 | ;;; There are really (structurally) only 3 different types - Entity, Proposition, Act(ion). 4 | ;;; Proposition is an Entity with a support-set, and supported-nodes-set 5 | ;;; Act/Action is an Entity/Thing with a primaction 6 | 7 | (declare type-of subtypep) 8 | 9 | (defn genericTerm? 10 | [o] 11 | (when-let [pset (@property-map o)] 12 | (pset :Generic))) 13 | 14 | (defn genericAnalyticTerm? 15 | [o] 16 | (when-let [pset (@property-map o)] 17 | (and (pset :Generic) (pset :Analytic)))) 18 | 19 | (defn analyticTerm? 20 | [o] 21 | (when-let [pset (@property-map o)] 22 | (and (pset :Analytic)))) 23 | 24 | ;;; Functions on Semantic Types 25 | ;;; ============================ 26 | 27 | (defn list-types 28 | [] 29 | "Lists all the semantic types." 30 | (when-not (nil? @semantic-type-hierarchy) (println TOP-SEMANTIC-TYPE)) 31 | (doseq [x (vec (descendants @semantic-type-hierarchy TOP-SEMANTIC-TYPE))] 32 | (println x)) 33 | nil) 34 | 35 | (defn showTypes 36 | "Lists all the semantic types." 37 | [] 38 | (list-types)) 39 | 40 | (defn semantic-type-p 41 | "Returns t if name is the name of a SNePS semantic type; 42 | else returns nil." 43 | [name] 44 | (isa? @semantic-type-hierarchy name TOP-SEMANTIC-TYPE)) 45 | 46 | (defn subtypep 47 | "Checks if type1 is a descendent of type2" 48 | [type1 type2] 49 | (isa? @semantic-type-hierarchy type1 type2)) 50 | 51 | (defn proper-subtypep 52 | "Checks if type1 is a proper subtype of type2" 53 | [type1 type2] 54 | (and (not= type1 type2) (subtypep type1 type2))) 55 | 56 | (defn semtype? 57 | "Checks if a keyword is a semtype" 58 | [kw] 59 | ((conj (descendants @semantic-type-hierarchy :Entity) :Entity) kw)) 60 | 61 | (defn gcsubtype 62 | "Returns a set of the greatest common subtypes of type1 and type2" 63 | [type1 type2] 64 | ;(println "gcsubtype") 65 | (if (= type1 type2) (list type1) 66 | (let [common (clojure.set/intersection (set (conj (descendants @semantic-type-hierarchy type1) type1)) 67 | (set (conj (descendants @semantic-type-hierarchy type2) type2))) 68 | result (ref #{})] 69 | (doseq [x (seq common)] 70 | (if (empty? (clojure.set/intersection (ancestors @semantic-type-hierarchy x) common)) 71 | (dosync (ref-set result (conj @result x))))) 72 | (seq @result)))) -------------------------------------------------------------------------------- /src/clj/csneps/debug.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.debug 2 | (:require [clojure.set :as set]) 3 | (:use [csneps.core])) 4 | 5 | ;;;;;;;;;;;;;;;;;;; 6 | ;;; Debug Tools ;;; 7 | ;;;;;;;;;;;;;;;;;;; 8 | 9 | (def screenprinter (agent nil)) 10 | 11 | (defn println-agent 12 | ([s] 13 | (send screenprinter (fn [_] (println s)))) 14 | ([s & strs] 15 | (println-agent (clojure.string/join " " (conj strs s))))) 16 | 17 | (def debug-features (ref #{})) 18 | (def debug-nodes (ref #{})) 19 | 20 | (defn set-debug-features [& opts] 21 | (dosync (ref-set debug-features (set opts)))) 22 | 23 | ;; Empty nodes list means debug all nodes. 24 | (defn set-debug-nodes [& nodes] 25 | (dosync (ref-set debug-nodes (set (map get-term nodes))))) 26 | 27 | (defmacro debug [& {:keys [features nodes] :or {features '() nodes '()}}] 28 | `(do 29 | (set-debug-features ~@features) 30 | (set-debug-nodes ~@nodes))) 31 | 32 | (defmacro print-debug 33 | "Prints the message if any item from features is in debug-features, and 34 | if any of: any item in nodes is in debug-nodes or debug-nodes is empty 35 | or nodes is empty. Accepts either a set of nodes/features, or a single 36 | one on their own." 37 | [features nodes & message-strs] 38 | (let [features (if (seqable? features) (set features) #{features}) 39 | nodes (if (and (seqable? nodes) (not (map? nodes))) (set nodes) #{nodes})] ;; Records are seqable. 40 | `(when (and (not (empty? (set/intersection ~features @debug-features))) 41 | (or (empty? @debug-nodes) 42 | (empty? ~nodes) 43 | (not (empty? (set/intersection ~nodes @debug-nodes))))) 44 | (println-agent ~@message-strs)))) -------------------------------------------------------------------------------- /src/clj/csneps/demo.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.demo 2 | (:use [clojure.java.io :only (reader)] 3 | [clojure.pprint :only (cl-format pprint)])) 4 | 5 | (declare demo demoindex) 6 | 7 | (defn noop 8 | []) 9 | 10 | (defn- list-demos 11 | "Lists the demos in the /Demo directory via the index.clj file." [] 12 | (let [demodir (str (System/getProperty "user.dir") "/Demo")] 13 | (load-file (str demodir "/index.clj")) 14 | (doseq [x (range (count demoindex)) 15 | :let [[demoname _] (nth demoindex x)]] 16 | (println x "\t" demoname)))) 17 | 18 | (defn- demo-chooser [pause failonerror] 19 | (let [demodir (str (System/getProperty "user.dir") "/Demo")] 20 | (println "Enter the number next to the demo you wish to run:") 21 | (list-demos) 22 | (println "q\tQuit") 23 | (let [input (read-line) 24 | q? (= input "q") 25 | numstr (re-find #"\d+" input) 26 | num (when numstr (Integer/parseInt numstr))] 27 | (cond 28 | q? nil 29 | (and numstr 30 | (>= num 0) 31 | (< num (count demoindex))) (demo :file (str demodir "/" (second (nth demoindex num))) :pause pause :failonerror failonerror) 32 | :default (println "Invalid selection."))))) 33 | 34 | (defn demo 35 | "Echoes and evaluates the forms in the file. 36 | If pause is true, will pause after echoing each form, 37 | but before evaluating it. If failonerror is true, an 38 | exception will halt the demo. If the file is omitted, 39 | a menu will be presented of available demos." 40 | [& {:keys [file pause failonerror] :or {file nil, pause nil, failonerror nil}}] 41 | (if file 42 | (with-open [r (java.io.PushbackReader. 43 | (clojure.java.io/reader file))] 44 | (binding [*read-eval* false] 45 | (loop [form (read r false nil) 46 | keep-pausing (ref pause) 47 | continue (ref true)] 48 | (when (and form @continue) 49 | (print "\ninput: ") 50 | (clojure.pprint/pprint form) 51 | (when @keep-pausing 52 | (loop [] 53 | (println "\n--- pause ---\n") 54 | (let [usrinput (read-line)] 55 | (case usrinput 56 | "" (noop) 57 | "c" (dosync (ref-set keep-pausing nil)) 58 | "q" (dosync (ref-set continue nil)) 59 | ("l" "^") (do 60 | (println "Demo interrupted. Type exit and press enter to continue.") 61 | (clojure.main/repl :read (fn [request-prompt request-exit] 62 | (let [form (clojure.main/repl-read request-prompt request-exit)] 63 | (if (= 'exit form) request-exit form)))) 64 | (recur)) 65 | ("?" "h") (do 66 | (cl-format true 67 | "~%The following commands are available at pause points:~ 68 | ~% h,? Print this help message~ 69 | ~% l,^ Enter Clojure read/eval/print loop~ 70 | ~% c Continue without pausing~ 71 | ~% q Quit the demo~ 72 | ~% RETURN Continue the demo~ 73 | ~%") 74 | (recur)) 75 | (recur)))))) 76 | (when (and form @continue) 77 | (if failonerror 78 | (println "output:" (eval form)) 79 | (println "output:" (try (eval form) (catch Exception e (.getMessage e))))) ;; We watch to catch errors, print them, and move on sometimes. 80 | (recur (read r false nil) keep-pausing continue))))) 81 | (demo-chooser pause failonerror))) -------------------------------------------------------------------------------- /src/clj/csneps/snip.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.snip 2 | (:require [clojure.string :as string] 3 | [csneps.core.build :as build] 4 | [csneps.core.find-utils :as find-utils] 5 | [csneps.core.contexts :as ct] 6 | [csneps.core.caseframes :as cf] 7 | [csneps.core.find :as find] 8 | [csneps.core.relations :as slot] 9 | [csneps.core.semantic-types :as st] 10 | [csneps.core.printer :as print] 11 | [csneps.snip.message :as msg] 12 | [csneps.snip.messagestructure :as msgstruct] 13 | [csneps.snip.originset :as os] 14 | [csneps.snip.ptree :as ptree] 15 | [csneps.snip.linear_message_set :as lms] 16 | [csneps.snip.passthrough-message-set :as pms] 17 | [csneps.snip.sindex :as sindex] 18 | [clojure.walk :as walk]) 19 | ; (:refer-clojure :exclude [merge]) 20 | (:use [csneps.core] 21 | [csneps.util] 22 | [csneps.utils.coreutils] 23 | [csneps.configuration] 24 | [csneps.debug] 25 | [csneps.snip.util] 26 | [csneps.snip.inference-graph.concurrent] 27 | [csneps.core.build :only (term-prewalk)] 28 | [clojure.core.memoize :only (memo)] 29 | [clojure.pprint :only (cl-format)] 30 | [clojure.set]) 31 | (:import [java.util Comparator] 32 | [java.util.concurrent TimeUnit LinkedBlockingQueue PriorityBlockingQueue ThreadPoolExecutor RejectedExecutionException] 33 | [csneps.util CountingLatch])) 34 | 35 | (declare assertTrace askif) 36 | 37 | (def trace 38 | "If non-nil, inference will be traced when rules fire." 39 | (atom nil)) 40 | 41 | (def goaltrace 42 | "If non-nil, inference will be traced 43 | when (sub)goals are generated, 44 | and when (sub)goals are found asserted in the KB." 45 | (atom true)) 46 | 47 | (load "snip_sort_based") 48 | (load "snip_path_based") 49 | (load "snip_slot_based") 50 | ;(load "snip_originset") 51 | ;(load "snip_message") 52 | (load "snip_inference_graph") 53 | (load "snip_acting") 54 | 55 | (defn askif 56 | "If the proposition prop is derivable in context, 57 | return a singleton set of that proposition; 58 | else return the empty set 59 | The termstack is a stack of propositions 60 | that this goal is a subgoal of.." 61 | [prop context termstack] 62 | (let [p (build/build prop :Proposition {} #{})] 63 | (when @goaltrace (cl-format true "~&I wonder if ~S~%" p)) 64 | (cond 65 | (ct/asserted? p context) 66 | (do 67 | (when @goaltrace (cl-format true "~&I know that ~S~%" p)) 68 | #{p}) 69 | :else 70 | (setOr 71 | (slot-based-derivable p context termstack) 72 | (backward-infer-derivable p context) 73 | (when-not semtype-objectlang-experimental (sort-based-derivable p context)) 74 | )))) 75 | 76 | (defn askwh [ques context] 77 | "If the WhQuestion ques can be answered in context, 78 | return a list of substitutions for the qvars, 79 | else return the empty set." 80 | (let [q (build/variable-parse-and-build ques :Entity #{})] 81 | (for [[k v] (backward-infer-answer q context) 82 | :when (not (analyticTerm? v))] 83 | k))) 84 | 85 | (defn askwh-instances [ques context] 86 | "If the WhQuestion ques can be answered in context, 87 | return a list of satisfying terms, 88 | else return the empty set." 89 | (let [q (build/variable-parse-and-build ques :Entity #{})] 90 | (set (remove analyticTerm? (vals (backward-infer-answer q context)))))) 91 | 92 | (defn assertTrace 93 | [rule antecedents consequent reason context] 94 | (build/assert consequent context)) -------------------------------------------------------------------------------- /src/clj/csneps/snip/inference_graph/concurrent.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.snip.inference-graph.concurrent 2 | (:use [csneps.configuration]) 3 | (:import [java.util Comparator] 4 | [java.util.concurrent TimeUnit LinkedBlockingQueue PriorityBlockingQueue ThreadPoolExecutor])) 5 | 6 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 | ;;; Concurrency Control for IG ;;; 8 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 9 | 10 | ;; Incremented whenever a message is submitted, and decremented once inference 11 | ;; on a message is complete, this allows us to determine when the graph is in 12 | ;; a quiescent state. 13 | (def infer-status (ref {nil (csneps.util.CountingLatch.)})) 14 | 15 | ;; Tasks have :priority metadata. This allows the queue to order them 16 | ;; properly for execution. Higher priority is executed first. 17 | (def task-cmpr (proxy [Comparator] [] 18 | (compare [a b] 19 | (let [p_a (:priority (meta a)) 20 | p_b (:priority (meta b))] 21 | (cond 22 | (= p_a p_b) 0 23 | (> p_a p_b) -1 24 | :else 1))))) 25 | 26 | ;; Priority Blocking Queue to handle the tasks. 27 | (def queue (PriorityBlockingQueue. 50 task-cmpr)) 28 | 29 | ;; Fixed Thread Pool of size 2 * processors, using queue as it's queue. 30 | 31 | (def executorService nil) 32 | 33 | (defn startExecutor 34 | [] 35 | (def executorService (ThreadPoolExecutor. 36 | ig-cpus-to-use 37 | ig-cpus-to-use 38 | (Long/MAX_VALUE) TimeUnit/NANOSECONDS queue)) 39 | (.prestartAllCoreThreads ^ThreadPoolExecutor executorService)) 40 | 41 | (defn resetExecutor 42 | [] 43 | (.shutdownNow ^ThreadPoolExecutor executorService) 44 | (.awaitTermination ^ThreadPoolExecutor executorService 60 TimeUnit/SECONDS) 45 | (when-not (.isTerminated ^ThreadPoolExecutor executorService) 46 | (println "ThreadPoolExecutor did not terminate.")) 47 | (.clear ^PriorityBlockingQueue queue) 48 | (def executorService (ThreadPoolExecutor. 49 | ig-cpus-to-use 50 | ig-cpus-to-use 51 | (Long/MAX_VALUE) TimeUnit/NANOSECONDS queue)) 52 | (.prestartAllCoreThreads ^ThreadPoolExecutor executorService) 53 | (def infer-status (ref {nil (csneps.util.CountingLatch.)}))) 54 | 55 | ;; Only used when exiting. 56 | (defn shutdownExecutor 57 | [] 58 | (.shutdownNow ^ThreadPoolExecutor executorService) 59 | (.awaitTermination ^ThreadPoolExecutor executorService 60 TimeUnit/SECONDS) 60 | (when-not (.isTerminated ^ThreadPoolExecutor executorService) 61 | (println "ThreadPoolExecutor did not terminate."))) 62 | 63 | ;;; Experimental attempt at pausing inference. 64 | (let [waiting-queue (LinkedBlockingQueue.)] 65 | (defn pause-execute 66 | [] 67 | (.drainTo ^PriorityBlockingQueue queue waiting-queue)) 68 | 69 | (defn resume-execute 70 | [] 71 | (.drainTo ^LinkedBlockingQueue waiting-queue queue))) -------------------------------------------------------------------------------- /src/clj/csneps/snip/inference_graph/util.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.snip.inference-graph.util) 2 | 3 | -------------------------------------------------------------------------------- /src/clj/csneps/snip/linear_message_set.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.snip.linear_message_set 2 | (:use [csneps.snip.messagestructure] 3 | [csneps.snip.message] 4 | [csneps.snip.message-compat] 5 | [clojure.set])) 6 | 7 | ;; This is the worst case, combinatorial algorithm. 8 | 9 | (defrecord LinearMessageSet 10 | [matched-msgs 11 | working-msgs 12 | sent-msgs] ;;A ref to a set. 13 | MessageStructure 14 | (get-new-messages [this new-msg] 15 | ;; if new-msg isn't actually new, return empty set. 16 | (let [new-msg (sanitize-message new-msg)] 17 | (dosync 18 | (if (or (@(:working-msgs this) new-msg) (@(:matched-msgs this) new-msg)) 19 | #{} 20 | (let [compat-msgs (filter #(compatible? % new-msg) @(:working-msgs this)) 21 | merged-msgs (map #(merge-messages new-msg %) compat-msgs) 22 | new-merged-msgs (set (filter #(not (@(:working-msgs this) %)) merged-msgs))] 23 | (alter (:working-msgs this) union new-merged-msgs #{new-msg}) 24 | (conj new-merged-msgs new-msg)))))) 25 | (seen-message? 26 | [this msg] 27 | (let [msg (sanitize-message msg)] 28 | (or (@(:working-msgs this) msg) (@(:matched-msgs this) msg)))) 29 | (get-sent-messages 30 | [this chtype] 31 | (@(:sent-msgs this) chtype)) 32 | (get-matched-messages 33 | [this] 34 | @(:matched-msgs this)) 35 | (add-matched-and-sent-messages 36 | [this matched sent] (add-matched-and-sent-messages this matched sent true)) 37 | (add-matched-and-sent-messages 38 | [this matched sent remove-matched-from-working?] 39 | (dosync 40 | (alter (:sent-msgs this) (partial merge-with union) sent) 41 | (alter (:matched-msgs this) union matched) 42 | (when remove-matched-from-working? (alter (:working-msgs this) difference matched)))) 43 | (print-messages 44 | [this] 45 | (println "--- Linear Message Set ---") 46 | (println "Matched Messages:") 47 | (doseq [mm @(:matched-msgs this)] (println mm)) 48 | (println "Sent Messages:") 49 | (doseq [[chtype sms] @(:sent-msgs this) 50 | sm sms] (println chtype ":" sm)) 51 | (println "Working Messages:") 52 | (doseq [wm @(:working-msgs this)] (println wm)))) 53 | 54 | (defn make-linear-msg-set 55 | [] 56 | (LinearMessageSet. (ref #{}) (ref #{}) (ref {}))) -------------------------------------------------------------------------------- /src/clj/csneps/snip/message_compat.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.snip.message-compat 2 | (:use [clojure.set] 3 | [csneps.util] 4 | [csneps.snip.message]) 5 | (:require [csneps.core.build :as build])) 6 | 7 | (defn compatible? [msg1 msg2] 8 | "Returns true if the two Messages do not have contradictory 9 | flagged node sets, and their substitutions are compatible." 10 | (and 11 | (build/compatible-substitutions? (:subst msg1) (:subst msg2)) 12 | (loop [fns1 (:flaggedns msg1)] 13 | (if (empty? fns1) 14 | true 15 | (let [fn1p (second fns1) 16 | fn2p (get (:flaggedns msg2) (first fns1))] 17 | (when-not (or 18 | (and (false? fn2p) (true? fn1p)) 19 | (and (true? fn2p) (false? fn1p))) 20 | (recur (rest fns1)))))))) -------------------------------------------------------------------------------- /src/clj/csneps/snip/messagestructure.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.snip.messagestructure) 2 | 3 | (defprotocol MessageStructure 4 | (get-new-messages [this new-msg]) 5 | (seen-message? [this msg]) ;; Sometimes you don't want to combine msgs, just check if you've already seen one. 6 | (get-matched-messages [this]) 7 | (get-sent-messages [this chtype]) 8 | (add-matched-and-sent-messages [this matched sent] [this matched sent remove-matched-from-working?]) 9 | (print-messages [this])) 10 | 11 | (defmethod print-method csneps.snip.messagestructure.MessageStructure [o w] 12 | (.write ^java.io.Writer w 13 | (str (print-messages o)))) 14 | 15 | (prefer-method print-method csneps.snip.messagestructure.MessageStructure java.util.Map) 16 | (prefer-method print-method csneps.snip.messagestructure.MessageStructure clojure.lang.IPersistentMap) 17 | (prefer-method print-method csneps.snip.messagestructure.MessageStructure clojure.lang.IRecord) -------------------------------------------------------------------------------- /src/clj/csneps/snip/originset.clj: -------------------------------------------------------------------------------- 1 | ;;; This file includes several functions for calcluating origin sets. 2 | ;;; Since IGs reason in all contexts simultaneously, it's often necessary to 3 | ;;; create origin sets which are the combinatoric combination of other sets, 4 | ;;; or to apply difference operations to many sets. These functions are meant 5 | ;;; to abstract that away from the implementation of IGs. 6 | 7 | (ns csneps.snip.originset 8 | (:use [clojure.set]) 9 | (:require [csneps.core :as csneps])) 10 | 11 | (defn combine-origin-tags 12 | [t1 t2] 13 | (cond 14 | (= t1 'ext) 'ext 15 | (= t2 'ext) 'ext 16 | :else 'der)) 17 | 18 | (defn der-tag 19 | [ss] 20 | (set (map #(vector (combine-origin-tags (first %) 'der) (second %)) ss))) 21 | 22 | (defn ext-tag 23 | [ss] 24 | (set (map #(vector 'ext (second %)) ss))) 25 | 26 | (defn os-union 27 | "When two sets of sets are unioned, the result is a set of sets 28 | which has size |supports1|*|supports2|, and represents every 29 | combination of the two." 30 | [supports1 supports2] 31 | (cond 32 | (empty? supports1) supports2 33 | (empty? supports2) supports1 34 | :else (set (for [[t1 os1] supports1 35 | [t2 os2] supports2] 36 | [(combine-origin-tags t1 t2) (union os1 os2)])))) 37 | 38 | (defn os-remove-hyp 39 | "For all sets in supports1 which contain hyp, 40 | remove hyp, and return the resulting set of sets." 41 | [supports1 hyp] 42 | (let [sup-with-hyp (filter #(get (second %) hyp) supports1)] 43 | (set (map #(vector (first %) (disj (second %) hyp) sup-with-hyp))))) 44 | 45 | (defn os-remove-hyps 46 | "For all sets in supports1 which are supersets of 47 | hyps. remove the hyps elements, and return the 48 | resulting set of sets." 49 | [supports1 hyps] 50 | (let [sup-with-hyps (filter #(subset? hyps (second %)) supports1)] 51 | (set (map #(vector (first %) (difference % hyps)) sup-with-hyps)))) 52 | 53 | (defn os-equal-sets 54 | "Return the set of sets in supports1 also in supports2 55 | (i.e., the intersection of the two)" 56 | [supports1 supports2] 57 | (intersection supports1 supports2)) 58 | 59 | (defn os-concat 60 | "When two sets of OSes are concatted, the union of the two sets is 61 | taken, while ensuring only minimal members remain in the final 62 | set." 63 | [supports1 supports2] 64 | (loop [result supports1 65 | supports2 (seq supports2)] 66 | (cond 67 | (empty? supports2) 68 | result 69 | (nil? (first (filter #(subset? (second %) (second (first supports2))) supports1))) 70 | (recur (conj result (first supports2)) 71 | (rest supports2)) 72 | :else 73 | (recur result 74 | (rest supports2))))) 75 | 76 | (defn alter-support 77 | [term new-support] 78 | (alter csneps/support assoc term new-support)) 79 | 80 | (defn ss-contains-os 81 | [ss os] 82 | (some #(= (second %) os) ss)) 83 | 84 | (defn has-shared-os? 85 | "Takes a list of of sets of support. Determines if any OS is used in 86 | each set of support." 87 | [supports] 88 | (let [ss (first supports) 89 | rs (rest supports)] 90 | (loop [s ss] 91 | (if (empty? s) 92 | nil 93 | (let [[t o] (first s) 94 | check-rs (filter #(ss-contains-os % o) rs)] 95 | (if (= (set check-rs) (set rs)) 96 | true 97 | (recur (rest s)))))))) -------------------------------------------------------------------------------- /src/clj/csneps/snip/passthrough_message_set.clj: -------------------------------------------------------------------------------- 1 | ;; This message set is meant to handle the case where the down cableset only contains one item, so any relevant 2 | ;; message which is not a duplicate should just be returned. It does not track working messages, as there should be none. 3 | ;; It's somewhat debatable whether this is really needed as a separate structure or if linear / ptree can be adapted to 4 | ;; handle this case. 5 | 6 | (ns csneps.snip.passthrough-message-set 7 | (:use [csneps.snip.messagestructure] 8 | [csneps.snip.message] 9 | [clojure.set])) 10 | 11 | (defrecord PassthroughMessageSet 12 | [matched-msgs 13 | working-msgs 14 | sent-msgs] 15 | MessageStructure 16 | (get-new-messages [this new-msg] 17 | ;; if new-msg isn't actually new, return empty set. 18 | (let [new-msg (sanitize-message new-msg)] 19 | (if (@(:matched-msgs this) new-msg) 20 | #{} 21 | #{new-msg}))) 22 | (seen-message? 23 | [this msg] 24 | (@(:matched-msgs this) (sanitize-message msg))) 25 | (get-sent-messages 26 | [this chtype] 27 | (@(:sent-msgs this) chtype)) 28 | (get-matched-messages 29 | [this] 30 | @(:matched-msgs this)) 31 | (add-matched-and-sent-messages 32 | [this matched sent] (add-matched-and-sent-messages this matched sent true)) 33 | (add-matched-and-sent-messages 34 | [this matched sent _] 35 | (dosync 36 | (alter (:sent-msgs this) (partial merge-with union) sent) 37 | (alter (:matched-msgs this) union matched))) 38 | (print-messages 39 | [this] 40 | (println "--- Passthrough Message Set ---") 41 | (println "Matched Messages:") 42 | (doseq [mm @(:matched-msgs this)] (println mm)) 43 | (println "Sent Messages:") 44 | (doseq [[chtype sms] @(:sent-msgs this) 45 | sm sms] (println chtype ":" sm)))) 46 | 47 | (defn make-passthrough-msg-set 48 | [] 49 | (PassthroughMessageSet. (ref #{}) (ref #{}) (ref {}))) -------------------------------------------------------------------------------- /src/clj/csneps/snip/sindex.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.snip.sindex 2 | (:use [csneps.snip.messagestructure] 3 | [csneps.snip.message] 4 | [clojure.set])) 5 | 6 | ;;; An S-Index is a map from substitution to a RUI. 7 | ;;; Preconditions for use: 8 | ;;; - Disjunctive rule, 9 | ;;; - Each antecedent uses all the same variables. 10 | 11 | (defrecord SIndex 12 | [sindex ;;A ref to a hash-map. 13 | matched-msgs 14 | sent-msgs] ;;A ref to a set. 15 | MessageStructure 16 | (get-new-messages [this new-msg] 17 | (let [old-msg (@(:sindex this) (:subst new-msg))] 18 | (if old-msg 19 | (let [merged-msg (merge-messages new-msg old-msg)] 20 | ;; I don't think we need to check compatibility - 21 | ;; they can't have different bindings at this point. 22 | (dosync (alter (:sindex this) assoc (:subst new-msg) merged-msg)) 23 | #{merged-msg}) 24 | (do 25 | (dosync (alter (:sindex this) assoc (:subst new-msg) new-msg)) 26 | #{new-msg})))) 27 | (seen-message? 28 | [this msg] 29 | (let [msg (sanitize-message msg) 30 | old-msg (@(:sindex this) (:subst msg))] 31 | (= old-msg msg))) 32 | (get-sent-messages 33 | [this chtype] 34 | (@(:sent-msgs this) chtype)) 35 | (get-matched-messages 36 | [this] 37 | @(:matched-msgs this)) 38 | (add-matched-and-sent-messages 39 | [this matched sent] (add-matched-and-sent-messages this matched sent false)) 40 | (add-matched-and-sent-messages 41 | [this matched sent _] 42 | (dosync 43 | (alter (:matched-msgs this) union matched) 44 | (alter (:sent-msgs this) (partial merge-with union) sent))) 45 | (print-messages 46 | [this] 47 | (println "--- S-Index ---") 48 | (println "Matched Messages:") 49 | (doseq [mm @(:matched-msgs this)] (println mm)) 50 | (println "Sent Messages:") 51 | (doseq [[chtype sms] @(:sent-msgs this) 52 | sm sms] (println chtype ":" sm)) 53 | (println "Working Messages:") 54 | (doseq [wm (vals @(:sindex this))] (println wm)))) 55 | 56 | (defn make-sindex 57 | [] 58 | (SIndex. (ref {}) (ref {}) (ref {}))) -------------------------------------------------------------------------------- /src/clj/csneps/snip/util.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.snip.util 2 | (:require [csneps.core :as csneps] 3 | [csneps.core.contexts :as ct] 4 | [csneps.core.build :as build] 5 | [clojure.set :as set]) 6 | (:use [csneps.utils.coreutils])) 7 | 8 | (defn variables-in 9 | [term] 10 | (loop [dcs #{term} 11 | vars #{}] 12 | (if (seq dcs) 13 | (if (variable? (first dcs)) 14 | (recur (set (rest dcs)) (conj vars (first dcs))) 15 | (recur (apply set/union (set (rest dcs)) (:down-cableset (first dcs))) vars)) 16 | vars))) -------------------------------------------------------------------------------- /src/clj/csneps/snip_beliefrevision.clj: -------------------------------------------------------------------------------- 1 | (in-ns 'csneps.snip) 2 | 3 | (defn inconsistent? 4 | "If one of p1 or p2 is the negation of the other one, and both 5 | are believed in ct, then they are contradictory." 6 | [p1 p2 ct] 7 | (and (ct/asserted? p1 ct) 8 | (ct/asserted? p2 ct) 9 | (let [dcs-map1 (cf/dcsRelationTermsetMap p1) 10 | nor-dcs1 (when dcs-map1 (dcs-map1 (slot/find-slot 'nor))) 11 | dcs-map2 (cf/dcsRelationTermsetMap p2) 12 | nor-dcs2 (when dcs-map2 (dcs-map2 (slot/find-slot 'nor)))] 13 | (or (some #(= % p2) nor-dcs1) 14 | (some #(= % p1) nor-dcs2))))) 15 | 16 | (defn detect-contradiction 17 | "When a change has been made to p1, this function can be used to 18 | determine if p1 is now contradictory to some other term." 19 | [p1 ct] 20 | (and (ct/asserted? p1 ct) 21 | (let [dcs-map (cf/dcsRelationTermsetMap p1) 22 | nor-dcs (when dcs-map (dcs-map (slot/find-slot 'nor))) 23 | ucs-map (@up-cablesetw p1) 24 | nor-ucs (when ucs-map (ucs-map (slot/find-slot 'nor))) 25 | nor-ucs (when nor-ucs @nor-ucs)] 26 | (or (some #(ct/asserted? % ct) nor-dcs) 27 | (some #(ct/asserted? % ct) nor-ucs))))) -------------------------------------------------------------------------------- /src/clj/csneps/snip_rnode.clj: -------------------------------------------------------------------------------- 1 | (in-ns 'csneps.snip) 2 | 3 | (defrecord2 rnode 4 | [term nil 5 | cached-terms (ref #{}) 6 | origin-set (ref #{})]) 7 | -------------------------------------------------------------------------------- /src/clj/csneps/snip_sort_based.clj: -------------------------------------------------------------------------------- 1 | (in-ns 'csneps.snip) 2 | 3 | (defn sort-based-derivable 4 | "If the categorization Proposition p 5 | is derivable in the given context 6 | accordng to sort-based inference 7 | returns a singleton set of that proposition; 8 | else returns the empty set ." 9 | [p context] 10 | ;; sort-based-derivable only considers the sorts of terms. 11 | ;; So it doesn't consider any term that logically implies p. 12 | ;; So it doesn't need a termstack argument. 13 | (if-not (= (syntactic-type-of p) :csneps.core/Categorization) 14 | #{} 15 | (let [members (seq (find-utils/findto p 'member))] 16 | (if (= (count members) 17 | (loop [member members 18 | countm 0] 19 | (let [classes (find-utils/findto p 'class)] 20 | (if (and member (= (count classes) 21 | (loop [class classes 22 | countc 0] 23 | (if (and class 24 | (semantic-type-p (keyword (:name (first class)))) 25 | (isa? (st/semantic-type-of (first member)) (keyword (:name (first class))))) 26 | (recur (next class) (inc countc)) 27 | countc)))) 28 | (recur (next member) (inc countm)) 29 | countm)))) 30 | (do 31 | (assertTrace nil nil p "Sort-Based inference" context) 32 | #{p}) 33 | #{})))) -------------------------------------------------------------------------------- /src/clj/csneps/test/.#benchmark.clj.1.3: -------------------------------------------------------------------------------- 1 | (ns csneps.test.benchmark 2 | (:require [csneps.core.contexts :as ct] 3 | [csneps.core.caseframes :as cf] 4 | [csneps.core.relations :as slot] 5 | [csneps.core :as csneps] 6 | [csneps.core.build :as build] 7 | [csneps.snip :as snip] 8 | [clojure.set :as set] 9 | [csneps.core.snuser :as snuser])) 10 | 11 | (def ^:dynamic start-time nil) 12 | (def ^:dynamic end-time nil) 13 | 14 | (declare benchmark-impl) 15 | 16 | (defn generate-and 17 | [assert? ant-ct] 18 | (let [ant-syms (map gensym (repeat ant-ct "ant")) 19 | term (if assert? 20 | (do 21 | ;(doall (map #(snuser/assert %) ant-syms)) 22 | (snuser/assert (list* 'and ant-syms))) 23 | (snuser/defineTerm (list* 'and ant-syms)))] 24 | (if assert? 25 | ;; If the and is snuser/asserted, don't snuser/assert the 26 | ;; ants, but return them. 27 | (do 28 | (snuser/assert (list* 'and ant-syms)) 29 | ant-syms) 30 | ;; Otherwise, snuser/assert the ants, and return the rule 31 | (do 32 | (doall (map #(snuser/assert %) ant-syms)) 33 | (:name (snuser/defineTerm (list* 'and ant-syms))))))) 34 | 35 | (defn generate-andor 36 | [assert? ant-ct] 37 | (let [min-ct (int (inc (rand ant-ct))) 38 | max-ct (+ min-ct (int (rand (- ant-ct min-ct)))) 39 | true-ants (map gensym (repeat max-ct "ant")) 40 | false-ants (map gensym (repeat (- ant-ct max-ct) "ant")) 41 | term (if assert? 42 | (snuser/assert (list* 'andor (list min-ct max-ct) (concat true-ants false-ants))) 43 | (snuser/defineTerm (list* 'andor (list min-ct max-ct) (concat true-ants false-ants))))] 44 | [true-ants false-ants term])) 45 | 46 | (defn generate-implication 47 | [assert? ant-ct cqset] 48 | (let [ants (set (map gensym (repeat ant-ct "ant")))] 49 | (if assert? 50 | [ants (snuser/assert (list 'if ants cqset))] 51 | [ants (snuser/defineTerm (list 'if ants cqset))]))) 52 | 53 | (defn generate-implication-chain 54 | [branching-factor maxdepth] 55 | (loop [depth 0 56 | cqset '#{cq}] 57 | (if (< depth maxdepth) 58 | (recur (inc depth) 59 | (apply clojure.set/union 60 | (map first 61 | (map #(generate-implication true branching-factor %) cqset)))) 62 | (doall (map #(snuser/assert %) cqset))))) 63 | 64 | (def totaltime (atom 0)) 65 | (def iterations (atom 10)) 66 | 67 | (defn log-elapsed 68 | [start-time] 69 | (swap! totaltime + (/ (- (. java.lang.System (clojure.core/nanoTime)) start-time) 1000000.0))) 70 | 71 | 72 | (defn print-elapsed 73 | [start-time] 74 | (println "Elapsed:" 75 | (/ (- (. java.lang.System (clojure.core/nanoTime)) start-time) 1000000.0) "ms")) 76 | 77 | 78 | (defn benchmark-done? 79 | [start-time ref key oldvalue newvalue] 80 | (when (newvalue (snuser/find-term 'cq)) 81 | (println "Done.") 82 | (log-elapsed start-time) 83 | (remove-watch (:ders (ct/currentContext)) :ders) 84 | (if (> (swap! iterations dec) 0) 85 | (benchmark-impl) 86 | (println "Total Time:" @totaltime) 87 | ))) 88 | 89 | (defn benchmark-impl 90 | [] 91 | (snuser/clearkb true) 92 | (generate-implication-chain 2 10) 93 | (let [start-time (. java.lang.System (clojure.core/nanoTime))] 94 | (add-watch (:ders (ct/currentContext)) :ders (partial benchmark-done? start-time)) 95 | (snip/backward-infer (snuser/find-term 'cq)))) 96 | 97 | (defn benchmark 98 | [] 99 | (def totaltime (atom 0)) 100 | (def iterations (atom 10)) 101 | (benchmark-impl)) 102 | 103 | (defn generate-next-level 104 | [true-cqs false-cqs] 105 | 106 | 107 | 108 | ) 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | (defn statistics 117 | [] 118 | (let [molterms (filter csneps/molecularTerm? (vals @csneps/TERMS)) 119 | inferredin (filter #(not (nil? @(:ruis %))) molterms)] 120 | (println "Molecular Terms:" (count molterms)) 121 | (println "Terms Inferred In:" (count inferredin)))) 122 | 123 | (defn generate-graph 124 | [depth order] 125 | 126 | 127 | ) -------------------------------------------------------------------------------- /src/clj/csneps/test/mapper_benchmark.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.test.mapper-benchmark 2 | (:require [csneps.core.contexts :as ct] 3 | [csneps.core.caseframes :as cf] 4 | [csneps.core.printer :as print] 5 | [csneps.core.relations :as slot] 6 | [csneps.core :as csneps] 7 | [csneps.core.semantic-types :as st] 8 | [csneps.core.build :as build] 9 | [csneps.snip :as snip] 10 | [clojure.set :as set] 11 | [clojure.string :as str] 12 | [csneps.core.snuser :as snuser])) 13 | 14 | (declare sneps3kbtocsneps semtypesToObjLang) 15 | 16 | (def runtime (atom 0)) 17 | 18 | (defn log-elapsed 19 | [start-time] 20 | (swap! runtime + (/ (- (. java.lang.System (clojure.core/nanoTime)) start-time) 1000000.0))) 21 | 22 | (defn reset-benchmark 23 | [] 24 | (def runtime (atom 0))) 25 | 26 | (defn print-time 27 | [] 28 | (println "Run Time: " @runtime)) 29 | 30 | (def adopt-order 31 | '[properNounToName1 32 | properNounToName2 33 | organizationHasName 34 | nnName 35 | nounPhraseToInstance 36 | eventToInstance 37 | pluralNounToGroup 38 | subjAction 39 | dobjAction 40 | prepToRelation 41 | nnToModifier 42 | amodToModifier]) 43 | 44 | (defn loadkb 45 | [msgfile framefile rulefile] 46 | (load-file framefile) 47 | (sneps3kbtocsneps msgfile) 48 | (semtypesToObjLang) 49 | (load-file rulefile)) 50 | 51 | (defn synsem-one-file 52 | [msgfile framefile rulefile] 53 | (snuser/clearkb true) 54 | (loadkb msgfile framefile rulefile) 55 | (let [start-time (. java.lang.System (clojure.core/nanoTime))] 56 | (snuser/adopt-rules adopt-order) 57 | (log-elapsed start-time) 58 | (print-time))) 59 | 60 | (defn synsem-benchmark 61 | [msgfolder framefile rulefile] 62 | (reset-benchmark) 63 | (doseq [f (file-seq (clojure.java.io/file msgfolder))] 64 | (when-not (.isDirectory f) 65 | (synsem-one-file (.getPath f) framefile rulefile)))) 66 | 67 | 68 | ;;; Util fns 69 | 70 | (defn semtypesToObjLang 71 | [] 72 | ; (doseq [[c ps] (:parents @csneps/semantic-type-hierarchy) 73 | ; p ps] 74 | ; (snuser/assert `(~'Isa (~'every ~'x (~'Isa ~'x ~(name c))) ~(name p)))) 75 | (let [terms (filter csneps/atomicTerm? (vals @csneps/TERMS))] 76 | (doseq [t terms] 77 | (snuser/assert ['Isa t (name (st/semantic-type-of t))])))) 78 | 79 | (defn typeToGeneric 80 | [typestr] 81 | (let [typeseq (read-string typestr)] 82 | (str (list 'Isa (list 'every 'x (list 'Isa 'x (second typeseq))) (nth typeseq 2))))) 83 | 84 | (defn sneps3kbtocsneps 85 | [filename] 86 | (let [filestr (-> (slurp filename) 87 | (str/replace "ct:assert" "csneps.core.snuser/assert") 88 | (str/replace " 'DefaultCT :origintag :hyp" "") 89 | (str/replace "|" "\"") 90 | (str/replace "\"\"\"" "\"\\\"\"") 91 | (str/replace "(load" "(comment") 92 | (str/replace #"\(csneps.core.snuser/assert '\(Message.*?\)\)" "") ;; Not using the message assertion, lets ignore it since it has weird parsing requirements. 93 | (str/replace #"\(csneps.core.snuser/assert '\(SyntacticCategoryOf POS.*?\)\)" "") 94 | (str/replace "(in-package :snuser)" "(in-ns 'csneos.core.snuser)") 95 | (str/replace "Action" "Action1")) 96 | typestrings (re-seq #"\(Type\s\S+\s\S+?\)" filestr) 97 | filestr (loop [typestrings typestrings 98 | fs filestr] 99 | (if (seq typestrings) 100 | (recur (rest typestrings) 101 | (str/replace fs (first typestrings) (typeToGeneric (first typestrings)))) 102 | fs)) 103 | mgrsstrings (set (re-seq #"\d+[A-Z]+\d+" filestr)) 104 | filestr (loop [mgrsstrings mgrsstrings 105 | fs filestr] 106 | (if (seq mgrsstrings) 107 | (recur (rest mgrsstrings) 108 | (str/replace fs (first mgrsstrings) (str \" (first mgrsstrings) \"))) 109 | fs))] 110 | (println filestr) 111 | (load-string filestr))) 112 | 113 | 114 | 115 | -------------------------------------------------------------------------------- /src/clj/csneps/test/unification.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.test.unification 2 | (:use [csneps.core.build] 3 | [csneps.core.unify.treenode]) 4 | (:require [csneps.core.snuser])) 5 | 6 | (defn basicunif-test [] 7 | (addTermToUnificationTree (csneps.core.snuser/assert '(Isa (every x) Animal))) 8 | (getUnifiers (csneps.core.snuser/defineTerm '(Isa Glacier Animal)))) 9 | 10 | (defn fullunif-test [] 11 | (csneps.core.snuser/clearkb true) 12 | (csneps.core.snuser/defineSlot entity :type Entity :docstring "General slot for holding entities.") 13 | (csneps.core.snuser/defineSlot entity1 :type Entity :docstring "General slot for holding entities.") 14 | (csneps.core.snuser/defineSlot entity2 :type Entity :docstring "General slot for holding entities.") 15 | (csneps.core.snuser/defineCaseframe 'Proposition '('SameSpecies entity entity1 entity2)) 16 | (csneps.core.snuser/defineCaseframe 'Proposition '('caregiver entity1)) 17 | (csneps.core.snuser/defineCaseframe 'Proposition '('friend entity2)) 18 | (addTermToUnificationTree (csneps.core.snuser/assert '(SameSpecies (caregiver (every x)) (friend (caregiver (every w))) w))) 19 | (getUnifiers (csneps.core.snuser/defineTerm '(SameSpecies (every x) (friend x) Alex)))) -------------------------------------------------------------------------------- /src/clj/csneps/utils/coreutils.clj: -------------------------------------------------------------------------------- 1 | ;; Utils depending only on the CSNePS core. 2 | 3 | (ns csneps.utils.coreutils 4 | (:require [csneps.core :as csneps])) 5 | 6 | (defn- flatten-term-helper 7 | "Takes a term, and recursively explores its down-cablesets and optionally 8 | its restrictions to build a complete set of subterms." 9 | ([term seen vars?] 10 | (cond 11 | (seen term) '() 12 | (csneps/molecularTerm? term) (flatten (conj (map #(flatten-term-helper % (conj seen term) vars?) (@csneps/down-cableset term)) term)) 13 | (and vars? (csneps/variableTerm? term)) (flatten (conj (map #(flatten-term-helper % (conj seen term) vars?) (@csneps/restriction-set term)) term)) 14 | (csneps/atomicTerm? term) (list term) 15 | (set? term) (flatten (map #(flatten-term-helper % seen vars?) term))))) 16 | 17 | ;; vars? = true is obviously a little slower, so only do it when needed. 18 | (defn flatten-term 19 | "Takes a term, and recursively explores its down-cablesets (and optionally 20 | restrictions) to build a complete set of subterms." 21 | [term & {:keys [vars?] :or {vars? false}}] 22 | (disj (set (flatten-term-helper term #{} vars?)) term)) 23 | 24 | ;; Moved from buildutils: 25 | (defn ignore-variable? [sym] (= '_ sym)) 26 | 27 | (defn varinlist? [list] #(some #{%} list)) 28 | 29 | (def variable? 30 | (fn [term] 31 | (csneps/variableTerm? term))) 32 | 33 | ;(def variable? #(or (= (type-of %) :csneps.core/Arbitrary) (= (type-of %) :csneps.core/QueryVariable))) 34 | 35 | (def synvariable? #(or (ignore-variable? %) 36 | (and (symbol? %) (re-matches #"^\?.*" (name %))))) 37 | 38 | (def syntype-fsym-map {:csneps.core/Negation 'not, 39 | :csneps.core/Negationbyfailure 'thnot, 40 | :csneps.core/Conjunction 'and, 41 | :csneps.core/Disjunction 'or, 42 | :csneps.core/Equivalence 'iff, 43 | :csneps.core/Xor 'xor, 44 | :csneps.core/Nand 'nand, 45 | :csneps.core/Andor 'andor, 46 | :csneps.core/Thresh 'thresh, 47 | :csneps.core/Implication 'if}) 48 | 49 | (defn term-predicate 50 | [term] 51 | (or 52 | ((csneps/type-of term) syntype-fsym-map) 53 | (let [p (:print-pattern (@csneps/term-caseframe-map term))] 54 | (if (and (seq? (first p)) (= (first (first p)) 'quote)) 55 | (second (first p)) 56 | (:name (first (first (@csneps/down-cableset term)))))))) -------------------------------------------------------------------------------- /src/clj/csneps/utils/dotgraph.clj: -------------------------------------------------------------------------------- 1 | ;; Convert (part of) a CSNePS KB to a dot graph to be rendered with Graphviz. 2 | 3 | (ns csneps.utils.dotgraph 4 | (:use [clojure.set]) 5 | (:require [csneps.core :as csneps] 6 | [csneps.core.semantic-types :as st] 7 | [csneps.core.caseframes :as cf] 8 | [csneps.core.contexts :as ct] 9 | [clojure.string :as str] 10 | [clojure.java.io :as io])) 11 | 12 | (defn display-name [term] 13 | (if (ct/asserted? term (ct/currentContext)) 14 | (str \" (:name term) "!\"") 15 | (str \" (:name term) "\""))) 16 | 17 | (defn filler-to-dot [term slot filler] 18 | (str (display-name term) " -> " (display-name filler) " [label=\" " (:name slot) "\" arrowhead=\"open\"];")) 19 | 20 | (defn relation-to-dot [term slot fillers] 21 | (str/join "\n" (map #(filler-to-dot term slot %) fillers))) 22 | 23 | (defn restriction-to-dot [quantterm restriction] 24 | (str (display-name quantterm) " -> " (display-name restriction) " [label=\"restriction\" style=\"dashed\"")) 25 | 26 | (defn restrictions-to-dot [quantterm restrictions] 27 | (str/join "\n" (map #(restriction-to-dot quantterm %) restrictions))) 28 | 29 | ;; Pre-supposes collapseable. 30 | (defn collapsed-relations-to-dot [term term-relations] 31 | (let [cf (csneps/caseframe-for term) 32 | slots (:slots cf) 33 | origin (if (= (count slots) 2) 34 | (first slots) ;; 2 slot case 35 | (second slots)) ;; 3 slot case 36 | destination (if (= (count slots) 2) 37 | (second slots) ;; 2 slot case 38 | (nth slots 2))] ;; 3 slot case 39 | (str (display-name (first (term-relations origin))) 40 | " -> " 41 | (display-name (first (term-relations destination))) 42 | " [label=\" " (cf/caseframe-name cf) (if (ct/asserted? term (ct/currentContext)) "!" "") 43 | "\" arrowhead=\"empty\"];"))) 44 | 45 | ;; There are two cases for collapseable terms: 46 | ;; 3 slots, Propositional, has fsymbols, no in edges. 47 | ;; 2 slots, Propositional, no in edges. 48 | (defn collapseable? [term] 49 | (let [cf (csneps/caseframe-for term)] 50 | (and (empty? (@csneps/up-cablesetw term)) 51 | (csneps/subtypep (st/semantic-type-of term) :Propositional) 52 | (or 53 | (and (= 2 (count (:slots cf))) 54 | (cf/quotedpp? cf)) ;; Quoted if no fsymbols. 55 | (and (= 3 (count (:slots cf))) 56 | (not (cf/quotedpp? cf))))))) 57 | 58 | (defn relations-to-dot [term term-relations] 59 | (str/join "\n" 60 | (for [[slot fillers] term-relations] 61 | (relation-to-dot term slot fillers)))) 62 | 63 | ;; Possible candidate to replace flatten-term - it's certainly nicer to look at. Performance? 64 | (defn terms-in-term [term] 65 | (loop [terms #{} 66 | to-check [term]] 67 | (if (subset? (set to-check) terms) ;; Should we just check for empty? 68 | terms 69 | (recur (conj terms (first to-check)) 70 | (concat (rest to-check) 71 | (apply union (@csneps/down-cableset (first to-check))) 72 | (@csneps/restriction-set (first to-check))))))) 73 | 74 | (defn terms-to-dot [terms collapse?] 75 | (let [terms (map csneps/get-term terms)] 76 | (str/join "\n" 77 | (for [term (apply union (map terms-in-term terms)) ;; Get all subterms so we don't omit anything! 78 | :let [term-relations (cf/dcsRelationTermsetMap term)]] 79 | (if (and collapse? (collapseable? term)) 80 | (collapsed-relations-to-dot term term-relations) 81 | (relations-to-dot term term-relations)))))) 82 | 83 | (defn generate-dotfile [terms fname collapse?] 84 | (let [termstr (terms-to-dot terms collapse?)] 85 | (with-open [w ^java.io.Writer (io/writer fname)] 86 | (.write w "digraph G {\n") 87 | (.write w ^String termstr) 88 | (.write w "\n}")))) -------------------------------------------------------------------------------- /src/clj/csneps/utils/ontology.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.utils.ontology 2 | (:require [csneps.core.caseframes :as cf] 3 | [csneps.core.relations :as slot] 4 | [clojure.set :as set])) 5 | 6 | (defn- anonclass? 7 | [term] 8 | (or (= (csneps.core/caseframe-for term) (cf/find-frame 'ObjectSomeValuesFrom)) 9 | (= (csneps.core/caseframe-for term) (cf/find-frame 'ObjectAllValuesFrom)) 10 | (= (csneps.core/caseframe-for term) (cf/find-frame 'ObjectHasValue)))) 11 | 12 | (defn- supertype-of 13 | [term] 14 | (let [ucs (@csneps.core/up-cablesetw term) 15 | wfts (when (get ucs (slot/find-slot 'subClassExpression)) 16 | @(get ucs (slot/find-slot 'subClassExpression))) 17 | supertypes (apply set/union (map #(second (@csneps.core/down-cableset %)) wfts)) 18 | supertypes (remove anonclass? supertypes) 19 | supertype (first supertypes)];; Assume single inheritance 20 | supertype)) 21 | 22 | (defn- subtypes-of 23 | [term] 24 | (let [ucs (@csneps.core/up-cablesetw term) 25 | wfts (when (get ucs (slot/find-slot 'superClassExpression)) 26 | @(get ucs (slot/find-slot 'superClassExpression))) 27 | subtypes (apply set/union (map #(first (@csneps.core/down-cableset %)) wfts)) 28 | subtypes (remove anonclass? subtypes)] 29 | subtypes)) 30 | 31 | (defn- dist-to-root 32 | [term] 33 | (loop [term term 34 | dist 0] 35 | (let [supertype (supertype-of term)] 36 | (if supertype 37 | (recur supertype (inc dist)) 38 | dist)))) 39 | 40 | (defn- defined? 41 | [term] 42 | nil 43 | ) 44 | 45 | (defn- siblings-of 46 | [term] 47 | (let [supertype (supertype-of term)] 48 | (remove #{term} (subtypes-of supertype)))) 49 | 50 | (defn- get-roots 51 | "A root is a concrete term which is a supertype, but not a subtype." 52 | [frame-terms] 53 | (let [subtypes (apply set/union (map #(first (@csneps.core/down-cableset %)) frame-terms)) 54 | supertypes (apply set/union (map #(second (@csneps.core/down-cableset %)) frame-terms)) 55 | roots (set/difference supertypes subtypes)] 56 | (remove anonclass? roots))) 57 | 58 | (defn definition-order 59 | "Returns a list of ontology terms without definitions, sorted 60 | according to the algorithm in Schlegel & Elkin @ IWOOD 2015" 61 | [] 62 | (if-not (cf/find-frame 'SubClassOf) 63 | nil 64 | (let [subclassframe (cf/find-frame 'SubClassOf) 65 | frame-terms @(:terms subclassframe) 66 | roots (get-roots frame-terms) 67 | terms (apply set/union (map #(apply set/union (@csneps.core/down-cableset %)) frame-terms)) 68 | terms (remove anonclass? terms) 69 | terms (remove defined? terms) 70 | dist-term-map (apply merge-with concat (map #(hash-map (dist-to-root %) [%]) terms)) 71 | distances (sort (remove #{0} (keys dist-term-map)))] 72 | (apply concat 73 | (apply concat 74 | (for [i distances 75 | :let [terms (get dist-term-map i)]] 76 | (sort-by #(count (filter defined? %)) 77 | (loop [terms terms 78 | siblingsets []] 79 | (if (nil? (first terms)) 80 | siblingsets 81 | (let [term (first terms) 82 | siblingset (conj (set (siblings-of term)) term)] 83 | (recur (remove siblingset (rest terms)) 84 | (conj siblingsets siblingset)))))))))))) 85 | 86 | (defn define-next-term 87 | [] 88 | (first (definition-order))) -------------------------------------------------------------------------------- /src/jvm/csneps/api/CSNePS.java: -------------------------------------------------------------------------------- 1 | /* 2 | Making use of the API is really like having access to the back end of the GUI. 3 | */ 4 | 5 | package csneps.api; 6 | 7 | import clojure.java.api.Clojure; 8 | import clojure.lang.*; 9 | import csneps.gui.GUI2; 10 | import csneps.gui.business.FnInterop; 11 | import csneps.gui.business.Term; 12 | import csneps.gui.dataaccess.Controller; 13 | import csneps.gui.dataaccess.Model; 14 | 15 | import java.io.BufferedReader; 16 | import java.io.IOException; 17 | import java.io.InputStream; 18 | import java.io.InputStreamReader; 19 | import java.net.URL; 20 | import java.util.HashSet; 21 | import java.util.Set; 22 | import java.util.stream.Collectors; 23 | 24 | public class CSNePS extends FnInterop { 25 | 26 | public CSNePS(){ 27 | load_csneps(); 28 | } 29 | 30 | public void startGUI(){ 31 | Controller.gui_startGUI(); 32 | } 33 | 34 | public void startGUI(Set termNames) { 35 | PersistentHashSet hs = PersistentHashSet.create(termNames.stream().map(Symbol::intern).collect(Collectors.toList())); 36 | Controller.gui_startGUI(hs); 37 | } 38 | 39 | public static void clearkb(boolean clearall){ 40 | Controller.snuser_clearkb(clearall); 41 | } 42 | 43 | public static void load(String filename) { Controller.snuser_load(filename); } 44 | 45 | public static void load(InputStream inputStream) { 46 | String str = ""; 47 | StringBuilder buffer = new StringBuilder(); 48 | try { 49 | BufferedReader reader = new BufferedReader(new InputStreamReader(inputStream)); 50 | while ((str = reader.readLine()) != null) { 51 | buffer.append(str).append("\n"); 52 | } 53 | } 54 | catch (IOException e){ 55 | e.printStackTrace(); 56 | } 57 | 58 | if (buffer.length() > 10000) { // Big load operation 59 | Controller.gui_remove_watches(); 60 | loadString(buffer.toString()); 61 | GUI2.model = new Model(); 62 | Controller.gui_add_watches(GUI2.getModel()); 63 | GUI2.initializeModel(); 64 | } 65 | else { 66 | loadString(buffer.toString()); 67 | } 68 | } 69 | 70 | public static Set pathsfrom(Term term, String path){ 71 | 72 | Set results = new HashSet<>(); 73 | 74 | IPersistentSet res = Controller.snip_pathsfrom(term.getClojureTerm(), (IPersistentList) RT.readString(path)); 75 | ISeq resSeq = res.seq(); 76 | 77 | while(resSeq != null && resSeq.count() > 0){ 78 | results.add(Term.create((IPersistentMap) resSeq.first())); 79 | resSeq = resSeq.next(); 80 | } 81 | 82 | return results; 83 | } 84 | 85 | // Internal implementation // 86 | private static void load_csneps(){ 87 | IFn require = Clojure.var("clojure.core", "require"); 88 | require.invoke(Clojure.read("csneps.core.snuser")); 89 | IFn startExecutor = Clojure.var("csneps.snip.inference-graph.concurrent", "startExecutor"); 90 | startExecutor.invoke(); 91 | clearkb(true); 92 | GUI2.model = new Model(); 93 | Controller.gui_add_watches(GUI2.getModel()); 94 | GUI2.initializeModel(); 95 | } 96 | } 97 | -------------------------------------------------------------------------------- /src/jvm/csneps/api/ICaseframe.java: -------------------------------------------------------------------------------- 1 | package csneps.api; 2 | 3 | import csneps.gui.business.Slot; 4 | 5 | import java.util.List; 6 | import java.util.Set; 7 | 8 | public interface ICaseframe { 9 | Set getFSymbols(); 10 | String getName(); 11 | List getSlots(); 12 | ISemanticType getType(); 13 | } 14 | -------------------------------------------------------------------------------- /src/jvm/csneps/api/IContext.java: -------------------------------------------------------------------------------- 1 | package csneps.api; 2 | 3 | import csneps.gui.business.Context; 4 | import csneps.gui.business.Term; 5 | 6 | import java.util.List; 7 | import java.util.Set; 8 | 9 | public interface IContext { 10 | Set getHyps(); 11 | String getName(); 12 | List getParents(); 13 | } 14 | -------------------------------------------------------------------------------- /src/jvm/csneps/api/ISemanticType.java: -------------------------------------------------------------------------------- 1 | package csneps.api; 2 | 3 | import csneps.gui.business.SemanticType; 4 | 5 | import java.util.List; 6 | import java.util.Set; 7 | 8 | public interface ISemanticType { 9 | Set getAncestors(); 10 | String getName(); 11 | List getParents(); 12 | boolean hasAncestor(SemanticType p); 13 | boolean hasParent(SemanticType p); 14 | } 15 | -------------------------------------------------------------------------------- /src/jvm/csneps/api/ISlot.java: -------------------------------------------------------------------------------- 1 | package csneps.api; 2 | 3 | public interface ISlot { 4 | Long getMax(); 5 | Long getMin(); 6 | String getName(); 7 | ISemanticType getType(); 8 | } 9 | -------------------------------------------------------------------------------- /src/jvm/csneps/api/ITerm.java: -------------------------------------------------------------------------------- 1 | package csneps.api; 2 | 3 | import csneps.gui.business.SemanticType; 4 | import csneps.gui.business.Slot; 5 | import csneps.gui.business.Term; 6 | 7 | import java.util.*; 8 | 9 | public interface ITerm { 10 | String getName(); 11 | String getSyntacticType(); 12 | SemanticType getSemanticType(); 13 | ICaseframe getCaseframe(); 14 | Set getDependencies(); 15 | String getDescription(); 16 | String getFSymbol(); 17 | String getVarLabel(); 18 | Set getRestrictionset(); 19 | Map> getUpCableset(); 20 | List getUpCablesetTerms(); 21 | Boolean isMolecular(); 22 | Boolean isVariable(); 23 | boolean isArbitrary(); 24 | boolean isIndefinite(); 25 | boolean isGeneric(); 26 | boolean isAnalytic(); 27 | } 28 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/CaseframeTableModel.java: -------------------------------------------------------------------------------- 1 | /* 2 | * To change this template, choose Tools | Templates 3 | * and open the template in the editor. 4 | */ 5 | package csneps.gui; 6 | 7 | import javax.swing.table.DefaultTableModel; 8 | 9 | /** 10 | * 11 | * @author dan 12 | */ 13 | public class CaseframeTableModel extends DefaultTableModel { 14 | 15 | public CaseframeTableModel(Object[] columnNames, int rowCount) { 16 | super(columnNames, rowCount); 17 | } 18 | 19 | @Override 20 | public boolean isCellEditable(int row, int col) { 21 | if (col == 0) { 22 | return false; 23 | } 24 | return true; 25 | } 26 | } 27 | 28 | /* 29 | * jTable1.setModel(new javax.swing.table.DefaultTableModel( 30 | new Object [][] { 31 | {null, null, null, null, null}, 32 | {null, null, null, null, null} 33 | }, 34 | new String [] { 35 | "Slot", "Filler", "Title 3", "Title 4", "Title 5" 36 | } 37 | ) { 38 | boolean[] canEdit = new boolean [] { 39 | false, true, true, true, true 40 | }; 41 | 42 | public boolean isCellEditable(int rowIndex, int columnIndex) { 43 | return canEdit [columnIndex]; 44 | } 45 | }); 46 | */ -------------------------------------------------------------------------------- /src/jvm/csneps/gui/ComparableTreeNode.java: -------------------------------------------------------------------------------- 1 | /* 2 | * To change this template, choose Tools | Templates 3 | * and open the template in the editor. 4 | */ 5 | 6 | package csneps.gui; 7 | 8 | import javax.swing.tree.DefaultMutableTreeNode; 9 | import javax.swing.tree.MutableTreeNode; 10 | 11 | /** 12 | * 13 | * @author dan 14 | */ 15 | public class ComparableTreeNode extends DefaultMutableTreeNode implements Comparable>{ 16 | private static final long serialVersionUID = 4091648073735653660L; 17 | 18 | public ComparableTreeNode(Comparable c) { 19 | super(c); 20 | } 21 | 22 | // Essentially does stepwise insertion sort. 23 | private void insertInOrder(MutableTreeNode newChild) { 24 | if(this.children == null) { 25 | super.insert(newChild, 0); 26 | return; 27 | } 28 | 29 | for(int i = 0; i < this.children.size(); i++) { 30 | String stringrep = this.children.get(i).toString(); 31 | if (stringrep.compareTo(newChild.toString()) >= 0) { 32 | super.insert(newChild, i); 33 | return; 34 | } 35 | } 36 | super.insert(newChild, this.children.size() - 1); 37 | } 38 | 39 | @Override 40 | public void insert(final MutableTreeNode newChild, final int childIndex) { 41 | insertInOrder(newChild); 42 | //super.insert(newChild, childIndex); 43 | //Collections.sort(this.children); 44 | } 45 | 46 | @SuppressWarnings("unchecked") 47 | @Override 48 | public int compareTo(ComparableTreeNode o) { 49 | return ((Comparable)this.getUserObject()).compareTo((T)o.getUserObject()); 50 | } 51 | } -------------------------------------------------------------------------------- /src/jvm/csneps/gui/GlobalGraphFilterDialog.java: -------------------------------------------------------------------------------- 1 | /* 2 | * To change this template, choose Tools | Templates 3 | * and open the template in the editor. 4 | */ 5 | 6 | package csneps.gui; 7 | 8 | import java.awt.event.ActionEvent; 9 | import javax.swing.JDialog; 10 | import java.awt.Frame; 11 | import java.awt.event.ActionListener; 12 | 13 | /** 14 | * 15 | * @author dan 16 | */ 17 | public class GlobalGraphFilterDialog extends JDialog{ 18 | 19 | public GlobalGraphFilterDialog(Frame frame, final GlobalGraphFilter panel){ 20 | super(frame, true); 21 | setTitle("Set Global Graph Filter"); 22 | setSize(265, 400); 23 | 24 | panel.getOKButton().addActionListener(new ActionListener() { 25 | public void actionPerformed(ActionEvent e) { 26 | dispose(); 27 | panel.perfomOK(); 28 | } 29 | }); 30 | 31 | panel.getCancelButton().addActionListener(new ActionListener() { 32 | public void actionPerformed(ActionEvent e) { 33 | dispose(); 34 | } 35 | }); 36 | 37 | add(panel); 38 | } 39 | 40 | } 41 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/JTableRE.java: -------------------------------------------------------------------------------- 1 | //Based on http://www.javaworld.com/javaworld/javatips/jw-javatip102.html, modified by DSchlegel. 2 | 3 | package csneps.gui; 4 | 5 | import javax.swing.*; 6 | import javax.swing.table.*; 7 | import java.util.Vector; 8 | 9 | public class JTableRE extends JTable { 10 | 11 | protected RowEditorModel rm; 12 | 13 | public JTableRE() { 14 | super(); 15 | rm = null; 16 | } 17 | 18 | public JTableRE(TableModel tm) { 19 | super(tm); 20 | rm = null; 21 | } 22 | 23 | public JTableRE(TableModel tm, TableColumnModel cm) { 24 | super(tm, cm); 25 | rm = null; 26 | } 27 | 28 | public JTableRE(TableModel tm, TableColumnModel cm, 29 | ListSelectionModel sm) { 30 | super(tm, cm, sm); 31 | rm = null; 32 | } 33 | 34 | public JTableRE(int rows, int cols) { 35 | super(rows, cols); 36 | rm = null; 37 | } 38 | 39 | public JTableRE(final Vector rowData, final Vector columnNames) { 40 | super(rowData, columnNames); 41 | rm = null; 42 | } 43 | 44 | public JTableRE(final Object[][] rowData, final Object[] colNames) { 45 | super(rowData, colNames); 46 | rm = null; 47 | } 48 | 49 | // new constructor 50 | public JTableRE(TableModel tm, RowEditorModel rm) { 51 | super(tm, null, null); 52 | this.rm = rm; 53 | } 54 | 55 | public void setRowEditorModel(RowEditorModel rm) { 56 | this.rm = rm; 57 | } 58 | 59 | public RowEditorModel getRowEditorModel() { 60 | return rm; 61 | } 62 | 63 | public TableCellEditor getCellEditor(int row, int col) { 64 | TableCellEditor tmpEditor = null; 65 | if (rm != null) { 66 | tmpEditor = rm.getEditor(row); 67 | } 68 | if (tmpEditor != null) { 69 | return tmpEditor; 70 | } 71 | return super.getCellEditor(row, col); 72 | } 73 | } 74 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/LazyLayout.java: -------------------------------------------------------------------------------- 1 | package csneps.gui; 2 | 3 | import java.awt.Container; 4 | import java.awt.FlowLayout; 5 | 6 | // a do-nothing layout manager 7 | class LazyLayout extends FlowLayout { 8 | 9 | LazyLayout(){ 10 | super(); 11 | } 12 | 13 | public void layoutContainer (Container target){ 14 | } 15 | 16 | 17 | 18 | } -------------------------------------------------------------------------------- /src/jvm/csneps/gui/PairLR.java: -------------------------------------------------------------------------------- 1 | /* 2 | * To change this template, choose Tools | Templates 3 | * and open the template in the editor. 4 | */ 5 | 6 | package csneps.gui; 7 | 8 | /** 9 | * 10 | * @author dan 11 | */ 12 | public class PairLR { 13 | 14 | private final L left; 15 | private final R right; 16 | 17 | public PairLR(L left, R right) { 18 | this.left = left; 19 | this.right = right; 20 | } 21 | 22 | public L getLeft() { return left; } 23 | public R getRight() { return right; } 24 | 25 | @Override 26 | public int hashCode() { return left.hashCode() ^ right.hashCode(); } 27 | 28 | @Override 29 | public boolean equals(Object o) { 30 | if (o == null) return false; 31 | if (!(o instanceof PairLR)) return false; 32 | PairLR pairo = (PairLR) o; 33 | return this.left.equals(pairo.getLeft()) && 34 | this.right.equals(pairo.getRight()); 35 | } 36 | 37 | } -------------------------------------------------------------------------------- /src/jvm/csneps/gui/PluginPanel.java: -------------------------------------------------------------------------------- 1 | /* 2 | * To change this template, choose Tools | Templates 3 | * and open the template in the editor. 4 | */ 5 | 6 | /* 7 | * PluginPanel.java 8 | * 9 | * Created on Nov 10, 2011, 4:59:41 PM 10 | */ 11 | 12 | package csneps.gui; 13 | 14 | import java.awt.BorderLayout; 15 | import java.awt.Component; 16 | import java.util.ArrayList; 17 | 18 | import org.jdesktop.swingx.MultiSplitLayout; 19 | import org.jdesktop.swingx.JXMultiSplitPane; 20 | 21 | /** 22 | * 23 | * @author dan 24 | */ 25 | public class PluginPanel extends javax.swing.JPanel { 26 | 27 | RDockComponent semantic; 28 | SemanticTypesPanel stPanel = new SemanticTypesPanel(); 29 | 30 | RDockComponent cf; 31 | CaseframesPanel cfPanel; 32 | 33 | RDockComponent context; 34 | ContextsPanel ctPanel; 35 | 36 | JXMultiSplitPane multiSplitPane = new JXMultiSplitPane(); 37 | ArrayList components = new ArrayList(); 38 | 39 | /** Creates new form PluginPanel */ 40 | public PluginPanel() { 41 | initComponents(); 42 | this.setLayout(new BorderLayout()); 43 | //this.add(new JLabel("Hi"), BorderLayout.CENTER); 44 | // String layoutDef = 45 | // "(COLUMN top bottom)"; 46 | //MultiSplitLayout.Node modelRoot = MultiSplitLayout.parseModel(layoutDef); 47 | 48 | //MultiSplitPane multiSplitPane = new MultiSplitPane(); 49 | //multiSplitPane.getMultiSplitLayout().setModel(modelRoot); 50 | //multiSplitPane.add(new JButton("Left Column"), "top"); 51 | //multiSplitPane.add(new JButton("Bottom Row"), "bottom"); 52 | //this.add(multiSplitPane, BorderLayout.CENTER); 53 | addDefaultComponents(); 54 | } 55 | 56 | 57 | 58 | public void addDefaultComponents(){ 59 | //Semantic Types 60 | semantic = new RDockComponent(); 61 | //RelationFrame rl = new RelationFrame(null, null, 5, 5, 5, 5); 62 | semantic.setComponentName("Semantic Types"); 63 | //semantic.setLocation(0, 0); 64 | semantic.setSize(100, 200); 65 | semantic.setComponent(stPanel); 66 | this.addComponent(semantic); 67 | GUI2.model.registerView(stPanel); 68 | 69 | 70 | //Caseframes 71 | cfPanel = new CaseframesPanel(); 72 | cf = new RDockComponent(); 73 | cf.setComponentName("Caseframes"); 74 | //cf.setLocation(0, semantic.getHeight()); 75 | cf.setSize(100,200); 76 | cf.setComponent(cfPanel); 77 | this.addComponent(cf); 78 | 79 | 80 | //Contexts 81 | ctPanel = new ContextsPanel(); 82 | context = new RDockComponent(); 83 | context.setComponentName("Contexts"); 84 | //context.setLocation(0, semantic.getHeight()+cf.getHeight()); 85 | context.setSize(100,200); 86 | context.setComponent(ctPanel); 87 | this.addComponent(context); 88 | GUI2.model.registerView(ctPanel); 89 | } 90 | 91 | 92 | public void addComponent(Component c){ 93 | components.add(c); 94 | if(components.size() > 1){ 95 | String layoutDef = "(COLUMN "; 96 | for(int i = 0 ; i < components.size(); i++) layoutDef += "c"+i+" "; 97 | layoutDef += ")"; 98 | MultiSplitLayout.Node modelRoot = MultiSplitLayout.parseModel(layoutDef); 99 | multiSplitPane = new JXMultiSplitPane(); 100 | multiSplitPane.getMultiSplitLayout().setModel(modelRoot); 101 | for(int i = 0 ; i < components.size(); i++){ 102 | multiSplitPane.add(components.get(i), "c"+i); 103 | } 104 | this.removeAll(); 105 | this.add(multiSplitPane, BorderLayout.CENTER); 106 | } 107 | } 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | /** This method is called from within the constructor to 116 | * initialize the form. 117 | * WARNING: Do NOT modify this code. The content of this method is 118 | * always regenerated by the Form Editor. 119 | */ 120 | @SuppressWarnings("unchecked") 121 | // //GEN-BEGIN:initComponents 122 | private void initComponents() { 123 | 124 | javax.swing.GroupLayout layout = new javax.swing.GroupLayout(this); 125 | this.setLayout(layout); 126 | layout.setHorizontalGroup( 127 | layout.createParallelGroup(javax.swing.GroupLayout.Alignment.LEADING) 128 | .addGap(0, 400, Short.MAX_VALUE) 129 | ); 130 | layout.setVerticalGroup( 131 | layout.createParallelGroup(javax.swing.GroupLayout.Alignment.LEADING) 132 | .addGap(0, 300, Short.MAX_VALUE) 133 | ); 134 | }// //GEN-END:initComponents 135 | 136 | 137 | // Variables declaration - do not modify//GEN-BEGIN:variables 138 | // End of variables declaration//GEN-END:variables 139 | 140 | } 141 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/RDockComponent.java: -------------------------------------------------------------------------------- 1 | /* 2 | * To change this template, choose Tools | Templates 3 | * and open the template in the editor. 4 | */ 5 | 6 | /* 7 | * RDockComponent.java 8 | * 9 | * Created on Jan 15, 2010, 9:38:58 PM 10 | */ 11 | 12 | package csneps.gui; 13 | 14 | import javax.swing.JPanel; 15 | 16 | /** 17 | * 18 | * @author dan 19 | */ 20 | public class RDockComponent extends javax.swing.JPanel 21 | { 22 | 23 | /** Creates new form RDockComponent */ 24 | public RDockComponent() { 25 | initComponents(); 26 | } 27 | 28 | public void setComponentName(String s){ 29 | containerName.setText(s); 30 | } 31 | 32 | public void setComponent(JPanel p){ 33 | jSplitPane1.setBottomComponent(p); 34 | } 35 | 36 | /** This method is called from within the constructor to 37 | * initialize the form. 38 | * WARNING: Do NOT modify this code. The content of this method is 39 | * always regenerated by the Form Editor. 40 | */ 41 | @SuppressWarnings("unchecked") 42 | // //GEN-BEGIN:initComponents 43 | private void initComponents() { 44 | 45 | jSplitPane1 = new javax.swing.JSplitPane(); 46 | jPanel1 = new javax.swing.JPanel(); 47 | containerName = new javax.swing.JLabel(); 48 | 49 | jSplitPane1.setDividerLocation(20); 50 | jSplitPane1.setDividerSize(0); 51 | jSplitPane1.setOrientation(javax.swing.JSplitPane.VERTICAL_SPLIT); 52 | 53 | containerName.setText("containerName"); 54 | 55 | javax.swing.GroupLayout jPanel1Layout = new javax.swing.GroupLayout(jPanel1); 56 | jPanel1.setLayout(jPanel1Layout); 57 | jPanel1Layout.setHorizontalGroup( 58 | jPanel1Layout.createParallelGroup(javax.swing.GroupLayout.Alignment.LEADING) 59 | .addGroup(jPanel1Layout.createSequentialGroup() 60 | .addComponent(containerName, javax.swing.GroupLayout.PREFERRED_SIZE, 195, javax.swing.GroupLayout.PREFERRED_SIZE) 61 | .addContainerGap(31, Short.MAX_VALUE)) 62 | ); 63 | jPanel1Layout.setVerticalGroup( 64 | jPanel1Layout.createParallelGroup(javax.swing.GroupLayout.Alignment.LEADING) 65 | .addComponent(containerName, javax.swing.GroupLayout.DEFAULT_SIZE, 20, Short.MAX_VALUE) 66 | ); 67 | 68 | jSplitPane1.setTopComponent(jPanel1); 69 | 70 | javax.swing.GroupLayout layout = new javax.swing.GroupLayout(this); 71 | this.setLayout(layout); 72 | layout.setHorizontalGroup( 73 | layout.createParallelGroup(javax.swing.GroupLayout.Alignment.LEADING) 74 | .addComponent(jSplitPane1, javax.swing.GroupLayout.DEFAULT_SIZE, 226, Short.MAX_VALUE) 75 | ); 76 | layout.setVerticalGroup( 77 | layout.createParallelGroup(javax.swing.GroupLayout.Alignment.LEADING) 78 | .addComponent(jSplitPane1, javax.swing.GroupLayout.DEFAULT_SIZE, 225, Short.MAX_VALUE) 79 | ); 80 | }// //GEN-END:initComponents 81 | 82 | 83 | // Variables declaration - do not modify//GEN-BEGIN:variables 84 | private javax.swing.JLabel containerName; 85 | private javax.swing.JPanel jPanel1; 86 | private javax.swing.JSplitPane jSplitPane1; 87 | // End of variables declaration//GEN-END:variables 88 | 89 | } 90 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/RowEditorModel.java: -------------------------------------------------------------------------------- 1 | //Based on http://www.javaworld.com/javaworld/javatips/jw-javatip102.html, modified by DSchlegel. 2 | 3 | package csneps.gui; 4 | 5 | import javax.swing.table.*; 6 | import java.util.*; 7 | 8 | public class RowEditorModel { 9 | 10 | private HashMap data; 11 | 12 | public RowEditorModel() { 13 | data = new HashMap(); 14 | } 15 | 16 | public void addEditorForRow(int row, TableCellEditor e) { 17 | data.put(row, e); 18 | } 19 | 20 | public void removeEditorForRow(int row) { 21 | data.remove(row); 22 | } 23 | 24 | public TableCellEditor getEditor(int row) { 25 | return (TableCellEditor) data.get(row); 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/SNePSEditor.java: -------------------------------------------------------------------------------- 1 | /* 2 | * To change this template, choose Tools | Templates 3 | * and open the template in the editor. 4 | */ 5 | 6 | /* 7 | * SNePSEditor.java 8 | * 9 | * Created on Nov 20, 2011, 11:57:59 AM 10 | */ 11 | 12 | package csneps.gui; 13 | 14 | import java.awt.Color; 15 | import java.util.ArrayList; 16 | import java.util.logging.Level; 17 | import java.util.logging.Logger; 18 | import javax.swing.text.BadLocationException; 19 | import javax.swing.text.DefaultHighlighter; 20 | import javax.swing.text.Highlighter; 21 | import javax.swing.text.Highlighter.HighlightPainter; 22 | 23 | /** 24 | * 25 | * @author dan 26 | */ 27 | public class SNePSEditor extends javax.swing.JPanel { 28 | 29 | Highlighter h; 30 | HighlightPainter redPainter = new DefaultHighlighter.DefaultHighlightPainter(Color.red); 31 | HighlightPainter yellowPainter = new DefaultHighlighter.DefaultHighlightPainter(Color.yellow); 32 | ArrayList lParens; 33 | 34 | 35 | /** Creates new form SNePSEditor */ 36 | public SNePSEditor() { 37 | initComponents(); 38 | h = editor.getHighlighter(); 39 | lParens = new ArrayList(); 40 | } 41 | 42 | /** This method is called from within the constructor to 43 | * initialize the form. 44 | * WARNING: Do NOT modify this code. The content of this method is 45 | * always regenerated by the Form Editor. 46 | */ 47 | @SuppressWarnings("unchecked") 48 | // //GEN-BEGIN:initComponents 49 | private void initComponents() { 50 | 51 | jScrollPane2 = new javax.swing.JScrollPane(); 52 | editor = new javax.swing.JTextPane(); 53 | 54 | editor.addKeyListener(new java.awt.event.KeyAdapter() { 55 | public void keyPressed(java.awt.event.KeyEvent evt) { 56 | editorKeyPressed(evt); 57 | } 58 | }); 59 | jScrollPane2.setViewportView(editor); 60 | 61 | javax.swing.GroupLayout layout = new javax.swing.GroupLayout(this); 62 | this.setLayout(layout); 63 | layout.setHorizontalGroup( 64 | layout.createParallelGroup(javax.swing.GroupLayout.Alignment.LEADING) 65 | .addComponent(jScrollPane2, javax.swing.GroupLayout.Alignment.TRAILING, javax.swing.GroupLayout.DEFAULT_SIZE, 400, Short.MAX_VALUE) 66 | ); 67 | layout.setVerticalGroup( 68 | layout.createParallelGroup(javax.swing.GroupLayout.Alignment.LEADING) 69 | .addComponent(jScrollPane2, javax.swing.GroupLayout.Alignment.TRAILING, javax.swing.GroupLayout.DEFAULT_SIZE, 300, Short.MAX_VALUE) 70 | ); 71 | }// //GEN-END:initComponents 72 | 73 | private void editorKeyPressed(java.awt.event.KeyEvent evt) {//GEN-FIRST:event_editorKeyPressed 74 | if(evt.getKeyChar() == '('){ 75 | lParens.add(editor.getCaretPosition()-1); 76 | } 77 | else if(evt.getKeyChar() == ')'){ 78 | if(lParens.isEmpty()){ 79 | try { 80 | h.addHighlight(editor.getCaretPosition() - 1, editor.getCaretPosition(), redPainter); 81 | } catch (BadLocationException ex) { 82 | Logger.getLogger(SNePSEditor.class.getName()).log(Level.SEVERE, null, ex); 83 | } 84 | } 85 | else{ 86 | //h.addHighlight(editor.getCaretPosition() - 1, editor.getCaretPosition(), yellowPainter); 87 | //h.addHighlight(lParens. - 1, editor.getCaretPosition(), yellowPainter); 88 | } 89 | } 90 | }//GEN-LAST:event_editorKeyPressed 91 | 92 | 93 | // Variables declaration - do not modify//GEN-BEGIN:variables 94 | private javax.swing.JTextPane editor; 95 | private javax.swing.JScrollPane jScrollPane2; 96 | // End of variables declaration//GEN-END:variables 97 | 98 | } 99 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/VectorTable.java: -------------------------------------------------------------------------------- 1 | /* 2 | * To change this template, choose Tools | Templates 3 | * and open the template in the editor. 4 | */ 5 | 6 | package csneps.gui; 7 | 8 | import java.util.Vector; 9 | 10 | /** 11 | * 12 | * @author dan 13 | */ 14 | public class VectorTable { 15 | Vector aVect; 16 | Vector> bVects; 17 | 18 | VectorTable(){ 19 | 20 | } 21 | 22 | VectorTable(Vector a, Vector b){ 23 | aVect = a; 24 | bVects.add(b); 25 | } 26 | 27 | public A getItemFromCol1(int row){ 28 | return aVect.get(row); 29 | } 30 | 31 | public B getItemFromCol2(int row){ 32 | return bVects.get(0).get(row); 33 | } 34 | 35 | public B getItemFromColGT1(int col, int row){ 36 | return bVects.get(col-1).get(row); 37 | } 38 | } 39 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/addfile_sneps3.sh: -------------------------------------------------------------------------------- 1 | export CVS_RSH=/usr/bin/ssh 2 | cvs -d :ext:drschleg@timberlake.cse.buffalo.edu:/projects/snwiz/src/CVS-Repository/ add CaseframeTableModel.java 3 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/business/Caseframe.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.business; 2 | 3 | import java.util.*; 4 | import java.util.concurrent.ConcurrentHashMap; 5 | 6 | import clojure.lang.APersistentSet; 7 | import clojure.lang.ISeq; 8 | import clojure.lang.IPersistentMap; 9 | import clojure.lang.IPersistentVector; 10 | import clojure.lang.PersistentVector; 11 | import clojure.lang.Keyword; 12 | import csneps.api.ICaseframe; 13 | import csneps.gui.GUI2; 14 | 15 | public class Caseframe implements Comparable, ICaseframe { 16 | 17 | private static Map cfs = new ConcurrentHashMap(); 18 | private static Map fsymbols = new ConcurrentHashMap(); 19 | 20 | private static Keyword name_key = Keyword.intern("name"); 21 | private static Keyword type_key = Keyword.intern("type"); 22 | private static Keyword slots_key = Keyword.intern("slots"); 23 | 24 | private IPersistentMap cf; 25 | 26 | private List slotnames; 27 | private List slots; 28 | 29 | private Caseframe(IPersistentMap cf){ 30 | this.cf = cf; 31 | } 32 | 33 | public static Caseframe create(IPersistentMap newcf){ 34 | Caseframe c = new Caseframe(newcf); 35 | String key = c.getName() + c.getSlotNames().toString(); 36 | 37 | if (cfs.get(key) != null) 38 | return cfs.get(key); 39 | else{ 40 | cfs.put(key, c); 41 | if(GUI2.DEBUG) 42 | System.err.println("Created Caseframe: " + c.getName() + " " + c.getSlots() + " " + c.getType()); 43 | return c; 44 | } 45 | } 46 | 47 | /** 48 | * 49 | * @param cljcfs 50 | * @return Returns only new caseframes created. 51 | */ 52 | public static ArrayList createCaseframes(APersistentSet cljcfs){ 53 | ArrayList newcfs = new ArrayList(); 54 | for (Iterator iter = cljcfs.iterator(); iter.hasNext(); ){ 55 | IPersistentMap cljcf = iter.next(); 56 | newcfs.add(create(cljcf)); 57 | } 58 | return newcfs; 59 | } 60 | 61 | public static void clearCaseframes(){ 62 | cfs.clear(); 63 | fsymbols.clear(); 64 | } 65 | 66 | public static Collection reinitializeCaseframes(IPersistentMap fsyms, APersistentSet scs){ 67 | cfs = new ConcurrentHashMap<>(); 68 | for (Iterator iter = scs.iterator(); iter.hasNext(); ){ 69 | create(iter.next()); 70 | } 71 | 72 | for (Iterator iter = fsyms.iterator(); iter.hasNext(); ){ 73 | Map.Entry e = iter.next(); 74 | fsymbols.put( 75 | e.getKey().toString(), 76 | create((IPersistentMap)e.getValue())); 77 | } 78 | 79 | return getCaseframes(); 80 | } 81 | 82 | public static Collection getCaseframes(){ 83 | return cfs.values(); 84 | } 85 | 86 | public static Caseframe getCaseframe(String cf, ArrayList slots){ 87 | return cfs.get(cf + slots.toString()); 88 | } 89 | 90 | public String getName(){ 91 | return FnInterop.getCaseframeName(this.cf); 92 | } 93 | 94 | public SemanticType getType(){ 95 | return SemanticType.getSemanticType(((Keyword)cf.valAt(type_key)).getName()); 96 | } 97 | 98 | public List getSlotNames(){ 99 | if(slotnames == null){ 100 | slotnames = Collections.synchronizedList(new ArrayList<>()); 101 | IPersistentVector v = PersistentVector.create((ISeq)cf.valAt(slots_key)); 102 | for(int i = 0; i < v.length(); i++){ 103 | IPersistentMap cljslot = (IPersistentMap)v.nth(i); 104 | slotnames.add(cljslot.valAt(name_key).toString()); 105 | } 106 | } 107 | return slotnames; 108 | } 109 | 110 | public List getSlots(){ 111 | if(slots == null){ 112 | slots = Collections.synchronizedList(new ArrayList<>()); 113 | 114 | for(String s : getSlotNames()){ 115 | slots.add(Slot.getSlot(s)); 116 | } 117 | } 118 | 119 | return slots; 120 | } 121 | 122 | public static void addFSymbols(IPersistentMap fsyms){ 123 | for (Map.Entry e : (Iterable) fsyms) { 124 | fsymbols.put( 125 | e.getKey().toString(), 126 | create((IPersistentMap) e.getValue())); 127 | } 128 | } 129 | 130 | public static void addFSymbol(String s, Caseframe c){ 131 | fsymbols.put(s, c); 132 | } 133 | 134 | // We shouldn't cache this since (sameFrame ...) allows adding them. 135 | public Set getFSymbols(){ 136 | Set fsyms = Collections.synchronizedSet(new HashSet<>()); 137 | if(FnInterop.quotedppQ(cf)) return fsyms; 138 | 139 | for(String k : fsymbols.keySet()){ 140 | if(fsymbols.get(k) == this) fsyms.add(k); 141 | } 142 | return fsyms; 143 | } 144 | 145 | public String toString(){ 146 | return getName(); 147 | } 148 | 149 | public int compareTo(Caseframe c) { 150 | return this.toString().toLowerCase().compareTo(c.toString().toLowerCase()); 151 | } 152 | 153 | } 154 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/business/Channel.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.business; 2 | 3 | import java.util.*; 4 | import java.util.concurrent.ConcurrentHashMap; 5 | 6 | import clojure.lang.APersistentSet; 7 | import clojure.lang.IPersistentMap; 8 | import clojure.lang.Keyword; 9 | import clojure.lang.MapEntry; 10 | import clojure.lang.Ref; 11 | 12 | public class Channel { 13 | 14 | private static Keyword originator = Keyword.intern("originator"); 15 | private static Keyword destination = Keyword.intern("destination"); 16 | private static Keyword waiting_msgs = Keyword.intern("waiting-msgs"); 17 | private static Keyword valve_open = Keyword.intern("valve-open"); 18 | 19 | private IPersistentMap channel; 20 | 21 | public enum ChannelType { ICHANNEL, UCHANNEL, GCHANNEL } 22 | 23 | private Channel(IPersistentMap channel){ 24 | this.channel = channel; 25 | } 26 | 27 | public static Channel create(IPersistentMap channel){ 28 | Channel c = new Channel(channel); 29 | return c; 30 | } 31 | 32 | public static Set createChannels(APersistentSet channels){ 33 | Set chs = Collections.synchronizedSet(new HashSet<>()); 34 | 35 | for (Iterator itr = channels.iterator(); itr.hasNext(); ){ 36 | chs.add(create((IPersistentMap)itr.next())); 37 | } 38 | 39 | return chs; 40 | } 41 | 42 | public static Map> createChannelCollection(IPersistentMap channels){ 43 | Map> chs = new ConcurrentHashMap>(); 44 | 45 | for(Iterator itr = channels.iterator(); itr.hasNext(); ){ 46 | MapEntry e = itr.next(); 47 | Term t = Term.create((IPersistentMap)e.getKey()); 48 | 49 | chs.put(t.getName(), createChannels((APersistentSet)e.getValue())); 50 | } 51 | 52 | return chs; 53 | } 54 | 55 | public Term originator(){ 56 | IPersistentMap orig = (IPersistentMap)channel.valAt(originator); 57 | return Term.create(orig); 58 | } 59 | 60 | public Term destination(){ 61 | IPersistentMap dest = (IPersistentMap)channel.valAt(destination); 62 | return Term.create(dest); 63 | } 64 | 65 | public Boolean isValveOpen(){ 66 | return (Boolean)((Ref)channel.valAt(valve_open)).deref(); 67 | } 68 | 69 | public Integer waitingMsgCount(){ 70 | APersistentSet msgset = (APersistentSet)((Ref)channel.valAt(waiting_msgs)).deref(); 71 | return msgset.count(); 72 | } 73 | 74 | public boolean equals(Channel channel2){ 75 | return (originator().equals(channel2.originator()) && 76 | destination().equals(channel2.destination())); 77 | } 78 | 79 | } 80 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/business/Context.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.business; 2 | 3 | import java.util.*; 4 | import java.util.concurrent.ConcurrentHashMap; 5 | 6 | import clojure.lang.IPersistentMap; 7 | import clojure.lang.IPersistentVector; 8 | import clojure.lang.ISeq; 9 | import clojure.lang.Keyword; 10 | import clojure.lang.MapEntry; 11 | import clojure.lang.PersistentVector; 12 | import csneps.api.IContext; 13 | import csneps.gui.GUI2; 14 | 15 | /** 16 | * Java wrapper for CSNePS Contexts. 17 | * 18 | * @author Daniel R. Schlegel 19 | */ 20 | public class Context implements Comparable, IContext { 21 | 22 | private static final Map contexts = new ConcurrentHashMap(); 23 | 24 | private static final Keyword name_key = Keyword.intern("name"); 25 | private static final Keyword parents_key = Keyword.intern("parents"); 26 | 27 | private static Context currentContext; 28 | 29 | private final IPersistentMap context; 30 | 31 | private Context(IPersistentMap context) { 32 | this.context = context; 33 | } 34 | 35 | public static Context create(IPersistentMap context) { 36 | Context c = new Context(context); 37 | if (contexts.get(c.getName()) != null) { 38 | return contexts.get(c.getName()); 39 | } else { 40 | contexts.put(c.getName(), c); 41 | if (GUI2.DEBUG) 42 | System.err.println("Created context: " + c.getName()); 43 | return c; 44 | } 45 | } 46 | 47 | @SuppressWarnings("unchecked") 48 | public static List createContexts(IPersistentMap cljcts) { 49 | List cts = Collections.synchronizedList(new ArrayList<>()); 50 | for (Iterator itr = cljcts.iterator(); itr.hasNext();) { 51 | cts.add(create((IPersistentMap) itr.next().getValue())); 52 | } 53 | return cts; 54 | } 55 | 56 | public static void clearContexts() { 57 | contexts.clear(); 58 | currentContext = null; 59 | } 60 | 61 | public static Context getContext(String name) { 62 | return contexts.get(name); 63 | } 64 | 65 | public static Collection getContexts() { 66 | return contexts.values(); 67 | } 68 | 69 | public static Context getCurrentContext() { 70 | if (currentContext == null) 71 | currentContext = FnInterop.getCurrentContext(); 72 | return currentContext; 73 | } 74 | 75 | public static void setCurrentContext(Context c) { 76 | currentContext = c; 77 | for (Term t : Term.getTerms()) { 78 | t.resetAsserted(); 79 | } 80 | } 81 | 82 | public String getName() { 83 | return context.valAt(name_key).toString(); 84 | } 85 | 86 | public List getParents() { 87 | List p = new ArrayList(); 88 | IPersistentVector v = PersistentVector.create((ISeq) context.valAt(parents_key)); 89 | for (int i = 0; i < v.length(); i++) { 90 | if (v.nth(i) != null) // Vector created from empty list contains nil. 91 | p.add(create((IPersistentMap) v.nth(i))); 92 | } 93 | return p; 94 | } 95 | 96 | // This relies in calls into the CSNePS implementation since getting the hyps in 97 | // a context 98 | // requires checking parent contexts as well, and I didn't want to reimplement 99 | // that here. 100 | // There may be some cues we can use for caching based on the upated hyps call 101 | // which does 102 | // happen from gui.clj. 103 | public Set getHyps() { 104 | return FnInterop.hyps(this); 105 | } 106 | 107 | IPersistentMap getClojureContext() { 108 | return context; 109 | } 110 | 111 | @Override 112 | public String toString() { 113 | return getName(); 114 | } 115 | 116 | @Override 117 | public int compareTo(Context arg0) { 118 | return this.toString().compareTo(arg0.toString()); 119 | } 120 | } 121 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/business/IView.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.business; 2 | 3 | import java.util.Collection; 4 | import java.util.List; 5 | import java.util.Map; 6 | import java.util.Set; 7 | 8 | 9 | public interface IView { 10 | //Context updates 11 | public void ctUpdate(List c, Boolean clear); 12 | //Current context 13 | public void ctCurrent(Context c); 14 | //SemanticType updates 15 | public void stUpdate(Collection v, Boolean clear); 16 | //Caseframe updates 17 | public void cfUpdate(Collection cf, boolean clear); 18 | //Slot updates 19 | public void slotUpdate(Collection slot, Boolean clear); 20 | //Term updates 21 | public void termUpdate(Collection term, Boolean clear); 22 | //Channel updates 23 | public void channelUpdate(Map> chs, Channel.ChannelType type, Boolean clear); 24 | } 25 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/business/InteropUtils.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.business; 2 | 3 | import java.util.ArrayList; 4 | 5 | import clojure.lang.PersistentList; 6 | import clojure.lang.Symbol; 7 | 8 | public class InteropUtils { 9 | 10 | @SuppressWarnings({ "rawtypes", "unchecked" }) 11 | public static PersistentList arrayListToPersistentList(ArrayList a){ 12 | ArrayList intermediate = new ArrayList(); 13 | for (int i = 0; i < a.size(); i++){ 14 | if(a.get(i) instanceof ArrayList) 15 | arrayListToPersistentList((ArrayList)a.get(i)); 16 | else intermediate.add(Symbol.create((String) a.get(i))); 17 | } 18 | return (PersistentList) PersistentList.create(intermediate); 19 | } 20 | 21 | } 22 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/business/SemanticType.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.business; 2 | 3 | import java.util.*; 4 | import java.util.concurrent.ConcurrentHashMap; 5 | 6 | import clojure.lang.APersistentSet; 7 | import clojure.lang.IPersistentMap; 8 | import clojure.lang.Keyword; 9 | import clojure.lang.RT; 10 | import csneps.api.ISemanticType; 11 | import csneps.gui.GUI2; 12 | 13 | public class SemanticType implements ISemanticType { 14 | private static Map semtypes = new ConcurrentHashMap(); 15 | 16 | private String typename; 17 | private ArrayList parents; 18 | 19 | private SemanticType(String typename, ArrayList parents){ 20 | this.typename = typename; 21 | this.parents = parents; 22 | } 23 | 24 | 25 | public static SemanticType create(String typename, ArrayList parents){ 26 | if (semtypes.get(typename) != null) 27 | return semtypes.get(typename); 28 | else{ 29 | SemanticType s = new SemanticType(typename, parents); 30 | semtypes.put(typename, s); 31 | if(GUI2.DEBUG) System.out.println("Added Semantic Type: " + s.getName() + " with parents " + s.getParents()); 32 | return s; 33 | } 34 | } 35 | 36 | public static Collection getSemanticTypes(){ 37 | return semtypes.values(); 38 | } 39 | 40 | public static Collection reinitializeSemanticTypes(IPersistentMap stsfull){ 41 | semtypes = new ConcurrentHashMap<>(); 42 | semtypes.put("Entity", new SemanticType("Entity", new ArrayList())); 43 | 44 | IPersistentMap sts = (IPersistentMap)stsfull.valAt(Keyword.intern("parents")); 45 | 46 | //System.out.println("STS: " + sts); 47 | 48 | for (Iterator iter = sts.iterator(); iter.hasNext(); ){ 49 | Object entry = iter.next(); 50 | Keyword key = (Keyword)RT.first(entry); 51 | Object[] vals = ((APersistentSet)RT.second(entry)).toArray(); 52 | ArrayList strvals = new ArrayList(); 53 | for (int i = 0; i < vals.length; i++){ 54 | strvals.add(((Keyword)vals[i]).getName()); 55 | } 56 | //System.out.println("Name: " + key.getName() + " Parents: " + strvals); 57 | 58 | create(key.getName(), strvals); 59 | } 60 | 61 | return semtypes.values(); 62 | } 63 | 64 | public static SemanticType getSemanticType(String name){ 65 | return semtypes.get(name); 66 | } 67 | 68 | public ArrayList getParents(){ 69 | ArrayList p = new ArrayList(); 70 | for(String s : parents) 71 | p.add(semtypes.get(s)); 72 | return p; 73 | } 74 | 75 | public Set getAncestors(){ 76 | Set a = new HashSet(); 77 | for(SemanticType p : getParents()){ 78 | a.add(p); 79 | a.addAll(p.getAncestors()); 80 | } 81 | return a; 82 | } 83 | 84 | public boolean hasAncestor(SemanticType p){ 85 | return getAncestors().contains(p); 86 | } 87 | 88 | public boolean hasParent(SemanticType p){ 89 | for(String s : parents) 90 | if (s.equals(p.getName())) return true; 91 | return false; 92 | } 93 | 94 | public String getName(){ 95 | return typename; 96 | } 97 | 98 | public String toString(){ 99 | return typename; 100 | } 101 | 102 | // Can't have twp types with the same name - they must be equal. 103 | public boolean equals(SemanticType other) { return this.typename.equals(other.typename); } 104 | } 105 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/business/Slot.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.business; 2 | 3 | import java.util.HashMap; 4 | import java.util.Iterator; 5 | import java.util.Collection; 6 | 7 | import clojure.lang.IPersistentMap; 8 | import clojure.lang.ASeq; 9 | import clojure.lang.RT; 10 | import clojure.lang.Keyword; 11 | import csneps.api.ISlot; 12 | import csneps.gui.GUI2; 13 | 14 | public class Slot implements Comparable, ISlot { 15 | 16 | private static HashMap slots = new HashMap(); 17 | 18 | private IPersistentMap slot; 19 | 20 | private Slot(IPersistentMap slot){ 21 | this.slot = slot; 22 | } 23 | 24 | public static Slot create(IPersistentMap slot){ 25 | return createHelper((IPersistentMap)RT.first(RT.vals(slot))); 26 | } 27 | 28 | public static Slot createHelper(IPersistentMap slot){ 29 | Slot s = new Slot(slot); 30 | if(slots.get(s.getName()) != null) return slots.get(s.getName()); 31 | else{ 32 | slots.put(s.getName(), s); 33 | if(GUI2.DEBUG) 34 | System.err.println("Slot Added: " + s.getName() + " " + s.getType() + " " + s.getMin() + " " + s.getMax()); 35 | return s; 36 | } 37 | } 38 | 39 | public static Collection getSlots(){ 40 | return slots.values(); 41 | } 42 | 43 | public static void clearSlots(){ 44 | slots.clear(); 45 | } 46 | 47 | @SuppressWarnings("unchecked") 48 | public static Collection reinitializeSlots(IPersistentMap sls, Boolean clear){ 49 | if(clear) slots.clear(); 50 | for (Iterator iter = ((ASeq)RT.vals(sls)).iterator(); iter.hasNext(); ){ 51 | createHelper(iter.next()); 52 | //Slot s = new Slot((IPersistentMap)iter.next()); 53 | //if(slots.get(s.getName()) == null) slots.put(s.getName(), s); 54 | } 55 | 56 | return getSlots(); 57 | } 58 | 59 | public static Slot getSlot(String s){ 60 | return slots.get(s); 61 | } 62 | 63 | public String getName(){ 64 | return slot.valAt(Keyword.intern("name")).toString(); 65 | } 66 | 67 | public SemanticType getType(){ 68 | return SemanticType.getSemanticType(slot.valAt(Keyword.intern("type")).toString()); 69 | } 70 | 71 | public Long getMin(){ 72 | return (Long)slot.valAt(Keyword.intern("min")); 73 | } 74 | 75 | public Long getMax(){ 76 | if (slot.valAt(Keyword.intern("max")) != null) 77 | return (Long)slot.valAt(Keyword.intern("max")); 78 | return null; 79 | } 80 | 81 | @Override 82 | public String toString(){ 83 | return getName(); 84 | } 85 | 86 | @Override 87 | public int compareTo(Slot s) { 88 | return this.toString().compareTo(s.toString()); 89 | } 90 | 91 | } 92 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/business/repl/IREPLView.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.business.repl; 2 | 3 | public interface IREPLView { 4 | 5 | } 6 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/business/repl/REPLView.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.business.repl; 2 | 3 | import java.io.IOException; 4 | import java.io.PipedInputStream; 5 | 6 | import clojure.lang.IFn; 7 | import clojure.lang.RT; 8 | import clojure.lang.Var; 9 | import clojure.tools.nrepl.Connection; 10 | import csneps.gui.REPLPanel; 11 | 12 | public class REPLView { 13 | 14 | private REPLPanel replPanel; 15 | 16 | private String currentNamespace = "csneps.core.snuser"; 17 | 18 | private Connection nreplConnection; 19 | private String sessionId; 20 | 21 | private Var configureRepl = RT.var("csneps.gui", "configure-repl"); 22 | private IFn evalExpression; 23 | 24 | public String getCurrentNamespace(){ 25 | return currentNamespace; 26 | } 27 | 28 | public void setCurrentNamespace(String ns){ 29 | currentNamespace = ns; 30 | } 31 | 32 | private void prepareRepl(Connection c){ 33 | sessionId = nreplConnection.newSession(null); 34 | System.out.println(sessionId); 35 | evalExpression = (IFn)configureRepl.invoke(this, replPanel.getLogComponent(), nreplConnection.client, sessionId); 36 | } 37 | 38 | public void eval(String expr){ 39 | evalExpression.invoke(expr, true); 40 | } 41 | 42 | public void log(String s){ 43 | replPanel.appendText(s); 44 | } 45 | 46 | //Vector views; 47 | //PipedInputStream input 48 | 49 | public REPLView(REPLPanel replPanel, Connection nreplConnection){ 50 | this.replPanel = replPanel; 51 | this.nreplConnection = nreplConnection; 52 | 53 | prepareRepl(nreplConnection); 54 | //views = new Vector(); 55 | } 56 | 57 | 58 | public static void readStream(PipedInputStream input) throws IOException{ 59 | byte[] buffer = new byte[1024]; 60 | int bytesRead; 61 | while((bytesRead = input.read(buffer)) != -1){ 62 | System.out.println(new String(buffer)); 63 | } 64 | } 65 | 66 | } 67 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/graph/ArrowFillTransformer.java: -------------------------------------------------------------------------------- 1 | /* 2 | * To change this template, choose Tools | Templates 3 | * and open the template in the editor. 4 | */ 5 | 6 | package csneps.gui.graph; 7 | 8 | import com.google.common.base.Function; 9 | 10 | import java.awt.Color; 11 | import java.awt.Paint; 12 | 13 | 14 | public class ArrowFillTransformer implements Function { 15 | 16 | public Paint apply(IEdge arg0) { 17 | return Color.white; 18 | } 19 | 20 | } 21 | 22 | /** 23 | * 24 | * @author dan 25 | */ 26 | /*public class ArrowTransformerTriangle implements Transformer { 27 | 28 | public Shape transform(Shape s) { 29 | return ArrowFactory.getWedgeArrow(10, 10); 30 | } 31 | 32 | //Transformer,E>,Shape> 33 | 34 | } 35 | */ -------------------------------------------------------------------------------- /src/jvm/csneps/gui/graph/ArrowShapeTransformer.java: -------------------------------------------------------------------------------- 1 | /* 2 | * To change this template, choose Tools | Templates 3 | * and open the template in the editor. 4 | */ 5 | 6 | package csneps.gui.graph; 7 | 8 | import com.google.common.base.Function; 9 | import edu.uci.ics.jung.graph.Graph; 10 | import edu.uci.ics.jung.graph.util.Context; 11 | import edu.uci.ics.jung.visualization.util.ArrowFactory; 12 | import java.awt.Shape; 13 | 14 | 15 | public class ArrowShapeTransformer implements Function,IEdge>,IEdge>,Shape> { 16 | 17 | public Shape apply(Context, IEdge>, IEdge> arg0) { 18 | IEdge e = arg0.element; 19 | if(e instanceof CollapsedEdge){ 20 | return ArrowFactory.getWedgeArrow(15, 15); 21 | } 22 | else return ArrowFactory.getNotchedArrow(8, 8, 5); 23 | } 24 | } 25 | 26 | /** 27 | * 28 | * @author dan 29 | */ 30 | /*public class ArrowTransformerTriangle implements Transformer { 31 | 32 | public Shape transform(Shape s) { 33 | return ArrowFactory.getWedgeArrow(10, 10); 34 | } 35 | 36 | //Transformer,E>,Shape> 37 | 38 | } 39 | */ -------------------------------------------------------------------------------- /src/jvm/csneps/gui/graph/ChannelEdge.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.graph; 2 | 3 | import csneps.gui.business.Channel; 4 | 5 | public class ChannelEdge extends Edge { 6 | 7 | private Channel.ChannelType type; 8 | 9 | public ChannelEdge(String relation, ITermNode from, ITermNode to, Channel.ChannelType type) { 10 | super(relation, from, to); 11 | this.type = type; 12 | } 13 | 14 | public Channel.ChannelType getType(){ 15 | return type; 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/graph/CollapsedEdge.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.graph; 2 | 3 | import java.util.ArrayList; 4 | 5 | public class CollapsedEdge extends Edge{ 6 | 7 | private ITermNode replacesTerm; 8 | 9 | private ArrayList> addlReplacedTerms; 10 | 11 | public CollapsedEdge(String relation, ITermNode start, ITermNode end, ITermNode replacesTerm){ 12 | super(relation,start,end); 13 | this.replacesTerm = replacesTerm; 14 | addlReplacedTerms = new ArrayList>(); 15 | } 16 | 17 | public ITermNode getReplacedTerm(){ 18 | return replacesTerm; 19 | } 20 | 21 | void addAdditionalReplacedTerm(ITermNode term){ 22 | addlReplacedTerms.add(term); 23 | } 24 | 25 | public ArrayList> getAdditionalReplacedTerms(){ 26 | return addlReplacedTerms; 27 | } 28 | 29 | } 30 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/graph/DependencyEdge.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.graph; 2 | 3 | public class DependencyEdge extends Edge{ 4 | public DependencyEdge(ITermNode start, ITermNode end){ 5 | super("dependency",start,end); 6 | } 7 | } 8 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/graph/Edge.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.graph; 2 | 3 | import csneps.gui.business.Slot; 4 | import csneps.gui.business.Term; 5 | 6 | public class Edge implements IEdge{ 7 | 8 | private ITermNode from; 9 | private ITermNode to; 10 | private Slot slot; 11 | private String relationName; 12 | 13 | public Edge(Slot slot, ITermNode from, ITermNode to) { 14 | this.from = from; 15 | this.to = to; 16 | this.slot = slot; 17 | this.relationName = slot.getName(); 18 | } 19 | 20 | Edge(String relation, ITermNode from, ITermNode to) { 21 | this.from = from; 22 | this.to = to; 23 | this.relationName = relation; 24 | } 25 | 26 | /* (non-Javadoc) 27 | * @see csneps.gui.graph.IEdge#getFrom() 28 | */ 29 | @Override 30 | public ITermNode getFrom(){ 31 | return from; 32 | } 33 | 34 | /* (non-Javadoc) 35 | * @see csneps.gui.graph.IEdge#getTo() 36 | */ 37 | @Override 38 | public ITermNode getTo(){ 39 | return to; 40 | } 41 | 42 | public Slot getRelation(){ 43 | return slot; 44 | } 45 | 46 | /* (non-Javadoc) 47 | * @see csneps.gui.graph.IEdge#getRelation() 48 | */ 49 | @Override 50 | public String getRelationName(){ 51 | return relationName; 52 | } 53 | 54 | public String toString(){ 55 | if (slot == Slot.getSlot("andorargs")){ 56 | String type = this.getFrom().getTerm().getSyntacticType(); 57 | if(type.equals("Param2op") || type.equals("Andor")) 58 | return relationName + " (" + this.getFrom().getTerm().getMin() + ", " + this.getFrom().getTerm().getMax() +")"; 59 | return type.toLowerCase(); 60 | } 61 | if (slot == Slot.getSlot("threshargs")){ 62 | String type = this.getFrom().getTerm().getSyntacticType(); 63 | if(type.equals("Param2op") || type.equals("Thresh")) 64 | return relationName + " (" + this.getFrom().getTerm().getMin() + ", " + this.getFrom().getTerm().getMax() +")"; 65 | return type.toLowerCase(); 66 | } 67 | if (slot == Slot.getSlot("nor")){ 68 | Term wft = this.getFrom().getTerm(); 69 | if(wft.getDownCableset().get(slot).size() == 1) return "not"; 70 | } 71 | 72 | 73 | return relationName; 74 | } 75 | 76 | @Override 77 | public int hashCode() { 78 | int hash = 7; 79 | hash = 89 * hash + (this.relationName != null ? this.relationName.hashCode() : 0); 80 | hash = 89 * hash + (this.from != null ? this.from.hashCode() : 0); 81 | hash = 89 * hash + (this.from != null ? this.from.hashCode() : 0); 82 | return hash; 83 | } 84 | 85 | @Override 86 | public boolean equals(Object obj) { 87 | if (obj == null) { 88 | return false; 89 | } 90 | if (getClass() != obj.getClass()) { 91 | return false; 92 | } 93 | final Edge other = (Edge)obj; 94 | 95 | if(this.from.equals(other.from) && this.to.equals(other.to) && this.relationName.equals(other.relationName)) return true; 96 | 97 | return false; 98 | } 99 | } 100 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/graph/IEdge.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.graph; 2 | 3 | public interface IEdge { 4 | 5 | public ITermNode getFrom(); 6 | 7 | public ITermNode getTo(); 8 | 9 | public String getRelationName(); 10 | 11 | } -------------------------------------------------------------------------------- /src/jvm/csneps/gui/graph/ITermNode.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.graph; 2 | 3 | import java.util.ArrayList; 4 | 5 | import csneps.gui.business.Caseframe; 6 | import csneps.gui.business.Term; 7 | 8 | public interface ITermNode { 9 | 10 | public Term getTerm(); 11 | 12 | public ArrayList getInEdges(); 13 | 14 | public void addInEdge(E e); 15 | 16 | public ArrayList getOutEdges(); 17 | 18 | public void addOutEdge(E e); 19 | 20 | public boolean isVisible(); 21 | 22 | public boolean inCollapsedForm(); 23 | 24 | public void show(); 25 | 26 | public void hide(); 27 | 28 | public int getDownCablesetVisibleCount(); 29 | 30 | public boolean isDownCablesetVisible(); 31 | 32 | public boolean isDownCablesetPartialVisible(); 33 | 34 | public int getUpCablesetVisibleCount(); 35 | 36 | public boolean isUpCablesetVisible(); 37 | 38 | public boolean isUpCablesetPartialVisible(); 39 | 40 | public ArrayList getInEdgesMinusFS(); 41 | 42 | public ArrayList getRelationsPartOf(); 43 | 44 | public CollapsedEdge getCollapsedEdge(); 45 | 46 | } -------------------------------------------------------------------------------- /src/jvm/csneps/gui/graph/RestrictionEdge.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.graph; 2 | 3 | public class RestrictionEdge extends Edge{ 4 | public RestrictionEdge(ITermNode start, ITermNode end){ 5 | super("restriction",start,end); 6 | } 7 | } 8 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/util/ClojureTools.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.util; 2 | 3 | public class ClojureTools { 4 | 5 | public static boolean matchingParens(String s){ 6 | boolean inStr = false; 7 | boolean inComment = false; 8 | 9 | int openCount = 0; 10 | int closeCount = 0; 11 | 12 | for (int i = 0; i < s.length(); i++){ 13 | char c = s.charAt(i); 14 | 15 | if (c == '"') inStr = !inStr; 16 | if (c == ';') inComment = true; 17 | if (c == '\n' || c == '\r') inComment = false; 18 | else if (!inStr && !inComment && c == '(') openCount++; 19 | else if (!inStr && !inComment && c == ')') closeCount++; 20 | } 21 | 22 | return openCount == closeCount; 23 | } 24 | 25 | 26 | } 27 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/util/OSTools.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.util; 2 | 3 | public class OSTools { 4 | 5 | private static String OS = System.getProperty("os.name").toLowerCase(); 6 | 7 | public static boolean isWindows() { 8 | return (OS.indexOf("win") >= 0); 9 | } 10 | 11 | public static boolean isMac() { 12 | return (OS.indexOf("mac") >= 0); 13 | } 14 | 15 | public static boolean isUnix() { 16 | return (OS.indexOf("nix") >= 0 || OS.indexOf("nux") >= 0 || OS.indexOf("aix") > 0 ); 17 | } 18 | 19 | public static boolean isSolaris() { 20 | return (OS.indexOf("sunos") >= 0); 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /src/jvm/csneps/gui/util/SortedComboBoxModel.java: -------------------------------------------------------------------------------- 1 | package csneps.gui.util; 2 | 3 | import java.util.Collections; 4 | import java.util.Comparator; 5 | import java.util.Vector; 6 | 7 | import javax.swing.AbstractListModel; 8 | import javax.swing.MutableComboBoxModel; 9 | 10 | public class SortedComboBoxModel extends AbstractListModel implements MutableComboBoxModel{ 11 | private static final long serialVersionUID = -3806471690493405434L; 12 | 13 | @SuppressWarnings("rawtypes") 14 | Comparator comparator; 15 | @SuppressWarnings("rawtypes") 16 | Vector items; 17 | 18 | Object selected; 19 | 20 | @SuppressWarnings("rawtypes") 21 | public SortedComboBoxModel(Comparator c){ 22 | super(); 23 | comparator = c; 24 | items = new Vector(); 25 | } 26 | 27 | @SuppressWarnings({ "rawtypes" }) 28 | public SortedComboBoxModel(Comparator c, Vector items){ 29 | super(); 30 | comparator = c; 31 | this.items = sortItems((Vector)items.clone(), c); 32 | } 33 | 34 | @SuppressWarnings({ "unchecked", "rawtypes" }) 35 | protected Vector sortItems(Vector v, Comparator c){ 36 | Collections.sort(v, c); 37 | return v; 38 | } 39 | 40 | @Override 41 | public int getSize() { 42 | return items.size(); 43 | } 44 | 45 | @Override 46 | public Object getElementAt(int index) { 47 | return items.get(index); 48 | } 49 | 50 | @Override 51 | public void setSelectedItem(Object anItem) { 52 | if(selected == null && anItem == null) return; 53 | if(selected != null && anItem.equals(selected)) return; 54 | if(anItem != null && !items.contains(anItem)) return; 55 | 56 | selected = anItem; 57 | fireContentsChanged(this, -1, -1); 58 | } 59 | 60 | @Override 61 | public Object getSelectedItem() { 62 | return selected; 63 | } 64 | 65 | @Override 66 | public void addElement(Object obj) { 67 | insertElementAt(obj, 0); 68 | if (items.size() == 1 && selected == null) 69 | setSelectedItem(obj); 70 | } 71 | 72 | @Override 73 | public void removeElement(Object obj) { 74 | int idx = items.indexOf(obj); 75 | if(idx >= 0) removeElementAt(idx); 76 | } 77 | 78 | @SuppressWarnings("unchecked") 79 | @Override 80 | public void insertElementAt(Object obj, int index) { 81 | int size = items.size(); 82 | int idx = 0; 83 | //Stay sorted. 84 | for (idx = 0; idx < size; idx++) 85 | { 86 | Object o = getElementAt( idx ); 87 | if (comparator.compare(o, obj) > 0) 88 | break; 89 | } 90 | 91 | items.insertElementAt(obj, idx); 92 | fireIntervalAdded(this, index, index); 93 | } 94 | 95 | @Override 96 | public void removeElementAt(int index) { 97 | if(index < items.size()){ 98 | int selected = items.indexOf(this.selected); 99 | if (selected == index) // choose a new selected item 100 | { 101 | if (selected > 0) setSelectedItem(getElementAt(selected - 1)); 102 | else setSelectedItem(getElementAt(selected + 1)); 103 | } 104 | items.remove(index); 105 | fireIntervalRemoved(this, index, index); 106 | } 107 | } 108 | } 109 | -------------------------------------------------------------------------------- /src/jvm/csneps/util/BlockingLifoQueue.java: -------------------------------------------------------------------------------- 1 | package csneps.util; 2 | 3 | import java.util.Collection; 4 | import java.util.Iterator; 5 | import java.util.NoSuchElementException; 6 | import java.util.concurrent.BlockingDeque; 7 | import java.util.concurrent.BlockingQueue; 8 | import java.util.concurrent.LinkedBlockingDeque; 9 | import java.util.concurrent.TimeUnit; 10 | 11 | 12 | public final class BlockingLifoQueue implements BlockingQueue 13 | { 14 | // we add and remove only from the end of the queue 15 | private final BlockingDeque deque; 16 | 17 | public BlockingLifoQueue() 18 | { deque = new LinkedBlockingDeque(); } 19 | 20 | public boolean add(T e) { 21 | deque.addLast(e); 22 | return true; 23 | } 24 | 25 | public boolean contains(Object o) 26 | { return deque.contains(o); } 27 | 28 | public int drainTo(Collection c) 29 | { return deque.drainTo(c); } 30 | 31 | public int drainTo(Collection c, int maxElements) 32 | { return deque.drainTo(c,maxElements); } 33 | 34 | public boolean offer(T e) 35 | { return deque.offerLast(e); } 36 | 37 | public boolean offer(T e, long timeout, TimeUnit unit) 38 | throws InterruptedException 39 | { return deque.offerLast(e,timeout,unit); } 40 | 41 | public T poll(long timeout, TimeUnit unit) throws InterruptedException 42 | { return deque.pollLast(timeout, unit); } 43 | 44 | public void put(T e) throws InterruptedException 45 | { deque.putLast(e); } 46 | 47 | public int remainingCapacity() 48 | { return deque.size(); } 49 | 50 | public boolean remove(Object o) 51 | { return deque.remove(o); } 52 | 53 | public T take() throws InterruptedException 54 | { return deque.takeLast(); } 55 | 56 | public T element() 57 | { 58 | if (deque.isEmpty()) { 59 | throw new NoSuchElementException("empty stack"); 60 | } 61 | 62 | return deque.pollLast(); 63 | } 64 | 65 | public T peek() 66 | { return deque.peekLast(); } 67 | 68 | public T poll() 69 | { return deque.pollLast(); } // deque.peekLast(); } -- fixed typo. 70 | 71 | public T remove() 72 | { 73 | if (deque.isEmpty()) { 74 | throw new NoSuchElementException("empty stack"); 75 | } 76 | 77 | return deque.pollLast(); 78 | } 79 | 80 | public boolean addAll(Collection c) 81 | { 82 | for (T e : c) { deque.add(e); } 83 | return true; 84 | } 85 | 86 | public void clear() 87 | { deque.clear();} 88 | 89 | public boolean containsAll(Collection c) 90 | { return deque.containsAll(c); } 91 | 92 | public boolean isEmpty() 93 | { return deque.isEmpty(); } 94 | 95 | public Iterator iterator() 96 | { return deque.descendingIterator(); } 97 | 98 | public boolean removeAll(Collection c) 99 | { return deque.removeAll(c); } 100 | 101 | public boolean retainAll(Collection c) 102 | { return deque.retainAll(c); } 103 | 104 | public int size() 105 | { return deque.size(); } 106 | 107 | public Object[] toArray() 108 | { return deque.toArray(); } 109 | 110 | public T[] toArray(T[] a) 111 | { return deque.toArray(a); } 112 | } -------------------------------------------------------------------------------- /src/jvm/csneps/util/CountingLatch.java: -------------------------------------------------------------------------------- 1 | package csneps.util; 2 | 3 | import java.util.concurrent.TimeUnit; 4 | import java.util.concurrent.locks.AbstractQueuedSynchronizer; 5 | 6 | public class CountingLatch 7 | { 8 | 9 | /** 10 | * Synchronization control for CountingLatch. 11 | * Uses AQS state to represent count. 12 | */ 13 | private static final class Sync extends AbstractQueuedSynchronizer 14 | { 15 | private Sync() 16 | { 17 | } 18 | 19 | private Sync(final int initialState) 20 | { 21 | setState(initialState); 22 | } 23 | 24 | int getCount() 25 | { 26 | return getState(); 27 | } 28 | 29 | protected int tryAcquireShared(final int acquires) 30 | { 31 | return getState()==0 ? 1 : -1; 32 | } 33 | 34 | protected boolean tryReleaseShared(final int delta) 35 | { 36 | // Decrement count; signal when transition to zero 37 | for(; ; ){ 38 | final int 39 | c=getState(), 40 | nextc=c+delta; 41 | if(compareAndSetState(c,nextc)){ 42 | return nextc==0; 43 | } 44 | } 45 | } 46 | } 47 | 48 | private final Sync sync; 49 | 50 | public CountingLatch() 51 | { 52 | sync=new Sync(); 53 | } 54 | 55 | public CountingLatch(final int initialCount) 56 | { 57 | sync=new Sync(initialCount); 58 | } 59 | 60 | public void increment() 61 | { 62 | sync.releaseShared(1); 63 | } 64 | 65 | public int getCount() 66 | { 67 | return sync.getCount(); 68 | } 69 | 70 | public void decrement() 71 | { 72 | sync.releaseShared(-1); 73 | } 74 | 75 | public void await() throws InterruptedException 76 | { 77 | sync.acquireSharedInterruptibly(1); 78 | } 79 | 80 | public boolean await(final long timeout) throws InterruptedException 81 | { 82 | return sync.tryAcquireSharedNanos(1,TimeUnit.MILLISECONDS.toNanos(timeout)); 83 | } 84 | 85 | public String toString(){ 86 | return Integer.toString(this.getCount()); 87 | } 88 | 89 | } -------------------------------------------------------------------------------- /test/csneps/api/test/APITester.java: -------------------------------------------------------------------------------- 1 | package csneps.api.test; 2 | 3 | import csneps.api.CSNePS; 4 | import csneps.gui.business.Context; 5 | import csneps.gui.business.Term; 6 | 7 | public class APITester { 8 | public static void main(String[] args){ 9 | CSNePS csneps = new CSNePS(); 10 | csneps.startGUI(); 11 | System.out.println(Context.getContexts()); 12 | System.out.println(CSNePS.pathsfrom(Term.getTerm("Entity"), "(compose class- member)")); 13 | System.out.println(Term.getTerm("wft1").getDescription()); 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /test/csneps/test/arithmetic.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.test.arithmetic 2 | (:use [csneps.core.arithmetic] 3 | [clojure.test]) 4 | (:require [csneps.core.snuser :as snuser])) 5 | 6 | (defn csneps-setup [f] 7 | (csneps.snip.inference-graph.concurrent/startExecutor) 8 | (f)) 9 | 10 | (defn clearkb-fixture [f] 11 | (snuser/clearkb true) 12 | (f)) 13 | 14 | (use-fixtures :once csneps-setup) 15 | (use-fixtures :each clearkb-fixture) 16 | 17 | (deftest add 18 | (is (= 1 (+ 0 1))) 19 | (is (= 7 (+ 2 1 4))) 20 | (is (= (symbol "1") (:name (+ 1 (snuser/defineTerm 0))))) 21 | (is (= (symbol "7") (:name (+ 2 1 (snuser/defineTerm 4)))))) 22 | 23 | (deftest sub 24 | (is (= -1 (- 0 1))) 25 | (is (= 1 (- 6 1 4))) 26 | (is (= (symbol "-1") (:name (- 0 (snuser/defineTerm 1))))) 27 | (is (= (symbol "1") (:name (- 6 1 (snuser/defineTerm 4)))))) 28 | 29 | (deftest mult 30 | (is (= 0 (* 0 1))) 31 | (is (= 8 (* 2 1 4))) 32 | (is (= (symbol "0") (:name (* 0 (snuser/defineTerm 1))))) 33 | (is (= (symbol "8") (:name (* 2 1 (snuser/defineTerm 4)))))) 34 | 35 | (deftest div 36 | (is (= 1 (/ 1 1))) 37 | (is (= 1/2 (/ 2 1 4))) 38 | (is (= (symbol "1") (:name (/ 1 (snuser/defineTerm 1))))) 39 | (is (= (symbol "1/2") (:name (/ 2 1 (snuser/defineTerm 4)))))) 40 | 41 | (deftest lt 42 | (is (= false (< 1 1))) 43 | (is (= true (< 1 2))) 44 | (is (= true (< 1 3 4))) 45 | (is (= false (< 1 3 5 4))) 46 | (is (= false (< 1 (snuser/defineTerm 0)))) 47 | (is (= true (< 3 (snuser/defineTerm 4))))) 48 | 49 | (deftest lteq 50 | (is (= true (<= 1 1))) 51 | (is (= true (<= 1 2))) 52 | (is (= true (<= 1 3 4))) 53 | (is (= false (<= 1 4 5 4))) 54 | (is (= false (<= 1 (snuser/defineTerm 0)))) 55 | (is (= true (<= 4 (snuser/defineTerm 4))))) 56 | 57 | (deftest gt 58 | (is (= false (> 1 1))) 59 | (is (= true (> 2 1))) 60 | (is (= true (> 4 3 1))) 61 | (is (= false (> 4 3 5 1))) 62 | (is (= true (> 1 (snuser/defineTerm 0)))) 63 | (is (= false (> 3 (snuser/defineTerm 4))))) 64 | 65 | (deftest gteq 66 | (is (= true (>= 1 1))) 67 | (is (= true (>= 2 1))) 68 | (is (= true (>= 4 3 1))) 69 | (is (= false (>= 4 3 4 1))) 70 | (is (= true (>= 1 (snuser/defineTerm 1)))) 71 | (is (= false (>= 3 (snuser/defineTerm 4))))) 72 | 73 | (deftest eq 74 | (is (= true (== 1 1))) 75 | (is (= false (== 1 2))) 76 | (is (= true (== 1 (snuser/defineTerm 1)))) 77 | (is (= false (== 3 (snuser/defineTerm 4))))) 78 | 79 | (deftest neq 80 | (is (= true (not= 1 2))) 81 | (is (= false (not= 1 1))) 82 | (is (= false (not= 1 (snuser/defineTerm 1)))) 83 | (is (= true (not= 3 (snuser/defineTerm 4))))) -------------------------------------------------------------------------------- /test/csneps/test/combined_inference.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.test.combined-inference 2 | (:require [clojure.test :refer :all]) 3 | (:require [csneps.core.snuser :as snuser]) 4 | (:require [csneps.snip :as snip])) 5 | 6 | (defn csneps-setup [f] 7 | (csneps.snip.inference-graph.concurrent/startExecutor) 8 | (snuser/nogoaltrace) 9 | (f)) 10 | 11 | (defn clearkb-fixture [f] 12 | (snuser/clearkb true) 13 | (f)) 14 | 15 | (use-fixtures :once csneps-setup) 16 | (use-fixtures :each clearkb-fixture) 17 | 18 | (deftest ig+path-novar 19 | (snip/definePath 'member '(compose member (kstar (compose equiv- ! equiv)))) 20 | (snuser/assert '(Isa a q)) 21 | (snuser/assert '(Equiv a b)) 22 | (snuser/assert '(Equiv b c)) 23 | (snuser/assert '(if (Isa c q) (Isa c r))) 24 | (snuser/askif '(Isa c r)) 25 | (Thread/sleep 100) ;; Give it a sec... 26 | (is (= #{(snuser/defineTerm '(Isa c r))} (snuser/askif '(Isa c r))))) -------------------------------------------------------------------------------- /test/csneps/test/core.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.test.core 2 | (:use [clojure.test]) 3 | (:require [CSNePS.test.arithmetic])) 4 | 5 | 6 | (defn load-sneps-fixture [f] 7 | (f)) 8 | 9 | (use-fixtures :once load-sneps-fixture) 10 | 11 | ;(deftest test-suite 12 | ; (run-tests 'CSNePS.test.arithmetic)) -------------------------------------------------------------------------------- /test/csneps/test/find.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.test.find 2 | (:use [csneps.core.find]) 3 | (:require [clojure.test :refer :all] 4 | [csneps.core.snuser :as snuser])) 5 | 6 | (defn initialize-types-and-frames [] 7 | ;;; Define Types 8 | (snuser/defineType Agent (Thing) "Individuals that have agency") 9 | (snuser/defineType Action (Thing) "Actions that Agents can perform.") 10 | 11 | ;;; Define Slots 12 | (snuser/defineSlot agent :type Agent) 13 | (snuser/defineSlot actions :type Action) 14 | (snuser/defineSlot object :type Thing 15 | :docstring "Non-agentive objects of actions.") 16 | (snuser/defineSlot property :type Thing) 17 | (snuser/defineSlot life :type Thing) 18 | (snuser/defineSlot whole :type Thing) 19 | (snuser/defineSlot part :type Thing) 20 | (snuser/defineSlot group :type Thing) 21 | 22 | ;;; Caseframes 23 | (snuser/defineCaseframe 'Proposition '(actions agent object) 24 | :docstring "[agent] [actions] [object]" 25 | :fsymbols '(Owns Buys))) 26 | 27 | (defn csneps-setup [f] 28 | (csneps.snip.inference-graph.concurrent/startExecutor) 29 | (snuser/clearkb true) 30 | (initialize-types-and-frames) 31 | (f)) 32 | 33 | (defn clearkb-fixture [f] 34 | (snuser/clearkb false) 35 | (f)) 36 | 37 | (use-fixtures :once csneps-setup) 38 | (use-fixtures :each clearkb-fixture) 39 | 40 | (deftest find-base-prop 41 | (let [fido (snuser/assert '(Isa "Fido" Dog)) 42 | rover (snuser/assert '(Isa Rover Dog)) 43 | mister (snuser/assert '(Isa "Mister Meowgi" Cat)) 44 | glacier (snuser/assert '(Isa Glacier Cat))] 45 | (is (= (list [fido {}]) (find '(Isa Fido Dog)))) 46 | (is (= (list [rover {}]) (find '(Isa Rover Dog)))) 47 | (is (= (list [mister {}]) (find '(Isa "Mister Meowgi" Cat)))) 48 | (is (empty? (find '(Isa Lassie Dog)))))) 49 | 50 | (deftest find-by-variable 51 | (let [fido (snuser/assert '(Isa Fido Dog)) 52 | rover (snuser/assert '(Isa Rover Dog)) 53 | mister (snuser/assert '(Isa "Mister Meowgi" Cat)) 54 | glacier (snuser/assert '(Isa Glacier Cat))] 55 | (is (empty? (find '(Isa x Dog)))) ;; x is not a variable here. 56 | (is (= (hash-set [fido {'x (snuser/find-term 'Fido)}] 57 | [rover {'x (snuser/find-term 'Rover)}]) 58 | (set (find '(Isa x Dog) '(x))))) 59 | (is (= (hash-set [fido {'?x (snuser/find-term 'Fido)}] 60 | [rover {'?x (snuser/find-term 'Rover)}]) 61 | (set (find '(Isa ?x Dog))))))) -------------------------------------------------------------------------------- /test/csneps/test/snere.clj: -------------------------------------------------------------------------------- 1 | (ns csneps.test.snere 2 | (:require [clojure.test :refer :all] 3 | [csneps.core.snuser :as snuser] 4 | [csneps.snip :as snip]) 5 | (:use [clojure.pprint :only (cl-format)])) 6 | 7 | (defn csneps-setup [f] 8 | (csneps.snip.inference-graph.concurrent/startExecutor) 9 | (snuser/nogoaltrace) 10 | (f)) 11 | 12 | (defn clearkb-fixture [f] 13 | (snuser/clearkb true) 14 | (f)) 15 | 16 | (use-fixtures :once csneps-setup) 17 | (use-fixtures :each clearkb-fixture) 18 | 19 | ;;;;;;;;;;;;;;;;;;;;;;;;; 20 | ;;; Primitive Actions ;;; 21 | ;;;;;;;;;;;;;;;;;;;;;;;;; 22 | 23 | (deftest primitive-action 24 | (let [act (snuser/defineTerm 'helloWorld :Act) 25 | primaction-fn (snip/define-primaction helloWorldfn [] 26 | (cl-format true "~&Hello world.~%"))] 27 | (snip/attach-primaction act primaction-fn))) 28 | ;(snip/perform 'helloWorld))) --------------------------------------------------------------------------------