Fitted distributions (bivariate elicitation)
In SHELF: Tools to Support the Sheffield Elicitation Framework

Parameter 1

knitr::opts_chunk$set(echo=FALSE, warning=FALSE, message=FALSE,
                      fig.pos = 'h',
                      fig.align = 'center',
                      fig.height = 3,
                      fig.width = 4)

fit <- params$fit1
bin.left <- NA
bin.right <- NA
chips <- NA
roulette <- FALSE
filename <- system.file("shinyAppFiles", "distributionsChild.Rmd", package="SHELF")

Parameter 2

fit <- params$fit2

Joint distribution

d1 <- switch(params$d[1],
                       "normal" = "normal",
                       "t" = "Student-t",
                       "skewnormal" = "Skew normal",
                       "gamma" = "gamma",
                       "lognormal" = "log normal",
                       "logt" = "log Student-t",
                       "beta" = "beta",
                       "hist" = "histogram",
                       "best" = as.character(params$fit1$best.fitting[1, 1]))

d2 <- switch(params$d[2],
                       "normal" = "normal",
                       "t" = "Student-t",
                       "skewnormal" = "Skew normal",
                       "gamma" = "gamma",
                       "lognormal" = "log normal",
                       "logt" = "log Student-t",
                       "beta" = "beta",
                       "hist" = "histogram",
                       "best" = as.character(params$fit2$best.fitting[1, 1]))

Elicited concordance probability:

$$ P({X_1 < m_1,\, X_2 < m_2} \cup{ X_1>m_1, \, X_2 > m_2}) = r params$cp $$ Joint sample, obtained using a r paste(d1) distribution for $X_1$ and a r paste(d2) distribution for $X_2$:

library(ggplot2)
conc.probs <- matrix(0, 2, 2)
      conc.probs[1, 2] <- params$cp
      df1<-data.frame(copulaSample(params$fit1, params$fit2, cp=conc.probs, n=10000, 
                                     d=params$d))


      annotations <- data.frame(
        xpos = c(Inf,Inf,-Inf,-Inf),
        ypos =  c(Inf, -Inf,-Inf,Inf),
        annotateText = as.character(c(params$cp / 2, 0.5 - params$cp /2,
                                      params$cp / 2, 
                                      0.5 - params$cp /2)),
        hjustvar = c(1.5, 1.5, -0.5, -0.5) ,
        vjustvar = c(1.5, -0.5, -0.5, 1.5))


      p1<-ggplot(data=df1,aes(x=X1, y=X2))+
        geom_point(alpha=0.15, colour = "red") +
        geom_hline(yintercept = params$m2)+
        geom_vline(xintercept = params$m1)+
        labs(x=expression(X[1]), y = expression(X[2]))+
        geom_text(data = annotations, aes(x = xpos,
                                          y = ypos,
                                          hjust = hjustvar,
                                          vjust = vjustvar,
                                          label = annotateText),
                  size =10) +
        xlim(0.95*params$fit1$limits[1, 1], 1.05*params$fit1$limits[1, 2])+
        ylim(0.95*params$fit2$limits[1, 1], 1.05*params$fit2$limits[1, 2])
      suppressWarnings(suppressMessages(ggExtra::ggMarginal(p1, type = "histogram",
                                           fill = "red")))