diff --git a/R/apply-table-changes.R b/R/apply-table-changes.R index 29b0d32..ef2ecec 100644 --- a/R/apply-table-changes.R +++ b/R/apply-table-changes.R @@ -42,7 +42,7 @@ applyChange <- function(table, change, trim=TRUE){ # Extract and shift to 1-based-indexing row <- as.integer(change[1]) + 1 col <- as.integer(change[2]) + 1 - old <- change[3] + old <- setHtableClass(change[3], table[row, col])[1, 1] new <- change[4] if (trim){ diff --git a/R/calc-htable-delta.R b/R/calc-htable-delta.R index 41578c4..dd0feb5 100644 --- a/R/calc-htable-delta.R +++ b/R/calc-htable-delta.R @@ -5,11 +5,10 @@ #' @param new The new data.frame #' @return A matrix in which each row represents a change from the old to the #' new matrix in the form of [row, col, newVal, oldVal]. -#' @author Jeff Allen \email{jeff@@trestletech.com} +#' @author Jeff Allen \email{jeff@@trestletech.com}, Jonathan Owen \email{jonathanro@@gmail.com}, Tadeas Palusga \email{tadeas@@palusga.cz} #' @export calcHtableDelta <- function (old, new, zeroIndex = TRUE){ - changes <- matrix(ncol=4, nrow=0) - colnames(changes) <- c("row", "col", "new", "old") + changes <- NULL # Loop through each column, comparing the data for(i in 1:(max(ncol(new), ncol(old)))){ @@ -18,36 +17,41 @@ calcHtableDelta <- function (old, new, zeroIndex = TRUE){ if (i > ncol(new)){ # the new data.frame doesn't have this column - thisColChanges <- matrix(c(1:nrow(old), - rep(i, nrow(old)), - rep(NA, nrow(old)), - old[,i]) - , ncol=4) + thisColChanges <- data.frame(1:nrow(old), + rep(i, nrow(old)), + rep(NA, nrow(old)), + old[,i]) } else if (i > ncol(old)){ # The old data.frame doesn't have this column - thisColChanges <- matrix(c(1:nrow(new), - rep(i, nrow(new)), - new[,i], - rep(NA, nrow(new))) - , ncol=4) + thisColChanges <- data.frame(1:nrow(new), + rep(i, nrow(new)), + new[,i], + rep(NA, nrow(new))) } else { # They both have this column deltaInd <- which(suppressWarnings(old[,i] != new[,i])) lng <- length(deltaInd) - thisColChanges <- matrix(c(deltaInd, - rep(i, lng), - new[deltaInd, i], - old[deltaInd, i]) - , ncol=4) + thisColChanges <- data.frame(deltaInd, + rep(i, lng), + new[deltaInd, i], + old[deltaInd, i]) } + if (is.logical(thisColChanges[, 3])) + thisColChanges[, 3] = ifelse(thisColChanges[, 3], "true", "false") + if (is.logical(thisColChanges[, 4])) + thisColChanges[, 4] = ifelse(thisColChanges[, 4], "true", "false") + if (zeroIndex && nrow(thisColChanges) > 0){ thisColChanges[,1] <- as.integer(thisColChanges[,1]) - 1; thisColChanges[,2] <- as.integer(thisColChanges[,2]) - 1; } - changes <- rbind(changes, thisColChanges) } + + if(!is.null(changes)) { + colnames(changes) <- c("row", "col", "new", "old") + } return (changes) } \ No newline at end of file diff --git a/R/get-htable-types.R b/R/get-htable-types.R index f373bc1..888267c 100644 --- a/R/get-htable-types.R +++ b/R/get-htable-types.R @@ -26,4 +26,39 @@ getHtableTypes <- function(data){ }) as.character(types) +} + +# Convert to specified class +# +# @param x vector +# @param cls character +# @return converted vector +# @seealso https://stackoverflow.com/questions/9214819/supply-a-vector-to-classes-of-dataframe +# @author Jonathan Owen, jonathanro@@gmail.com +toCls = function(x, cls) tryCatch(do.call(paste("as", cls, sep = "."), list(x)), + warning = function(w) do.call(as.character, list(x))) + +# Covert htable output matrix to data.frame using classes of model data.frame +# +# @param data htable matrix +# @param old original data.frame +# @return data.frame +# @seealso https://stackoverflow.com/questions/9214819/supply-a-vector-to-classes-of-dataframe +# @author Jonathan Owen, jonathanro@@gmail.com +setHtableClass = function(data, old) { + if (class(old) == "matrix") { + toCls(data, class(old[1, 1])) + } else { + data = as.data.frame(data, stringsAsFactors = FALSE) + + cls = sapply(old, class) + + # assume all cols are numeric, will be down coverted to character in toCls + # is there a better way to track which columns were added or removed? + if (length(cls) != ncol(data)) + cls = rep("numeric", ncol(data)) + + data = replace(data, values = Map(toCls, data, cls)) + } + data } \ No newline at end of file diff --git a/R/render-htable.R b/R/render-htable.R index 23fb1cb..6cd7391 100644 --- a/R/render-htable.R +++ b/R/render-htable.R @@ -58,11 +58,6 @@ renderHtable <- function(expr, env = parent.frame(), } delta <- calcHtableDelta(.oldTables[[shinysession$token]][[name]], data) - - # Avoid the awkward serialization of a row-less matrix in RJSONIO - if (nrow(delta) == 0){ - delta <- NULL - } .oldTables[[shinysession$token]][[name]] <- data