Nothing
.womSetupDiagnosticsComboBox<-function()
{
itersSpace = theWidget('diagnosticItersComboSpace')
typeSpace = theWidget('diagnosticTypeComboSpace')
StateEnv$itersCombo = gtkComboBoxNewText()
StateEnv$typeCombo = gtkComboBoxNewText()
gtkComboBoxAppendText(StateEnv$itersCombo, "All")
gtkComboBoxAppendText(StateEnv$typeCombo, "effects")
itersSpace$packStart(StateEnv$itersCombo,FALSE,FALSE,0)
typeSpace$packStart(StateEnv$typeCombo,FALSE,FALSE,0)
gtkComboBoxSetActive(StateEnv$itersCombo,0)
gtkComboBoxSetActive(StateEnv$typeCombo,0)
#Connect chain limit signal
StateEnv$handlers$diagnosticLimitCombo <- gSignalConnect(StateEnv$itersCombo, "changed", .selected_number_chain_iterations)
# Connect parameter type signal
StateEnv$handlers$diagnosticTypeCombo <- gSignalConnect(StateEnv$typeCombo, "changed", .selected_diagnostic_parameter_type)
}
.womActiveDiagnosticsTab<-function(status=TRUE)
{
theWidget("diagnosticPageBox")$setSensitive(status)
}
.womCreateDiagnosticsDefinedModelsColumns <- function()
{
#modelsTreeview <- theWidget("modelsDefinedModelsTreeview")
diagnosticsTreeview <- theWidget("diagnosticDefinedModelsTreeview")
#model = gtkTreeViewGetModel(modelsTreeview)
#gtkTreeViewSetModel(diagnosticsTreeview, model)
treeview = diagnosticsTreeview
#Create tree view
if(is.null(gtkTreeViewGetColumn(treeview,0))){
# name
renderer <- gtkCellRendererTextNew()
renderer$set(xalign = 0.5)
col.offset <- treeview$insertColumnWithAttributes(-1, "Name", renderer,
text = .womDefinedModelsTreeCols("name"))
column <- treeview$getColumn(col.offset - 1)
column$setClickable(TRUE)
# hasResults
renderer <- gtkCellRendererToggleNew()
renderer$set(xalign = 0.5)
col.offset <- treeview$insertColumnWithAttributes(-1, "Results?", renderer,
active = .womDefinedModelsTreeCols("hasResults")
)
column <- treeview$getColumn(col.offset - 1)
column$setClickable(FALSE)
# time
renderer <- gtkCellRendererTextNew()
renderer$set(xalign = 0.5)
col.offset <- treeview$insertColumnWithAttributes(-1, "Time", renderer,
text = .womDefinedModelsTreeCols("timeAnalyzed"))
column <- treeview$getColumn(col.offset - 1)
column$setClickable(TRUE)
# acc rate
renderer <- gtkCellRendererTextNew()
renderer$set(xalign = 1.0)
col.offset <- treeview$insertColumnWithAttributes(-1, "Acc. Rate", renderer,
text = .womDefinedModelsTreeCols("accRate"),
foreground = .womDefinedModelsTreeCols("accColor"))
column <- treeview$getColumn(col.offset - 1)
column$setClickable(TRUE)
gtkTreeViewColumnSetSortColumnId(column,.womDefinedModelsTreeCols("accRate"))
# iterations
renderer <- gtkCellRendererTextNew()
renderer$set(xalign = 1.0)
col.offset <- treeview$insertColumnWithAttributes(-1, "Iterations", renderer,
text = .womDefinedModelsTreeCols("iterations"))
column <- treeview$getColumn(col.offset - 1)
column$setClickable(TRUE)
gtkTreeViewColumnSetSortColumnId(column,.womDefinedModelsTreeCols("iterations"))
# effective iterations
renderer <- gtkCellRendererTextNew()
renderer$set(xalign = 1.0)
col.offset <- treeview$insertColumnWithAttributes(-1, "Effective Iterations", renderer,
text = .womDefinedModelsTreeCols("effectiveIterations"))
column <- treeview$getColumn(col.offset - 1)
column$setClickable(TRUE)
gtkTreeViewColumnSetSortColumnId(column,.womDefinedModelsTreeCols("effectiveIterations"))
# burnin
renderer <- gtkCellRendererTextNew()
renderer$set(xalign = 1.0)
col.offset <- treeview$insertColumnWithAttributes(-1, "Burnin", renderer,
text = .womDefinedModelsTreeCols("burnin"))
column <- treeview$getColumn(col.offset - 1)
column$setClickable(TRUE)
gtkTreeViewColumnSetSortColumnId(column,.womDefinedModelsTreeCols("burnin"))
# hybrid EPS
renderer <- gtkCellRendererTextNew()
renderer$set(xalign = 1.0)
col.offset <- treeview$insertColumnWithAttributes(-1, "Lower eps.", renderer,
text = .womDefinedModelsTreeCols("epsLow"))
column <- treeview$getColumn(col.offset - 1)
column$setClickable(TRUE)
renderer <- gtkCellRendererTextNew()
renderer$set(xalign = 1.0)
col.offset <- treeview$insertColumnWithAttributes(-1, "Upper eps.", renderer,
text = .womDefinedModelsTreeCols("epsUpp"))
column <- treeview$getColumn(col.offset - 1)
column$setClickable(TRUE)
# Leapfrog
renderer <- gtkCellRendererTextNew()
renderer$set(xalign = 1.0)
col.offset <- treeview$insertColumnWithAttributes(-1, "Leapfrog", renderer,
text = .womDefinedModelsTreeCols("leapfrog"))
column <- treeview$getColumn(col.offset - 1)
column$setClickable(TRUE)
# use Metropolis
renderer <- gtkCellRendererToggleNew()
renderer$set(xalign = 0.5)
col.offset <- treeview$insertColumnWithAttributes(-1, "MH instead?", renderer,
active = .womDefinedModelsTreeCols("useMet")
)
column <- treeview$getColumn(col.offset - 1)
column$setClickable(FALSE)
# metrop scale
renderer <- gtkCellRendererTextNew()
renderer$set(xalign = 1.0)
col.offset <- treeview$insertColumnWithAttributes(-1, "MH scale", renderer,
text = .womDefinedModelsTreeCols("metropScale"))
column <- treeview$getColumn(col.offset - 1)
column$setClickable(TRUE)
# metrop scale
renderer <- gtkCellRendererTextNew()
renderer$set(xalign = 1.0)
col.offset <- treeview$insertColumnWithAttributes(-1, "MH thin", renderer,
text = .womDefinedModelsTreeCols("metropThin"))
column <- treeview$getColumn(col.offset - 1)
column$setClickable(TRUE)
}
}
.womGetDiagnosticsModelSelection<-function()
{
treeview = theWidget("diagnosticDefinedModelsTreeview")
model <- gtkTreeViewGetModel(treeview)
selection <- gtkTreeViewGetSelection(treeview)
iter <- gtkTreeSelectionGetSelected(selection)$iter
# Next line caused crash - "visible" is not a valid column!
# I don't remember why I used this. (cut and paste?)
# vis <- model$get(iter, .womDefinedModelsTreeCols("visible"))[[1]]
vis <- NULL
return(list(iter=iter,visible=vis))
}
.selected_diagnostics_model_row <- function(treeview, path, view_column)
{
treeview <- theWidget("diagnosticDefinedModelsTreeview")
model = gtkTreeViewGetModel(treeview)
iter = .womGetDiagnosticsModelSelection()$iter
modelName = gtkTreeModelGetValue(model,iter,.womDefinedModelsTreeCols("name"))$value
myModel = wommbatAnalysis$Models[[modelName]]
limitCombo = StateEnv$itersCombo
typeCombo = StateEnv$typeCombo
if(is.null(myModel$results))
{
.womClearDiagnosticPlots()
limitCombo$setSensitive(FALSE)
typeCombo$setSensitive(FALSE)
theWidget("hscrollbar1")$setSensitive(FALSE)
return()
}
limitCombo$setSensitive(TRUE)
typeCombo$setSensitive(TRUE)
theWidget("hscrollbar1")$setSensitive(TRUE)
# Combo box for iterations limit
currentValue = limitCombo$getActiveText()
currentValue = ifelse(is.null(currentValue),"All",currentValue)
gSignalHandlerBlock(limitCombo, StateEnv$handlers$diagnosticLimitCombo)
burnin <- myModel$settings$burninIters
upperLimit <- myModel$settings$effectiveIters
# Make options model
limitOptions <-c(upperLimit-burnin,500,1000,5000)
limitOptions <- limitOptions[limitOptions <= upperLimit-burnin]
limitOptions[1]="All"
findCurrent = match(currentValue,limitOptions)
selectIters = ifelse(is.na(findCurrent),0,findCurrent-1)
clearComboModel(StateEnv$itersCombo)
for (LO in limitOptions) {
gtkComboBoxAppendText(limitCombo,LO)
}
gtkComboBoxSetActive(limitCombo,selectIters)
# Combo box for parameter type
#currentValueType = theWidget("diagnosticTypeComboBox")$getActiveText()
currentValueType = typeCombo$getActiveText()
currentValueType = ifelse(is.null(currentValueType),"effect",currentValueType)
selectType=0
gSignalHandlerBlock(typeCombo, StateEnv$handlers$diagnosticTypeCombo)
clearComboModel(StateEnv$typeCombo)
gtkComboBoxAppendText(typeCombo,"effect")
if(myModel$model$covNgroups>0){
gtkComboBoxAppendText(typeCombo,"correlation")
if(currentValueType=="correlation") selectType=1
}
gtkComboBoxSetActive(typeCombo,selectType)
maxPar <- length(myModel$results$pointEst[,1])
scrollBar <- theWidget("hscrollbar1")
gSignalHandlerBlock(scrollBar, StateEnv$handlers$diagnosticScrollBar1)
adjustment <- gtkAdjustmentNew(value = 1, lower = 1, upper = maxPar, step.incr=1)
scrollBar$setAdjustment(adjustment)
gtkAdjustmentSetValue(scrollBar$getAdjustment(), 1)
.womDisplayNthDiagnosticPlot(1)
gSignalHandlerUnblock(scrollBar, StateEnv$handlers$diagnosticScrollBar1)
gSignalHandlerUnblock(typeCombo,StateEnv$handlers$diagnosticTypeCombo)
gSignalHandlerUnblock(limitCombo, StateEnv$handlers$diagnosticLimitCombo)
}
.womClearDiagnosticPlots <- function()
{
if(!is.null(StateEnv$Graphics$ChainsDevice)){
dev.set(which = StateEnv$Graphics$ChainsDevice)
plot.new()
}
if(!is.null(StateEnv$Graphics$DensityDevice)){
dev.set(which = StateEnv$Graphics$DensityDevice)
plot.new()
}
if(!is.null(StateEnv$Graphics$ACFDevice)){
dev.set(which = StateEnv$Graphics$ACFDevice)
plot.new()
}
}
.womGetApproprateChain <- function()
{
treeview <- theWidget("diagnosticDefinedModelsTreeview")
model = gtkTreeViewGetModel(treeview)
iter = .womGetDiagnosticsModelSelection()$iter
modelName = gtkTreeModelGetValue(model,iter,.womDefinedModelsTreeCols("name"))$value
myModel = wommbatAnalysis$Models[[modelName]]
scrollBar <- theWidget("hscrollbar1")
n = floor(scrollBar$getValue())
if(n==0) n=1
parameterType <- StateEnv$typeCombo#theWidget("diagnosticTypeComboBox")
typeModel <- parameterType$getModel()
typeIdx <- gtkComboBoxGetActiveIter(parameterType)
if(!typeIdx$retval)
{
myType <- "effects"
}else
{
iter <- typeIdx$iter
myType <- gtkTreeModelGetValue(typeModel,iter,0)$value
}
if(myType=="correlation")
{
if(myModel$model$covNgroups==0) return(NULL)
nParameters <- myModel$model$covSizes*(myModel$model$covSizes-1)/2
if(n>sum(nParameters)) return(NULL)
group <- which(n<=cumsum(nParameters))[1]
idxInGroup = ifelse(group==1,n,n-cumsum(nParameters)[group-1])
groupPars = nParameters[group]
groupSize <- myModel$model$covSizes[group]
x=matrix(1:groupSize^2,groupSize,groupSize)
idx = x[lower.tri(x)][idxInGroup]
row = (idx-1)%%groupSize + 1
column = (idx-1)%/%groupSize + 1
lab = paste("Correlation: ",dimnames(myModel$results$corChains[[group]])[[1]][row]," and ",
dimnames(myModel$results$corChains[[group]])[[1]][column],sep="")
return(list(chain=myModel$results$corChains[[group]][row,column,],group=group,row=row,column=column,label=lab))
}else
{
if(n>length(myModel$results$effectChains[1,])) return(0)
parameterName <- paste(myModel$results$pointEst[n,2]," on ",myModel$results$pointEst[n,1],": ",myModel$results$pointEst[n,3],sep="")
chain <- myModel$results$effectChains[,n]
return(list(chain=chain,group=NULL,row=NULL,column=NULL,label=parameterName))
}
return(NULL)
}
.womDisplayNthDiagnosticPlot <- function(n)
{
treeview <- theWidget("diagnosticDefinedModelsTreeview")
model = gtkTreeViewGetModel(treeview)
iter = .womGetDiagnosticsModelSelection()$iter
modelName = gtkTreeModelGetValue(model,iter,.womDefinedModelsTreeCols("name"))$value
myModel = wommbatAnalysis$Models[[modelName]]
parameterLabel <- theWidget("diagnosticsParameterLabel")
parameterType <- StateEnv$typeCombo#theWidget("diagnosticTypeComboBox")
typeModel <- parameterType$getModel()
typeIdx <- gtkComboBoxGetActiveIter(parameterType)
if(!typeIdx$retval)
{
myType <- "effects"
}else
{
iter <- typeIdx$iter
myType <- gtkTreeModelGetValue(typeModel,iter,0)$value
}
upperLimit <- myModel$settings$MCMCIters
burnin <- myModel$settings$burninIters
chainData <- .womGetApproprateChain()
parameterName <- chainData$lab
gtkLabelSetText(parameterLabel, parameterName)
chain <- chainData$chain
postMean <- mean(chain[-(1:burnin)])
postQuant <- quantile(chain[-(1:burnin)],p=c(.025,.975))
#Chain
limitCombo <- StateEnv$itersCombo#theWidget("diagnosticCombobox1")
limitModel <- gtkComboBoxGetModel(limitCombo)
upperLimitIdx <- gtkComboBoxGetActiveIter(limitCombo)
if(!upperLimitIdx$retval)
{
upperLimit <- myModel$settings$effectiveIters
}else
{
iter <- upperLimitIdx$iter
upperLimit <- gtkTreeModelGetValue(limitModel,iter,0)$value
if(upperLimit=="All")
{
upperLimit <- myModel$settings$effectiveIters
}else
{
upperLimit <- as.numeric(upperLimit) + burnin
}
}
.womUpdateChainPlot(myModel,upperLimit)
#Density
if(!is.null(StateEnv$Graphics$DensityDevice)){
dev.set(which = StateEnv$Graphics$DensityDevice)
}else{
da = theWidget("diagnosticDrawingarea2")
cairoDevice::asCairoDevice(da)
StateEnv$Graphics$DensityDevice = dev.cur()
}
par(mar=c(4.5,0,0,0))
plot(density(chain[-(1:burnin)]),axes=FALSE,xlab="Parameter Estimate",main="")
abline(v=postMean,col="blue",lwd=2)
abline(v=postQuant,col="blue",lty=2)
axis(1)
box()
#ACF
if(!is.null(StateEnv$Graphics$ACFDevice)){
dev.set(which = StateEnv$Graphics$ACFDevice)
}else{
da = theWidget("diagnosticDrawingarea3")
cairoDevice::asCairoDevice(da)
StateEnv$Graphics$ACFDevice = dev.cur()
}
par(mar=c(4.5,4,1,1))
acf(chain[-(1:burnin)])
axis(1)
box()
}
.selected_diagnostic_parameter_type <- function(treeview, path)
{
treeview <- theWidget("diagnosticDefinedModelsTreeview")
model = gtkTreeViewGetModel(treeview)
iter = .womGetDiagnosticsModelSelection()$iter
modelName = gtkTreeModelGetValue(model,iter,.womDefinedModelsTreeCols("name"))$value
myModel = wommbatAnalysis$Models[[modelName]]
#parameterType <- theWidget("diagnosticTypeComboBox")
parameterType <- StateEnv$typeCombo
typeModel <- parameterType$getModel()
typeIdx <- gtkComboBoxGetActiveIter(parameterType)
if(!typeIdx$retval)
{
myType <- "effects"
}else
{
iter <- typeIdx$iter
myType <- gtkTreeModelGetValue(typeModel,iter,0)$value
}
if(myType=="correlation")
{
maxPar <- sum(myModel$model$covSizes*(myModel$model$covSizes-1)/2)
}else
{
maxPar <- length(myModel$results$pointEst[,1])
}
scrollBar <- theWidget("hscrollbar1")
adjustment <- gtkAdjustmentNew(value = 1, lower = 1, upper = maxPar, step.incr=1)
scrollBar$setAdjustment(adjustment)
gtkAdjustmentSetValue(scrollBar$getAdjustment(), 1)
.womDisplayNthDiagnosticPlot(1)
}
.selected_number_chain_iterations <- function(treeview, path)
{
treeview <- theWidget("diagnosticDefinedModelsTreeview")
model = gtkTreeViewGetModel(treeview)
iter = .womGetDiagnosticsModelSelection()$iter
modelName = gtkTreeModelGetValue(model,iter,.womDefinedModelsTreeCols("name"))$value
myModel = wommbatAnalysis$Models[[modelName]]
burnin <- myModel$settings$burninIters
#limitCombo <- theWidget("diagnosticCombobox1")
limitCombo <- StateEnv$itersCombo
limitModel <- gtkComboBoxGetModel(limitCombo)
upperLimitIdx <- gtkComboBoxGetActiveIter(limitCombo)
if(!upperLimitIdx$retval)
{
upperLimit <- myModel$settings$effectiveIters
}else
{
iter <- upperLimitIdx$iter
upperLimit <- gtkTreeModelGetValue(limitModel,iter,0)$value
if(upperLimit=="All")
{
upperLimit <- myModel$settings$effectiveIters
}else
{
upperLimit <- as.numeric(upperLimit) + burnin
}
}
.womUpdateChainPlot(myModel,upperLimit)
}
.womUpdateChainPlot<-function(myModel,upperLimit)
{
scrollBar <- theWidget("hscrollbar1")
n = floor(scrollBar$getValue())
if(n==0) n=1
burnin <- myModel$settings$burninIters
chainData <- .womGetApproprateChain()
chain <- chainData$chain
postMean <- mean(chain[-(1:burnin)])
postQuant <- quantile(chain[-(1:burnin)],p=c(.025,.975))
# plots
# Chains plot
if(!is.null(StateEnv$Graphics$ChainsDevice)){
dev.set(which = StateEnv$Graphics$ChainsDevice)
}else{
da = theWidget("diagnosticDrawingarea1")
cairoDevice::asCairoDevice(da)
StateEnv$Graphics$ChainsDevice = dev.cur()
}
par(mar=c(4.5,4,1,1))
plot(chain[(burnin+1):upperLimit],axes=FALSE,ty='l',ylab="Parameter Estimate")
abline(h=postMean,col="blue",lwd=2)
abline(h=postQuant,col="blue",lty=2)
lines(lowess(chain[(burnin+1):upperLimit],f=.25),col="red",lwd=2)
axis(2)
axis(1,at=c(1,upperLimit-burnin),labels=c(burnin+1,upperLimit))
box()
}
.scrolled_diagnostics_scrollbar <- function(scrollBar,...)
{
scrollBar <- theWidget("hscrollbar1")
value = floor(scrollBar$getValue())
.womDisplayNthDiagnosticPlot(value)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.