CRAN v0.5.2 released

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: periscope
 Type: Package
 Title: Enterprise Streamlined 'Shiny' Application Framework
-Version: 0.5.1
+Version: 0.5.2
 Authors@R: c(
     person("Constance", "Brett", email="connie@aggregate-genius.com", role = c("aut", "cre")),
     person("Isaac", "Neuhaus", role = "aut", comment = "canvasXpress JavaScript Library Maintainer"),
@@ -12,7 +12,7 @@ Description: An enterprise-targeted scalable and UI-standardized 'shiny' framewo
     including a variety of developer convenience functions with the goal of both 
     streamlining robust application development while assisting with creating a 
     consistent user experience regardless of application or developer.
-URL: https://github.com/cb4ds/periscope.git, http://periscopeapps.org:3838, https://www.canvasxpress.org
+URL: https://github.com/cb4ds/periscope, http://periscopeapps.org:3838, https://www.canvasxpress.org
 BugReports: https://github.com/cb4ds/periscope/issues
 Repository: BRAN
 License: GPL-3
@@ -28,12 +28,14 @@ Imports:
     shinyBS (>= 0.61),
     lubridate (>= 1.6),
     DT (>= 0.2),
-    openxlsx (>= 3.0),
+    writexl (>= 1.3),
     ggplot2 (>= 2.2),
-    methods
-RoxygenNote: 7.1.0
+    methods,
+    utils
+RoxygenNote: 7.1.1
 Suggests:
     knitr,
     rmarkdown,
-    testthat
+    testthat,
+    openxlsx (>= 3.0)
 VignetteBuilder: knitr

NEWS.md

@@ -1,5 +1,9 @@
 #Revisions and Change Log
 
+### v0.5.2
+* Moved openxlsx to suggested
+* Added tests
+
 ### v0.5.1  
 * Added support for other color schemes in the dashboard
 * Replaced CRAN-archived logging package functionality

R/convert_template.R

@@ -95,11 +95,12 @@ add_right_sidebar <- function(location) {
             usersep <- .Platform$file.sep
 
             files_updated <- c()
-            # replace ui by ui_plus (take car of resetbutton!)
+            # replace ui by ui_plus (take care of resetbutton!)
             ui_content <- gsub(" ", "", readLines(con = paste(location, ui_filename, sep = usersep)))
             # update ui if needed
             if (!any(grepl("fw_create_right_sidebar", ui_content))) {
-                reset_button <- TRUE
+                reset_button   <- TRUE
+                new_ui_content <- ui_content
                 if (any(grepl("resetbutton=FALSE", ui_content))) { 
                     reset_button <- FALSE 
                 }
@@ -108,6 +109,11 @@ add_right_sidebar <- function(location) {
                     if (!reset_button) {
                         new_ui_content <- gsub(create_left_sidebar_closed_expr, no_reset_button_closed_expr, new_ui_content)
                     }
+                } else {
+                    new_ui_content <- readLines(con = system.file("fw_templ", ui_plus_no_sidebar_filename, package = "periscope"))
+                    if (!reset_button) {
+                        new_ui_content <- gsub(create_left_sidebar_closed_expr, no_reset_button_closed_expr, new_ui_content)
+                    }
                 }
                 writeLines(new_ui_content, con = paste(location, ui_filename, sep = usersep))   
 

R/downloadFile.R

@@ -209,14 +209,17 @@ downloadFile <- function(input, output, session, logger,
         }
         # excel file
         else if (type == "xlsx") {
-            if ((class(data) == "Workbook") && ("openxlsx" %in% attributes(class(data)))) {
-                openxlsx::saveWorkbook(data, file)
-            }
-            else {
-                show_rownames <- attr(data, "show_rownames")
-                openxlsx::write.xlsx(data, file, 
-                                     asTable   = TRUE, 
-                                     row.names = !is.null(show_rownames) && show_rownames)
+            if ("openxlsx" %in% utils::installed.packages()) {
+                if ((class(data) == "Workbook") && ("openxlsx" %in% attributes(class(data)))) {
+                    openxlsx::saveWorkbook(data, file)
+                } else {
+                    show_rownames <- attr(data, "show_rownames")
+                        openxlsx::write.xlsx(data, file, 
+                                             asTable   = TRUE, 
+                                             row.names = !is.null(show_rownames) && show_rownames)
+                }
+            } else {
+                writexl::write_xlsx(data, file)
             }
         }
         # text file processing

cran-comments.md

@@ -1,6 +1,13 @@
 ## Comments from Maintainer
 
-Added functionality, testing and resolved the use of the archived logging package.
+UPDATE 9/20: removed .git from DESCRIPTION file to resolve note appearing on some servers
+
+Moved openxlsx to suggested and added tests.
+
+There is a NOTE on some servers 'unable to verify current time' while checking for future file timestamps (a devtools check).  There seems to be an issue with the world time server which is not something I can resolve in this package and I prefer not to silence the check in the package.  WinBuilder check did not have the issue but R-Hub Ubuntu reports this, and it appears to have happened before.  Pls. see references below:
+
+* https://stat.ethz.ch/pipermail/r-package-devel/2019q1/003577.html
+* https://stackoverflow.com/questions/63613301/r-cmd-check-note-unable-to-verify-current-time
 
 ---  
 
@@ -11,13 +18,13 @@ RStudio Server Pro (Ubuntu 18.04.2)
 
 * R 3.5.3  
 * R 3.6.3
-* R 4.0.1
+* R 4.0.2
 
 Travis-CI (Ubuntu 16.04.6)
 
 * R 3.6.3
-* R 4.0.0
-* R devel (2020-07-03 r78773)
+* R 4.0.2
+* R devel (2020-09-16 r79221)
 
 WinBuilder
 

tests/testthat/sample_app/program/fxn/plots.R

@@ -6,6 +6,7 @@ library(lattice)
 data(mtcars)
 mtcars$cyl <- factor(mtcars$cyl, levels = c(4,6,8),
                      labels = c("4cyl", "6cyl", "8cyl"))
+attr(mtcars, "show_rownames") <- TRUE
 
 
 # -- plotting functions

tests/testthat/sample_app_both_sidebar/global.R

@@ -0,0 +1,14 @@
+# -------------------------------------------------
+# --              FRAMEWORK global.R             --
+# -------------------------------------------------
+# NOTEs:                                         --
+# Program code goes in "program" directory files --
+# -------------------------------------------------
+# *****        DO NOT EDIT THIS FILE       ***** --
+# -------------------------------------------------
+
+library(periscope)
+library(shinyBS)
+
+
+source(paste("program", "global.R", sep = .Platform$file.sep), local = TRUE)

tests/testthat/sample_app_both_sidebar/program/data/.gitignore

@@ -0,0 +1,3 @@
+*
+*/
+!.gitignore

tests/testthat/sample_app_both_sidebar/program/fxn/plots.R

@@ -0,0 +1,58 @@
+library(ggplot2)
+library(lattice)
+
+
+# -- data for plots
+data(mtcars)
+mtcars$cyl <- factor(mtcars$cyl, levels = c(4,6,8),
+                     labels = c("4cyl", "6cyl", "8cyl"))
+attr(mtcars, "show_rownames") <- TRUE
+
+
+# -- plotting functions
+
+plot2ggplot <- function() {
+    plot <- ggplot(data = mtcars, aes(x = wt, y = mpg)) +
+        geom_point(aes(color = cyl)) +
+        theme(legend.justification = c(1, 1),
+              legend.position = c(1, 1),
+              legend.title = element_blank()) +
+        ggtitle("GGPlot Example w/Hover") +
+        xlab("wt") +
+        ylab("mpg")
+    return(plot)
+}
+
+
+plot2ggplot_data <- function() {
+    return(mtcars)
+}
+
+
+plot3lattice <- function() {
+    plot <- xyplot(mpg ~ wt , data = mtcars,
+                   pch = 1, groups = factor(cyl),
+                   auto.key = list(corner = c(1, 1)),
+                   main = "Lattice Example")
+    return(plot)
+}
+
+plot3lattice_data <- function() {
+    return(mtcars)
+}
+
+
+plot_htmlwidget <- function(report_modus = FALSE) {
+    venn <- data.frame(A   = 57,   B = 12, C   = 67, D   = 72, AB   = 4,
+                       AC  = 67,  AD = 25, BC  = 67, BD  = 27, CD   = 38,
+                       ABC = 69, ABD = 28, ACD = 52, BCD = 46, ABCD = 3)
+
+    htmlwidget <- canvasXpress(vennData = venn,
+                               graphType = 'Venn',
+                               vennGroups = 4,
+                               vennLegend = list(A = "List1", B = "List2", C = "List3", D = "List4"),
+                               title = "CanvasXpress Example",
+                               disableToolbar = report_modus,
+                               disableTouchToolbar = report_modus)
+    return(htmlwidget)
+}

tests/testthat/sample_app_both_sidebar/program/fxn/program_helpers.R

@@ -0,0 +1,29 @@
+library(dplyr)
+
+df <- read.csv("program/data/example.csv",
+               strip.white = T,
+               comment.char = "#")
+
+
+load_data1 <- function() {
+    ldf <- df %>%
+        filter(substr(Geographic.Area, 1, 1) == ".") %>%
+        mutate(Geographic.Area = substring(Geographic.Area, 2))
+
+    as.data.frame(ldf)
+}
+
+
+load_data2 <- function() {
+    ldf <- df %>%
+        filter(substr(Geographic.Area, 1, 1) != ".")
+
+    as.data.frame(ldf)
+}
+
+load_data3 <- function() {
+    ldf <- df %>%
+        select(1:3)
+
+    as.data.frame(ldf)
+}

tests/testthat/sample_app_both_sidebar/program/global.R

@@ -0,0 +1,26 @@
+# ----------------------------------------
+# --          PROGRAM global.R          --
+# ----------------------------------------
+# USE: Global variables and functions
+#
+# NOTEs:
+#   - All variables/functions here are
+#     globally scoped and will be available
+#     to server, UI and session scopes
+# ----------------------------------------
+
+# -- IMPORTS --
+library(canvasXpress)
+
+# -- Setup your Application --
+set_app_parameters(title = "Sample Title (click for an info pop-up)",
+                   titleinfo = HTML("<h3>Application Information Pop-Up</h3>",
+                                    "<p>This pop-up can contain any valid html
+                                     code.</p><p>If you prefer to have the title
+                                     link to any valid url location by providing
+                                     a character string to the titleinfo
+                                     parameter in <i>set_app_parameters(...)
+                                     </i> in program/global.R file.</p>"),
+                   loglevel = "DEBUG",
+                   app_version = "1.0.0")
+# -- PROGRAM --

tests/testthat/sample_app_both_sidebar/program/server_global.R

@@ -0,0 +1,41 @@
+# ----------------------------------------
+# --      PROGRAM server_global.R       --
+# ----------------------------------------
+# USE: Server-specific variables and
+#      functions for the main reactive
+#      shiny server functionality.  All
+#      code in this file will be put into
+#      the framework outside the call to
+#      shinyServer(function(input, output, session)
+#      in server.R
+#
+# NOTEs:
+#   - All variables/functions here are
+#     SERVER scoped and are available
+#     across all user sessions, but not to
+#     the UI.
+#
+#   - For user session-scoped items
+#     put var/fxns in server_local.R
+#
+# FRAMEWORK VARIABLES
+#     none
+# ----------------------------------------
+
+# -- IMPORTS --
+
+
+# -- VARIABLES --
+sg_example_data <- read.csv("program/data/example.csv",
+                            comment.char = c("#"),
+                            stringsAsFactors = F)
+    #note - since this is an example, the dataset provided is a reference
+    #       dataset.  This file is being read in server_global.R, where you
+    #       should only load data that will be available to ALL users/sessions.
+    #       ** IMPORTANT **
+    #       Do not read user-specific data in this file or global.R, use
+    #       server-local.R for user-specific (i.e. session-specific) data!
+
+# -- FUNCTIONS --
+
+