Draft Shiny app

server.R

library(unmarked)
library(shiny)
library(shinymanager)

credentials <- data.frame(
  user = ********,
  password = *********,
  stringsAsFactors = FALSE
)

# Simulate occupany dataset and fit model (user will do this normally)
umf <- simulate("occu", formulas=list(state=~elev, det=~wind),
                coefs=list(state=c(intercept=0, elev=0.3),
                           det=c(intercept=0.4, wind=-0.2)),
                design=list(M=100, J=5))

mod <- occu(~wind~elev, umf)

# Get template for coefficients
coefs <- unmarked:::check_coefs(NULL, mod, TRUE)

# Get input elements to appear next to each other
inline_wrap <- function(f, ...){
  out <- f(...)
  div(style='display:inline-block; width: 100px; vertical-align:top', out)
}

# Tells unmarked to use a progress bar that hooks into Shiny interface
options(unmarked_shiny=TRUE)

# Generate user interface elements for a given list of coefficients
get_coef_ui <- function(coefs){

  out <- c(list(h3("Coefficient values")))

  for (i in 1:length(coefs)){
    pars <- coefs[[i]]
    submod_name <- names(coefs)[i]
    inps <- lapply(1:length(pars), function(x){
      par_name <- names(pars)[x]
      inp_name <- paste0("coef_",submod_name,"_",par_name)
      inline_wrap(numericInput, inputId=inp_name, label=par_name,
                  value=0, step=0.01)
    })
    out <- c(out, list(h4(submod_name)), inps)
  }
  out
}

# Reconstruct Shiny inputs into a coefficients list to be passed to unmarked
get_coefs <- function(input){
  pass <- reactiveValuesToList(input)
  pass$shinymanager_where <- NULL
  inp_sub <- pass[grepl("coef_",names(pass), fixed=TRUE)]
  inp_sub <- pass[!is.na(names(inp_sub))]
  names(inp_sub) <- gsub("coef_", "", names(inp_sub))
  submods <- gsub("_(.*)$","",names(inp_sub))
  pars <- gsub("^(.*)_","",names(inp_sub))
  out <- lapply(unique(submods), function(x){
    vals <- unlist(inp_sub[which(submods==x)])
    names(vals) <- pars[which(submods==x)]
    vals
  })
  names(out) <- unique(submods)
  out
}

# Server code
function(input, output, session){

  res_auth <- secure_server(
    check_credentials = check_credentials(credentials)
  )

  output$auth_output <- renderPrint({
    reactiveValuesToList(res_auth)
  })

  options(unmarked_shiny_session=session)
  output$plot <- renderPlot(plot(mod))
  output$coef_ui <- renderUI(get_coef_ui(coefs))
  output$coefs <- renderPrint(get_coefs(input))
  output$mod <- renderUI(HTML(paste0("<b>Model:</b> ","mod")))
  output$class <- renderUI(HTML(paste0("<b>Type:</b>&nbsp&nbsp&nbsp",
                                       class(mod)[1])))
  output$sites <- renderUI(HTML(paste0("<b>Sites:</b>&nbsp&nbsp",
                                       numSites(mod@data))))

  # Only update analysis when button is pushed
  observeEvent(input$run, {
    coefs <- isolate(get_coefs(input))
    alpha <- isolate(input$alpha)
    nsims <- isolate(input$nsims)
    output$summary <- renderTable(
                      summary(powerAnalysis(mod, coefs=coefs, alpha=alpha,
                                            nsim=nsims))
                      )
  })
}

ui.R

library(shiny)
library(shinymanager)

inline_wrap <- function(f, ...){
  out <- f(...)
  div(style='display:inline-block; width: 100px; vertical-align:top', out)
}

ui <- fluidPage(
  tags$head(
    tags$style(HTML('#run{background-color:orange}'))
  ),
  titlePanel("Power Analysis"),
  sidebarLayout(
    sidebarPanel(width=4,
                 htmlOutput("mod"),
                 htmlOutput("class"),
                 htmlOutput("sites"),
                 br(),
                 inline_wrap(numericInput, inputId="alpha", label="Type I error (alpha)",
                             value=0.05, min=0.001, max=1),
                 inline_wrap(numericInput, inputId="nsims", label="Number of simulations",
                             value=10, min=1, max=300, step=1),
                 uiOutput("coef_ui"),
                 br(),
                 actionButton("run", "Run analysis")
                 ),
    mainPanel(width=8,
              h4("Output"),
              tableOutput("summary")
              )
    )
)

secure_app(ui)