CoCalc -- ess-jags-d.el

²⁷⁰¹ views
1
;;; ess-jags-d.el --- ESS[JAGS] 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 '(("\\.[jJ][aA][gG]\\'" . ess-jags-mode)) auto-mode-alist))
32

33
(defvar ess-jags-command "jags" "Default JAGS program in PATH.")
34
(make-local-variable 'ess-jags-command)
35

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

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

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

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

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

51
(defvar ess-jags-system t "Default whether JAGS recognizes the system command.")
52

53
(defvar ess-jags-font-lock-keywords
54
  (list
55
   ;; .jag 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\\|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
   ;; .jmd files
76
   (cons (concat "\\<\\(adapt\\|cd\\|clear\\|coda\\|data\\|dir\\|"
77
                 "exit\\|in\\(itialize\\)?\\|load\\|model\\|monitors\\|parameters\\|"
78
                 "pwd\\|run\\|s\\(amplers\\|ystem\\)\\|to\\|update\\)[ \t\n]")
79
         font-lock-keyword-face)
80

81
   (cons "\\<\\(compile\\|monitor\\)[, \t\n]"
82
         font-lock-keyword-face)
83

84
   (cons "[, \t\n]\\(by\\|chain\\|nchains\\|stem\\|thin\\|type\\)[ \t\n]*("
85
         font-lock-function-name-face)
86
   )
87
  "ESS[JAGS]: Font lock keywords."
88
  )
89

90
(defun ess-jags-switch-to-suffix (suffix &optional jags-chains jags-monitor jags-thin
91
                                         jags-burnin jags-update)
92
  "ESS[JAGS]: 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 ".jag" suffix) (progn
97
                                                            (insert "var ;\n")
98
                                                            (insert "model {\n")
99
                                                            (insert "    for (i in 1:N) {\n    \n")
100
                                                            (insert "    }\n")
101
                                                            (insert "}\n")
102
                                                            (insert "#Local Variables" ":\n")
103
                                                            (insert "#ess-jags-chains:1\n")
104
                                                            (insert "#ess-jags-monitor:(\"\")\n")
105
                                                            (insert "#ess-jags-thin:1\n")
106
                                                            (insert "#ess-jags-burnin:10000\n")
107
                                                            (insert "#ess-jags-update:10000\n")
108
                                                            (insert "#End:\n")
109
                                                            ))
110

111
                                (if (equal ".jmd" suffix) (let
112
                                                              ((ess-jags-temp-chains "") (ess-jags-temp-monitor "") (ess-jags-temp-chain ""))
113

114
                                                            (if jags-chains (setq ess-jags-chains jags-chains))
115
                                                            (if jags-monitor (setq ess-jags-monitor jags-monitor))
116
                                                            (if jags-thin (setq ess-jags-thin jags-thin))
117

118
                                                            (setq ess-jags-temp-chains
119
                                                                  (concat "compile, nchains(" (format "%d" ess-jags-chains) ")\n"))
120

121
                                                            (setq jags-chains ess-jags-chains)
122

123
                                                            (while (< 0 jags-chains)
124
                                                              (setq ess-jags-temp-chains
125
                                                                    (concat ess-jags-temp-chains
126
                                                                            "parameters ## \"" ess-bugs-file-root
127
                                                                            ".##" (format "%d" jags-chains) "\", chain("
128
                                                                            (format "%d" jags-chains) ")\n"))
129
                                                              (setq jags-chains (- jags-chains 1)))
130

131
                                                            (setq ess-jags-temp-monitor "")
132

133
                                                            (while (and (listp ess-jags-monitor) (consp ess-jags-monitor))
134
                                                              (if (not (string-equal "" (car ess-jags-monitor)))
135
                                                                  (setq ess-jags-temp-monitor
136
                                                                        (concat ess-jags-temp-monitor "monitor "
137
                                                                                (car ess-jags-monitor) ", thin(" (format "%d" ess-jags-thin) ")\n")))
138
                                                              (setq ess-jags-monitor (cdr ess-jags-monitor)))
139

140
                                                            (insert "model in \"" ess-bugs-file-root ".jag\"\n")
141
                                                            (insert "data in \"" ess-bugs-file-root ".jdt\"\n")
142
                                                            (insert (ess-replace-in-string ess-jags-temp-chains "##" "in"))
143
                                                            (insert "initialize\n")
144
                                                            (insert "update " (format "%d" (* jags-thin jags-burnin)) "\n")
145
                                                            (insert ess-jags-temp-monitor)
146
                                                            (insert "update " (format "%d" (* jags-thin jags-update)) "\n")
147
                                                            (insert (ess-replace-in-string
148
                                                                     (ess-replace-in-string ess-jags-temp-chains
149
                                                                                            "compile, nchains([0-9]+)" "#") "##" "to"))
150
                                                            (insert "coda "
151
                                                                    (if ess-microsoft-p (if (w32-shell-dos-semantics) "*" "\\*") "\\*")
152
                                                                    ", stem(\"" ess-bugs-file-root "\")\n")
153

154
                                                            (if ess-jags-system (progn
155
                                                                                  (insert "system rm -f " ess-bugs-file-root ".ind\n")
156
                                                                                  (insert "system ln -s " ess-bugs-file-root "index.txt " ess-bugs-file-root ".ind\n")
157

158
                                                                                  (setq jags-chains ess-jags-chains)
159

160
                                                                                  (while (< 0 jags-chains)
161
                                                                                    (setq ess-jags-temp-chain (format "%d" jags-chains))
162

163
                                        ;.txt not recognized by BOA and impractical to over-ride
164
                                                                                    (insert "system rm -f " ess-bugs-file-root ess-jags-temp-chain ".out\n")
165
                                                                                    (insert "system ln -s " ess-bugs-file-root "chain" ess-jags-temp-chain ".txt "
166
                                                                                            ess-bugs-file-root ess-jags-temp-chain ".out\n")
167
                                                                                    (setq jags-chains (- jags-chains 1)))))
168

169
                                                            (insert "exit\n")
170
                                                            (insert "Local Variables" ":\n")
171
                                                            (insert "ess-jags-chains:" (format "%d" ess-jags-chains) "\n")
172
                                                            (insert "ess-jags-command:\"jags\"\n")
173
                                                            (insert "End:\n")
174
                                                            ))
175
                                ))
176
  )
177

178
(defun ess-jags-na-jmd (jags-command jags-chains)
179
  "ESS[JAGS]: Perform the Next-Action for .jmd."
180
                                        ;(ess-save-and-set-local-variables)
181
  (if (equal 0 (buffer-size)) (ess-jags-switch-to-suffix ".jmd")
182
                                        ;else
183
    (shell)
184
    (ess-sleep)
185

186
    (if (w32-shell-dos-semantics)
187
        (if (string-equal ":" (substring ess-bugs-file 1 2))
188
            (progn
189
              (insert (substring ess-bugs-file 0 2))
190
              (comint-send-input)
191
              )
192
          )
193
      )
194

195
    (insert "cd \"" ess-bugs-file-dir "\"")
196
    (comint-send-input)
197

198
                                        ;    (let ((ess-jags-temp-chains ""))
199
                                        ;
200
                                        ;       (while (< 0 jags-chains)
201
                                        ;           (setq ess-jags-temp-chains
202
                                        ;               (concat (format "%d " jags-chains) ess-jags-temp-chains))
203
                                        ;           (setq jags-chains (- jags-chains 1)))
204

205
    (insert ess-bugs-batch-pre-command " " jags-command " "
206
            ess-bugs-file-root ".jmd "
207

208
            (if (or (equal shell-file-name "/bin/csh")
209
                    (equal shell-file-name "/bin/tcsh")
210
                    (equal shell-file-name "/bin/zsh")
211
                    (equal shell-file-name "/bin/bash"))
212
                (concat ">& " ess-bugs-file-root ".jog ")
213
                                        ;else
214
              "> " ess-bugs-file-root ".jog 2>&1 ")
215

216
                                        ;               ;.txt not recognized by BOA and impractical to over-ride
217
                                        ;               "&& (rm -f " ess-bugs-file-root ".ind; "
218
                                        ;               "ln -s " ess-bugs-file-root "index.txt " ess-bugs-file-root ".ind; "
219
                                        ;               "for i in " ess-jags-temp-chains "; do; "
220
                                        ;               "rm -f " ess-bugs-file-root "$i.out; "
221
                                        ;               "ln -s " ess-bugs-file-root "chain$i.txt " ess-bugs-file-root "$i.out; done) "
222

223
            ess-bugs-batch-post-command)
224

225
    (comint-send-input)
226
    ))
227

228
(defun ess-jags-na-bug ()
229
  "ESS[JAGS]: Perform Next-Action for .jag"
230

231
  (if (equal 0 (buffer-size)) (ess-jags-switch-to-suffix ".jag")
232
                                        ;else
233
    (ess-save-and-set-local-variables)
234
    (ess-jags-switch-to-suffix ".jmd"
235
                               ess-jags-chains ess-jags-monitor ess-jags-thin ess-jags-burnin ess-jags-update))
236
  )
237

238
(defun ess-jags-mode ()
239
  "ESS[JAGS]: Major mode for JAGS."
240
  (interactive)
241
  (kill-all-local-variables)
242
  (ess-setq-vars-local '((comment-start . "#")))
243
  (setq major-mode 'ess-jags-mode)
244
  (setq mode-name "ESS[JAGS]")
245
  (use-local-map ess-bugs-mode-map)
246
  (setq font-lock-auto-fontify t)
247
  (make-local-variable 'font-lock-defaults)
248
  (setq font-lock-defaults '(ess-jags-font-lock-keywords nil t))
249
  (setq ess-language "S") ; mimic S for ess-smart-underscore
250
  (run-hooks 'ess-bugs-mode-hook)
251

252
  (if (not (w32-shell-dos-semantics))
253
      (add-hook 'comint-output-filter-functions 'ess-bugs-exit-notify-sh))
254
  )
255

256
(setq features (delete 'ess-bugs-d features))
257
(provide 'ess-jags-d)
258

259
;;; ess-jags-d.el ends here
260

261
Product

Resources

Company
