I have read other questions on the topic, but all of the models on those questions are far more complicated than mine and are not helping me find my answer (very new to JAGS).
When I run the following:
x <- c(1,0,4,1,4,2,5,3,0,3,1,2,2,4,1)
Data <- as.list(x=x, nx=length(x))
model <- function() {
## Likelihood
for (i in 1:nx) {
x[i] ~ dpois(mu[i])
}
## Prior
mu[i] ~ dexp(1)
}
fit <- jags(Data, param=c("mu"), model=model, n.chains=1, n.iter=10000,
n.burn=0, n.thin=1, DIC=FALSE)
I get the error:
Error in jags.model(model.file, data = data, inits = init.values, n.chains = n.chains, :
RUNTIME ERROR:
Compilation error on line 3.
Cannot evaluate upper index of counter i
Other solutions mention things being in the loops that shouldn't be in the loops, but I don't think I have any problems with my loop? I'm not sure. Thank you!
I believe your issue is that your data list isn't in the right format. Rather than use as.list just use list(). Also, like jbaums mentioned you need to move mu[i] inside the loop. Try this:
x <- c(1,0,4,1,4,2,5,3,0,3,1,2,2,4,1)
Data <- list(x=x, nx=length(x))
model <- function() {
## Likelihood
for (i in 1:nx) {
x[i] ~ dpois(mu[i])
## Prior
mu[i] ~ dexp(1)
}
}
fit <- jags(Data, param=c("mu"), model=model, n.chains=1, n.iter=10000,
n.burn=0, n.thin=1, DIC=FALSE)
Related
I have a df that is all numeric values. Columns 1:1028 are the predictors and columns 1029:1033 are the responses. Here is a subset of this:
PhHAL9G636300 PhHAL9G639600 PhHAL9G640000 PhHAL9G642000 PhHAL9G643800 PhHAL9G645300 PhHAL9G646100 PhHAL9G646600 PhHALJ003900 Biomass Growth WaterLoss
PENW3 5.365778 2.98025485 5.495861 4.405202465 2.9113147 2.5418600 2.09767062 2.52296664 1.9087030 0.46125981 -13.4226665 -0.37320470
PENW1 3.490321 4.64568874 3.717329 3.604487984 2.1293068 2.2661013 -1.47617955 -0.83020824 -1.4564567 4.61259811 -14.4985291 -1.41470618
CERD2 4.602228 1.83881344 4.474194 2.395140203 3.7523682 -0.2886215 -0.73070022 2.79344405 -0.7981627 -0.76634289 5.5581189 15.96563076
COCW2 4.614825 1.59769640 5.498260 0.006269791 1.9118368 4.2591423 3.73962184 2.53800230 2.5671915 -0.13178852 -25.7182390 -0.07377302
PENW2 2.874244 3.33668026 2.686314 3.640362110 3.3344128 1.5625493 -1.92483779 0.85800308 -1.8455277 -0.09584619 -15.5743917 -0.99376599
NIGD3 2.534445 1.86024236 3.028953 3.531425944 4.2376438 2.0732650 -0.46514048 0.79555084 -0.5451820 1.05436439 12.0221867 21.04783002
PEND2 5.362056 2.64328649 4.464727 3.452061385 3.8409665 -0.5227258 -0.06950176 2.05314895 -1.5741809 0.68405104 4.6766551 11.99731270
CERD3 6.379754 3.02126477 5.958883 2.617817128 3.2571087 0.6389388 -1.54158346 2.70402517 -1.5102857 -0.98235901 4.4562891 15.74806130
PEND3 5.530008 3.49150186 4.664897 4.122665811 3.4805644 1.6611925 1.00556471 2.13871970 -0.5366320 0.42174575 3.2075488 12.88432662
NIGW3 4.183288 5.26329612 5.928775 8.194201254 1.4188970 3.3488663 -0.24100014 1.17649150 -0.3305682 0.29951936 1.1783257 1.30187685
SORW2 6.893395 3.84929409 7.853042 0.700629044 1.2822700 3.7429352 2.73703304 3.38057924 2.5338634 0.02995194 -12.5004986 -5.77946530
BISD3 7.044496 2.75794859 3.816874 2.703812532 2.6916801 2.3260304 3.37232732 2.31685090 1.7024061 -1.02864818 -0.6121276 14.66858209
COCD2 5.393332 3.05175638 5.822644 2.200587922 2.2212163 2.4246024 3.13408898 2.07709126 2.1863062 -0.10286482 -2.4485105 7.86349310
BISW2 2.174211 2.62450842 5.128353 4.037738498 1.3183220 0.9764650 0.53499762 1.02802526 0.4124477 1.55750066 -25.8719336 -13.89189391
SORD3 6.154951 2.22626768 4.676438 0.489662530 1.1602737 1.6238320 3.90773303 3.34912476 3.7395865 0.11315130 0.2693362 17.67178436
COCW3 4.341137 4.05631371 5.292476 2.505723413 0.4784145 0.1552958 2.35139206 2.34302308 1.9836908 -1.03034659 -25.2571550 -1.06753902
CERW1 4.980878 0.91666130 2.190792 1.724122567 3.0002243 -0.9078029 -1.30732267 1.90047369 -1.3084019 -0.11381736 -10.3487734 -0.48603403
NIGW1 4.310666 5.24869379 6.482000 6.341412520 2.6579484 3.7324397 -0.69538644 1.39456781 -0.7667490 -0.07787503 1.9467990 -2.35639710
SORD2 3.439050 1.01743984 3.608031 1.984325521 0.9697594 1.9438491 2.75019240 3.59450372 3.0152745 -0.14915399 1.8118978 19.30355526
BISW3 4.995399 3.02559441 5.391413 0.707718031 -0.0867396 2.1041361 3.57258520 2.88651590 2.2532781 1.48561601 -26.3330176 -12.63775254
SORD1 4.867184 3.58269882 5.082423 0.847579020 1.1842905 3.2943452 3.54584508 2.26684212 3.2791237 -1.80013432 -3.0361530 18.53648347
NIGD2 3.433412 1.38880580 5.344590 6.113465129 1.3389915 0.9967764 0.55527371 1.04742251 0.4318620 1.16237244 10.5530804 20.06039943
SORW3 6.832991 3.48434777 7.954499 -0.373941722 0.9673997 3.8959556 2.87342668 3.53076025 2.5194703 1.12619278 -7.8896590 -6.45557334
PEND1 4.536131 1.98241616 2.469180 2.938093546 4.6266296 -0.3003059 -1.62573524 1.53755316 -1.5869045 0.49889437 3.3544594 12.90013295
CERW3 3.947328 1.97539246 4.499408 1.135578151 2.1385166 -0.2011640 -0.65101772 -0.06185877 -0.7272633 -0.04193271 -7.1211857 -1.98319240
NIGD1 1.517705 -0.02588437 2.040182 4.303738855 3.0117854 -0.9594330 -1.35627738 0.18988023 -1.3514038 0.88463744 8.0555996 20.38861318
COCW1 4.705918 2.51742179 4.476741 0.975394641 1.2854224 3.7611179 3.28623937 2.48855442 3.5451750 0.60502910 -26.9477962 0.97206804
BISD2 4.838736 3.99032517 7.239421 2.461942761 2.4587895 2.0971745 3.19578030 2.09829508 1.4836582 -1.10579679 -0.9059489 14.44078502
I am following the IPMRF package manual (pg 7):
#IMP based on CIT-RF (party package)
library(randomForestSRC)
library(party)
mtcars.new <- mtcars
ntree<-500
da<-mtcars.new[,3:10]
mc.cf <- cforest(carb+ mpg+ cyl ~., data = mtcars.new,
control = cforest_unbiased(mtry = 8, ntree = 500))
#IPM case-wise computing with OOB with party
pupf<-ipmparty(mc.cf ,da,ntree)
#global IPM
pua<-apply(pupf,2,mean)
pua
But I am switching mtcars for my dataset. However, when I run mine, I get all NaNs in the output and I can not figure out what is wrong with my code. So far I've checked if everything is numeric, if it's a limit in predictors (tried 10 rather than 1028), changed mtcars to have negative values to check that since mine has negative values, but none of these seem to be the problem. Granted, please double check me just in case. Here is my code that I am running with my dataset:
phallii.cf = cforest(Biomass + Growth + WaterLoss ~., data= RFTrainData, control=cforest_unbiased(mtry=33, ntree=1000)) #mtry = p/3
da = RFTrainData[,1:1028] #predictor variables only
ntree=1000
phallii.ipm = ipmparty(phallii.cf, da, ntree)
If anyone has any ideas I would greatly appreciate it!
I am running the following model using r2WinBUGS package from R.
model{
for (i in 1:Nshim) {
y.SHIM[i]~ dnorm(mu[i], tau)
mu[i] <- zeta[PID[i]]+beta0[T[PID[i]]]+beta1[T[PID[i]]]*TIME[i]+beta2[T[PID[i]]]*pow(TIME[i],2)
}
for ( k in 1:Mshim){
zeta[k]~dnorm(0, prec.zeta)
}
for ( j in 1:Mshim){
T[j]~ dcat(p[])
}
for ( k in 1:2){
beta0[k]~dnorm(0.0,1.0E-6)
beta1[k]~dnorm(0.0, 1.0E-6)
beta2[k]~dnorm(0.0, 1.0E-6)
}
prec.zeta~dgamma(0.1,0.01)
p[1:2]~ ddirch(alpha[])
alpha[1] <- 1
alpha[2] <- 1
tau~dgamma(0.1,0.1)
sig2<-1/tau
sig2.zeta<-1/prec.zeta
}
Considering the following initials for 3-chains.
init_2quad.SHIM_RI=function(){list(beta0=c(10,15),beta1=rnorm(2),beta2=rnorm(2),zeta=rgamma(70,1,1),T=rbinom(70,1,0.5)+1)
list(beta0=c(12,18),beta1=rnorm(2),beta2=rnorm(2),zeta=rgamma(70,1,1),T=rbinom(70,1,0.5)+1)
list(beta0=c(15,20),beta1=rnorm(2),beta2=rnorm(2),zeta=rgamma(70,1,1),T=rbinom(70,1,0.5)+1)
}
setwd("C:/Users/mnudd/Desktop/IndStudy/WinBUGS14")
mix_2quad.RI_res=bugs(data = SHIM_2quad,model.file = "mix_2Q_SHIM_RI.bug",
inits = init_2quad.SHIM_RI, parameters.to.save = c("beta0","beta1", "beta2", "zeta","T","sig2"),
n.chains = 3, n.iter = n.iter_2q.RI, n.burnin = n.burnin_2q.RI, n.thin = n.thin_2q.RI,
bugs.directory = "C:/Users/mnudd/Desktop/IndStudy/WinBUGS14",
debug=T,codaPkg=F)
Unfortunately each time I run, getting the following warning
this chain contains uninitialized variables
inits(3,C:/Users/mnudd/AppData/Local/Temp/RtmpWQM8aq/inits3.txt)
this chain contains uninitialized variables
gen.inits()
initial values generated, model initialized
thin.updater(10)
update(100)
set(beta0)
set(beta1)
set(beta2)
set(zeta)
set(T)
set(sig2)
set(deviance)
dic.set()
command #Bugs:dic.set cannot be executed (is greyed out)
update(1000)
coda(*,C:/Users/mnudd/AppData/Local/Temp/RtmpWQM8aq/coda)
How can identify which one is uninitialized and why the bugs can not be executed(grayed out)?
Any suggestion or help would be appreciated.
I've been trying to find a solution how to add and remove input fields with a button in shiny. I don't have a source code since I haven't made that much progress, but this jQuery example (http://www.mkyong.com/jquery/how-to-add-remove-textbox-dynamically-with-jquery/) gives a good idea on what I'm trying to accomplish. Is this possible in shiny or should I use shinyjs to do this? Thank you in advance!
EDIT: I read the jQuery example a bit more, and added a code snippet doing what I think you were looking for.
I don't know jQuery, so I couldn't make much out of the example link. I took a guess on what you wanted, but I think the key idea is the use of renderUI and uiOutput even if my suggestion here misses the point.
To toggle a ui element:
If you specifically don't want to use shinyjs, you could do something like this:
library(shiny)
ui <- shinyUI(fluidPage(
actionButton("btn", "Toggle Textbox"),
textOutput("btn_val"),
uiOutput("textbox_ui")
))
server <- shinyServer(function(input, output, session) {
output$btn_val <- renderPrint(print(input$btn))
textboxToggle <- reactive({
if (input$btn %% 2 == 1) {
textInput("textin", "Write something:", value = "Hello World!")
}
})
output$textbox_ui <- renderUI({ textboxToggle() })
})
shinyApp(ui, server)
To add and remove elements:
After reading a bit of the jQuery example, I think this is similar to what you were looking for:
library(shiny)
ui <- shinyUI(fluidPage(
sidebarPanel(
actionButton("add_btn", "Add Textbox"),
actionButton("rm_btn", "Remove Textbox"),
textOutput("counter")
),
mainPanel(uiOutput("textbox_ui"))
))
server <- shinyServer(function(input, output, session) {
# Track the number of input boxes to render
counter <- reactiveValues(n = 0)
observeEvent(input$add_btn, {counter$n <- counter$n + 1})
observeEvent(input$rm_btn, {
if (counter$n > 0) counter$n <- counter$n - 1
})
output$counter <- renderPrint(print(counter$n))
textboxes <- reactive({
n <- counter$n
if (n > 0) {
lapply(seq_len(n), function(i) {
textInput(inputId = paste0("textin", i),
label = paste0("Textbox", i), value = "Hello World!")
})
}
})
output$textbox_ui <- renderUI({ textboxes() })
})
shinyApp(ui, server)
The problem with this approach is that each time you press the add or remove button, all of the input boxes get re-rendered. This means that any input you might have had on them disappears.
I think you could get around that by also saving the current input values of the input boxes into a reactiveValues object, and setting the values from the object as the starting values of the re-rendered input boxes by using the value option in textInput. I'll leave the implementation of that for now, though.
Thank you #Mikko Marttila for your answer. I was able to use it for my purpose. Also, referring to the issue of all input boxes getting re-rendered here I found a solution worked from this answer. You can save all user inputs using reactiveValuesToList(), then call the reactive list accordingly to set every value to the corresponding user's input in the lapply() statement.
library(shiny)
ui <- shinyUI(fluidPage(
sidebarPanel(
actionButton("add_btn", "Add Textbox"),
actionButton("rm_btn", "Remove Textbox"),
textOutput("counter")
),
mainPanel(uiOutput("textbox_ui"))
))
server <- shinyServer(function(input, output, session) {
# Track the number of input boxes to render
counter <- reactiveValues(n = 0)
# Track all user inputs
AllInputs <- reactive({
x <- reactiveValuesToList(input)
})
observeEvent(input$add_btn, {counter$n <- counter$n + 1})
observeEvent(input$rm_btn, {
if (counter$n > 0) counter$n <- counter$n - 1
})
output$counter <- renderPrint(print(counter$n))
textboxes <- reactive({
n <- counter$n
if (n > 0) {
isolate({
lapply(seq_len(n), function(i) {
textInput(inputId = paste0("textin", i),
label = paste0("Textbox", i),
value = AllInputs()[[paste0("textin", i)]])
})
})
}
})
output$textbox_ui <- renderUI({ textboxes() })
})
shinyApp(ui, server)
EDIT: I wrapped the lapply() statement in isolate() because it gets annoying when boxes are being re-rendered as you're trying to type in the field
Instead of re-rendering the entire list of inputs, try the following
I keep track of all the ids that are created, I remove the last one created, and I reuse the ids of the deleted ones.
I start with an initial box (there is no real need for that, but I guess in a real work scenario you would expect at least 1 textBox to appear and increase thereafter). It is straightforward to start without the initial box.
Also, I keep track of the values of the textInput boxes that are currently active, in a reactive List. You would definitely need this
Lastly, I think for the two reactiveValues I have [inserted and counter], one of them is possibly redundant, but hey...
Hope it helps!
library(shiny)
ui <- fluidPage(
actionButton("insertBtn", "Insert"),
actionButton("deleteBtn", "Delete"),
h4("My boxes"),
# Initial box here to start with. Not needed but it is nice to have one :)
div(id = "box-1", textInput(inputId = "box-1", label = "box-1")),
div(id = "placeholder"),
h4('Box contents'),
verbatimTextOutput("my_inputs")
)
server <- function(input, output, session) {
## keep track of elements inserted and a counter of the elements
rv <- reactiveValues(
inserted = c("box-1"),
counter = 1
)
observeEvent(input$insertBtn, {
rv$counter <- rv$counter+1
serial <- rv$counter
id <- paste0('box-', serial)
rv$inserted <- c(rv$inserted, id)
insertUI(
selector = '#placeholder',
## wrap element in a div with id for ease of removal
ui = div(id = id,
textInput(inputId = id, label = paste0("box-", serial))
)
)
})
observeEvent(input$deleteBtn, {
req(rv$counter>0)
# removes the last one
id_to_remove <- rv$inserted[length(rv$inserted)]
removeUI(
## pass it in as JQuery selector
selector = paste0('#', id_to_remove)
)
rv$inserted <- rv$inserted[-length(rv$inserted)]
rv$counter <- rv$counter - 1
})
my_inputs <- reactive({
req(rv$inserted) # need to have some inputs
l <- reactiveValuesToList(input)
# regex of the union of all inputs. Note the starting input box-1
ids_regex <- paste(c("box-1", rv$inserted), collapse = "|")
l[grepl(ids_regex, names(l))]
})
output$my_inputs <- renderPrint({
my_inputs()
})
}
shinyApp(ui, server)
Many thanks to
this post
and this
and these SO posts one, two
I started playing with the idea of testing a webpage load time using R. I have devised a tiny R code to do so:
page.load.time <- function(theURL, N = 10, wait_time = 0.05)
{
require(RCurl)
require(XML)
TIME <- numeric(N)
for(i in seq_len(N))
{
Sys.sleep(wait_time)
TIME[i] <- system.time(webpage <- getURL(theURL, header=FALSE,
verbose=TRUE) )[3]
}
return(TIME)
}
And would welcome your help in several ways:
Is it possible to do the same, but to also know which parts of the page took what parts to load? (something like Yahoo's YSlow)
I sometime run into the following error -
Error in curlPerform(curl = curl,
.opts = opts, .encoding = .encoding) :
Failure when receiving data from the
peer Timing stopped at: 0.03 0 43.72
Any suggestions on what is causing this and how to catch such errors and discard them?
Can you think of ways to improve the above function?
Update: I redid the function. It is now painfully slow...
one.page.load.time <- function(theURL, HTML = T, JavaScript = T, Images = T, CSS = T)
{
require(RCurl)
require(XML)
TIME <- NULL
if(HTML) TIME["HTML"] <- system.time(doc <- htmlParse(theURL))[3]
if(JavaScript) {
theJS <- xpathSApply(doc, "//script/#src") # find all JavaScript files
TIME["JavaScript"] <- system.time(getBinaryURL(theJS))[3]
} else ( TIME["JavaScript"] <- NA)
if(Images) {
theIMG <- xpathSApply(doc, "//img/#src") # find all image files
TIME["Images"] <- system.time(getBinaryURL(theIMG))[3]
} else ( TIME["Images"] <- NA)
if(CSS) {
theCSS <- xpathSApply(doc, "//link/#href") # find all "link" types
ss_CSS <- str_detect(tolower(theCSS), ".css") # find the CSS in them
theCSS <- theCSS[ss_CSS]
TIME["CSS"] <- system.time(getBinaryURL(theCSS))[3]
} else ( TIME["CSS"] <- NA)
return(TIME)
}
page.load.time <- function(theURL, N = 3, wait_time = 0.05,...)
{
require(RCurl)
require(XML)
TIME <- vector(length = N, "list")
for(i in seq_len(N))
{
Sys.sleep(wait_time)
TIME[[i]] <- one.page.load.time(theURL,...)
}
require(plyr)
TIME <- data.frame(URL = theURL, ldply(TIME, function(x) {x}))
return(TIME)
}
a <- page.load.time("http://www.r-bloggers.com/", 2)
a
your getURL call will only do one request and get the source HTML for the web page. It won't get the CSS or Javascript or other elements. If this is what you mean by 'parts' of the web page then you'll have to scrape the source HTML for those parts (in SCRIPT tags, or css references etc) and getURL them separately with timing.
Perhaps Spidermonkey from Omegahat could work.
http://www.omegahat.org/SpiderMonkey/
Alright, so my title sucked. An example works better:
input = 'check yahoo.com'
I want to parse input, using the first word as the "command", and the rest of the string as a parameter. Here's the simple version of how my non-Pythonic mind is coding it:
if len(input) > 0:
a = input.split(' ')
if a[0] == 'check':
if len(a) > 1:
do_check(a[1])
elif a[0] == 'search':
if len(a) > 1:
do_search(a[1])
I like Python because it makes normally complicated things into rather simple things. I'm not too experienced with it, and I am fairly sure there's a much better way to do these things... some way more pythonic. I've seen some examples of people replacing switch statements with dicts and lambda functions, while other people simply recommended if..else nests.
dispatch = {
'check': do_check,
'search': do_search,
}
cmd, _, arg = input.partition(' ')
if cmd in dispatch:
dispatch[cmd](arg)
else:
do_default(cmd, arg)
I am fairly sure there's a much better way to do these things... some way more pythonic.
Not really. You code is simple, clear, obvious and English-like.
I've seen some examples of people replacing switch statements with dicts and lambda functions,
Yes, you've seen them and they're not clear, obvious or English-like. They exist because some people like to wring their hands over the switch statement.
while other people simply recommended if..else nests.
Correct. They work. They're simple, clear, ...
Your code is good. Leave it alone. Move on.
This lets you avoid giving each command name twice; function names are used almost directly as command names.
class CommandFunctions:
def c_check(self, arg):
print "checking", arg
def c_search(self, arg):
print "searching for", arg
def c_compare(self, arg1, arg2):
print "comparing", arg1, "with", arg2
def execute(self, line):
words = line.split(' ')
fn = getattr(self, 'c_' + words[0], None)
if fn is None:
import sys
sys.stderr.write('error: no such command "%s"\n' % words[0])
return
fn(*words[1:])
cf = CommandFunctions()
import sys
for line in sys.stdin:
cf.execute(line.strip())
If you're looking for a one liner 'pythonic' approach to this you can use this:
def do_check(x): print 'checking for:', x
def do_search(x): print 'searching for:', x
input = 'check yahoo.com'
{'check': do_check}.get(input.split()[0], do_search)(input.split()[1])
# checking for: yahoo.com
input = 'search google.com'
{'check': do_check}.get(input.split()[0], do_search)(input.split()[1])
# searching for: google.com
input = 'foo bar.com'
{'check': do_check}.get(input.split()[0], do_search)(input.split()[1])
# searching for: bar.com
Disregard, I just realized that my answer was similar to one of the other answers - and apparently there's no delete key :)
Variation on #MizardX's answer:
from collections import defaultdict
dispatch = defaultdict(do_default, check=do_check, search=do_search)
cmd, _, arg = input.partition(' ')
dispatch[cmd](arg)