lisp/essd-bugs.el

   1 ;;; essd-bugs.el -- ESS[BUGS] dialects
   2
   3 ;; Copyright (C) 2006 Rodney Sparapani
   4
   5 ;; Original Author: Rodney Sparapani <rsparapa@mcw.edu>
   6 ;; Created: 16 August 2006
   7 ;; Maintainers: ESS-help <ess-help@stat.math.ethz.ch>
   8
   9 ;; This file is part of ESS
  10
  11 ;; This file is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15 ;;
  16 ;; This file is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20 ;;
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24 ;;
  25 ;; In short: you may use this code any way you like, as long as you
  26 ;; don't charge money for it, remove this notice, or hold anyone liable
  27 ;; for its results.
  28
  29 ;; Code:
  30
  31 (require 'essl-bugs)
  32
  33 (setq auto-mode-alist
  34     (delete '("\\.[bB][uU][gG]\\'" . ess-jags-mode) auto-mode-alist))
  35
  36 (setq auto-mode-alist
  37     (append '(("\\.[bB][uU][gG]\\'" . ess-bugs-mode)) auto-mode-alist))
  38
  39 (defcustom ess-bugs-batch-version "0.6"
  40 "ESS[BUGS]: Major version of BUGS, i.e. 0.6 or 0.5"
  41     :group 'ess-bugs
  42     :type  'string
  43 )
  44
  45 (setq ess-bugs-batch-command
  46     (if (equal ess-bugs-batch-version "0.5") "backbug5" "backbugs"))
  47
  48 (defcustom ess-bugs-default-bins "32"
  49 "ESS[BUGS]: Number of bins for the Griddy algorithm (Metropolis sampling)."
  50     :group 'ess-bugs
  51     :type  'string
  52 )
  53
  54 (defcustom ess-bugs-default-checkpoint "100"
  55     "ESS[BUGS]: Make a snapshot every this many iterations."
  56     :group 'ess-bugs
  57     :type  'string
  58 )
  59
  60 (defvar ess-bugs-font-lock-keywords
  61     (list
  62         ;; .bug files
  63         (cons "#.*\n"                   font-lock-comment-face)
  64
  65         (cons "^[ \t]*\\(model\\|const\\|data\\|inits\\|var\\)\\>"
  66                                         font-lock-keyword-face)
  67
  68         (cons "\\<in[ \t]+[1-9]\\>"     font-lock-keyword-face)
  69
  70         (cons (concat "\\<d\\(bern\\|beta\\|bin\\|cat\\|chisqr\\|"
  71                 "dexp\\|dirch\\|exp\\|gamma\\|lnorm\\|logis\\|"
  72                 "mnorm\\|multi\\|negbin\\|norm\\|par\\|pois\\|"
  73                 "t\\|unif\\|weib\\|wish\\)[ \t\n]*(")
  74                                         font-lock-reference-face)
  75
  76         (cons (concat "\\<\\(for\\|cloglog\\|equals\\|exp\\|inprod\\|"
  77                 "inverse\\|log\\(det\\|fact\\|gam\\|it\\)?\\|max\\|"
  78                 "mean\\|min\\|phi\\|pow\\|probit\\|sd\\|sqrt\\|"
  79                 "step\\|sum\\|I\\)[ \t\n]*(")
  80                                         font-lock-function-name-face)
  81
  82         ;; .bmd files
  83         (cons (concat "\\<\\(clear\\|checkpoint\\|compile\\|data\\|"
  84                 "diag\\|help\\|inits\\|iter\\|model\\|monitor\\|"
  85                 "out\\|q\\|save\\|stats\\|update\\)[ \t\n]*(")
  86                                         font-lock-function-name-face)
  87     )
  88     "ESS[BUGS]: Font lock keywords."
  89 )
  90
  91 (defun ess-bugs-switch-to-suffix (suffix)
  92    "ESS: Switch to file with suffix."
  93    (find-file (concat ess-bugs-file-dir ess-bugs-file-root suffix))
  94
  95    (if (equal 0 (buffer-size)) (progn
  96         (if (equal ".bug" suffix) (progn
  97             (insert (concat "model %MODEL;\n"))
  98             (insert (concat "const N = 0;#%N\n"))
  99             (insert "var ;\n")
 100             (insert "#%MONITOR;\n")
 101             (insert "#%STATS;\n")
 102             (insert (concat "data  in \"%DATA\";\n"))
 103             (insert (concat "inits in \"%INITS\";\n"))
 104             (insert "{\n")
 105             (insert "    for (i in 1:N) {\n    \n")
 106             (insert "    }\n")
 107             (insert "}\n")
 108         ))
 109
 110         (if (equal ".bmd" suffix) (let
 111             ((tmp-bugs-file-dir (if (equal ess-bugs-batch-version "0.6") ess-bugs-file-dir)))
 112             (insert (concat "compile(\"" tmp-bugs-file-dir ess-bugs-file-root ".bug\")\n"))
 113             (insert (concat "save(\"" tmp-bugs-file-dir ess-bugs-file-root ".in0\")\n"))
 114             (insert (concat "update(" ess-bugs-default-burn-in ")\n"))
 115             (insert (concat "save(\"" tmp-bugs-file-dir ess-bugs-file-root ".in1\")\n"))
 116             (insert "#%MONITOR\n\n#%MONITOR\n")
 117             (if (equal ess-bugs-batch-version "0.6")
 118                 (insert (concat "checkpoint(" ess-bugs-default-checkpoint ")\n")))
 119             (insert (concat "update(" ess-bugs-default-update ")\n"))
 120             (insert (concat "save(\"" tmp-bugs-file-dir ess-bugs-file-root ".in2\")\n"))
 121             (insert "#%STATS\n\n#%STATS\n")
 122             (insert "q()\n")
 123             ;;(insert "q(\"" ess-bugs-file-dir ess-bugs-file-root ".bog\")\n")
 124         ))
 125     ))
 126 )
 127
 128 (defun ess-bugs-next-action ()
 129    "ESS[BUGS]: Perform the appropriate next action."
 130    (interactive)
 131    (ess-bugs-file)
 132
 133    (if (equal ".bug" ess-bugs-file-suffix) (ess-bugs-na-bug))
 134    ;;else
 135    (if (equal ".bmd" ess-bugs-file-suffix) (ess-bugs-na-bmd))
 136 )
 137
 138 (defun ess-bugs-na-bmd ()
 139     "ESS[BUGS]: Perform the Next-Action for .bmd."
 140
 141     (save-buffer)
 142     (shell)
 143
 144     (if (w32-shell-dos-semantics)
 145         (if (string-equal ":" (substring ess-bugs-file 1 2))
 146             (progn
 147                 (insert (substring ess-bugs-file 0 2))
 148                 (comint-send-input)
 149             )
 150         )
 151     )
 152
 153         (insert (concat "cd \"" ess-bugs-file-dir "\""))
 154         (comint-send-input)
 155
 156         (insert (concat ess-bugs-batch-pre-command " " ess-bugs-batch-command " "
 157             (if (equal ess-bugs-batch-version "0.6") ess-bugs-default-bins)
 158              " " ess-bugs-file-root " "
 159             (if (equal ess-bugs-batch-version "0.6")
 160                  ess-bugs-file (concat ess-bugs-file-root ".bmd"))
 161              " " ess-bugs-batch-post-command))
 162
 163         (comint-send-input)
 164 )
 165
 166 (defun ess-bugs-na-bug ()
 167     "ESS[BUGS]: Perform Next-Action for .bug"
 168
 169         (if (equal 0 (buffer-size)) (ess-bugs-switch-to-suffix ".bug")
 170             (save-excursion (let
 171                 ((tmp-bugs-file-dir (if (equal ess-bugs-batch-version "0.6") ess-bugs-file-dir)))
 172                 (goto-char (point-min))
 173
 174                 (if (search-forward "%MODEL" nil t)
 175                     (replace-match ess-bugs-file-root t t))
 176
 177                 (if (search-forward "%DATA" nil t) (progn
 178                     (setq ess-bugs-file-data
 179                         (concat tmp-bugs-file-dir ess-bugs-file-root ess-bugs-data-suffix))
 180                     (replace-match ess-bugs-file-data t t))
 181                 ;;else
 182                 (if (search-forward-regexp "data.+in[ \t\n]+\"\\(.*\\)\"" nil t)
 183                     (setq ess-bugs-file-data (match-string 1))
 184                 ;;else
 185                     (setq ess-bugs-file-data "...")
 186                 ))
 187
 188                 (if (search-forward "%INITS" nil t)
 189                     (replace-match
 190                         (concat tmp-bugs-file-dir ess-bugs-file-root ess-bugs-inits-suffix) t t))
 191
 192                 (let ((ess-bugs-temp-string " ")
 193                     (ess-bugs-buffer-ptr nil))
 194                     (goto-char (point-min))
 195
 196                     (if (search-forward-regexp
 197                             "N[ \t]*=[ \t]*[0-9]+[ \t]*;[ \t]*#[ \t]*%N" nil t) (progn
 198
 199                         (save-excursion (save-match-data
 200                             (setq ess-bugs-buffer-ptr (find-buffer-visiting ess-bugs-file-data))
 201
 202                             (if ess-bugs-buffer-ptr (set-buffer ess-bugs-buffer-ptr)
 203                                 (set-buffer (create-file-buffer ess-bugs-file-data))
 204                                 (insert-file-contents ess-bugs-file-data t))
 205
 206                             (setq ess-bugs-temp-string
 207                                 (concat "N = "
 208                                     (int-to-string (count-lines (point-min) (point-max))) ";#%N"))
 209                         ))
 210
 211                         (replace-match ess-bugs-temp-string t t)
 212                     ))
 213                 )
 214
 215                 (let (
 216                     (ess-bugs-search-min nil)
 217                     (ess-bugs-search-max nil)
 218                     (ess-bugs-search-vars
 219 "\\([a-zA-Z0-9.]+\\)\\(\\(\\[\\)[a-zA-Z0-9]*\\(,\\)?[a-zA-Z0-9]*\\(\\]\\)\\)?[ \t]*[,]?[ \t]*\\(#.*\\)?[\n]?"
 220                     ))
 221
 222                     (goto-char (point-min))
 223
 224                     (if (search-forward-regexp "%MONITOR[ \t]+" nil t)
 225                         (setq ess-bugs-search-min (point))
 226                     ;;else
 227                         (setq ess-bugs-search-min (search-forward "var"))
 228                     )
 229
 230                     (setq ess-bugs-search-max (search-forward-regexp ";"))
 231
 232                     (goto-char ess-bugs-search-min)
 233                     (setq ess-bugs-monitor-vars "")
 234
 235                     (while (search-forward-regexp ess-bugs-search-vars ess-bugs-search-max t)
 236
 237                         (setq ess-bugs-monitor-vars
 238                             (concat ess-bugs-monitor-vars "monitor("
 239                                 (match-string 1) (match-string 3) (match-string 4) (match-string 5) ")\n"))
 240                     )
 241
 242                     (setq ess-bugs-monitor-vars
 243                         (concat "#%MONITOR\n" ess-bugs-monitor-vars "#%MONITOR\n"))
 244
 245                     (goto-char (point-min))
 246
 247                     (if (search-forward-regexp "%STATS[ \t]+" nil t) (progn
 248                         (setq ess-bugs-search-min (point))
 249                         (setq ess-bugs-search-max (search-forward-regexp ";"))
 250
 251                         (goto-char ess-bugs-search-min)
 252                         (setq ess-bugs-stats-vars "")
 253
 254                         (while (search-forward-regexp ess-bugs-search-vars ess-bugs-search-max t)
 255
 256                             (setq ess-bugs-stats-vars
 257                                 (concat ess-bugs-stats-vars "stats("
 258                                     (match-string 1) (match-string 3) (match-string 4) (match-string 5) ")\n"))
 259                         )
 260
 261                         (setq ess-bugs-stats-vars (concat "#%STATS\n" ess-bugs-stats-vars "#%STATS\n"))
 262                     )
 263
 264                     ;;else
 265                     (setq ess-bugs-stats-vars ess-bugs-monitor-vars)
 266
 267                     (while (string-match "#%MONITOR" ess-bugs-stats-vars)
 268                         (setq ess-bugs-stats-vars
 269                             (replace-match "#%STATS" t t ess-bugs-stats-vars)))
 270
 271                     (while (string-match "monitor" ess-bugs-stats-vars)
 272                         (setq ess-bugs-stats-vars
 273                             (replace-match "stats" t t ess-bugs-stats-vars)))
 274
 275                     )
 276                 )
 277
 278             ))
 279
 280             (save-buffer)
 281             (ess-bugs-switch-to-suffix ".bmd")
 282
 283     (save-excursion
 284         (goto-char (point-min))
 285
 286         (if (search-forward-regexp "#%MONITOR\\(.\\|\n\\)*#%MONITOR\n" nil t)
 287             (replace-match ess-bugs-monitor-vars t))
 288
 289         (if (search-forward-regexp "#%STATS\\(.\\|\n\\)*#%STATS\n" nil t)
 290             (replace-match ess-bugs-stats-vars t))
 291     )
 292
 293         )
 294 )
 295
 296 (defun ess-bugs-mode ()
 297    "ESS[BUGS]: Major mode for Classic BUGS."
 298    (interactive)
 299    (kill-all-local-variables)
 300    (setq major-mode 'ess-bugs-mode)
 301    (setq mode-name "ESS[BUGS]")
 302    (use-local-map ess-bugs-mode-map)
 303    (setq font-lock-auto-fontify t)
 304    (make-local-variable 'font-lock-defaults)
 305    (setq font-lock-defaults '(ess-bugs-font-lock-keywords nil t))
 306    (run-hooks 'ess-bugs-mode-hook)
 307
 308    (if (not (w32-shell-dos-semantics))
 309         (add-hook 'comint-output-filter-functions 'ess-bugs-exit-notify-sh))
 310 )
 311
 312 (setq features (delete 'essd-jags features))
 313 (provide 'essd-bugs)