Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

In open-problem, consolidate replies from old sessions

and use logged values for matches to student definitions.
This greatly speeds up open-problem and removes
issues with timeouts and truncated server replies on open-problem.
  • Loading branch information...
commit 02fea3272eafe2095886292f472533c5633fc2b8 1 parent f46e1c0
@bvds authored
View
99 Help/Entry-API.cl
@@ -116,6 +116,26 @@
"Last two characters of a string"
(subseq x (max 0 (- (length x) 2))))
+(defun format-props (sysentries &key allowed-tools)
+ "Find guesses or sysentries associated with given tools, returning an alist of models and props."
+ (mapcar
+ #'(lambda (x) (cons (expand-vars (SystemEntry-model x))
+ (SystemEntry-prop x)))
+ (remove-if #'(lambda (prop) (not (member (car prop) allowed-tools)))
+ sysentries
+ :key #'SystemEntry-prop)))
+
+(defun matches-from-guesses (guesses allowed-tools)
+ (mapcar
+ ;; This could be made faster by borrowing the
+ ;; SystemEntry-model from any matching SystemEntry instead
+ ;; of constructing a new one.
+ #'(lambda (prop) (match:make-best :prop prop))
+ (remove-if
+ #'(lambda (prop) (not (member (car prop) allowed-tools)))
+ (mapcar #'read-from-string guesses))))
+
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Match student phrase to Ontology
@@ -132,12 +152,27 @@
;; valued. Thus, if we want to do better, than we demand the
;; bound be decreased by 1.
-(defun match-student-phrase0 (student tool-prop &key
+(defun match-student-phrase0 (student tool-prop &key
+ guesses
all-scalars
(cutoff-fraction 0.4)
;; If larger, too slow on benchmarks
(cutoff-max 3.7))
"Match student phrase to Ontology, returning best matches for tool or other tool."
+
+ ;; When guesses are provided, we will assume they are correct and
+ ;; complete, and ignore any sysentries. This is appropriate
+ ;; when the guesses are from the old server replies when
+ ;; rerunning old sessions.
+ ;;
+ (when (and guesses (eql t (car guesses)))
+ (let ((allowed-tools (remove tool-prop *tool-props-with-definitions*)))
+ (return-from match-student-phrase0
+ (values
+ (matches-from-guesses (cdr guesses) (list tool-prop))
+ (matches-from-guesses (cdr guesses) allowed-tools)
+ 0))))
+
;; :cutoff-fraction is fractional length of student phrase to
;; use as bound, adding 1 for the tool. This should be adjusted to
;; balance type 1 and type 2 errors:
@@ -154,9 +189,7 @@
;; :cutoff-max is maximum allowed score to use as bound. This should
;; be adjusted to so that very long student phrases can
;; be matched quickly enough.
- (let* ((sysentries (remove (cons tool-prop '?rest) *sg-entries*
- :key #'SystemEntry-prop :test-not #'unify))
- (initial-cutoff (min (* cutoff-fraction (length student))
+ (let* ((initial-cutoff (min (* cutoff-fraction (length student))
cutoff-max))
;; To speed up best-wrong-match for long phrases, maybe reduce
;; max cutoff a bit.
@@ -173,27 +206,25 @@
(mapcar #'(lambda (x)
(cons (expand-vars (new-english-find x))
(list nil x)))
- (mapcar #'qvar-exp (problem-varindex *cp*)))
- (mapcar #'(lambda (x)
- (cons (expand-vars (SystemEntry-model x))
- (SystemEntry-prop x)))
- sysentries))
+ (mapcar #'qvar-exp (problem-varindex *cp*)))
+ (format-props *sg-entries*
+ :allowed-tools (list tool-prop)))
:cutoff initial-cutoff))
;; The value of the best correct match or the initial cutoff.
;; This is used to determine cutoffs for wrong quantity searches.
(wrong-bound (if best (- (best-value best) 1) initial-cutoff))
wrong-tool-best)
-
+
(when nil ;debug print
- (format t "Best match to ~s is~% ~S~% from ~S~%"
+ (format webserver:*stdout*
+ "Best match to ~s is~% ~S~%"
(when student (match:word-string student))
(mapcar
#'(lambda (x) (cons (match:best-value x)
(expand-vars (new-english-find
(reduce-prop
(match:best-prop x))))))
- best)
- (mapcar #'systementry-prop sysentries)))
+ best)))
;; Attempt to detect a wrong tool error.
;; The strategy is to treat the choice of tool as being
@@ -205,19 +236,12 @@
;; wrong-tool-best less than best score minus 1 or no best.
;; this certainly should be given wrong tool help.
(when (>= wrong-bound 0)
- (let* ((allowed-tools (remove tool-prop *tool-props-with-definitions*))
- (sysentries (remove-if
- #'(lambda (x) (not (member
- (car (SystemEntry-prop x))
- allowed-tools)))
- *sg-entries*)))
+ (let ((allowed-tools (remove tool-prop *tool-props-with-definitions*)))
(setf wrong-tool-best
(match:best-model-matches
student
- (mapcar #'(lambda (x)
- (cons (expand-vars (SystemEntry-model x))
- (SystemEntry-prop x)))
- sysentries)
+ (format-props *sg-entries*
+ :allowed-tools allowed-tools)
;; If there is no match in best, then the help is
;; pretty weak. In that case, just find anything
;; below the cutoff.
@@ -234,6 +258,8 @@
;; take shortest matching proposition.
;; need to pre-order quantities so that shorter propositions
;; are matched first...
+ ;;
+ ;; Assume guesses contain all viable props.
(when (or (null best) (>= (best-value best) 1))
(update-bound
best
@@ -252,6 +278,8 @@
;; the wrong tool has also been used.
;; Must be better than any quantity in solution, but allow
;; for ties with one plus any quantity not in solution.
+ ;;
+ ;; Assume guesses contain all viable props.
(when (and (>= wrong-cutoff-max 1)
(>= wrong-bound 0)
(or (null best) (>= (best-value best) 1)))
@@ -279,7 +307,7 @@
(- (best-value wrong-tool-best) 1)
wrong-bound))))))))
- (values best wrong-tool-best wrong-bound sysentries)))
+ (values best wrong-tool-best wrong-bound)))
(defun match-student-phrase (entry tool-prop)
"Match student phrase to Ontology, returning best match prop, tutor turn (if there is an error) and any unsolicited hints."
@@ -288,10 +316,15 @@
(let ((student (match:word-parse
(pull-out-quantity (StudentEntry-symbol entry)
(StudentEntry-text entry))))
+ ;; Was previously calculated in match-student-phrase0
+ (no-tool-sysentries
+ (notany #'(lambda (x) (eql tool-prop (car (SystemEntry-prop x))))
+ *sg-entries*))
hints)
- (multiple-value-bind (best wrong-tool-best best-correct sysentries)
- (match-student-phrase0 student tool-prop)
+ (multiple-value-bind (best wrong-tool-best best-correct)
+ (match-student-phrase0 student tool-prop
+ :guesses (StudentEntry-guesses entry))
;; If there isn't a good match to solution quantities,
;; try another tool and non-solution quanitities.
@@ -326,7 +359,7 @@
tool-prop
(mapcar #'match:best-prop wrong-tool-best)) hints))
- ((null sysentries)
+ (no-tool-sysentries
(values nil (nothing-to-match-ErrorInterp entry tool-prop) hints))
((null best)
@@ -357,9 +390,9 @@
(unless prop (warn "Null prop for correct match"))
;; Return the best fit entry.
(values prop nil hints)))
-
+
(t
- (let ((props (mapcar #'match:best-prop best)))
+ (let ((props (mapcar #'match:best-prop best)))
(values nil (too-many-matches-ErrorInterp entry props) hints)))))))
;; Debug printout:
@@ -472,9 +505,9 @@
;; Should use props to inform starting point
;; for NSH.
'(function next-step-help)))
- :assoc `((too-many-matches . ,full-props))
+ :assoc `((too-many-matches . ,(length full-props)))
:state +incorrect+
- :diagnosis '(definition-has-too-many-matches))))
+ :diagnosis `(definition-has-too-many-matches . ,full-props))))
(defun wrong-tool-ErrorInterp (entry tool-prop full-props)
@@ -987,7 +1020,7 @@
;; finally return entry
(check-noneq-entry entry :unsolicited-hints hints))
- (t
+ (t
(setf (StudentEntry-prop entry) nil)
(setf (turn-result tturn) (append (turn-result tturn) hints))
tturn)))))
@@ -1038,7 +1071,7 @@
;; finally return entry
(check-noneq-entry entry :unsolicited-hints hints))
- (t
+ (t
(setf (StudentEntry-prop entry) nil)
(setf (turn-result tturn) (append (turn-result tturn) hints))
tturn)))))
View
2  Help/Interface.cl
@@ -253,7 +253,7 @@
;; if there is assoc info in the turn, add to reply
;; :assoc has the format of an alist.
- ;; Still need to properly logs into "student" and "tutor", Bug #1870
+ ;; Still need to properly log into "student" and "tutor", Bug #1870
(when (and turn (turn-assoc turn))
(alist-warn (turn-assoc turn))
(push `((:action . "log") (:log . "tutor")
View
99 Help/database.cl
@@ -274,50 +274,39 @@ list of characters and replacement strings."
:text "get-matching-sessions-result got invalid result.")
(return-from get-matching-sessions))
- ;; Filter out turns where the reply contains a timeout error.
- ;; Unless the bug causing the timeout has been fixed, these errors
- ;; prevent a student from reopening a problem.
- (setf result
- (remove-if
- #'(lambda (x)
- ;; find client turn such that associated server
- ;; reply does not have a timeout error.
- (and x
- (server-reply-has-timeout
- ;; Actually, we only need to decode the
- ;; top-level list.
- ;; Sometimes result gets truncated on very long
- ;; backtraces. It might be better to just search
- ;; the string for the timeout message?
- (errors-to-warnings x (decode-json-from-string x)))))
- result
- :key #'car))
-
- ;; parse json in each member of result
- ;; pick out post and client-id
- (setf result
- (mapcar
- ;; A post with no json sent gets translated into nil;
- ;; see write-transaction.
- #'(lambda (x)
- (let ((y (second x)))
- (cons (and y
- (errors-to-warnings
- y
- (decode-json-from-string y)))
- (third x))))
- result))
-
- ;; pick out the solution-step and get-help methods
- (remove-if #'(lambda (x) (not (member (cdr (assoc :method x))
- methods
- :test #'equal)))
- result
- :key #'car))))
-
-(defun server-reply-has-timeout (reply)
+ (loop for line in result
+ with client and server
+ when
+ (and (second line)
+ ;; Decode client post, if it exists
+ ;; A post with no json sent gets translated into nil;
+ ;; see write-transaction.
+ (setf client (errors-to-warnings
+ (second line)
+ (decode-json-from-string (second line))))
+ ;; pick out the solution-step and get-help methods
+ (member (cdr (assoc :method client))
+ methods :test #'string-equal)
+ ;; Filter out turns where the reply contains a timeout error.
+ ;; Unless the bug causing the timeout has been fixed,
+ ;; these errors prevent a student from reopening a problem.
+ (server-reply-has-no-timeout
+ (setf server
+ (errors-to-warnings
+ (first line)
+ ;; Actually, we only need to decode the
+ ;; top-level list.
+ ;; Sometimes result gets truncated on
+ ;; very long backtraces.
+ (when (first line)
+ (decode-json-from-string (first line)))))))
+ collect
+ (list server client (third line))))))
+
+
+(defun server-reply-has-no-timeout (reply)
"Test whether a server reply includes a timeout error."
- (some #'(lambda (x) (and (string-equal (cdr (assoc :action x)) "log")
+ (notany #'(lambda (x) (and (string-equal (cdr (assoc :action x)) "log")
(string-equal (cdr (assoc :error-type x))
"timeout")))
(cdr (assoc :result reply))))
@@ -455,18 +444,22 @@ list of characters and replacement strings."
;; variables.
;; A global cache would need periodic flushing.
(defun get-start-tID (client-id)
- (let ((result
- (query *connection*
- (format nil "SELECT MIN(tID) FROM STEP_TRANSACTION WHERE clientID='~A'"
- (truncate-client-id client-id)))))
+ (let* ((sel (format nil "SELECT MIN(tID) FROM STEP_TRANSACTION WHERE clientID='~A'"
+ (truncate-client-id client-id)))
+ (result (query *connection* sel)))
+
(if (and (consp result) (consp (car result)))
(car (car result))
- (warn 'log-condition:log-warn
- :tag (list 'get-start-tID result
- *old-client-id*
- webserver:*log-id*
- (truncate-client-id client-id))
- :text "get-start-tID expecting list of lists"))))
+
+ ;; If there is no entry in STEP_TRANSACTION, then something
+ ;; has gone wrong. Determine if session exists.
+ (let ((nst (query *connection* (format nil "Select count(*) FROM STEP_TRANSACTION WHERE clientID='~A'"
+ (truncate-client-id client-id))))
+ (npa (query *connection* (format nil "Select count(*) FROM PROBLEM_ATTEMPT WHERE clientID='~A'"
+ (truncate-client-id client-id)))))
+ (warn 'log-condition:log-warn
+ :tag (list 'get-start-tID client-id nst npa)
+ :text "get-start-tID dif not find matching entry")))))
(defun get-session-starting-tID ()
"Get any existing tID associated with the start of the current session. If client-id is a string, use that session."
View
302 Help/sessions.cl
@@ -158,7 +158,7 @@
*parse-memo* *lexical-rules-memo* *rules-starting-with-memo*
;; Session state information
session:*user* session:*section* session:*problem*
- session:*state-cache*
+ session:*state-cache*
)
#-sbcl "List of global variables that need to be saved between turns in a session."
#+sbcl #'equalp
@@ -247,7 +247,6 @@
:extra extra)
(let (replies solution-step-replies predefs
- last-client-id ;used when re-running old sessions
;; Override global variable on start-up
(*simulate-loaded-server* nil))
(env-wrap
@@ -366,7 +365,7 @@
(let* ((label (pop line))
(id (format nil "doneButton~S" i))
;; If name of activity was supplied, use that.
- ;; else search for any done button.
+ ;; Else, search for any done button.
(label-match (if label (list 'done label)
'(done . ?rest)))
;; Find any done button SystemEntry.
@@ -490,71 +489,15 @@
;; Pull old sessions out of the database that match
;; student, problem, & section. Run turns through help system
;; to set problem up and set scoring state.
- (andes-database:old-sessions
- (dolist (old-step (andes-database:get-matching-sessions
- '("solution-step" "seek-help" "record-action")
- :student user :problem problem :section section
- :extra extra))
-
- ;; Detect first turn in an old session.
- (unless (equal last-client-id (cdr old-step))
- ;; flush state cache
- (env-wrap
- (setf session:*state-cache* nil))
- (andes-database:set-old-session-start (cdr old-step))
- (setf last-client-id (cdr old-step)))
-
- (let* ((method (cdr (assoc :method (car old-step))))
- (params (cdr (assoc :params (car old-step))))
- ;; If an old session turn produces an error, convert it
- ;; into a warning and move on to the next turn.
- ;; Otherwise old sessions with unfixed errors cannot
- ;; be reopened.
- (reply
- (handler-case
- (apply
- (cond
- ((equal method "solution-step") #'solution-step)
- ;; Help requests are sent to the help system to set
- ;; the solution status and grading state.
- ;; Alternatively, we could just send the solution
- ;; steps to the help system state and then set
- ;; the grading state by brute force.
- ((equal method "seek-help") #'seek-help)
- ((equal method "record-action") #'record-action))
- ;; flatten the alist
- (mapcan #'(lambda (x) (list (car x) (cdr x)))
- params))
- (error (c) (old-errors-into-warnings c method params))))
-
- ;; solution-steps and help results are passed back to client
- ;; to set up state on client.
- (send-reply (filter-reply reply)))
-
- ;; Echo any solution step action
- (when (equal method "solution-step")
- ;; "checked" is supposed to be a json array.
- ;; Need special handling in case it is empty.
- (let ((checked (assoc :checked params)))
- (when (and checked (null (cdr checked)))
- ;; Hack for creating an empty array in json
- (setf (cdr checked) (make-array '(0)))))
- ;; Remove time from reply
- (push (remove :time params :key #'car) send-reply))
-
- ;; Echo any text entered in Tutor pane text box.
- (when (and (equal method "seek-help")
- (equal (cdr (assoc :action params)) "get-help")
- (assoc :text params))
- (push `((:action . "echo-get-help-text")
- (:text . ,(cdr (assoc :text params)))) send-reply))
-
- (setf solution-step-replies
- (append solution-step-replies send-reply)))))
+ (setf solution-step-replies
+ (append solution-step-replies
+ (rerun-old-sessions :user user :problem problem
+ :section section :extra extra)))
+
(env-wrap
;; After running through old session, flush state cache
(setf session:*state-cache* nil)
-
+
;; Determine if this is the first session for this user.
;; Do separately from seen-intro-video in case video window
;; is killed by pop-up blocker on client.
@@ -628,10 +571,214 @@
(append (reverse replies) solution-step-replies)))
+;; lines are supposed in reverse chronological order
+;; Only modify last occurrence of object.
+(defmacro push-reply-to-replies (line lines)
+ "Add line to list of replies, consolidating any object modifications."
+ `(let ((action (cdr (assoc :action ,line))))
+ (setf ,lines
+ (cond
+ ((equal action "modify-object")
+ (consolidate-modify ,line ,lines))
+ ((equal action "delete-object")
+ (consolidate-delete ,line ,lines))
+ (t (cons ,line ,lines))))))
+
+(defvar *debug-consolidate* nil)
+
+(defun consolidate-modify (line lines)
+ (cond
+ (*debug-consolidate* (cons line lines))
+ ((null lines)
+ ;; Assume any id's not found in lines apply
+ ;; to an object already created (answer box, for example).
+ (list line))
+ ((and (member (cdr (assoc :action (car lines)))
+ '("new-object" "modify-object") :test #'equal)
+ (equal (assoc :id line) (assoc :id (car lines))))
+ (cons (consolidate-line (remove :action line :key #'car)
+ (car lines)) (cdr lines)))
+ (t (cons (car lines) (consolidate-modify line (cdr lines))))))
+
+(defun consolidate-delete (line lines)
+ (cond
+ (*debug-consolidate* (cons line lines))
+ ((null lines)
+ ;; Assume any id's not found in lines apply
+ ;; to an object already created (answer box, for example).
+ (list line))
+ ((and (equal (cdr (assoc :action (car lines))) "new-object")
+ (equal (cdr (assoc :id line)) (cdr (assoc :id (car lines)))))
+ (cdr lines))
+ ((and (equal (cdr (assoc :action (car lines))) "modify-object")
+ (equal (cdr (assoc :id line)) (cdr (assoc :id (car lines)))))
+ (consolidate-delete line (cdr lines)))
+ (t (cons (car lines) (consolidate-delete line (cdr lines))))))
+
+;; update old line with new line, maintaining order of oldline.
+(defun consolidate-line (newline oldline)
+ (if oldline
+ (let ((match (assoc (car (car oldline)) newline)))
+ (if match
+ (cons match (consolidate-line (remove match newline)
+ (cdr oldline)))
+ (cons (car oldline) (consolidate-line newline (cdr oldline)))))
+ newline))
+
+
+(defvar *debug-old-sessions* nil)
+
+;; Pull old sessions out of the database that match
+;; student, problem, & section. Run turns through help system
+;; to set problem up and set scoring state.
+;; returns list of replies.
+;;
+;; For very long sessions, the reply can be too big, resulting
+;; in trucation of the reply. As a work-around, consolidate
+;; creation/modification/deletion of of objects.
+(defun rerun-old-sessions (&key user problem section extra)
+
+ (let (last-client-id solution-step-replies
+ (tn (get-internal-run-time)) (ttn (get-internal-real-time)))
+
+ (andes-database:old-sessions
+ (dolist (old-step (andes-database:get-matching-sessions
+ '("solution-step" "seek-help" "record-action")
+ :student user :problem problem :section section
+ :extra extra))
+
+ (let ((client-id (third old-step))
+ (method (cdr (assoc :method (second old-step))))
+ (params (cdr (assoc :params (second old-step))))
+ guesses
+ (t0 (get-internal-run-time)) (tt0 (get-internal-real-time)))
+
+ ;; Collect any interpretations from old server reply
+ (when (string-equal method "solution-step")
+ (dolist (line (cdr (assoc :result (car old-step))))
+ (when (and (string-equal (cdr (assoc :action line)) "log")
+ (string-equal (cdr (assoc :log line)) "student"))
+ (cond
+ ;; Error where too many matches found.
+ ;; Logs from before middle of June 2012 do not contiain
+ ;; list of matches.
+ ((and (assoc :error-type line)
+ ;; Actually, we just want to match beginning
+ ;; of strings
+ (search "(DEFINITION-HAS-TOO-MANY-MATCHES"
+ (cdr (assoc :error-type line))
+ :test #'char-equal))
+ ;; This looks rather kludgy: convert from string
+ ;; break into a list, and convert each prop back
+ ;; into a string. However, since guesses can potentially
+ ;; come from a client, they should be passed as strings.
+ ;; Right now, andes3.smd specifies this should be an
+ ;; array of strings.
+ (let ((props (mapcar #'prin1-to-string
+ (cdr (read-from-string
+ (cdr (assoc :error-type line)))))))
+ (push (list* :guesses t props) guesses)))
+ ;; Error where no matches were found
+ ;; Before June 2012, logs sometimes included
+ ;; an incorrect prop for DEFINITION-HAS-NO-MATCHES.
+ ((and (assoc :error-type line)
+ (string-equal (cdr (assoc :error-type line))
+ "(DEFINITION-HAS-NO-MATCHES)"))
+ (push (list :guesses t) guesses))
+ ;; Error where student entry was evaluated
+ ;; Too many matches is handled above.
+ ;;
+ ;; Before June 2012, logs sometimes included
+ ;; an incorrect prop for too-many-matches that was
+ ;; a left-over from a previous turn.
+ ((assoc :entry line)
+ (let ((prop (cdr (assoc :entry line))))
+ (push (list :guesses t prop) guesses)))
+ ;; Normal case
+ ((assoc :assoc line)
+ (push (list* :guesses t
+ (mapcar #'cdr (cdr (assoc :assoc line))))
+ guesses))))))
+
+ (when *debug-old-sessions*
+ (format webserver:*stdout* "===== starting: ~A ~A~% guesses: ~A~%"
+ method params guesses))
+
+ ;; Detect first turn in an old session.
+ (unless (equal last-client-id client-id)
+ ;; flush state cache
+ (env-wrap
+ (setf session:*state-cache* nil))
+ (andes-database:set-old-session-start client-id)
+ (setf last-client-id client-id))
+
+ ;; Echo any text entered in Tutor pane text box.
+ (when (and (equal method "seek-help")
+ (equal (cdr (assoc :action params)) "get-help")
+ (assoc :text params))
+ (push-reply-to-replies `((:action . "echo-get-help-text")
+ (:text . ,(cdr (assoc :text params))))
+ solution-step-replies))
+
+ ;; Echo any solution step action
+ (when (equal method "solution-step")
+ ;; "checked" is supposed to be a json array.
+ ;; Need special handling in case it is empty.
+ (let ((checked (assoc :checked params)))
+ (when (and checked (null (cdr checked)))
+ ;; Hack for creating an empty array in json
+ (setf (cdr checked) (make-array '(0)))))
+ ;; Remove time from reply
+ (push-reply-to-replies (remove :time params :key #'car)
+ solution-step-replies))
+
+ (let ((reply
+ ;; If an old session turn produces an error, convert it
+ ;; into a warning and move on to the next turn.
+ ;; Otherwise old sessions with unfixed errors cannot
+ ;; be reopened.
+ ;; (handler-case
+ (apply
+ (cond
+ ((equal method "solution-step") #'solution-step)
+ ;; Help requests are sent to the help system to set
+ ;; the solution status and grading state.
+ ;; Alternatively, we could just send the solution
+ ;; steps to the help system state and then set
+ ;; the grading state by brute force.
+ ((equal method "seek-help") #'seek-help)
+ ((equal method "record-action") #'record-action))
+ ;; flatten the alist
+ (mapcan #'(lambda (x) (list (car x) (cdr x)))
+ (append params guesses)))
+ ;; (error (c) (old-errors-into-warnings c method params)))
+))
+ ;; solution-steps and help results are passed back to client
+ ;; to set up state on client.
+ (dolist (line (filter-reply reply))
+ (push-reply-to-replies line solution-step-replies))
+
+ (let* ((t1 (get-internal-run-time))
+ (tt1 (get-internal-real-time))
+ (dt (/ (float (- t1 t0))
+ (float internal-time-units-per-second)))
+ (dtt (/ (float (- tt1 tt0))
+ (float internal-time-units-per-second))))
+ (when *debug-old-sessions*
+ (format webserver:*stdout* " time: ~,3F(~,3F)s; net ~,3F(~,3F)s~@[~* ****~]~%"
+ dt dtt
+ (/ (float (- t1 tn))
+ (float internal-time-units-per-second))
+ (/ (float (- tt1 ttn))
+ (float internal-time-units-per-second))
+ (> dt 1)))))))
+
+ (reverse solution-step-replies))))
+
;; helper function to handle errors from old sessions
;; Turns errors into log-warn.
(defun old-errors-into-warnings (c method params)
- (warn 'log-condition:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'old-session-error method params
(type-of c) (webserver:get-any-log-tag c))
:text (format nil "Error from rerunning old sessions: ~A" c)))
@@ -673,6 +820,7 @@
(push line result))))
result))
+
(defun problem-times-english (problem)
"Return list of English sentences defining times."
(let ((times (problem-times problem)))
@@ -702,7 +850,8 @@
(webserver:defun-method "/help" solution-step
(&key time id action type mode x y checked
text width height radius symbol x-statement y-statement
- x-label y-label z-label angle cosphi)
+ x-label y-label z-label angle cosphi
+ guesses)
"problem-solving step"
;; fixed attributes: type style id
;; updatable attributes: mode x y text width height radius symbol
@@ -749,7 +898,10 @@
(not (equal type (StudentEntry-type old-entry))))
(warn "Attempting to change type from ~A to ~A"
(StudentEntry-type old-entry) type))
-
+
+ ;; In Andes2, a new entry was created each time. This
+ ;; unnecessary step should be removed. Bug #1958
+
;; create new object
(setf new-entry (make-StudentEntry :id id :type type :time time))
@@ -758,21 +910,21 @@
(update-entry-from-entry
new-entry old-entry
type mode style x y text width height radius symbol x-statement
- y-statement x-label y-label z-label angle cosphi checked prop))
+ y-statement x-label y-label z-label angle cosphi checked prop))
;; update new object from non-null variables
(update-entry-from-variables
new-entry
mode x y text width height radius symbol x-statement y-statement
- x-label y-label z-label angle cosphi checked)
+ x-label y-label z-label angle cosphi checked guesses)
(add-entry new-entry) ;remove existing info and update
-
+
;; For Modified help experiment.
;; Need a way to do this kind of stuff that is
;; "pluggable". Bug #1940
(random-help-experiment:set-current-object id)
-
+
(model-no-tutor-turn time) ;for model of doing step without help
(update-fades
@@ -785,7 +937,7 @@
;; For debugging only, should be turned off in production
((and webserver:*debug* (equal text "help-test-error")
(error "help-test-error response.")))
-
+
;; Look for text with leading punctuation. This indicates
;; a comment, which is not analyzed by the help system.
((and (> (length text) 0)
@@ -824,7 +976,7 @@
((equal (StudentEntry-type new-entry) "graphics")
(warn "Can't modify a graphic object, id=~A"
(studententry-id new-entry)))
-
+
((equal (StudentEntry-type new-entry) "circle")
(execute-andes-command time 'assert-object new-entry))
@@ -842,7 +994,7 @@
((equal (StudentEntry-type new-entry) "line")
(execute-andes-command time 'lookup-line new-entry))
-
+
((equal (StudentEntry-type new-entry) "button")
(execute-andes-command time 'lookup-mc-answer new-entry))
View
4 HelpStructs/StudentEntry.cl
@@ -42,6 +42,10 @@
x-label y-label z-label angle cosphi
checked ;for buttons
+ ;; Possible good matches, from previous sessions or turns.
+ ;; Can be systementry
+ guesses
+
;; State overlaps with mode (need to fix this).
State ;One of: correct, inefficient, dead-path, forbidden, incorrect.
Prop ;Entry proposition (Equalp to SystemEntry-prop, except for
View
23 LogProcessing/rerun/steps.php
@@ -46,6 +46,7 @@ function openTrace($url){
$ignoreMetaHints = false; // Ignore meta hints
$ignorePreferences = false; // Ignore any client preferences
$ignoreConsent = false; // Ignore any consent forms
+$ignoreOpenObjects = true; // Ignore object manipulations on open-problem.
$printDiffs = true; // Whether to print out results for server diffs
$jsonFile = 'replies.json'; // File name for dumping reply json
$badResponseFile = 'badResponses.txt'; // File name for dumping bad responses.
@@ -454,6 +455,14 @@ function doneButtonProblem ($p){
(strcmp($bc->action,"show-hint") == 0 ||
strcmp($bc->action,"show-hint-link") == 0)) ||
+ // Remove object manipulations from open-problem.
+ // In June 2012, consolidated objects in open-problem reply.
+ ($ignoreOpenObjects && strcmp($method,"open-problem")==0 &&
+ isset($bc->action) &&
+ (strcmp($bc->action,"new-object") == 0 ||
+ strcmp($bc->action,"modify-object") == 0 ||
+ strcmp($bc->action,"delete-object") == 0)) ||
+
// Remove Done button from some problems
// problems commit 6376f20fd808, Nov 19 2011
(strcmp($method,"open-problem")==0 &&
@@ -554,6 +563,14 @@ function doneButtonProblem ($p){
(strcmp($bc->action,"show-hint") == 0 ||
strcmp($bc->action,"show-hint-link") == 0)) ||
+ // Remove object manipulations from open-problem.
+ // In June 2012, consolidated objects in open-problem reply.
+ ($ignoreOpenObjects && strcmp($method,"open-problem")==0 &&
+ isset($bc->action) &&
+ (strcmp($bc->action,"new-object") == 0 ||
+ strcmp($bc->action,"modify-object") == 0 ||
+ strcmp($bc->action,"delete-object") == 0)) ||
+
// New turn has score.
($ignoreScores && isset($bc->action) &&
strcmp($bc->action,"set-score")==0) ||
@@ -801,6 +818,12 @@ function doneButtonProblem ($p){
strpos($nbbc,'EQUATION-SYNTAX-ERROR') !== false){
$i++; $ni++;
}elseif(strcmp($method,"solution-step") == 0 &&
+ // Add list of matches to DEFINITION-HAS-TOO-MANY-MATCHES
+ // June 2012
+ preg_match('/DEFINITION-HAS-TOO-MANY-MATCHES/',$bbc) != 0 &&
+ preg_match('/DEFINITION-HAS-TOO-MANY-MATCHES/',$nbbc) != 0){
+ $i++; $ni++;
+ }elseif(strcmp($method,"solution-step") == 0 &&
// Add test for creation of excess answer box.
// commit c9ca2cccd4f4b5685a4, Mon Nov 28 13:13:02 2011
// Escaping is different with single quotes? Just use wild card.
View
7 web-UI/andes/andes3.smd
@@ -184,8 +184,11 @@
"description": "cos(phi), default is zero"},
{"name": "checked", "type": "array", "items": "string",
"optional": true,
- "description": "for buttons"}
- ],
+ "description": "for buttons"},
+ {"name": "guesses", "type": "array", "items": "string",
+ "optional": true,
+ "description": "list of props for interpreting student entry."}
+ ],
"returns": {
"type": "array",
"items": {
Please sign in to comment.
Something went wrong with that request. Please try again.