<commit_before>;;; This file is part of little b.

;;;; The MIT License

;;;; Copyright (c) 2007 <NAME>

;;;; Permission is hereby granted, free of charge, to any person obtaining a copy
;;;; of this software and associated documentation files (the "Software"), to deal
;;;; in the Software without restriction, including without limitation the rights
;;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;;;; copies of the Software, and to permit persons to whom the Software is
;;;; furnished to do so, subject to the following conditions:

;;;; The above copyright notice and this permission notice shall be included in
;;;; all copies or substantial portions of the Software.

;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
;;;; THE SOFTWARE.


;;; File: b/matlab:ode-translation
;;; Description: 


(in-package #I@FILE)

(include-declaration :expose-symbols (create-numerica-model)
                     :use-packages (mallavar-utility portable))                     

(include (@LIBRARY/math
          @LIBRARY/units/dimensionalization 
          @LIBRARY/math/ode-var))



(include-documentation 
  :description "Provides capability for translating little b temporal/reference/derived-vars to Numerica integration code."
  :organization "Harvard Medical School"
  :authors ("<NAME>"))

(define-var *numerica-model* ())
(defvar  *numerica-rate-string-max-length* 2000
  "Part of a horrendous kludge to deal with a numerica bug")

(define-function create-numerica-model (name &key 
                                        (vars (progn (format t "~&; Collecting variables...~%") (query ode-var)))
                                        (ode-comments t)
                                        (display-vars t)
                                        (overwrite :query)
                                        (abstol nil) 
                                        (reltol nil)
                                        (gauss-value :mean) ; may be mean or random
                                        (base-units (compute-default-base-units-from-vars vars)))
  (format t "~&; Creating Numerica model...~%")
  (let+ ((*print-pretty*          nil)
         ((name path)             (parse-model-name name))
         (nm                      (make-numerica-model name
                                                       :path path
                                                       :ode-vars vars
                                                       :ode-comments-p ode-comments
                                                       :reltol reltol
                                                       :abstol abstol
                                                       :gauss-value gauss-value
                                                       :display-vars (order-vars (if (eq t display-vars) vars
                                                                                   display-vars))
                                                       :base-units  base-units))
         (pathname                (numerica-file-path (numerica-model-name nm) path)))

        (when (ok-to-overwrite overwrite pathname)
          (unless vars
            (warn "*** No ode vars selected ***~%"))
          (format t "~&; Computing Numerica code...~%")
          (with-open-file (stream pathname :direction :output :if-does-not-exist :create :if-exists :supersede)
            (let ((*math-print-function*   (compute-numerica-math-print-function nm)))
              (write-numerica-code nm stream))))
        (setf *numerica-model* nm)))


;;;; (defun refresh-parameters (&optional (model *model*))
;;;;   "Rewrites the parameters/initial conditions of a model (default is *model*) to the model's initfile."  
;;;;   (let* ((name (numerica-model-init-script-name model))
;;;;          (path (numerica-model-path model))
;;;;          (init-path (numerica-file-path name path)))
;;;;     (with-open-file (file init-path :direction :output)
;;;;       (write-init-script file model))
;;;;     (format t "New parameters file (~A.~A) written to ~A."
;;;;             (pathname-name init-path)
;;;;             (pathname-type init-path)
;;;;             path)))

(defun make-safe-file-name (o)
  (substitute-if-not #\_ #'alphanumericp
                     (string-downcase o)))

(defun numerica-file-path (name path)
  (if (streamp path) path  ; a little hack to allow redirection of output from files to a single stream
    (normalize-pathname (merge-pathnames (mkstr name ".jac") path))))

(defun compute-indicies (varlist &optional (model *model*))
  (assert model (model)
    "No current model.  Please provide a model name.")
  (with-print-context t
    (format t "~&~A({'~A'~{,'~A'~}})"
            (numerica-model-var-indicies-name model)
            (first varlist) (rest varlist))))

(defun order-vars (vars)
  (format t "~&; Sorting variables...~%")
  (sort (copy-list vars)  ; must copy the list! Allegro destructively modifies the input list (removing elements!!!)
        #'string<
        :key (lambda (o) 
               (format nil "~(~A~)" o))))

(defun query-time-vars (&key prefer (base-set (query ode-var)))
  (compute-ode-vars base-set prefer))

(defun write-numerica-code (nm file)
  (write-declare-block nm file)
  (write-model-block nm file)
  (write-simulation-block nm file)
  
  (format t "~&; The following file has been written: ~A~%"
          (enough-namestring file)))

;;;
;;; helper functions which write numerica code to a stream:
;;;

(defun write-declare-block (nm file)
  (declare (ignore nm))
  (format file "DECLARE~%~
                ~2TTYPE~%~
                ~4TConcentration = 1 : -1e-6 : 1E20~%~
                END~%"))

(defun split-rate-string-equally (str &optional (max-char-size *numerica-rate-string-max-length*))
  (let ((term-breaks (sort (nconc (positions #\+ str)
                                  (positions #\- str))
                           #'<)))
    (loop with cur-start-pos = 0
          for last-term-pos = 0 then term-pos
          for term-pos in term-breaks
          for expr-len = (- term-pos cur-start-pos)
          when (> expr-len max-char-size)
          collect (subseq str cur-start-pos last-term-pos) into parts
          and do (setf cur-start-pos last-term-pos)
          finally 
          (setf parts (nconc parts (if (> last-term-pos cur-start-pos)
                                       (list (subseq str cur-start-pos last-term-pos)))))
          (return parts))))
          
(defun write-model-block (nm file)
  (let* ((ode-vars  (numerica-model-ode-vars nm))
         (allvars (query var))
         (klen-pos  nil))
    (labels ((rate-str-without-outer-parens (rate)
               (let ((rate-str (format nil "~S" rate)))
                 (with-dimensionless-math (numerica-model-base-units nm)
                   (if (char= (char rate-str 0) #\()
                       (subseq rate-str
                               1 (1- (length rate-str)))
                     rate-str))))
             (write-ode-fn (i rate)
               (let ((rate-strs (split-rate-string-equally (rate-str-without-outer-parens rate))))                  
                 (princ #\.)
                 (cond
                  ((> (length rate-strs) 1)
                   (loop for rate-str in rate-strs
                         for p = 1 then (1+ p)
                         do (format file "~%~4Tpart~S := ~A;" p rate-str)
                         collect p into parts
                         finally (format file "~%~4T$c(~S) = ~{part~S~^+~};" i parts)))
                  (t (format file "~%~4T$c(~S) = ~A;" i (first rate-strs)))))))

    (format t "~&; Writing model block")
    (format file "MODEL ~A~%~
                  ~2TPARAMETER~%~
                    ~4Tk as ARRAY("
            (numerica-model-model-name nm))

    ;; store the location of the k array length so we can set it later...
    (setf klen-pos (file-position file))

    (format file "~A) OF REAL~%~
                  ~2TVARIABLE~%~
                    ~4Tc as ARRAY(~S) of Concentration~%~
                  ~2TEQUATION"
            (map 'string (constantly #\space) (format nil "~A" (length allvars)))
            (length ode-vars))

    ;; write the rate fns:
    (loop for v in ode-vars
          for i = 1 then (1+ i)
          for rate = (compute-ode-expression (nth (1- i) (numerica-model-ode-rates nm)) nm)
          do  (with-print-context t 
                (princ #\.)
                ;; write comment
                (if (numerica-model-ode-comments-p nm)
                    (b-format file "~%~4T# ~A = ~A " v rate))
                ;; write eqn
                (write-ode-fn i rate)))

    ;; now, we've determine the actual # kvars ...
    ;; go back and scribble at klen-pos
    (let ((end (file-position file)))
      (file-position file klen-pos)
      (princ (numerica-model-kvar-count nm) file)
      (file-position file end))
    (format file "~%END~%~%"))))

<commit_msg>"partn := ..." is now in INTERMEDIATE section<commit_after>;;; This file is part of little b.

;;;; The MIT License

;;;; Copyright (c) 2007 <NAME>

;;;; Permission is hereby granted, free of charge, to any person obtaining a copy
;;;; of this software and associated documentation files (the "Software"), to deal
;;;; in the Software without restriction, including without limitation the rights
;;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;;;; copies of the Software, and to permit persons to whom the Software is
;;;; furnished to do so, subject to the following conditions:

;;;; The above copyright notice and this permission notice shall be included in
;;;; all copies or substantial portions of the Software.

;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
;;;; THE SOFTWARE.


;;; File: b/matlab:ode-translation
;;; Description: 


(in-package #I@FILE)

(include-declaration :expose-symbols (create-numerica-model)
                     :use-packages (mallavar-utility portable))                     

(include (@LIBRARY/math
          @LIBRARY/units/dimensionalization 
          @LIBRARY/math/ode-var))



(include-documentation 
  :description "Provides capability for translating little b temporal/reference/derived-vars to Numerica integration code."
  :organization "Harvard Medical School"
  :authors ("<NAME>"))

(define-var *numerica-model* ())
(defvar  *numerica-rate-string-max-length* 2000
  "Part of a horrendous kludge to deal with a numerica bug")

(define-function create-numerica-model (name &key 
                                        (vars (progn (format t "~&; Collecting variables...~%") (query ode-var)))
                                        (ode-comments nil)
                                        (display-vars t)
                                        (overwrite :query)
                                        (abstol nil) 
                                        (reltol nil)
                                        (gauss-value :mean) ; may be mean or random
                                        (base-units (compute-default-base-units-from-vars vars)))
  (format t "~&; Creating Numerica model...~%")
  (let+ ((*print-pretty*          nil)
         ((name path)             (parse-model-name name))
         (nm                      (make-numerica-model name
                                                       :path path
                                                       :ode-vars vars
                                                       :ode-comments-p ode-comments
                                                       :reltol reltol
                                                       :abstol abstol
                                                       :gauss-value gauss-value
                                                       :display-vars (order-vars (if (eq t display-vars) vars
                                                                                   display-vars))
                                                       :base-units  base-units))
         (pathname                (numerica-file-path (numerica-model-name nm) path)))

        (when (ok-to-overwrite overwrite pathname)
          (unless vars
            (warn "*** No ode vars selected ***~%"))
          (format t "~&; Computing Numerica code...~%")
          (with-open-file (stream pathname :direction :output :if-does-not-exist :create :if-exists :supersede)
            (let ((*math-print-function*   (compute-numerica-math-print-function nm)))
              (write-numerica-code nm stream))))
        (setf *numerica-model* nm)))


;;;; (defun refresh-parameters (&optional (model *model*))
;;;;   "Rewrites the parameters/initial conditions of a model (default is *model*) to the model's initfile."  
;;;;   (let* ((name (numerica-model-init-script-name model))
;;;;          (path (numerica-model-path model))
;;;;          (init-path (numerica-file-path name path)))
;;;;     (with-open-file (file init-path :direction :output)
;;;;       (write-init-script file model))
;;;;     (format t "New parameters file (~A.~A) written to ~A."
;;;;             (pathname-name init-path)
;;;;             (pathname-type init-path)
;;;;             path)))

(defun make-safe-file-name (o)
  (substitute-if-not #\_ #'alphanumericp
                     (string-downcase o)))

(defun numerica-file-path (name path)
  (if (streamp path) path  ; a little hack to allow redirection of output from files to a single stream
    (normalize-pathname (merge-pathnames (mkstr name ".jac") path))))

(defun compute-indicies (varlist &optional (model *model*))
  (assert model (model)
    "No current model.  Please provide a model name.")
  (with-print-context t
    (format t "~&~A({'~A'~{,'~A'~}})"
            (numerica-model-var-indicies-name model)
            (first varlist) (rest varlist))))

(defun order-vars (vars)
  (format t "~&; Sorting variables...~%")
  (sort (copy-list vars)  ; must copy the list! Allegro destructively modifies the input list (removing elements!!!)
        #'string<
        :key (lambda (o) 
               (format nil "~(~A~)" o))))

(defun query-time-vars (&key prefer (base-set (query ode-var)))
  (compute-ode-vars base-set prefer))

(defun write-numerica-code (nm file)
  (write-declare-block nm file)
  (write-model-block nm file)
  (write-simulation-block nm file)
  
  (format t "~&; The following file has been written: ~A~%"
          (enough-namestring file)))

;;;
;;; helper functions which write numerica code to a stream:
;;;

(defun write-declare-block (nm file)
  (declare (ignore nm))
  (format file "DECLARE~%~
                ~2TTYPE~%~
                ~4TConcentration = 1 : -1e-6 : 1E20~%~
                END~%"))

(defun split-rate-string-equally (str &optional (max-char-size *numerica-rate-string-max-length*))
  (let ((term-breaks (sort (nconc (positions #\+ str)
                                  (positions #\- str))
                           #'<)))
    (loop with cur-start-pos = 0
          for last-term-pos = 0 then term-pos
          for term-pos in term-breaks
          for expr-len = (- term-pos cur-start-pos)
          when (> expr-len max-char-size)
          collect (subseq str cur-start-pos last-term-pos) into parts
          and do (setf cur-start-pos last-term-pos)
          finally 
          (setf parts (nconc parts (if (> last-term-pos cur-start-pos)
                                       (list (subseq str cur-start-pos last-term-pos)))))
          (return parts))))
          
(defun write-model-block (nm file)
  (let* ((ode-vars  (numerica-model-ode-vars nm))
         (allvars   (query var))
         (klen-pos  nil)
         (npart     0))
    (labels ((rate-str-without-outer-parens (rate)
               (let ((rate-str (format nil "~S" rate)))
                 (with-dimensionless-math (numerica-model-base-units nm)
                   (if (char= (char rate-str 0) #\()
                       (subseq rate-str
                               1 (1- (length rate-str)))
                     rate-str))))
             (compute-and-write-parts (rate)
               (let ((rate-strs (split-rate-string-equally (rate-str-without-outer-parens rate))))                  
                 (princ #\.)
                 (loop for rate-str in rate-strs
                       for p = (incf npart)
                       collect p into parts
                       do (format file "~%~4Tpart~S := ~A;" p rate-str)
                       finally (return parts)))))

    (format t "~&; Writing model block")
    (format file "MODEL ~A~%~
                  ~2TPARAMETER~%~
                    ~4Tk as ARRAY("
            (numerica-model-model-name nm))

    ;; store the location of the k array length so we can set it later...
    (setf klen-pos (file-position file))

    (format file "~A) OF REAL~%~
                  ~2TVARIABLE~%~
                    ~4Tc as ARRAY(~S) of Concentration~%~
                  ~2TINTERMEDIATE~%"
            (map 'string (constantly #\space) (format nil "~A" (length allvars)))
            (length ode-vars))

    ;; write the rate fns:
    (loop for v in ode-vars
          for i =  0 then (1+ i)
          for rate = (compute-ode-expression (nth i (numerica-model-ode-rates nm)) nm)
          do  (with-print-context t 
                (princ #\.)
                ;; write comment
                (if (numerica-model-ode-comments-p nm)
                    (b-format file "~%~4T# ~A = ~A " v rate)))
          collect
                ;; write parts
                (compute-and-write-parts rate) into eqns
          finally 
          (format file "~%~2TEQUATION~%")
          (loop for eqn in eqns
                for e = 1 then (1+ e)
                do (format file "~%~4T$c(~A) = ~{part~A~^+~};"
                           e eqn)))

    ;; now, we've determine the actual # kvars ...
    ;; go back and scribble at klen-pos
    (let ((end (file-position file)))
      (file-position file klen-pos)
      (princ (numerica-model-kvar-count nm) file)
      (file-position file end))
    (format file "~%END~%~%"))))


{'fraction_non_alphanumeric': 0.12752138557397824, 'fraction_numerical': 0.0037490759319885945, 'mean_word_length': 1.6955593509820666, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 12, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 63, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1071458', 'n_tokens_mistral': 5490, 'n_tokens_neox': 5105, 'n_words': 1647}