Skip to content

Instantly share code, notes, and snippets.

@jColeChanged
Last active February 26, 2021 04:02
Show Gist options
  • Save jColeChanged/2970757 to your computer and use it in GitHub Desktop.
Save jColeChanged/2970757 to your computer and use it in GitHub Desktop.
Subset of Eliza Chatbot in Clojure
(ns paip.eliza
(:require [clojure.string :as string])
(:gen-class))
(defn index-of
"Returns the index of item. If start is given indexes prior to
start are skipped."
([coll item] (.indexOf coll item))
([coll item start]
(let [unadjusted-index (.indexOf (drop start coll) item)]
(if (= -1 unadjusted-index)
unadjusted-index
(+ unadjusted-index start)))))
(defn strings-equal? [x y]
"Returns true if two strings are equal. Case insensitive."
(and (string? x) (string? y) (.equalsIgnoreCase x y)))
(defn capture-token? [token]
"Returns whether the given token captures text."
(= (first token) \?))
(defn capture-segment-token? [pattern]
"Returns whether the given token captures segments of text."
(and (not (string? pattern))
(string? (first pattern))
(.startsWith (first pattern) "?*")))
(defn bind-capture-token [token input bindings]
"Associatse token with input in bindings as long as it hasn't been
associated with a different value."
(let [input (if (string? input) input (string/join " " input))
value (get bindings token input)]
(when (.equalsIgnoreCase value input)
(assoc bindings token input))))
;; forward declaration
(def segment-match)
(defn match-pattern
"Matches patterns against input. If matches violate bindings then matching
has failed. Otherwise returns a map in the form: {'?token' 'match'}."
([pattern input] (match-pattern pattern input {}))
([pattern input bindings]
(cond
;; If we failed, finished, or the tokens being considered match...
(or (nil? bindings)
(and (empty? pattern) (empty? input))
(strings-equal? pattern input))
bindings
;; If the token being considerd should be saved
;; This operates at the rest level when recursing
(capture-segment-token? pattern)
(segment-match pattern input bindings)
;; This operates at the first level when recursing
(capture-token? pattern)
(bind-capture-token pattern input bindings)
;; If were not on an end case then compute the next end case and
;; treat it as bindings then process everything else... this makes it
;; very clear that we are always reducing the work that is left so
;; the function should eventually terminate
(and (seq? pattern) (seq? input))
(match-pattern (rest pattern) (rest input)
(match-pattern (first pattern) (first input)
bindings)))))
(defn segment-match
([pattern input bindings] (segment-match pattern input bindings 0))
([pattern input bindings start]
(let [var (first pattern)
pat (rest pattern)]
(if (empty? pat)
(bind-capture-token var input bindings)
;; This code, like Norvig's, assumes that pat starts with a constant
(let [pos (index-of input (first pat) start)]
(when (not= pos -1)
;; Need to account for position in list despite having trimmed the list...
(let [new-bindings (bind-capture-token var (take pos input) bindings)
b2 (match-pattern pat (drop pos input) new-bindings)]
;; If the match failed try the next match
(if (nil? b2)
(segment-match pattern input bindings (inc pos))
b2))))))))
(defn tokenize [pattern-string] (string/split pattern-string #" "))
;; A rule is hereby defined to be: (pattern (responses))
(defn get-pattern [rule] (first rule))
(defn get-responses [rule] (second rule))
(def eliza-rules
'(("?*x hello ?*y"
("How do you do. Please state your problem."))
("?*x I want ?*y"
("What would it mean if you got ?*y"
"Suppose you got ?*y soon?"
"Why do you want ?*y"))
("?*x if ?*y"
("Do you really think its likely that ?*y")
("Do you with that ?*y"))))
(defn substitute-mappings
[string mappings]
(let [substitute-mapping
(fn [string mapping]
(let [pattern (java.util.regex.Pattern/quote (name (key mapping)))
pattern (re-pattern pattern)
matcher (re-matcher pattern string)
replacement (java.util.regex.Matcher/quoteReplacement (str (val mapping)))]
(.replaceAll matcher replacement)))]
(reduce substitute-mapping string (seq mappings))))
(defn use-eliza-rules [input]
(some #(let [result (match-pattern (tokenize (get-pattern %))
(tokenize input))]
(when result
(substitute-mappings (rand-nth (get-responses %)) result)))
eliza-rules))
(defn eliza []
(while true
(print "Eliza> ")
(flush)
(println (use-eliza-rules (read-line)))))
(defn -main [& args]
(println "Starting... ") (eliza))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment