Errors from the posterior approximation graphs

[0ldM4j0r]

I am getting this error when trying to generate posterior approximation graphs:

Warning: Error in plot.xy: object 'pal' not found
Stack trace (innermost first):
    64: plot.xy
    63: lines.default
    62: lines
    61: FUN [/Users/faisal/git/KaphiShiny/app.R#524]
    60: lapply
    59: renderPlot
    58: FUN [/Users/faisal/git/KaphiShiny/app.R#512]
    57: lapply
    56: observerFunc
     1: runApp
ERROR: [on_request_read] connection reset by peer

I am using the following code (it is commented out in the master branch as the above error breaks the app):

      observe(
        lapply(seq_len(length(parameters[[input$specificModel]])), function(i) {
          output[[paste0("posteriorApproximationsOf", parameters[[input$specificModel]][[i]])]] <- renderPlot(
            pal = rainbow(n=6, start=0, end=0.5, v=1, s=1),
            plot(density
                 (trace[[parameters[[input$specificModel]][[i]]]][trace$n==1], weights=trace$weight[trace$n==1]),
                 col=pal[1],
                 lwd=2,
                 main=paste0(names(parameters[[input$specificModel]]), " ", names(parameters[[input$specificModel]][[i]])),
                 xlab=paste0(names(parameters[[input$specificModel]]), ' rate parameter (', names(parameters[[input$specificModel]][[i]]), ')'),
                 cex.lab=1.2
            ),
            lapply(seq_len(5), function(i) {
              temp <- trace[trace$n==i*10,]
              lines(density(temp[[parameters[[input$specificModel]][[i]]]], weights=temp$weight), col=pal[i+1], lwd=1.5)
            }),
            lines(density(trace[[parameters[[input$specificModel]][[i]]]][trace$n==max(trace$n)], weights=trace$weight[trace$n==max(trace$n)]), col='black', lwd=2)
          )
        })
      )

[ArtPoon]

Try directly assigning rainbow wherever it is being used and see if you still get an error. This may be a problem of the assignment to pal being sent to the same namespace where your plot functions are being evaluated

[0ldM4j0r]

So when I directly assigned rainbow I got a different error message:

Warning: Error in plot.xy: plot.new has not been called yet
Stack trace (innermost first):
    63: plot.xy
    62: lines.default
    61: lines
    60: FUN [/home/fabusard/git/KaphiShiny/app.R#525]
    59: lapply
    58: FUN [/home/fabusard/git/KaphiShiny/app.R#523]
    57: lapply
    56: observerFunc
     1: runApp

This is happening because observe is outputting the results of all what is inside it at the same time. Therefore, all the calls which come after the plot(), which are dependent on plot(), cannot reference it.

In 2371673 I commented out everything after plot() and moved rainbow outside renderPlot() and managed to get the plot of the red line (n=10) to render. Now I need to find a way to update the plot with out re-rending it in shiny, as creating more observes for the same plot will result in the plot re-rendering and in turn just showing the result of the last observe.

[0ldM4j0r]

@gtng92 found a bug/mistake in my approach to plotting the lines on the posterior approximation graph, and help me fix it. This issue is still unsolved but solving that bug is a step in the right direction.

The nested lapply and for loop used the same variable to iterate (it was i). Now I changed it such that the lapply uses i and the for loop uses j:

      observe(
        lapply(seq_len(length(modelParameters)), function(i) {
          pal = rainbow(n=6, start=0, end=0.5, v=1, s=1)
          output[[paste0("posteriorApproximationsOf", modelParameters[[i]])]] <- renderPlot(
            for (j in 1:5) {
              temp <- trace[trace$n==j*10,]
              lines(density(temp[[modelParameters[[i]]]], weights=temp$weight), col=pal[j+1], lwd=1.5)
            }
          )
        }),
        priority = 97
      )

[0ldM4j0r]

I am still working on update the plot with out re-rending it in shiny. I tried plotting using the approach outline in this stackoverflow thread, but that didin't work. I just got white space with no plot.

code used:

      observe(
        lapply(seq_len(length(modelParameters)), function(i) {
          pal = rainbow(n=6, start=0, end=0.5, v=1, s=1)
          output[[paste0("posteriorApproximationsOf", modelParameters[[i]])]] <- renderPlot(function() {
            plot.new()
            plot.window(xlim=c(0, 3), ylim=c(0, 20))
            axis(1)
            axis(2)
            title(main=paste0(input$specificModel, " ", modelParameters[[i]]))
            title(xlab=paste0(input$specificModel, ' rate parameter (', modelParameters[[i]], ')'))
            title(ylab="Density")
            box()
            lines(density(trace[[modelParameters[[i]]]][trace$n==1], weights=trace$weight[trace$n==1]))
            for (j in 1:5) {
              temp <- trace[trace$n==j*10,]
              lines(density(temp[[modelParameters[[i]]]], weights=temp$weight), col=pal[j+1], lwd=1.5)
            }
            lines(density(trace[[modelParameters[[i]]]][trace$n==max(trace$n)], weights=trace$weight[trace$n==max(trace$n)]), col='black', lwd=2)
          })
        })
      )

Note that this approach works when implemented in an R script.

[0ldM4j0r]

I tried plotting points instead of densities but that also returned white space instead of the plot. here is the code snippet I used:

      observe(
        lapply(seq_len(length(modelParameters)), function(i) {
          pal = rainbow(n=6, start=0, end=0.5, v=1, s=1)
          output[[paste0("posteriorApproximationsOf", modelParameters[[i]])]] <- renderPlot(function() {
            plot.new()
            plot.window(xlim=c(0, 3), ylim=c(0, 20))
            axis(1)
            axis(2)
            title(main=paste0(input$specificModel, " ", modelParameters[[i]]))
            title(xlab=paste0(input$specificModel, ' rate parameter (', modelParameters[[i]], ')'))
            title(ylab="Density")
            box()
            points(1,1)
            points(2,2)
            points(3,3)
          })
        })
      )

[0ldM4j0r]

I used reactivePlot instead of renderPlot and the points plotted just fine. So I tried reactive plot with density and that worked fine.

However, reactivePlot is deprecated, as the following message is returned when using it: reactivePlot is deprecated. Please use renderPlot instead. To disable this message, run options(shiny.deprecation.messages=FALSE).

[0ldM4j0r]

When trying to use renderPlot instead of reactiveplot I get the following error message:

Warning in density.default(temp[[modelParameters[[i]]]], weights = temp$weight) :
  sum(weights) != 1  -- will not get true density
Warning: Error in density.default: need at least 2 points to select a bandwidth automatically
Stack trace (innermost first):
    102: density.default
    101: density
    100: lines
     99: renderPlot [/home/fabusard/git/KaphiShiny/app.R#452]
     89: <reactive:plotObj>
     78: plotObj
     77: origRenderFunc
     76: output$posteriorApproximationsOflambda
      1: runApp

as of commit 0b5297b, i am using reactivePlot since it is the one that is working for now.

[gtng92]

Error in density.default: need at least 2 points to select a bandwidth automatically

This code is specifically tailored to the SMC simulation of the Yule model in pkg/examples/example-yule.R

Originally the code was:

for (i in 1:7) {
    temp <- trace[trace$n==i*10,]
    lines(density(temp[[param]], weights=temp$weight), col=pal[i+1], lwd=1.5)
  }

This code will run assuming that there will be at least n = 70 iterations of the SMC simulation.

While looking at results from run in pkg/examples/example-epidem.R, I modified my code to the one below:

for (i in 1: ( length(unique(trace$n)) %/% 10 ) ) {
    temp <- trace[trace$n==i*10,]
    lines(density(temp[[param]], weights=temp$weight), col=pal[i+1], lwd=1.5)
  }

Hopefully this helps!

[0ldM4j0r]

Thanks @gtng92, I will incorporate your changes in KaphiShiny, test, and push when completed!

[gtng92]

Also when you show the prior distribution, there's another section that needs to be generalized.

Originally it was:

# show the prior distribution
  x <- seq(0, 2, 0.1)      # again, specifically for param lambda in Yule model)
  y <- function(x) {arg.prior <- x; eval(parse(text=config$prior.densities[[param]]))}
  lines(x, y(x), lty=5)

In pkg/examples/epidem.R I changed it to:

# show the prior distribution
x <- sort( replicate(1000, eval(parse(text=config$priors[[param]]))) )
y <- function(x) {arg.prior <- x; eval(parse(text=config$prior.densities[[param]]))}
lines(x, y(x), lty=5)

[0ldM4j0r]

Thanks again, I will incorporate this ASAP

[0ldM4j0r]

The generalizations make renderPlot work!!!!!!!!!!!!!!!!!!!!!! No need to used the deprecated reactivePlot anymore. Thanks @gtng92 for all the help with this issue. 2dd4750