Merge pull request #22 from Swechhya/auto-column-type

Add column type mapping

Author: Swechhya

R/get_col_types.R

@@ -0,0 +1,29 @@
+# Get column types of the given data
+get_col_types <-  function(data) {
+
+  if(is.data.frame(data)){
+
+    colTypes <-  as.character(lapply(data,class))
+
+  }else if(is.matrix(data)){
+
+    colTypes <-  rep(typeof(data), ncol(data))
+
+  }else {
+
+    stop("'data' must be either a matrix or a data frame, cannot be ",
+         class(data))
+  }
+  mappedColTypes <- sapply(colTypes, function(colType){
+    switch(colType,
+           factor = "text",
+           integer="integer",
+           double="numeric",
+           logical="checkbox",
+           Date="calendar",
+           numeric="numeric",
+           "text")
+  })
+
+  as.character(mappedColTypes)
+}

R/jexcel.R

@@ -54,6 +54,8 @@
 #' @param loadingSpin a boolean value indicating if loading spinner should be enabled. By default it is set to false.
 #' @param style a named list to specify style for each cell. The name should be the cell address and the value should be
 #' a valid 'css' string with styles.  For example, to style cell 'A1', the list should look like
+#' @param autoColTypes a boolean value indicating if column type should be automatically detected if
+#' 'type' is not specified in 'columns' attribute
 #' \code{style = list("A1" = "background-color: gray;")}.
 #' @import jsonlite
 #' @import htmlwidgets
@@ -86,7 +88,8 @@ excelTable <-
            fullscreen = FALSE,
            lazyLoading = FALSE,
            loadingSpin = FALSE,
-           style = NULL) {
+           style = NULL,
+           autoColTypes = TRUE) {
     # List of parameters to send to js
     paramList <- list()
 
@@ -137,8 +140,7 @@ excelTable <-
       paramList$colHeaders <- jsonlite::toJSON(colHeaders)
 
 
-    } else if (!is.null(columns))
-    {
+    } else if (!is.null(columns)) {
       #Check if 'columns' is a dataframe
       if (!is.data.frame(columns)) {
         stop("'columns' must be a dataframe, cannot be ", class(columns))
@@ -189,6 +191,29 @@ excelTable <-
 
     }
 
+    #Check autoColTypes
+    #If 'type' attribute is not specified in column and autoColTypes is true, then we map this and add it
+    #column attributes
+    if(autoColTypes && !is.null(data)){
+      if(is.null(columns)){
+        message("Since 'type' attribute is not specified and autoColTypes is true, detecting type from 'data'")
+
+        colTypes <- get_col_types(data)
+        columns <- data.frame(type=colTypes)
+        paramList$columns <- jsonlite::toJSON(columns)
+      }else{
+        if(!"type" %in% colnames(columns) && autoColTypes){
+          message("Since 'type' attribute is not specified and autoColTypes is true, detecting type from 'data'")
+
+          colTypes <- get_col_types(data)
+          columns$type <- colTypes
+          paramList$columns <-
+            jsonlite::toJSON(columns[colnames(columns) %in% colAttributes])
+        }
+      }
+    }
+
+
     #Check row height
     if (!is.null(rowHeight)) {
       if (!is.data.frame(rowHeight) && !is.matrix(rowHeight)) {
@@ -210,7 +235,7 @@ excelTable <-
     if (!is.null(nestedHeaders)) {
       # nestedHeaders should be list
       if (!is.list(nestedHeaders)) {
-        stop("'nestedHeaders' must be a list of dataframe(s), cannot be ", 
+        stop("'nestedHeaders' must be a list of dataframe(s), cannot be ",
         class(nestedHeaders))
       }
 

inst/htmlwidgets/jexcel.js

@@ -52,7 +52,10 @@ HTMLWidgets.widget({
       }
 
         excel = jexcel(container, otherParams);
-        excel.updateSelectionFromCoords(selection[0], selection[1], selection[2], selection[3]);
+        
+        if(selection){
+          excel.updateSelectionFromCoords(selection[0], selection[1], selection[2], selection[3]);
+        }
 
       },
 
@@ -72,7 +75,7 @@ HTMLWidgets.widget({
       },
 
       onChangeHeader: function(obj, column, oldValue, newValue){
-        debugger;
+  
         if (HTMLWidgets.shinyMode) {
           var newColHeader = this.colHeaders;
           newColHeader[parseInt(column)] = newValue;

man/excelTable.Rd

@@ -0,0 +1,47 @@
+context("'autoColType' argument")
+
+test_that("'autoColType' returns null when data is null ", {
+
+  testthat::expect_null(excelTable()$x$autoColType)
+})
+
+test_that("'autoColType' returns null when 'data' is not null and 'autoColType' is FALSE", {
+  d <- matrix(1:100, ncol=10)
+  testthat::expect_null(suppressWarnings(excelTable(data = d, autoColType = FALSE)$x$autoColType))
+})
+
+test_that("'autoColType' returns null when 'data' is not null and 'type' attribute in column is specified", {
+  data <- data.frame(Model = c('Mazda', 'Pegeout', 'Honda Fit', 'Honda CRV'),
+                  Date=c('2006-01-01', '2005-01-01','2004-01-01', '2003-01-01' ))
+
+columns <-  data.frame(title=c('Model', 'Date' ),
+                     width= c(300, 300),
+                     type=c('text', 'calendar'))
+  testthat::expect_null(suppressWarnings(excelTable(data = data, columns=columns)$x$autoColType))
+})
+
+test_that("'autoColType' returns valid values when 'data' is not null and 'type' attribute in columns is not specified", {
+  data <- data.frame(Model = c('Mazda', 'Pegeout', 'Honda Fit', 'Honda CRV'),
+                  Date=c('TRUE', 'FALSE', 'TRUE', 'TRUE' ))
+
+   testthat::expect_s3_class(suppressWarnings(excelTable(data = data))$x$columns, "json")
+})
+
+test_that("'type' attribute of 'columns' should return supplied value when 'data' is not null and 'type' attribute in columns is specified", {
+ data <- data.frame(Model = c('Mazda', 'Pegeout', 'Honda Fit', 'Honda CRV'),
+                   Date=c('2006-01-01', '2005-01-01','2004-01-01', '2003-01-01' ),
+                   Availability = c(TRUE, FALSE, TRUE, TRUE))
+
+ columns <- data.frame(title=c('Model', 'Date', 'Availability'),
+                      width= c(300, 300, 300),
+                      type=c('text', 'calendar', 'checkbox')) 
+   testthat::expect_equal(jsonlite::fromJSON(suppressWarnings(excelTable(data = data, columns=columns))$x$columns)$type, 
+   c("text", "calendar", "checkbox"))
+})
+
+test_that("'autoColType' returns valid values when 'data' is not null and 'type' attribute in columns is not specified", {
+  data <- data.frame(Model = c('Mazda', 'Pegeout', 'Honda Fit', 'Honda CRV'),
+                  Date=c('TRUE', 'FALSE', 'TRUE', 'TRUE' ))
+
+   testthat::expect_message(suppressWarnings(excelTable(data = data)))
+})

tests/testthat/test_autoColType.R

@@ -9,3 +9,10 @@ test_that("valid 'data' object is passed to htmlwidget", {
   d <- matrix(1:100, ncol=10)
   testthat::expect_s3_class(suppressWarnings(excelTable(data=d))$x$data, "json")
 })
+
+test_that("valid 'data' object is passed to htmlwidget", {
+  d <- data.frame(Model = c('Mazda', 'Pegeout', 'Honda Fit', 'Honda CRV'),
+                   Availability = c(TRUE, FALSE, TRUE, TRUE))
+  testthat::expect_s3_class(suppressWarnings(excelTable(data=d))$x$data, "json")
+})
+

tests/testthat/test_data.R

@@ -0,0 +1,56 @@
+context("get_col_types")
+
+test_that("'get_col_types' argument gives error if 'data' not a dataframe or matrix", {
+    d <- c(1:10)
+    testthat::expect_error(get_col_types(data = d), c("'data' must be either a matrix or a data frame, cannot be integer"))
+})
+
+test_that("'get_col_types' argument gives character if 'data' a dataframe or matrix", {
+  d <- matrix(1:100, ncol=10)
+  testthat::expect_equal(get_col_types(data=d), rep("integer", 10))
+})
+
+test_that("'get_col_types' argument gives character if 'data' a dataframe or matrix", {
+  d <- data.frame(Model = c('Mazda', 'Pegeout', 'Honda Fit', 'Honda CRV'))
+
+  testthat::expect_equal(get_col_types(data=d), c("text"))
+})
+
+test_that("'get_col_types' argument gives character if 'data' a dataframe or matrix", {
+  d <- data.frame(Model = c('Mazda', 'Pegeout', 'Honda Fit', 'Honda CRV'),
+                   Availability = c(TRUE, FALSE, TRUE, TRUE))
+  testthat::expect_equal(get_col_types(data=d), c("text", "checkbox"))
+})
+
+test_that("'get_col_types' argument gives character if 'data' a dataframe or matrix", {
+  d <- data.frame(Model = c('Mazda', 'Pegeout', 'Honda Fit', 'Honda CRV'),
+                    Date=c(as.Date('2006-01-01'), as.Date('2005-01-01'),
+                    as.Date('2004-01-01'), as.Date('2003-01-01' )))
+
+  testthat::expect_equal(get_col_types(data=d), c("text", "calendar"))
+})
+
+test_that("'get_col_types' argument gives character if 'data' a dataframe or matrix", {
+  d <- data.frame( value = c(0.1, 0.2, 0.3))
+  testthat::expect_equal(get_col_types(data=d), c("numeric"))
+})
+
+test_that("'get_col_types' argument gives character if 'data' a dataframe or matrix", {
+  d <- data.frame( value = LETTERS[1:10], stringsAsFactors = FALSE)
+  testthat::expect_equal(get_col_types(data=d), c("text"))
+})
+
+test_that("'get_col_types' argument gives character if 'data' a dataframe or matrix", {
+  d <- data.frame( value =  c(1, 2.5, 4.5) )
+  testthat::expect_equal(get_col_types(data=d), c("numeric"))
+})
+
+test_that("'get_col_types' argument gives error if 'data' not a dataframe or matrix", {
+    d <- 1
+    testthat::expect_error(get_col_types(data = d), c("'data' must be either a matrix or a data frame, cannot be numeric"))
+})
+
+test_that("'get_col_types' argument gives character if 'data' a dataframe or matrix", {
+  d <- matrix( c(as.double(1), as.double(2.5)), ncol=1)
+  testthat::expect_equal(get_col_types(data=d), c("numeric"))
+})