266 lines
14 KiB
EmacsLisp
266 lines
14 KiB
EmacsLisp
|
;;; ess-bugs-d.el --- ESS[BUGS] dialect
|
||
|
|
||
|
;; Copyright (C) 2008-2011 Rodney Sparapani
|
||
|
|
||
|
;; Author: Rodney Sparapani
|
||
|
;; Created: 13 March 2008
|
||
|
;; Maintainer: ESS-help <ess-help@r-project.org>
|
||
|
|
||
|
;; This file is part of ESS
|
||
|
|
||
|
;; This file is free software; you can redistribute it and/or modify
|
||
|
;; it under the terms of the GNU General Public License as published by
|
||
|
;; the Free Software Foundation; either version 2, or (at your option)
|
||
|
;; any later version.
|
||
|
;;
|
||
|
;; This file 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 General Public License for more details.
|
||
|
;;
|
||
|
;; A copy of the GNU General Public License is available at
|
||
|
;; http://www.r-project.org/Licenses/
|
||
|
|
||
|
;;; Code:
|
||
|
|
||
|
(require 'ess-bugs-l)
|
||
|
(require 'ess-utils)
|
||
|
(require 'ess-inf)
|
||
|
|
||
|
(setq auto-mode-alist
|
||
|
(append '(("\\.[bB][uU][gG]\\'" . ess-bugs-mode)) auto-mode-alist))
|
||
|
|
||
|
(defvar ess-bugs-command "OpenBUGS" "Default BUGS program in PATH.")
|
||
|
(make-local-variable 'ess-bugs-command)
|
||
|
|
||
|
(defvar ess-bugs-monitor '("") "Default list of variables to monitor.")
|
||
|
(make-local-variable 'ess-bugs-monitor)
|
||
|
|
||
|
(defvar ess-bugs-thin 1 "Default thinning parameter.")
|
||
|
(make-local-variable 'ess-bugs-thin)
|
||
|
|
||
|
(defvar ess-bugs-chains 1 "Default number of chains.")
|
||
|
(make-local-variable 'ess-bugs-chains)
|
||
|
|
||
|
(defvar ess-bugs-burnin 10000 "Default burn-in.")
|
||
|
(make-local-variable 'ess-bugs-burnin)
|
||
|
|
||
|
(defvar ess-bugs-update 10000 "Default number of updates after burnin.")
|
||
|
(make-local-variable 'ess-bugs-update)
|
||
|
|
||
|
(defvar ess-bugs-system nil "Default whether BUGS recognizes the system command.")
|
||
|
|
||
|
(defvar ess-bugs-font-lock-keywords
|
||
|
(list
|
||
|
;; .bug files
|
||
|
(cons "#.*\n" font-lock-comment-face)
|
||
|
|
||
|
(cons "^[ \t]*\\(model\\|var\\)\\>"
|
||
|
font-lock-keyword-face)
|
||
|
|
||
|
(cons (concat "\\<d\\(bern\\|beta\\|bin\\|cat\\|chisq\\|"
|
||
|
"dexp\\|dirch\\|exp\\|\\(gen[.]\\)?gamma\\|hyper\\|"
|
||
|
"interval\\|lnorm\\|logis\\|mnorm\\|mt\\|multi\\|"
|
||
|
"negbin\\|norm\\(mix\\)?\\|par\\|pois\\|sum\\|t\\|"
|
||
|
"unif\\|weib\\|wish\\)[ \t\n]*(")
|
||
|
font-lock-constant-face)
|
||
|
|
||
|
(cons (concat "\\<\\(abs\\|cos\\|C\\|dim\\|\\(i\\)?cloglog\\|equals\\|"
|
||
|
"exp\\|for\\|inprod\\|interp[.]line\\|inverse\\|length\\|"
|
||
|
"\\(i\\)?logit\\|logdet\\|logfact\\|loggam\\|max\\|mean\\|"
|
||
|
"mexp\\|min\\|phi\\|pow\\|probit\\|prod\\|rank\\|round\\|"
|
||
|
"sd\\|sin\\|sort\\|sqrt\\|step\\|sum\\|t\\|trunc\\|T\\)[ \t\n]*(")
|
||
|
font-lock-function-name-face)
|
||
|
|
||
|
;; .bmd files
|
||
|
(cons (concat (regexp-opt '(
|
||
|
"dicClear" "dicSet" "dicStats"
|
||
|
"infoMemory" "infoModules" "infoNodeMethods"
|
||
|
"infoNodeTypes" "infoNodeValues"
|
||
|
"infoUpdatersbyDepth" "infoUpdatersbyName"
|
||
|
"modelCheck" "modelCompile" "modelData"
|
||
|
"modelDisable" "modelEnable" "modelGenInits"
|
||
|
"modelInits" "modelPrecision" "modelQuit"
|
||
|
"modelSaveState" "modelSetAP" "modelSetIts"
|
||
|
"modelSetOR" "modelSetRN" "modelUpdate"
|
||
|
"ranksClear" "ranksSet" "ranksStats"
|
||
|
"samplesAutoC" "samplesBgr" "samplesCoda"
|
||
|
"samplesDensity" "samplesHistory" "samplesSet"
|
||
|
"sampleStats" "samplesThin"
|
||
|
"summaryClear" "summarySet" "summaryStats"
|
||
|
) 'words) "(")
|
||
|
font-lock-function-name-face)
|
||
|
|
||
|
(cons (concat (regexp-opt '("Local Variables" "End") 'words) ":")
|
||
|
font-lock-keyword-face)
|
||
|
)
|
||
|
"ESS[BUGS]: Font lock keywords."
|
||
|
)
|
||
|
|
||
|
(defun ess-bugs-switch-to-suffix (suffix &optional bugs-chains bugs-monitor bugs-thin
|
||
|
bugs-burnin bugs-update)
|
||
|
"ESS[BUGS]: Switch to file with suffix."
|
||
|
(find-file (concat ess-bugs-file-dir ess-bugs-file-root suffix))
|
||
|
|
||
|
(if (equal 0 (buffer-size)) (progn
|
||
|
(if (equal ".bug" suffix) (progn
|
||
|
;(insert "var ;\n")
|
||
|
(insert "model {\n")
|
||
|
(insert " for (i in 1:N) {\n \n")
|
||
|
(insert " }\n")
|
||
|
(insert "}\n")
|
||
|
(insert "#Local Variables" ":\n")
|
||
|
; (insert "#enable-local-variables: :all\n")
|
||
|
(insert "#ess-bugs-chains:1\n")
|
||
|
(insert "#ess-bugs-monitor:(\"\")\n")
|
||
|
(insert "#ess-bugs-thin:1\n")
|
||
|
(insert "#ess-bugs-burnin:10000\n")
|
||
|
(insert "#ess-bugs-update:10000\n")
|
||
|
(insert "#End:\n")
|
||
|
))
|
||
|
|
||
|
(if (equal ".bmd" suffix) (let
|
||
|
((ess-bugs-temp-chains "") (ess-bugs-temp-monitor "") (ess-bugs-temp-chain ""))
|
||
|
|
||
|
(if bugs-chains (setq ess-bugs-chains bugs-chains))
|
||
|
(if bugs-monitor (setq ess-bugs-monitor bugs-monitor))
|
||
|
(if bugs-thin (setq ess-bugs-thin bugs-thin))
|
||
|
|
||
|
(setq ess-bugs-temp-chains
|
||
|
(concat "modelCompile(" (format "%d" ess-bugs-chains) ")\n"))
|
||
|
|
||
|
(setq bugs-chains ess-bugs-chains)
|
||
|
|
||
|
(while (< 0 bugs-chains)
|
||
|
(setq ess-bugs-temp-chains
|
||
|
(concat ess-bugs-temp-chains
|
||
|
"modelInits('" ess-bugs-file-root
|
||
|
".##" (format "%d" bugs-chains) "', "
|
||
|
(format "%d" bugs-chains) ")\n"))
|
||
|
(setq bugs-chains (- bugs-chains 1)))
|
||
|
|
||
|
(setq ess-bugs-temp-monitor "")
|
||
|
|
||
|
(while (and (listp ess-bugs-monitor) (consp ess-bugs-monitor))
|
||
|
(if (not (string-equal "" (car ess-bugs-monitor)))
|
||
|
(setq ess-bugs-temp-monitor
|
||
|
(concat ess-bugs-temp-monitor "samplesSet('"
|
||
|
(car ess-bugs-monitor)
|
||
|
;", thin(" (format "%d" ess-bugs-thin)
|
||
|
"')\n")))
|
||
|
(setq ess-bugs-monitor (cdr ess-bugs-monitor)))
|
||
|
|
||
|
(insert "modelCheck('" ess-bugs-file-root ".bug')\n")
|
||
|
(insert "modelData('" ess-bugs-file-root ".bdt')\n")
|
||
|
(insert (ess-replace-in-string ess-bugs-temp-chains "##" "in"))
|
||
|
(insert "modelGenInits()\n")
|
||
|
(insert "modelUpdate(" (format "%d" bugs-burnin) ")\n")
|
||
|
;(insert "modelUpdate(" (format "%d" (* bugs-thin bugs-burnin)) ")\n")
|
||
|
(insert ess-bugs-temp-monitor)
|
||
|
(insert "modelUpdate(" (format "%d" (* bugs-thin bugs-update)) ")\n")
|
||
|
; (insert (ess-replace-in-string
|
||
|
; (ess-replace-in-string ess-bugs-temp-chains
|
||
|
; "modelCompile([0-9]+)" "#") "##" "to"))
|
||
|
|
||
|
(if (< 1 bugs-thin) (insert "samplesThin(" (format "%d" bugs-thin) ")\n"))
|
||
|
|
||
|
(insert "samplesCoda('*', '" ess-bugs-file-root "')\n")
|
||
|
|
||
|
; (if ess-bugs-system (progn
|
||
|
; (insert "system rm -f " ess-bugs-file-root ".ind\n")
|
||
|
; (insert "system ln -s " ess-bugs-file-root "index.txt " ess-bugs-file-root ".ind\n")
|
||
|
|
||
|
; (setq bugs-chains ess-bugs-chains)
|
||
|
|
||
|
; (while (< 0 bugs-chains)
|
||
|
; (setq ess-bugs-temp-chain (format "%d" bugs-chains))
|
||
|
|
||
|
; ;.txt not recognized by BOA and impractical to over-ride
|
||
|
; (insert "system rm -f " ess-bugs-file-root ess-bugs-temp-chain ".out\n")
|
||
|
; (insert "system ln -s " ess-bugs-file-root "chain" ess-bugs-temp-chain ".txt "
|
||
|
; ess-bugs-file-root ess-bugs-temp-chain ".out\n")
|
||
|
; (setq bugs-chains (- bugs-chains 1)))))
|
||
|
|
||
|
(insert "modelQuit()\n")
|
||
|
(insert "Local Variables" ":\n")
|
||
|
; (insert "enable-local-variables: :all\n")
|
||
|
(insert "ess-bugs-chains:" (format "%d" ess-bugs-chains) "\n")
|
||
|
(insert "ess-bugs-command:\"" ess-bugs-command "\"\n")
|
||
|
(insert "End:\n")
|
||
|
))
|
||
|
))
|
||
|
)
|
||
|
|
||
|
(defun ess-bugs-na-bmd (bugs-command bugs-chains)
|
||
|
"ESS[BUGS]: Perform the Next-Action for .bmd."
|
||
|
;(ess-save-and-set-local-variables)
|
||
|
(if (equal 0 (buffer-size)) (ess-bugs-switch-to-suffix ".bmd")
|
||
|
;else
|
||
|
(shell)
|
||
|
(ess-sleep)
|
||
|
|
||
|
(if (and (w32-shell-dos-semantics) (string-equal ":" (substring ess-bugs-file 1 2)))
|
||
|
(insert (substring ess-bugs-file 0 2)))
|
||
|
|
||
|
(comint-send-input)
|
||
|
(insert "cd \"" ess-bugs-file-dir "\"")
|
||
|
(comint-send-input)
|
||
|
|
||
|
; (let ((ess-bugs-temp-chains ""))
|
||
|
;
|
||
|
; (while (< 0 bugs-chains)
|
||
|
; (setq ess-bugs-temp-chains
|
||
|
; (concat (format "%d " bugs-chains) ess-bugs-temp-chains))
|
||
|
; (setq bugs-chains (- bugs-chains 1)))
|
||
|
|
||
|
;; (insert "echo '"
|
||
|
;; ess-bugs-batch-pre-command " " bugs-command " < "
|
||
|
;; ess-bugs-file-root ".bmd > " ess-bugs-file-root ".bog 2>&1 "
|
||
|
;; ess-bugs-batch-post-command "' > " ess-bugs-file-root ".bsh")
|
||
|
;; (comint-send-input)
|
||
|
|
||
|
;; (insert "at -f " ess-bugs-file-root ".bsh now")
|
||
|
|
||
|
;; (comint-send-input)
|
||
|
|
||
|
(insert "echo '"
|
||
|
ess-bugs-batch-pre-command " " bugs-command " < "
|
||
|
ess-bugs-file-root ".bmd > " ess-bugs-file-root ".bog 2>&1 "
|
||
|
ess-bugs-batch-post-command "' | at now")
|
||
|
|
||
|
(comint-send-input)
|
||
|
))
|
||
|
|
||
|
(defun ess-bugs-na-bug ()
|
||
|
"ESS[BUGS]: Perform Next-Action for .bug"
|
||
|
|
||
|
(if (equal 0 (buffer-size)) (ess-bugs-switch-to-suffix ".bug")
|
||
|
;else
|
||
|
(ess-save-and-set-local-variables)
|
||
|
(ess-bugs-switch-to-suffix ".bmd"
|
||
|
ess-bugs-chains ess-bugs-monitor ess-bugs-thin ess-bugs-burnin ess-bugs-update))
|
||
|
)
|
||
|
|
||
|
(defun ess-bugs-mode ()
|
||
|
"ESS[BUGS]: Major mode for BUGS."
|
||
|
(interactive)
|
||
|
(kill-all-local-variables)
|
||
|
(ess-setq-vars-local '((comment-start . "#")))
|
||
|
(setq major-mode 'ess-bugs-mode)
|
||
|
(setq mode-name "ESS[BUGS]")
|
||
|
(use-local-map ess-bugs-mode-map)
|
||
|
(setq font-lock-auto-fontify t)
|
||
|
(make-local-variable 'font-lock-defaults)
|
||
|
(setq font-lock-defaults '(ess-bugs-font-lock-keywords nil t))
|
||
|
(setq ess-language "S") ; mimic S for ess-smart-underscore
|
||
|
(run-hooks 'ess-bugs-mode-hook)
|
||
|
|
||
|
(if (not (w32-shell-dos-semantics))
|
||
|
(add-hook 'comint-output-filter-functions 'ess-bugs-exit-notify-sh))
|
||
|
)
|
||
|
|
||
|
(setq features (delete 'ess-bugs-d features))
|
||
|
(provide 'ess-bugs-d)
|
||
|
|
||
|
;;; ess-bugs-d.el ends here
|