ImportFrom highr in NAMESPACE, and replace global assignments with op…

…tions() for shiny apps

NAMESPACE

@@ -45,4 +45,5 @@ export(rprop)
 export(wtd.mean)
 export(wtd.table)
 export(wtd.var)
+importFrom(highr,hi_html)
 importFrom(shiny,runApp)

R/icut.r

@@ -14,21 +14,22 @@
 ##' icut(hdv2003, "age")
 ##' irec(hdv2003, heures.tv) ## this also works}
 ##' @importFrom shiny runApp
+##' @importFrom highr hi_html
 ##' @export
 
 icut <- function(df, oldvar) {
     ## Check if df is an object or a character string
     if (!is.character(df)) df <- deparse(substitute(df))
     ## Check if df is a data frame
     if (!is.data.frame(get(df))) stop(sQuote(paste0(df, ' must be a data frame.')))
-    assign(".questionr_icut_df", df, envir=.GlobalEnv)
+    options(questionr_icut_df=df)
     ## If oldvar is not a character string, deparse it
     is_char <- FALSE
     try(if(is.character(oldvar)) is_char <- TRUE, silent=TRUE)
     if (!is_char) oldvar <- deparse(substitute(oldvar))
     ## Check if oldvar is a column of df
     if (!(oldvar %in% names(get(df)))) stop(sQuote(paste0(oldvar, ' must be a column of ', df, '.')))    
-    assign(".questionr_icut_oldvar", oldvar, envir=.GlobalEnv)
+    options(questionr_icut_oldvar=oldvar)
     ## Run shiny app
     invisible(shiny::runApp(system.file("icut", package="questionr")))
 }

R/iorder.R

@@ -16,21 +16,22 @@
 ##' \dontrun{data(hdv2003)
 ##' iorder(hdv2003, "qualif")}
 ##' @importFrom shiny runApp
+##' @importFrom highr hi_html
 ##' @export
 
 iorder <- function(df, oldvar) {
     ## Check if df is an object or a character string
     if (!is.character(df)) df <- deparse(substitute(df))
     ## Check if df is a data frame
     if (!is.data.frame(get(df))) stop(sQuote(paste0(df, ' must be a data frame.')))
-    assign(".questionr_iorder_df", df, envir=.GlobalEnv)
+    options(questionr_iorder_df=df)
     ## If oldvar is not a character string, deparse it
     is_char <- FALSE
     try(if(is.character(oldvar)) is_char <- TRUE, silent=TRUE)
     if (!is_char) oldvar <- deparse(substitute(oldvar))
     ## Check if oldvar is a column of df
     if (!(oldvar %in% names(get(df)))) stop(sQuote(paste0(oldvar, ' must be a column of ', df, '.')))    
-    assign(".questionr_iorder_oldvar", oldvar, envir=.GlobalEnv)
+    options(questionr_iorder_oldvar=oldvar)
     ## Run shiny app
     invisible(shiny::runApp(system.file("iorder", package="questionr")))
 }

R/irec.r

@@ -14,21 +14,22 @@
 ##' irec(hdv2003, "qualif")
 ##' irec(hdv2003, sexe) ## this also works}
 ##' @importFrom shiny runApp
+##' @importFrom highr hi_html
 ##' @export
 
 irec <- function(df, oldvar) {
     ## Check if df is an object or a character string
     if (!is.character(df)) df <- deparse(substitute(df))
     ## Check if df is a data frame
     if (!is.data.frame(get(df))) stop(sQuote(paste0(df, ' must be a data frame.')))
-    assign(".questionr_irec_df", df, envir=.GlobalEnv)
+    options(questionr_irec_df=df)
     ## If oldvar is not a character string, deparse it
     is_char <- FALSE
     try(if(is.character(oldvar)) is_char <- TRUE, silent=TRUE)
     if (!is_char) oldvar <- deparse(substitute(oldvar))
     ## Check if oldvar is a column of df
     if (!(oldvar %in% names(get(df)))) stop(sQuote(paste0(oldvar, ' must be a column of ', df, '.')))    
-    assign(".questionr_irec_oldvar", oldvar, envir=.GlobalEnv)
+    options(questionr_irec_oldvar=oldvar)
     ## Run shiny app
     invisible(shiny::runApp(system.file("irec", package="questionr")))
 }

inst/icut/server.R

@@ -3,10 +3,10 @@ library(highr)
 
 ## Global variables
 ## Original data frame name and object
-df_name <- get(".questionr_icut_df", .GlobalEnv)
+df_name <- getOption("questionr_icut_df")
 df <- get(df_name)
 ## Variable to be recoded, name and object
-oldvar_name <- get(".questionr_icut_oldvar", .GlobalEnv)
+oldvar_name <- getOption("questionr_icut_oldvar")
 oldvar <- df[,oldvar_name]
 ## Formatted source variable name
 src_var <- ifelse(grepl(" ", oldvar_name),

inst/icut/ui.R

@@ -2,18 +2,18 @@ library(shiny)
 library(xtable)
 
 ## Global variables
-df_name <- get(".questionr_icut_df", .GlobalEnv)
+df_name <- getOption("questionr_icut_df")
 df <- get(df_name)
-oldvar_name <- get(".questionr_icut_oldvar", .GlobalEnv)
+oldvar_name <- getOption("questionr_icut_oldvar")
 oldvar <- df[,oldvar_name]
 ## Formatted source variable name
 src_var <- ifelse(grepl(" ", oldvar_name),
                   sprintf('%s[,"%s"]', df_name, oldvar_name),
                   sprintf('%s$%s', df_name, oldvar_name))
 
 ## Flag to display the alert on first time launch
-display_alert <- !exists(".questionr_displayed_alert", .GlobalEnv)
-if (display_alert) assign(".questionr_displayed_alert", FALSE, envir=.GlobalEnv)
+display_alert <- is.null(getOption("questionr_displayed_alert"))
+if (display_alert) options(questionr_displayed_alert=TRUE)
 
 summary_table <- function(v) {
     out <- "<table class='table table-bordered table-condensed' id='sumtable'>"

inst/iorder/server.R

@@ -3,10 +3,10 @@ library(highr)
 
 ## Global variables
 ## Original data frame name and object
-df_name <- get(".questionr_iorder_df", .GlobalEnv)
+df_name <- getOption("questionr_iorder_df")
 df <- get(df_name)
 ## Variable to be recoded, name and object
-oldvar_name <- get(".questionr_iorder_oldvar", .GlobalEnv)
+oldvar_name <- getOption("questionr_iorder_oldvar")
 oldvar <- df[,oldvar_name]
 ## Formatted source variable name
 src_var <- ifelse(grepl(" ", oldvar_name),

inst/iorder/ui.R

@@ -1,18 +1,18 @@
 library(shiny)
 
 ## Global variables
-df_name <- get(".questionr_iorder_df", .GlobalEnv)
+df_name <- getOption("questionr_iorder_df")
 df <- get(df_name)
-oldvar_name <- get(".questionr_iorder_oldvar", .GlobalEnv)
+oldvar_name <- getOption("questionr_iorder_oldvar")
 oldvar <- df[,oldvar_name]
 ## Formatted source variable name
 src_var <- ifelse(grepl(" ", oldvar_name),
                   sprintf('%s[,"%s"]', df_name, oldvar_name),
                   sprintf('%s$%s', df_name, oldvar_name))
 
 ## Flag to display the alert on first time launch
-display_alert <- !exists(".questionr_displayed_alert", .GlobalEnv)
-if (display_alert) assign(".questionr_displayed_alert", FALSE, envir=.GlobalEnv)
+display_alert <- is.null(getOption("questionr_displayed_alert"))
+if (display_alert) options(questionr_displayed_alert=TRUE)
 
 
 generate_levels_ol <- function(oldvar) {
@@ -47,7 +47,7 @@ shinyUI(bootstrapPage(
                    div(class="span8",
                        div(class="alert alert-dismissable",
                            HTML('<button type="button" class="close" data-dismiss="alert" aria-hidden="true">&times;</button>'),
-                           HTML("<strong>Warning :</strong> This inteface doesn't do anything by itself. It only generates R code you'll have to copy/paste into your script and execute yourself.")
+                           HTML("<strong>Warning :</strong> This interface doesn't do anything by itself. It only generates R code you'll have to copy/paste into your script and execute yourself.")
                            )))} else "",
 
         ## First panel : new variable name and recoding style

inst/irec/server.R

@@ -3,10 +3,10 @@ library(highr)
 
 ## Global variables
 ## Original data frame name and object
-df_name <- get(".questionr_irec_df", .GlobalEnv)
+df_name <- getOption("questionr_irec_df")
 df <- get(df_name)
 ## Variable to be recoded, name and object
-oldvar_name <- get(".questionr_irec_oldvar", .GlobalEnv)
+oldvar_name <- getOption("questionr_irec_oldvar")
 oldvar <- df[,oldvar_name]
 ## Formatted source variable name
 src_var <- ifelse(grepl(" ", oldvar_name),

inst/irec/ui.R

@@ -1,16 +1,16 @@
 library(shiny)
 
 ## Global variables
-df_name <- get(".questionr_irec_df", .GlobalEnv)
-oldvar_name <- get(".questionr_irec_oldvar", .GlobalEnv)
+df_name <- getOption("questionr_irec_df")
+oldvar_name <- getOption("questionr_irec_oldvar")
 ## Formatted source variable name
 src_var <- ifelse(grepl(" ", oldvar_name),
                   sprintf('%s[,"%s"]', df_name, oldvar_name),
                   sprintf('%s$%s', df_name, oldvar_name))
 
 ## Flag to display the alert on first time launch
-display_alert <- !exists(".questionr_displayed_alert", .GlobalEnv)
-if (display_alert) assign(".questionr_displayed_alert", FALSE, envir=.GlobalEnv)
+display_alert <- is.null(getOption("questionr_displayed_alert"))
+if (display_alert) options(questionr_displayed_alert=TRUE)
 
 shinyUI(bootstrapPage(
 
@@ -31,7 +31,7 @@ shinyUI(bootstrapPage(
                    div(class="span12",
                        div(class="alert alert-dismissable",
                            HTML('<button type="button" class="close" data-dismiss="alert" aria-hidden="true">&times;</button>'),
-                           HTML("<strong>Warning :</strong> This inteface doesn't do anything by itself. It only generates R code you'll have to copy/paste into your script and execute yourself.")
+                           HTML("<strong>Warning :</strong> This interface doesn't do anything by itself. It only generates R code you'll have to copy/paste into your script and execute yourself.")
                            )))} else "",
 
         ## First panel : new variable name and recoding style