CoCalc -- ess-bugs-d.el

²⁷⁰¹ views
1
;;; ess-bugs-d.el --- ESS[BUGS] dialect
2

3
;; Copyright (C) 2008-2011 Rodney Sparapani
4

5
;; Author: Rodney Sparapani
6
;; Created: 13 March 2008
7
;; Maintainer: ESS-help <[email protected]>
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
;; A copy of the GNU General Public License is available at
22
;; http://www.r-project.org/Licenses/
23

24
;;; Code:
25

26
(require 'ess-bugs-l)
27
(require 'ess-utils)
28
(require 'ess-inf)
29

30
(setq auto-mode-alist
31
      (append '(("\\.[bB][uU][gG]\\'" . ess-bugs-mode)) auto-mode-alist))
32

33
(defvar ess-bugs-command "OpenBUGS" "Default BUGS program in PATH.")
34
(make-local-variable 'ess-bugs-command)
35

36
(defvar ess-bugs-monitor '("") "Default list of variables to monitor.")
37
(make-local-variable 'ess-bugs-monitor)
38

39
(defvar ess-bugs-thin 1 "Default thinning parameter.")
40
(make-local-variable 'ess-bugs-thin)
41

42
(defvar ess-bugs-chains 1 "Default number of chains.")
43
(make-local-variable 'ess-bugs-chains)
44

45
(defvar ess-bugs-burnin 10000 "Default burn-in.")
46
(make-local-variable 'ess-bugs-burnin)
47

48
(defvar ess-bugs-update 10000 "Default number of updates after burnin.")
49
(make-local-variable 'ess-bugs-update)
50

51
(defvar ess-bugs-system nil "Default whether BUGS recognizes the system command.")
52

53
(defvar ess-bugs-font-lock-keywords
54
  (list
55
   ;; .bug files
56
   (cons "#.*\n"                        font-lock-comment-face)
57

58
   (cons "^[ \t]*\\(model\\|var\\)\\>"
59
         font-lock-keyword-face)
60

61
   (cons (concat "\\<d\\(bern\\|beta\\|bin\\|cat\\|chisq\\|"
62
                 "dexp\\|dirch\\|exp\\|\\(gen[.]\\)?gamma\\|hyper\\|"
63
                 "interval\\|lnorm\\|logis\\|mnorm\\|mt\\|multi\\|"
64
                 "negbin\\|norm\\(mix\\)?\\|par\\|pois\\|sum\\|t\\|"
65
                 "unif\\|weib\\|wish\\)[ \t\n]*(")
66
         font-lock-constant-face)
67

68
   (cons (concat "\\<\\(abs\\|cos\\|C\\|dim\\|\\(i\\)?cloglog\\|equals\\|"
69
                 "exp\\|for\\|inprod\\|interp[.]line\\|inverse\\|length\\|"
70
                 "\\(i\\)?logit\\|logdet\\|logfact\\|loggam\\|max\\|mean\\|"
71
                 "mexp\\|min\\|phi\\|pow\\|probit\\|prod\\|rank\\|round\\|"
72
                 "sd\\|sin\\|sort\\|sqrt\\|step\\|sum\\|t\\|trunc\\|T\\)[ \t\n]*(")
73
         font-lock-function-name-face)
74

75
   ;; .bmd files
76
   (cons (concat (regexp-opt '(
77
                               "dicClear" "dicSet" "dicStats"
78
                               "infoMemory" "infoModules" "infoNodeMethods"
79
                               "infoNodeTypes" "infoNodeValues"
80
                               "infoUpdatersbyDepth" "infoUpdatersbyName"
81
                               "modelCheck" "modelCompile" "modelData"
82
                               "modelDisable" "modelEnable" "modelGenInits"
83
                               "modelInits" "modelPrecision" "modelQuit"
84
                               "modelSaveState" "modelSetAP" "modelSetIts"
85
                               "modelSetOR" "modelSetRN" "modelUpdate"
86
                               "ranksClear" "ranksSet" "ranksStats"
87
                               "samplesAutoC" "samplesBgr" "samplesCoda"
88
                               "samplesDensity" "samplesHistory" "samplesSet"
89
                               "sampleStats" "samplesThin"
90
                               "summaryClear" "summarySet" "summaryStats"
91
                               ) 'words) "(")
92
         font-lock-function-name-face)
93

94
   (cons (concat (regexp-opt '("Local Variables" "End") 'words) ":")
95
         font-lock-keyword-face)
96
   )
97
  "ESS[BUGS]: Font lock keywords."
98
  )
99

100
(defun ess-bugs-switch-to-suffix (suffix &optional bugs-chains bugs-monitor bugs-thin
101
                                         bugs-burnin bugs-update)
102
  "ESS[BUGS]: Switch to file with suffix."
103
  (find-file (concat ess-bugs-file-dir ess-bugs-file-root suffix))
104

105
  (if (equal 0 (buffer-size)) (progn
106
                                (if (equal ".bug" suffix) (progn
107
                                        ;(insert "var ;\n")
108
                                                            (insert "model {\n")
109
                                                            (insert "    for (i in 1:N) {\n    \n")
110
                                                            (insert "    }\n")
111
                                                            (insert "}\n")
112
                                                            (insert "#Local Variables" ":\n")
113
                                        ;           (insert "#enable-local-variables: :all\n")
114
                                                            (insert "#ess-bugs-chains:1\n")
115
                                                            (insert "#ess-bugs-monitor:(\"\")\n")
116
                                                            (insert "#ess-bugs-thin:1\n")
117
                                                            (insert "#ess-bugs-burnin:10000\n")
118
                                                            (insert "#ess-bugs-update:10000\n")
119
                                                            (insert "#End:\n")
120
                                                            ))
121

122
                                (if (equal ".bmd" suffix) (let
123
                                                              ((ess-bugs-temp-chains "") (ess-bugs-temp-monitor "") (ess-bugs-temp-chain ""))
124

125
                                                            (if bugs-chains (setq ess-bugs-chains bugs-chains))
126
                                                            (if bugs-monitor (setq ess-bugs-monitor bugs-monitor))
127
                                                            (if bugs-thin (setq ess-bugs-thin bugs-thin))
128

129
                                                            (setq ess-bugs-temp-chains
130
                                                                  (concat "modelCompile(" (format "%d" ess-bugs-chains) ")\n"))
131

132
                                                            (setq bugs-chains ess-bugs-chains)
133

134
                                                            (while (< 0 bugs-chains)
135
                                                              (setq ess-bugs-temp-chains
136
                                                                    (concat ess-bugs-temp-chains
137
                                                                            "modelInits('" ess-bugs-file-root
138
                                                                            ".##" (format "%d" bugs-chains) "', "
139
                                                                            (format "%d" bugs-chains) ")\n"))
140
                                                              (setq bugs-chains (- bugs-chains 1)))
141

142
                                                            (setq ess-bugs-temp-monitor "")
143

144
                                                            (while (and (listp ess-bugs-monitor) (consp ess-bugs-monitor))
145
                                                              (if (not (string-equal "" (car ess-bugs-monitor)))
146
                                                                  (setq ess-bugs-temp-monitor
147
                                                                        (concat ess-bugs-temp-monitor "samplesSet('"
148
                                                                                (car ess-bugs-monitor)
149
                                        ;", thin(" (format "%d" ess-bugs-thin)
150
                                                                                "')\n")))
151
                                                              (setq ess-bugs-monitor (cdr ess-bugs-monitor)))
152

153
                                                            (insert "modelCheck('" ess-bugs-file-root ".bug')\n")
154
                                                            (insert "modelData('" ess-bugs-file-root ".bdt')\n")
155
                                                            (insert (ess-replace-in-string ess-bugs-temp-chains "##" "in"))
156
                                                            (insert "modelGenInits()\n")
157
                                                            (insert "modelUpdate(" (format "%d" bugs-burnin) ")\n")
158
                                        ;(insert "modelUpdate(" (format "%d" (* bugs-thin bugs-burnin)) ")\n")
159
                                                            (insert ess-bugs-temp-monitor)
160
                                                            (insert "modelUpdate(" (format "%d" (* bugs-thin bugs-update)) ")\n")
161
                                        ;           (insert (ess-replace-in-string
162
                                        ;               (ess-replace-in-string ess-bugs-temp-chains
163
                                        ;                   "modelCompile([0-9]+)" "#") "##" "to"))
164

165
                                                            (if (< 1 bugs-thin) (insert "samplesThin(" (format "%d" bugs-thin) ")\n"))
166

167
                                                            (insert "samplesCoda('*', '" ess-bugs-file-root "')\n")
168

169
                                        ;           (if ess-bugs-system (progn
170
                                        ;               (insert "system rm -f " ess-bugs-file-root ".ind\n")
171
                                        ;               (insert "system ln -s " ess-bugs-file-root "index.txt " ess-bugs-file-root ".ind\n")
172

173
                                        ;               (setq bugs-chains ess-bugs-chains)
174

175
                                        ;               (while (< 0 bugs-chains)
176
                                        ;                   (setq ess-bugs-temp-chain (format "%d" bugs-chains))
177

178
                                        ;                   ;.txt not recognized by BOA and impractical to over-ride
179
                                        ;                   (insert "system rm -f " ess-bugs-file-root ess-bugs-temp-chain ".out\n")
180
                                        ;                   (insert "system ln -s " ess-bugs-file-root "chain" ess-bugs-temp-chain ".txt "
181
                                        ;                       ess-bugs-file-root ess-bugs-temp-chain ".out\n")
182
                                        ;                   (setq bugs-chains (- bugs-chains 1)))))
183

184
                                                            (insert "modelQuit()\n")
185
                                                            (insert "Local Variables" ":\n")
186
                                        ;           (insert "enable-local-variables: :all\n")
187
                                                            (insert "ess-bugs-chains:" (format "%d" ess-bugs-chains) "\n")
188
                                                            (insert "ess-bugs-command:\"" ess-bugs-command "\"\n")
189
                                                            (insert "End:\n")
190
                                                            ))
191
                                ))
192
  )
193

194
(defun ess-bugs-na-bmd (bugs-command bugs-chains)
195
  "ESS[BUGS]: Perform the Next-Action for .bmd."
196
                                        ;(ess-save-and-set-local-variables)
197
  (if (equal 0 (buffer-size)) (ess-bugs-switch-to-suffix ".bmd")
198
                                        ;else
199
    (shell)
200
    (ess-sleep)
201

202
    (if (and (w32-shell-dos-semantics) (string-equal ":" (substring ess-bugs-file 1 2)))
203
        (insert (substring ess-bugs-file 0 2)))
204

205
    (comint-send-input)
206
    (insert "cd \"" ess-bugs-file-dir "\"")
207
    (comint-send-input)
208

209
                                        ;    (let ((ess-bugs-temp-chains ""))
210
                                        ;
211
                                        ;       (while (< 0 bugs-chains)
212
                                        ;           (setq ess-bugs-temp-chains
213
                                        ;               (concat (format "%d " bugs-chains) ess-bugs-temp-chains))
214
                                        ;           (setq bugs-chains (- bugs-chains 1)))
215

216
    ;; (insert "echo '"
217
    ;;       ess-bugs-batch-pre-command " " bugs-command " < "
218
    ;;       ess-bugs-file-root ".bmd > " ess-bugs-file-root ".bog 2>&1 "
219
    ;;       ess-bugs-batch-post-command "' > " ess-bugs-file-root ".bsh")
220
    ;; (comint-send-input)
221

222
    ;; (insert "at -f " ess-bugs-file-root ".bsh now")
223

224
    ;; (comint-send-input)
225

226
    (insert "echo '"
227
            ess-bugs-batch-pre-command " " bugs-command " < "
228
            ess-bugs-file-root ".bmd > " ess-bugs-file-root ".bog 2>&1 "
229
            ess-bugs-batch-post-command "' | at now")
230

231
    (comint-send-input)
232
    ))
233

234
(defun ess-bugs-na-bug ()
235
  "ESS[BUGS]: Perform Next-Action for .bug"
236

237
  (if (equal 0 (buffer-size)) (ess-bugs-switch-to-suffix ".bug")
238
                                        ;else
239
    (ess-save-and-set-local-variables)
240
    (ess-bugs-switch-to-suffix ".bmd"
241
                               ess-bugs-chains ess-bugs-monitor ess-bugs-thin ess-bugs-burnin ess-bugs-update))
242
  )
243

244
(defun ess-bugs-mode ()
245
  "ESS[BUGS]: Major mode for BUGS."
246
  (interactive)
247
  (kill-all-local-variables)
248
  (ess-setq-vars-local '((comment-start . "#")))
249
  (setq major-mode 'ess-bugs-mode)
250
  (setq mode-name "ESS[BUGS]")
251
  (use-local-map ess-bugs-mode-map)
252
  (setq font-lock-auto-fontify t)
253
  (make-local-variable 'font-lock-defaults)
254
  (setq font-lock-defaults '(ess-bugs-font-lock-keywords nil t))
255
  (setq ess-language "S") ; mimic S for ess-smart-underscore
256
  (run-hooks 'ess-bugs-mode-hook)
257

258
  (if (not (w32-shell-dos-semantics))
259
      (add-hook 'comint-output-filter-functions 'ess-bugs-exit-notify-sh))
260
  )
261

262
(setq features (delete 'ess-bugs-d features))
263
(provide 'ess-bugs-d)
264

265
;;; ess-bugs-d.el ends here
266

267
Product

Resources

Company
