Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
1057 lines (926 sloc) 42.8 KB
;; SolutionGraph.cl
;; Collin Lynch
;; 04/19/2001
;;; Modifications by Anders Weinstein 2001-2008
;;; Modifications by Brett van de Sande, 2005-2008
;;; Copyright 2009 by Kurt Vanlehn and Brett van de Sande
;;; This file is part of the Andes Intelligent Tutor Stystem.
;;;
;;; The Andes Intelligent Tutor System is free software: you can redistribute
;;; it and/or modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation, either version 3
;;; of the License, or (at your option) any later version.
;;;
;;; The Andes Solver is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public License
;;; along with the Andes Intelligent Tutor System. If not, see
;;; <http:;;;www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; The solution graph module maintains a listing of
;; system entries and their status for the help system.
;; It also maintains a list of solution sets that are used
;; to provide help and to decompose equation entries for
;; help and entry use.
;;
;; The system entries themselves are defined in the helpstructs.
;; they are stored in a list of the form:
;; (<Active Eqns> . <Forbidden/DeadPath Eqns> . <Non Eqns>)
;; The purpose of this ordering is to keep the indicies
;; of the active equations identical within this module and
;; within the Algebra dll where they will also be stored.
;;
;; The solutions sets are lists (macroed as structs) containing:
;;
;; Count: an integer representing the number of 'objections' to
;; the solution. Unless this integer is 0 the solutions will not
;; be used to provide what's next help.
;;
;; Number: This is the Algebra DLL's set id assigned to the set
;; of canonical (system) equations associated with this solution
;; when a student equation is decomposed using the algebra system
;; this id is passed to identify this particular set.
;;
;; Entries: This is a list of SystemEntries that are associated
;; with this set. When non eqn entries are made this set is
;; searched to determine if the entry is compatible with it or
;; not, if not the count is incremented.
;;
;; Nodes: A list of Bubblegraph Nodes (Quantities and Equations)
;; That comprie this solution and that must be entered in order
;; for this solution to be used.
;;
;; When the SolutionGraph module is setup it is passed the current
;; problem struct to be used. The Bubblegraph is then used to obtain
;; the list of systementries. In the process each node in the bubblegraph
;; will have it's entries field updated to contain the set of Entries
;; that appear within its path. These entries are then merged to produce
;; the master *SG-Entries* index. In the process the system will pass
;; the solution point and the set of base equations to the Algebra DLL
;; So that it can later be used for testing student entries.
;;
;; Once the list of system entries has been obtained the system will then
;; set up the solutions (from the problem struct) by sending the equations
;; within them to the Algebra DLL. It will also translate from the list of
;; bgnodes stored in the solution to the list of System Entries within the
;; set for later searching.
;;
;; This whole process is fairly extensive and could and should probably be
;; streamlined but it has not become an issue as of yet. One possibility
;; might be offloading some of the setup process to sgg time such as the
;; collection of system entries within the graph and their storage, perhaps
;; storing them as props in the nodes for later use.
;;
;;;;;;;;;;;;;;;;;;; Ugly hack notes
;; The system merges the system entries by comparing their props and then
;; later updates them in the master index. It would be better to remove this
;; excess step by building the links correctly the first time around.
(in-package :cl-user)
;;=========================================================
;; Memory Storage.
(defvar **Test-For-Premature-Subst** nil "If t tests for premature substitutions.")
(defvar **Test-For-Prematurity** nil "If t tests for premature entries.")
;;; Constraint filtering is designed to prevent the students from walking
;;; themselves down an unsolvable dead-end where they will have "entered"
;;; all of the necessary system entries by combining equations. Yet they
;;; will be algebraically unable to solve for the sought quantity. This
;;; filtering is designed to prevent that by elminating those combinations
;;; from the system when the entries are made.
;;;
;;; AW: disable this because it is unreliable for projections as we write them:
;;; Our solutions do not use theta variables for known angles inside projections.
;;; Instead we use the pair of equations:
;;; (1) Fn_x = Fn * cos(120 deg)
;;; (2) thetaFn = 120 deg
;;; (It caused trouble for the solution indyset collection to have the theta
;;; vars in the equation, in some way because it couldn't make use of the fact
;;; that two angles denoted by different theta vars were in fact the same. So
;;; we plugged in known angle values instead.)
;;; So, when student enters
;;; (3) Fn_x = Fn*cos(thetaFn)
;;; this looks like a weaker constraint than {1,2} -- it does not determine
;;; that thetaFn is 120 deg so determines a plane.
;;; There might be some better way of dealing with this, but for now easiest
;;; just to turn it off.
(defvar **Filter-Constraint-losses** NIL
"If t will filter out systementries that cause constraint loss in the system.")
;;========================================================================
;; Setup process.
;; The solution graph setup process operates in five distinct phases.
;;
;; Step 0: Setup the eqns list by collecting the eqns from the system
;; ignoring all Forbidden equations as they will never appear
;; in a solution and they can raise
;;
;; Step 1: The algebra system is setup passing the equations to it and
;; priming it for later use.
;;
;; Step 2: the system sets up the system entries culling them from the
;; psm graphs and storing them in the nodes and the *Sg-Entries*
;; index.
;;
;; Step 3: The Matching of equation entries with the *Sg-Eqns* index
;; This allows for matching of eqn numbers with entries at
;; use time.
;;
;; Step 3: The Solutions are setup encoding them from their stored forms
;; into the forms necessary for help time.
;;
(defun sg-setup (Problem)
"Setup the solution graph by loading it and defining the entries."
(setq *Sg-Eqns* (sg-collect-Eqns Problem))
(sg-prime-algebra (problem-varindex Problem) *Sg-Eqns*)
(sg-setup-systementries (Problem-Graph Problem))
(setq *Sg-Eqns* (sg-match-eqn-entries *Sg-Eqns* *Sg-Entries*))
(sg-setup-solutions (Problem-Solutions Problem)
(Problem-Graph Problem) *Sg-Eqns*))
;;; -------------------------------------------------------------
;;; Equation collection.
;;; Given the problem collect the equations from it that we will
;;; use to prime the algebra system and to decompose equation
;;; entries. The resulting set should be all of the equations in
;;; the problem's eqnindex (translated to help-system form) minus
;;; those that are only part of forbidden nodes and therefore
;;; won't appear in any solutions and can cause errors.
(defun sg-collect-eqns (Problem)
(let ((tmp (remove-if #'sg-eqn-forbiddenp (Problem-EqnIndex Problem))))
(eqns->Help-sys-eqns tmp)))
(defun sg-eqn-forbiddenp (E)
"Return t if the eqn is only in forbidden eqns."
(null (remove-if
#'(lambda (N) (and (enode-p N) (enode-forbiddenp N)))
(Eqn-Nodes E))))
;;---------------------------------------------------------------
;; Algebra Setup.
;; Prior to being queried for student equations or any other
;; information the Algebra DLL needs to be passed the list of
;; variables (the solution point) that it will use and the list
;; of canonical equations that will be used to decompose
;; student equations. This code collects those sets and then
;; passes them into the algebra system.
(defun sg-prime-algebra (Vars Eqns)
"Send the IndyVars and Help-Sys-Eqns to the Algebra System."
(Solver-new-problem)
(dolist (V (qvars->IndyVars Vars))
(Solver-IndyAddVar V))
(dolist (P (collect-qvars->Marks Vars))
(Solver-Send-Problem-Statement P))
(solver-IndyDoneAddVar)
(dolist (E Eqns)
(Solver-IndyAddEquation
(car E) (cadr E))))
;;------------------------------------------------------------------------
;; sg-setup-systementries
;; The system entry setup proceeds first by collecting the system entries
;; from the paths of each node in the graph into their Entries fields.
;;
;; Once that is done The index is collected from those nodes and with it
;; the set of valid equation entries that will be used to prime the algebra
;; system.
;;
;; Once that has been done the entries within the nodes themselves are merged
;; in order that we can perform simple eq tests on them at a later date.
;;
;; this is an ugly hack and could doubtless be improved by storing only the
;; entryprops or other elements in the nodes for equalp testing and then
;; offloading some of the search to sgg time.
;;
;; Similarly the precond hack could be improved by offloading work to sgg time.
(defun sg-setup-systementries (Graph)
;; Set the entries list for each graph node.
(sg-set-graph-sysents Graph)
;; Collect the entry index.
(setq *SG-Entries* (sg-collect-sysent-index Graph))
;; Subst the preconds for the entries in *Sg-Entries*
(subst-prereqs-sysents *Sg-Entries* *Sg-Entries*)
;; Substitute the merged entries into the graph.
(sg-subst-graph-sysents *Sg-Entries* Graph)
;; Collect any children from inheritance
;; Do this after merge.
(find-inheritance (bubbleGraph-Enodes Graph))
;; This doesn't do anything since the enodes
;; don't have any path.
;;(find-inheritance (bubbleGraph-Qnodes Graph))
;;
;; Add alternatives to English from inheritance.
(add-inheritance-to-model *Sg-entries*))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; sg-set-graph-sysents
;; For each node in the Bubblegraph, search its path to collect
;; the set of System Entries within it, storing those entries
;; within its entries field.
(defun sg-set-graph-Sysents (Graph)
"Collect the set of entries within each node of the graph."
(dolist (Q (car Graph))
(setf (Qnode-Entries Q)
(sg-collect-qnode-Sysents Q)))
(dolist (E (cadr Graph))
(setf (Enode-Entries E)
(sg-collect-enode-sysents E))))
(defun sg-collect-qnode-sysents (Q)
"Collect the quantity node system entries."
(merge-duplicate-systementries
(sg-psmg->sysents
(Qnode-Path Q)
:State (sg-marks->State (Qnode-Marks Q)))))
(defun sg-collect-Enode-sysents (E)
"Collect the quantity node system entries."
(merge-duplicate-systementries
(sg-psmg->sysents
(Enode-Path E)
:State (sg-marks->State (Enode-Marks E)))))
(defun sg-Marks->State (Marks)
"Collect the specified marks from the list if they are present or return +correct+."
(or (loop for M in '(Dead-Path Invalid Forbidden)
when (find M Marks :test #'equalp) return M)
+correct+))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; sg-psmg->sysents
;; Collection of system entries from a psmg proceeds by cycling
;; through the graph and generating a SystemEntry (with the specified
;; state and for each cognitive do step encountered. The search proceeds
;; in depth-first fashon and a stack of SystemEntries is accumulated on
;; the way. This stack is used to set the preconditions for each
;; SystemEntry s.t. each entry's proconditions consist of the set of
;; entries that preceed it in the graph.
;;
;; The search accounts for splits by searching each next separately and
;; then unifying the results in the stuack. Thus in the following case:
;;
;; (Entry0
;; split
;; Next
;; Entry1
;; Next
;; Entry2
;; Join
;; Entry3
;;
;; Entry1 will have Entry0 in its preconditions.
;; Entry2 will have Entry0 but not Entry1 in its preconditions.
;; Entry3 will have Entry0, Entry1, AND Entry2 in its preconditions.
;;
;; When choose nodes are encountered the system responds by splitting
;; the search along several branches. Choose nodes never rejoin
;; therefore they share a common initial stack but separate independent stacks.
;; thus: (Entry0
;; (choose
;; (Entry1)
;; (Entry2 Entry3)))
;;
;; Entry1 will have Entry0 in its preconditions.
;; Entry2 will have Entry0 but not Entry1 in its preconditions.
;; Entry3 will have Entry0 and Entry2 but not Entry1 in its preconditions.
;;
(defun sg-psmg->sysents (Graph &key (Stk NIL) (State +correct+) optional)
"Collect the System entries from the specified PSM Graph."
(let ((Stack Stk) Entries tmp)
(dolist (N Graph)
(cond ((or (cssplit-p N) (csnext-p N)) ;Push ops and splits
(push N Stack)) ;onto the stack.
((csjoin-p N) ;When a join is encountered clear
(setq Stack (sg-drop-snj Stack))) ;the splits and nexts preceeding it.
;; This should match optional operators in KB/problem-solving.cl
((and (cssg-p N) (eql (cssg-op N) 'do-optional-step))
;; Later, for Bug #972, this should set variable
;; to 'allowed or 'preferred.
(setf optional (cssg-goal N)))
((and (csdo-p N) ;When a do is encountered
(find-if #'help-EntryProp-p (csdo-effects N))) ;and it contains an entry prop.
;; Generate the systementries.
(setq tmp (sg-generate-sysents N Stack State optional))
(setq stack (append tmp stack)) ;Add them to the stack.
(setq entries (append tmp Entries)) ;Add to the list of entries.
(setf (csdo-Entries N) tmp)) ;Set the back pointer to the csdo.
((cschoose-p N) ;When a choose is encountered
(setq Entries ;split the search for each element.
(append Entries (sg-split-psmg->sysents
(cdr N) Stack State optional))))))
Entries)) ;Return the entries.
(defun sg-split-psmg->sysents (Lst Stack State optional)
"Split the psmg->sysents search."
(loop for C in Lst
append (sg-psmg->sysents
C :stk Stack :State State :optional optional)))
(defun sg-drop-snj (Stack)
"Remove the topmost set of split next elements from the stack."
(let ((Loc (position 'Split Stack :test #'equalp)))
(append (remove 'Next (subseq Stack 0 Loc))
(subseq Stack (+ Loc 1)))))
(defun sg-generate-sysents (Do Stack State optional)
"Generate the sysents for a csdo and return them."
(loop for E in (csdo-effects do)
when (help-entryprop-p E)
collect (sg-generate-sysent Do E Stack State optional)))
(defun reduce-prop (full-prop)
"Take full prop and get quantity, except for bodies."
(if (eql (car full-prop) 'body)
full-prop ;use def-qexp body-wrapper
(second full-prop)))
(defun sg-generate-sysent (Do Entry Stack State optional)
"Given a help entry prop generate the system entry for it and return."
;; include helpful message for this error:
(when (not (get-operator-by-tag (csdo-op Do)))
(error 'log-condition:log-error
:tag (list 'operator-not-in-problem-file (csdo-op Do))
:text (strcat "Operator not found in current KB. "
"Maybe need to regenerate *.prb file.")))
;; else didn't signal error above:
(make-SystemEntry
:Prop Entry
:State State
:CogLoad (operator-CogLoad (get-operator-by-tag (csdo-op Do)))
:Sources (list Do)
:Prereqs (wrap-if (sg-collect-sysent-prereqs Entry Stack))
:optional optional
;; This doesn't give anything useful for axes, just the number.
;; Done button is a goalprop.
:model (unless (member (car entry)
'(done choose-answer
eqn implicit-eqn draw-axes))
(new-english-find (reduce-prop entry)))))
;;; Determination of what is and is not a prerequisite depends upon the problem
;;; specification at hand. At one time variable definitions were removed from
;;; the list of prerequisites. However, as we no longer use these for
;;; prematurity checking I am now amending this list so that it includes the
;;; variable definitions again. We may have to be more sensitive about how
;;; we use the prerequisites list when we go to test for prematurity again.
(defun sg-collect-sysent-prereqs (Prop Stack)
"Collect the prerequisites for the urrent element on the stack."
#|(cond ((help-eqn-entryprop-p prop)
;;(sg-collect-stack-prereqs stack))
(remove-if #'sg-defvar-entryp
(sg-collect-stack-prereqs stack)))
(t (sg-collect-stack-prereqs stack))))
|#
(declare (ignore Prop))
(sg-collect-stack-prereqs stack))
(defun sg-collect-stack-prereqs (Stack)
"collect the prereqs from a stack."
(let ((S (position 'split Stack :test #'equalp))
(n (position 'next Stack :test #'equalp)))
(cond ((null N) (remove-if-not #'SystemEntry-p Stack)) ;; No splits and nexts
(t ;; If the element is within a next collect all of the components between
(append (remove-if-not #'SystemEntry-p (subseq Stack 0 N)) ;; the top of the stack, and the
(remove-if-not #'SystemEntry-p (subseq Stack S))))))) ;; next and then between the split and the top.
(defun sg-defvar-entryp (entry)
"Return t iff the entry is a defvar entry."
(eq (help-entryprop-type (SystemEntry-Prop entry))
'define-var))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Collection of system entries.
;; The System Entry index consists of a list of all unique
;; system entries sorted s.t. the solved equations are
;; listed first followed by the unsolved euqation entries
;; lastly listing the non equation entries.
;;
;; This index is searched by the solution checking code below
;; for individual non-eqn entries and multiple equations.
;;
;; The collection proceed by cycling though each node in the
;; graph and collecting the entries from each path accounting
;; for the splits and joins in the path. Identical entries
;; are then merged and sorted to place the solved equations
;; first in the listing.
;;
(defun sg-collect-sysent-index (Graph)
"Collect the system entries index from the bubblegraph."
(let ((Index (sg-define-index Graph)))
(dotimes (n (length Index))
(setf (SystemEntry-Index (nth N Index)) n))
Index))
(defun sg-define-index (Graph)
"Define the contents of the index."
(sg-sort-sysents-for-eqns
(merge-duplicate-systementries
(append (loop for Q in (car Graph)
append (Qnode-Entries Q))
(loop for E in (Cadr Graph)
append (Enode-Entries E))))))
(defun sg-sort-sysents-for-eqns (Entries)
"Sort the entries s.t the equation entries preceed the non-eqn entries."
(let ((eq) (neq))
(multiple-value-setq (eq neq)
(set-split #'(lambda (x)
(let ((type (help-entryprop-type (SystemEntry-Prop x))))
(or (equalp type 'eqn) (equalp type 'given-eqn))))
Entries))
(append eq neq)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; sg-subst-graph-sysents
;; Once the *sg-index is built the SystemEntries within the
;; graph will contain redundancies. Prior to using them the
;; entries need to be replaced by the fully merged entries
;; within the *SG-Entries* index. This code cycles through
;; the Bubblegraph performing those substitutions.
(defun sg-subst-graph-sysents (Entries Graph)
"Substitute the entries back into the graph."
(dolist (Q (car Graph))
(setf (Qnode-Entries Q)
(sg-sysents->sysents (Qnode-Entries Q) Entries)))
(dolist (E (cadr Graph))
(setf (Enode-Entries E)
(sg-sysents->sysents (Enode-Entries E) Entries))))
(defun sg-sysents->Sysents (Entries Index)
"Substitute the entries in Entries for matching ones in index."
(let ((tmp))
(remove-duplicates
(loop for E in Entries
do (setq tmp (find (SystemEntry-Prop E) Index
:key #'SystemEntry-Prop :test #'unify)) ; AW: was equal
when (null tmp)
do (error "No matching entry in index~% ~A~% ~A." E Index)
else collect tmp))))
;;-------------------------------------------------------------------------
;; matching of equations and entries.
;; Match the entries and equations in the system. This allows
;; for a mapping between equations and entries at runtime.
;; This is related to the match-eqn->entry code below used to match
;; between the elements for the algebra system.
(defun sg-match-eqn-entries (Eqns Entries)
"Search the eqns for their entry matches."
(dotimes (N (length Eqns)) ;; Add space for the
(setf (nth n Eqns) ;; entry storage.
(append (nth n Eqns) (list nil))))
(sg-pair-eqn-entries Eqns Entries)
Eqns)
(defun sg-pair-eqn-entries (Eqns Entries)
(let ((tmp))
(dolist (E Eqns)
(setq tmp (sg-find-eqn->entry (cadr E) Entries))
(if (null tmp) (error "Unmatched eqn entry found in setup ~A." (cadr E)))
(setf (nth 2 E) tmp))))
(defun sg-find-eqn->entry (Eqn Entries)
"Find the matching entry for eqn if one exists."
(find eqn Entries
:key #'(lambda (e) (cadr (SystemEntry-Prop E)))
:test #'unify)) ;handle keywords properly
;;-------------------------------------------------------------------------
;; Setup Solutions
;; The solutions as read in from the problem file consist of a set of
;; base equations (any equation save derived equations) and a set of
;; bubblegraph nodes.
;;
;; Prior to being used by the solution graph three things must happen.
;; Firstly the set of equations must be passed to the Algebra DLL to
;; form a canonical equation set. This process will return an integer ID.
;;
;; Secondly the set of entries within the solution must be collected.
;; This is done by collecting the contents of the entries fields for each
;; node within the solution.
;;
;; Lastly the solution itself must be placed in an sgsol struct including
;; the count for use by the matching code.
(defun sg-setup-solutions (Solutions Graph Eqns)
;; special handling for no-quant problems
(setf *Sg-Solutions*
(if (no-quant-problem-p *cp*)
(sg-setup-solutions-no-quant Graph Eqns)
(sg-setup-solutions-quant Solutions Eqns)))
;; Mark SystemEntries found in *Sg-Solutions
(dolist (soln *Sg-Solutions*)
(dolist (sysent (sgsol-entries soln))
(setf (SystemEntry-in-Sg-Solutions sysent) t))))
(defun sg-setup-solutions-quant (Solutions Eqns)
"Define the list of solutions and store them in the algebra system."
(loop for S below (length Solutions)
do (sg-add-solution S (nth S Solutions) Eqns)
collect (sg-encode-solution S (nth S Solutions))))
(defun sg-add-solution (Num Solution Eqns)
"Add the numbered solution to the system"
(dolist (E (EqnSet-AllEqns Solution))
(when (eqn-entry-type-p (eqn-type E))
(let ((Eqn (find (Eqn-Algebra E) Eqns
:key #'cadr :test #'equalp)))
(if Eqn
(Solver-IndyAddEq2Set Num (car Eqn))
(error "NonIndy Solution Supplied ~A~% ~A." E Solution))))))
(defun sg-encode-solution (Num Solution)
"Translate elements of the solution for use."
(make-sgsol
:num Num
:Entries (remove-duplicates
(loop for node in (EqnSet-Nodes Solution)
append (BGNode-Entries node)))))
;; Variant for non-quant problems: these may include equation
;; writing steps (for entering given values of variables, say)
;; but have no solution sets since there is no quantity sought.
;; We collect any equations in the equation index into a dummy
;; solution set 0 to be registered with the solver so these
;; equation entries can be interpreted through the existing
;; solver machinery.
;; This still won't work for equations in a non-quant part
;; of a hybrid problem including quantitative soughts.
(defun sg-setup-solutions-no-quant (Graph Eqns)
;; instead of sg-add-solution above:
;; look through eqn index. For every equation matching one
;; in Eqns, add it's sg index to current set 0
(dolist (E (Problem-EqnIndex *cp*))
(when (eqn-entry-type-p (eqn-type E))
(let ((Eqn (find (Eqn-Algebra E) Eqns
:key #'cadr :test #'equalp)))
(when Eqn (Solver-IndyAddEq2Set 0 (car Eqn))))))
;; instead of sg-encode-solution above
;; map solution 0 to all entries in all eq-nodes
(let ((entries
;; maybe could use:
;; (reduce #'union (mapcar #'BGNode-Entries (bubble-graph-Enodes Graph)))
(remove-duplicates
(loop for N in (bubblegraph-Enodes Graph)
append (BGNode-Entries N)))))
(list (make-sgsol :num 0
:Entries entries))))
;;=========================================================================
;; check-solutions.
;; Given a student entry set its state depending upon its presence in the
;; set of SystemEntries.
;;
;;-------------------------------------------------------------------------
;; sg-match-entry
;; Given a student entry the code here ascertains it's type and then
;; calls the appropriate subfunction to obtain the match(es). The result
;; of this matching is then placed into the PossibleCinterps of the
;; Studententry and returned.
;; If the entry is an equation then it will be passed to the
;; equation matching code. Else it will be passed to match-non-eq-entry.
;;
;; Once the prop has been matched it will be returned with the state of each
;; interp marked on the interp itself
(defun sg-match-studententry (Entry)
(setf (StudentEntry-PossibleCInterps Entry)
(if (help-eqn-entryprop-p (subseq (StudentEntry-prop entry) 0 2))
(sg-match-eqn-num (StudentEntry-ID Entry))
;; Given a help entry prop locate the SystemEntry that matches
;; it from the *sg-entries* index and return it in a list.
;; If none is found return null.
(let ((match (find-ErrorInterp-correct entry)))
(when match
(list (sg-mark-interp (ErrorInterp-intended match))))))))
(defun find-ErrorInterp-correct (entry)
"Returns best match if correct, otherwise nil"
(let (tests)
;; select tests that always apply
(dolist (eh (remove 'nil **entry-tests** :key #'EntryTest-apply
:test-not #'eql))
(dolist (test (check-err-conds eh entry))
(push test tests)))
;; select best result from all applicable tests
;; then use that to determine correctness.
(when tests
(let ((best (select-error-interpretation tests)))
(when (eql (ErrorInterp-state best) +correct+)
best)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; sg-decompose-eqn
;; Occasionally for the purposes of the what's wrong help, the system
;; will need to decompose an arbitrary equation. The code here passes
;; the equation into joel's algebra dll occupying the next availible space
;; above the student slots (out of the student's sight). If it can be
;; entered it will then be decomposed and the decompositions returned
;; to the caller. If it cannot be decomposed then nil will be returned.
(defun sg-decompose-eqn (Algebra)
"Decompose the supplied eqn algebra."
(when (not (solver-equation-redp algebra))
(let ((R (solver-studentaddokay 'sg-decompose-equation Algebra)))
(setq R (when (and (not (stringp R)) (= 0 R))
(remove nil (sg-match-eqn-num 'sg-decompose-equation))))
(solver-studentemptyslot 'sg-decompose-equation)
R)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; sg-match-eqn
;; Given a student entry id cycle through each solution in *sg-Solutions*
;; For each solution obtain the set of base equations (possibly null) from
;; the solution that this equation decomposes into. Return the list of
;; these sets.
;;
;; The equation decomposition is controlled by the Algebra DLL. Given a
;; previously entered student equation id and a set id the system will
;; return an list of the form (<Status> <Definite> <Possible>)
;;
;; <Status> is an integer indication how independent the equation is from
;; the set ranging from 0: totally independent to 4 definitely dependent
;; on the equations in <Definite> Midway values from **sg-nonindy-1-thesh*
;; to **sg-nonindy-2-thresh** are composed of the equations in <Definite>
;; and in <Possible>.
;;
;; <definite> and <possible> are lists of canonical equation id's which
;; correspond to the indicies of the canonical equation system entries
;; in the *sg-Entries* index.
;;
;; Then the eqn interps are marked in addition to the usual markings for
;; premature substitutions of values and set activity.
(defun sg-match-eqn-num (Eqn)
"Check the eqn number student Entry."
(loop for S in *SG-Solutions*
collect (sg-set-decomp-eqn (sgsol-Num S) Eqn)))
;;; Note that as of the code Nonindy 1 thresh now overrides the nonindy
;;; 2 thresh by executing in the test prior to it. It may be reactivated
;;; later on as student experimentation provides more data.
(defparameter **sg-nonindy-1-thresh** 2 "Threshold for nonindy nodes taking from the linear expansion only")
(defparameter **sg-nonindy-2-thresh** 1 "Threshold for nonindy nodes taking from both linear expansion and mightdepends.")
(defun sg-set-decomp-eqn (Set Eqn)
"Obtain the set of base equations for EQN from set SET."
(let ((S (Solver-StudentisIndependent Set Eqn)))
(cond ((<= **sg-nonindy-1-thresh** (first S))
(sg-mark-eqn-interp
(sg-subst-enums->entries (second S))))
((<= **sg-nonindy-2-thresh** (first S))
(sg-mark-eqn-interp
(append (sg-subst-enums->entries (second S))
(sg-subst-enums->entries (third S))))))))
(defun sg-mark-eqn-interp (Interp)
"Mark the interps including premature subst and inactive."
(let ((I (sg-mark-interp Interp)))
(when (eq +correct+ (car I))
(if (and **Test-For-Premature-Subst**
(SystemEntries-Premature-substp I))
(setf (car I) +premature-subst+)))
I))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Mark interp(s)
;; Add the interp's state to the interp itself.
(defun sg-mark-interp (Interp)
"Mark the state of the interp not accounting for sets."
(when Interp
(cons (sg-check-interp Interp)
(sg-unmark-interp Interp))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; check interp(s)
;; Given an interpretation it is necessary to determine its state
;; which will be one of +correct+ +incorrect+ +forbidden+
;; +dead-path+ or +premature-entries+ The selected state will
;; be pushed onto the car of the interp and can then be used by
;; the help system to determine what interp (if given a choice)
;; to use.
;;
;; At present this code does not test for set membership or
;; premature substitution. That is handled by the
;; sg-mark-eqn-interps code above.
(defun sg-check-interp (Interp)
"Mark the state of the interp not accounting for sets."
(let ((State (Systementries->State (sg-unmark-interp Interp))))
;; Check for +forbidden+ +dead-path+
(if (and **Test-For-Prematurity**
(eq +correct+ State)
(SystemEntries-Prematurep (sg-unmark-interp Interp) *cp*))
+premature-entry+
State)))
;;----------------------------------------------------------------------
;; enter student entry
;; Given a student entry that has had its cinterp set by external
;; code the process of entering it involves pushing the
;; StudentEntry is pushed onto the Entered field
;; of each SystemEntry in the Cinterp.
(defun sg-enter-StudentEntry (Entry)
"For each system entry in the cinterps mark it with entry, marking it correct for the purposes of grading."
; For equation entries, apply constraint loss check if flag is set
(when (and **Filter-Constraint-Losses**
(eqn-prop-p (StudentEntry-Prop Entry))) ; it's an eqn entry
(sg-filter-constraint-losses Entry))
;; Print out Entry and Interps
(when (and *debug-help* (sg-unmark-interp (StudentEntry-Cinterp Entry)))
(format t
"Entering Interp:=====================================~%")
(format t "~A~%" (StudentEntry-Cinterp Entry)))
(let ((len-enter (cons Entry
(length (sg-unmark-interp
(studentEntry-Cinterp Entry)))))
(entries (sg-unmark-interp (studentEntry-Cinterp Entry))))
(update-grade-status entries +correct+)
(dolist (E entries)
(let ((grade (SystemEntry-graded E)))
(pushnew len-enter (graded-eqns grade) :test #'graded-eqns-equalp)
(pushnew Entry (SystemEntry-Entered E))))))
;;---------------------------------------------------------------------
;; Filter-constraint-losses
;; When the student makes an eqn SystemEntry they may combine several
;; equations into a single one and in so doing lose some of the factors
;; that will be necessary later. Thus they may walk themselves into
;; a situation where the help system thinks that they are done but the
;; equations that they have entered cannot be used algebraically to
;; solve for the sought. This function will test for that and, if so
;; return a null interp. Else it will return the interp itself.
;;
;; This function relies heavily on code located in solver.cl (for lack
;; of a better location as it is algebraic code) this code is passed
;; the algebra of the interps themselves and returns the dimensions of
;; the set.
;;
;; This code compares the dimensions of the eqn and the interp. If they
;; are equal or the Student Eqn has less dimensions than the interp then
;; nothing is done. If the eqn has more dimensions than the interp then
;; the cinterp will be set to nil so none of them are marked.
(defun sg-filter-constraint-losses (Entry)
"Filter the StudentEntry for constraint loss."
(let ((Mark (sg-get-interp-mark (StudentEntry-Cinterp Entry)))
(DE (sg-calc-eqn-dimensions (StudentEntry-ParsedEqn Entry)))
(DI (sg-calc-interp-dimensions (StudentEntry-Cinterp Entry))))
(when (> DE DI)
(format t "Interp not entered due to constraint loss:~%")
(format T " student eqn dimensions=~a, interp dimensions=~a~%" DE DI)
(setf (StudentEntry-Cinterp Entry)
(if (null Mark) nil
(sg-add-mark-to-interp Mark Nil))))))
;;; sg-calc-eqn-dimensions
;;; Given an equation calculate its dimensions according
;;; to the number of canonical variables that it contains.
(defun sg-calc-eqn-dimensions (Eqn)
"Calculate the dimensions of the eqn by sysvars."
(calc-exp-dimensions #'sysvar-p Eqn))
;;; sg-calc-interp-dimensions
;;; Given an interp calculate the dimensions of the equations
;;; within it again according to the sysvars.
(defun sg-calc-interp-dimensions (Interp)
"Calculate the eqn dimensions of the Interp."
(calc-exp-set-dimensions
#'sysvar-p
(remove-if
#'null (mapcar #'get-eqn-SystemEntry-algebra
(sg-unmark-interp Interp)))))
;;---------------------------------------------------------------------
;; sg-delete-Studententry
;; Deletion of a student entry is essentially a direct reversal
;; of the entry process. Here the entry is removed from the entered
;; fields of the System Entries in its cinterp.
(defun sg-delete-StudentEntry (Entry)
"Remove the markings from each node in the Entrie's CInterp."
;; AW: unneeded variable check will mark define-var sysentries
;; as entered by some student equation entries, even though
;; the define-vars are NOT saved in the studentEntry's Cinterp.
;; Change to loop over ALL system entries to allow for this case.
;; Hairy technique, probably should be changed.
(dolist (E *sg-entries*) ; was: (E (studentEntry-Cinterp Entry))
(setf (SystemEntry-Entered E)
(remove Entry (SystemEntry-Entered E)))))
;;==========================================================================
;; Utility functions.
;;----------------------------------------------------------
;; Utility function to find system entry for a given vector quantity.
;; Depends on structure of vector entry proposition
(defun sg-find-vector-entry (vector-quant)
"return the system entry for a vector quantity"
(find `(vector ,vector-quant ?dont-care) *sg-entries*
:test #'unify :key #'SystemEntry-Prop))
;;-------------------------------------------------------------
;; given a canonical equation number match it with a system
;; entry as necessary.
(defun sg-subst-enums->entries (enums)
(loop for e in enums
collect (sg-match-enum->entry e)))
(defun sg-match-enum->entry (enum)
(let ((e (nth 2 (nth enum *sg-eqns*))))
(if (null e)
(error "Unmatched eqn requested. ~A" (nth enum *sg-Eqns*))
e)))
;;-------------------------------------------------------------
;; Remove the marking from an interp if it is present.
(defun sg-unmark-interp (interp)
(if (SystemEntry-P (car Interp))
Interp
(cdr Interp)))
;;-------------------------------------------------------------
;; Add a marking to an interp
(defun sg-add-mark-to-interp (Mark Interp)
"Add the specified marking to the interp."
(cons Mark Interp))
;;-------------------------------------------------------------
;; Get the marking from an interp.
(defun sg-get-interp-mark (Interp)
(when (not (SystemEntry-p (car Interp)))
(car Interp)))
;;--------------------------------------------------------------
;; Get the SystemEntry's op's hints
; Following returns spec to be used as tail of a list of specs passed
; to make-hint-seq when appending operator hints. It returns a spec
; for a single function hint. When this spec is expanded, make-hint-seq
; will wind up getting called (again) on the operator hint spec list.
; We build this spec for a delayed call so it will include the :optail
; arg, which is needed to log the operator name in an :assoc.
; [This technique copied from hint-target-entry in nextstephelp.cl to
; fix bug 834 AW]
(defun sg-map-systementry->hints (entry)
(let ((step (car (SystemEntry-sources entry)))) ; a csdo
`((function make-hint-seq
,(collect-step-hints step)
:OpTail ,(list (csdo-op Step))))))
; collect tags of operator instances that made this system entry
; opinst tag is of form (WRITE-MASS-COMPOUND (BOOK PACKAGE))
(defun sg-map-systementry->opinsts (entry)
(remove-duplicates (mapcar #'csdo-op (SystemEntry-sources entry))
:test #'equalp))
; collect set of names of operators that made this system entry
(defun sg-map-systementry->opnames (entry)
(remove-duplicates
(mapcar #'first (sg-map-systementry->opinsts entry))))
; get name of one operator that made this system entry.
; For equations, set of opinsts should be a singleton (don't have
; two operators generating the same equation), so this can be
; more convenient than list.
(defun sg-map-systementry->opname (entry)
(first (sg-map-systementry->opnames entry)))
;; For treating entries as optional
;; An entry is optional iff for every enode in the graph:
;; either the node doesn't contain it at all or
;; there exists a path through that node that doesn't
;; include the entry. This requires traversing the hairy
;; psm graph structure.
;;
;; NB: Optionality here is defined by path structure and
;; will not exclude implicit eqn entries. Other code in
;; next-step-help and grading will treat implicit eqn entries
;; as effectively optional in a different way.
(defun sg-systementry-optional-p (entry &optional (problem *cp*))
(every #'(lambda (enode) (does-not-require enode entry))
(bubblegraph-enodes (problem-graph problem))))
(defun does-not-require (enode entry)
(cond ((not (member entry (enode-entries enode))) T)
(T (some-path-through-omits (enode-path enode) entry))))
(defun some-path-through-omits (path entry)
(cond ((null path) T)
((and (csdo-p (car path)) ; hit a CSDO for this entry
(member (car path) (SystemEntry-sources entry)))
NIL)
((cschoose-p (car path))
;; car path is (CHOOSE ((step 1) (step 2)) ((step1 step2)))
;; so everything to the end is inside the current CHOOSE item.
(some #'(lambda (path) (some-path-through-omits path entry))
(cdr (car path))))
;; !!! ignoring splits and joins since we don't
;; generate them any more
(T (some-path-through-omits (cdr path) entry))))
; Utility func to pull out only the required entries in an enode.
; Because intended for use by grading, this DOES ignore implicit eqns.
(defun enode-required-entries (enode)
(remove-if #'(lambda (entry)
(does-not-require enode entry))
(remove-if #'SystemEntry-implicit-eqnp
(enode-entries enode))))
;;;;
;;;; Pick up inheritance associated with a quantity
;;;; from bubblegraph
;;;;
;;(Remove nil (mapcar #'(lambda (x) (when (SystemEntry-children x) (cons (systementry-prop x) (systementry-children x)))) *sg-entries*))
(defun find-inheritance (graph-nodes)
"Cycle through bubblgraph nodes, collect any inheritance and save in SystemEntry-children."
;; Look for directive to not include inheritance in model.
;; This is used for mass, which is normally timeless,
;; but has inheritance for a few problems.
(let ((excludes (remove 'inherit-quantity-implicitly
(problem-wm *cp*)
:test-not #'eql :key #'car)))
;; Only enodes have a path constructed.
(dolist (node graph-nodes)
(let ((result (find-inheritance-in-graph (bgnode-path node))))
;; (format t "result for ~A is ~S~%" (bgnode-exp node) result)
(dolist (entry (bgnode-entries node))
(dolist (x result)
(when (and (not (member (car (SystemEntry-prop entry))
'(eqn implicit-eqn)))
(not (member (second x) excludes
:key #'second :test #'unify))
;; strip the action from the SystemEntry
(unify (second x) (second (SystemEntry-prop entry))))
(pushnew (car x) (systemEntry-children entry) :test #'unify)))
;; (when (systementry-children entry)
;; (format t " systementry ~S~% children: ~S~%"
;; (systemEntry-prop entry) (systementry-children entry)))
)))))
(defun find-inheritance-in-graph (path)
"Go through path and collect any instances of inheritance. Note that quantities and objects are inherited."
(let (result)
(dolist (step path)
(cond
;; ignore wm, op, sg
((or (cswm-p step) (csop-p step) (cssg-p step)))
((csdo-p step)
(dolist (effect (csdo-effects step))
(when (unify effect `(inherit-quantity . ?rest))
;; Could also get operator and associated hints here
(pushnew (cdr effect) result :test #'unify))))
;; 'SPLIT' (beginning of unordered) (not implemented)
;; Choose alternate paths.
((cschoose-p step)
(dolist (x (cdr step))
(setf result (union result (find-inheritance-in-graph x)
:test #'unify))))
;; Or signal a syntax error.
(T (Error "Car of path has illegal syntax"))))
result))
;; (Remove nil (mapcar #'(lambda (x) (when (SystemEntry-children x) (list (systementry-prop x) (systementry-model x)))) *sg-entries*))
(defun add-inheritance-to-model (entries)
"Add any children into model sentence."
;; Models are combined in a rather unintelligent manner
;; since child quantities typically have a large overlap with
;; each other and with parent quantities.
(dolist (entry entries)
(when (SystemEntry-children entry)
(setf (SystemEntry-model entry)
(cons 'or
(cons (SystemEntry-model entry)
(mapcar #'new-english-find
(SystemEntry-children entry))))))))
Something went wrong with that request. Please try again.