Skip to content

Commit

Permalink
Merge pull request #132 from stan-dev/v2.2.1
Browse files Browse the repository at this point in the history
Version 2.2.1
  • Loading branch information
jgabry authored Aug 31, 2016
2 parents 41ca2b4 + cecb75c commit 9c24c52
Show file tree
Hide file tree
Showing 23 changed files with 194 additions and 215 deletions.
1 change: 1 addition & 0 deletions .travis.yml
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@ r: devel
cache: packages

r_github_packages:
- HenrikBengtsson/matrixStats@develop
- jimhester/covr

after_success:
Expand Down
9 changes: 5 additions & 4 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
Package: shinystan
Title: Interactive Visual and Numerical Diagnostics and Posterior Analysis for
Bayesian Models
Version: 2.2.0
Date: 2016-05-23
Version: 2.2.1
Date: 2016-08-31
Authors@R: c(person("Jonah", "Gabry", role = c("aut", "cre"),
email = "jsg2201@columbia.edu"),
person(family = "Stan Development Team", role = "ctb"),
Expand Down Expand Up @@ -36,7 +36,8 @@ Suggests:
rstanarm (>= 2.9.0-3),
testthat
Imports:
DT (>= 0.1),
colourpicker,
DT (>= 0.2),
dygraphs (>= 0.4.5),
ggplot2 (>= 2.1.0),
gridExtra,
Expand All @@ -47,7 +48,7 @@ Imports:
rsconnect (>= 0.4.2),
rstan (>= 2.9.0-3),
stats,
shinyjs (>= 0.1.0),
shinyjs (>= 0.6.0),
shinythemes (>= 1.0.1),
threejs (>= 0.2.1),
utils,
Expand Down
2 changes: 1 addition & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -22,13 +22,13 @@ import(threejs)
import(utils)
import(xts)
importFrom(DT,datatable)
importFrom(colourpicker,colourInput)
importFrom(gridExtra,arrangeGrob)
importFrom(gridExtra,grid.arrange)
importFrom(gtools,mixedsort)
importFrom(markdown,markdownToHTML)
importFrom(reshape2,melt)
importFrom(rsconnect,deployApp)
importFrom(shinyjs,colourInput)
importFrom(shinyjs,useShinyjs)
importFrom(shinythemes,shinytheme)
importFrom(stats,acf)
Expand Down
11 changes: 11 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,14 @@
### Version 2.2.1
* Better compatibility with latest releases of 'shinyjs' and 'DT' packages
* `shinystan::launch_shinystan_demo()` now works without first having to load
the package with a call to `library`
* Unless running on a server, the app now stops running when browser tab is
closed

### Version 2.2.0-1
* Fix bug in `deploy_shinystan` preventing some ShinyStan apps from being
deployed

### Version 2.2.0
* Add optional argument `pars` to the `as.shinystan` method for stanfit objects,
allowing a subset of parameters to be selected for inclusion in the resulting
Expand Down
116 changes: 52 additions & 64 deletions R/deploy_shinystan.R
Original file line number Diff line number Diff line change
Expand Up @@ -2,85 +2,86 @@
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3 of the License, or (at your option) any later
# version.
#
#
# shinystan is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
#
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, see <http://www.gnu.org/licenses/>.


#' Deploy a ShinyStan app on the web using shinyapps.io by RStudio
#'
#' Requires a (free or paid) ShinyApps account. Visit
#'
#' Requires a (free or paid) ShinyApps account. Visit
#' \url{http://www.shinyapps.io/} to sign up.
#'
#'
#' @export
#' @template args-sso
#' @param appName The name to use for the application. Application names must be
#' at least four characters long and may only contain letters, numbers, dashes
#' and underscores.
#' @param account shinyapps.io account username. Only required if more than one
#' @param account shinyapps.io account username. Only required if more than one
#' account is configured on the system.
#' @param ... Optional arguments. See Details.
#' @param deploy Should the app be deployed? The only reason for this to be
#' @param deploy Should the app be deployed? The only reason for this to be
#' \code{FALSE} is if you just want to check that the preprocessing before
#' deployment is successful.
#'
#' @return \link[=invisible]{Invisibly}, \code{TRUE} if deployment succeeded
#' (did not encounter an error) or, if \code{deploy} argument is set to
#' \code{FALSE}, the path to the temporary directory containing the app ready
#'
#' @return \link[=invisible]{Invisibly}, \code{TRUE} if deployment succeeded
#' (did not encounter an error) or, if \code{deploy} argument is set to
#' \code{FALSE}, the path to the temporary directory containing the app ready
#' for deployment (also invisibly).
#'
#' @details In \code{...}, the arguments \code{ppcheck_data} and
#'
#' @details In \code{...}, the arguments \code{ppcheck_data} and
#' \code{ppcheck_yrep} can be specified. \code{ppcheck_data} should be a
#' vector of observations to use for graphical posterior predictive checking
#' and \code{ppcheck_yrep} should be a character string naming the parameter
#' in \code{sso} containing the posterior predictive simulations/replications.
#' The value of \code{ppcheck_yrep} is only used to preselect the appropriate
#' parameter/generated quantity to use for the posterior predictive checking.
#' parameter/generated quantity to use for the posterior predictive checking.
#' \code{ppcheck_yrep} (but not \code{ppcheck_data}) can also be set
#' interactively on shinyapps.io when using the app.
#'
#' @seealso The example in the \emph{Deploying to shinyapps.io} vignette that
#'
#' @seealso The example in the \emph{Deploying to shinyapps.io} vignette that
#' comes with this package.
#'
#'
#' \url{http://www.shinyapps.io/} to sign up for a free or paid ShinyApps
#' account and for details on how to configure your account on your local
#' system using RStudio's \pkg{\link[rsconnect]{rsconnect}} package.
#'
#'
#' @examples
#' \dontrun{
#' # For this example assume sso is the name of the shinystan object for
#' # the model you want to use. Assume also that you want to name your app
#' # 'my-model' and that your shinyapps.io username is 'username'.
#' # For this example assume sso is the name of the shinystan object for
#' # the model you want to use. Assume also that you want to name your app
#' # 'my-model' and that your shinyapps.io username is 'username'.
#'
#' deploy_shinystan(sso, appName = "my-model", account = "username")
#' deploy_shinystan(sso, appName = "my-model", account = "username")
#'
#' # If you only have one ShinyApps account configured then you can also omit
#' # the 'account' argument.
#' # If you only have one ShinyApps account configured then you can also omit
#' # the 'account' argument.
#'
#' deploy_shinystan(sso, appName = "my-model")
#' }
#'
#'
#' @importFrom rsconnect deployApp
#'
#'
deploy_shinystan <- function(sso, appName, account = NULL, ..., deploy = TRUE) {
sso_check(sso)
if (missing(appName))
stop("'appName' is required.")

# copy contents to temporary directory and write necessary additional lines to
# ui, server, and global
appDir <- tempdir()
deployDir <- file.path(appDir, "ShinyStan")
contents <- system.file("ShinyStan", package = "shinystan")
file.copy(from = contents, to = appDir, recursive = TRUE)

server_pkgs <- c(
"shiny",
"shinyjs",
"colourpicker",
"markdown",
"shinythemes"
)
Expand All @@ -99,25 +100,22 @@ deploy_shinystan <- function(sso, appName, account = NULL, ..., deploy = TRUE) {
server_lines <- paste0("library(", server_pkgs, ");")
ui_lines <- paste0("library(", ui_pkgs, ");")
global_lines <- paste(
"load('sso.RData');",
"load('sso.RData');",
"if (file.exists('y.RData')) load('y.RData')"
)
for (ff in c("ui", "server", "global")) {
file_name <- file.path(deployDir, paste0(ff, ".R"))
fconn <- file(file_name, 'r+')
original_content <- readLines(fconn)
if (ff %in% c("ui", "server")) {
sel <- grep(".SHINYSTAN_OBJECT", original_content)
original_content <- original_content[-sel]
}
new_lines <- get(paste0(ff, "_lines"))
writeLines(c(new_lines, original_content), con = fconn)
close(fconn)
}

# save sso to deployDir
object <- sso
save(object, file = file.path(deployDir, "sso.RData"))
.SHINYSTAN_OBJECT <- sso
save(.SHINYSTAN_OBJECT, file = file.path(deployDir, "sso.RData"))

# save ppcheck_data and set ppcheck defaults
pp <- list(...)
if ("ppcheck_data" %in% names(pp)) {
Expand All @@ -130,10 +128,10 @@ deploy_shinystan <- function(sso, appName, account = NULL, ..., deploy = TRUE) {
y_name = "y"
)
}

if (!deploy)
return(invisible(deployDir))

rsconnect::deployApp(
appDir = deployDir,
appName = appName,
Expand All @@ -144,24 +142,17 @@ deploy_shinystan <- function(sso, appName, account = NULL, ..., deploy = TRUE) {



# functions to set defaults for ppcheck shiny::selectInput for y and y_rep
# functions to set defaults for ppcheck shiny::selectInput for y and y_rep
set_ppcheck_defaults <- function(appDir, yrep_name, y_name = "y") {
stopifnot(is.character(yrep_name), is.character(y_name),
stopifnot(is.character(yrep_name), is.character(y_name),
length(yrep_name) == 1, length(y_name) == 1)
fileDir <- file.path(appDir, "server_files", "pages", "diagnose", "ppcheck", "ui")
y_file <- file.path(fileDir, "pp_y_from_r.R")
yrep_file <- file.path(fileDir, "pp_yrep_from_sso.R")
for (file in c("y_file", "yrep_file")) {
f <- get(file)
if (file.exists(f)) {
file.remove(f)
file.create(f)
}
ppc_file <- file.path(fileDir, "pp_get_y_and_yrep.R")
if (file.exists(ppc_file)) {
file.remove(ppc_file)
file.create(ppc_file)
}
.write_files(
files = c(y_file, yrep_file),
lines = c(.y_lines(y_name), .yrep_lines(yrep_name))
)
.write_files(files = ppc_file, lines = .ppc_lines(y_name, yrep_name))
}

.write_files <- function(files, lines) {
Expand All @@ -173,25 +164,22 @@ set_ppcheck_defaults <- function(appDir, yrep_name, y_name = "y") {
}
}

.y_lines <- function(y_name = "y") {
.ppc_lines <- function(y_name = "y", yrep_name) {
paste0(
"output$ui_pp_y_from_r <- renderUI({
"output$ui_pp_get_y <- renderUI({
choices <- objects(envir = .GlobalEnv)
selectizeInput('y_name', label = span(style = 'color: #337ab7;', 'y, a vector of observations'),
choices = c('', choices),
selectizeInput('y_name', label = span(style = 'color: #337ab7;', 'y, a vector of observations'),
choices = c('', choices),
selected = '", y_name,"')
})")
}
})
.yrep_lines <- function(yrep_name) {
paste0(
"output$ui_pp_yrep_from_sso <- renderUI({
choices <- param_names
output$ui_pp_get_yrep <- renderUI({
choices <- PARAM_NAMES
choices <- strsplit(choices, split = '[', fixed = TRUE)
choices <- lapply(choices, function(i) return(i[1]))
choices <- unique(unlist(choices))
selectizeInput('yrep_name',
label = span(style = 'color: #337ab7;', 'y_rep, posterior predictive replications'),
selectizeInput('yrep_name',
label = span(style = 'color: #337ab7;', 'y_rep, posterior predictive replications'),
choices = c('', choices),
selected = '", yrep_name,"')
})"
Expand Down
4 changes: 2 additions & 2 deletions R/launch_shinystan.R
Original file line number Diff line number Diff line change
Expand Up @@ -123,8 +123,8 @@ launch_shinystan_demo <- function(demo_name = "eight_schools",
rstudio = getOption("shinystan.rstudio"),
...) {
demo_name <- match.arg(demo_name)
demo_object <- get(demo_name)
invisible(launch(demo_object, rstudio = rstudio, ...))
data(list = demo_name, package = "shinystan", envir = environment())
invisible(launch(get(demo_name, inherits = FALSE), rstudio = rstudio, ...))
}

# Internal launch function
Expand Down
Loading

0 comments on commit 9c24c52

Please sign in to comment.