tidy R code (again)

R/as.scalar.R

@@ -9,7 +9,8 @@
 #' @examples toJSON(list(foo=123));
 #' toJSON(list(foo=as.scalar(123)));
 as.scalar <- function(obj) {
-  # Lists can never be a scalar (this can arise if a dataframe contains a column with lists)
+  # Lists can never be a scalar (this can arise if a dataframe contains a column
+  # with lists)
   if (is.data.frame(obj)) {
     if (nrow(obj) > 1) {
       warning("as.scalar was applied to dataframe with more than 1 row.")

R/asJSON.ANY.R

@@ -6,8 +6,9 @@ setMethod("asJSON", "ANY", function(x, force = FALSE, ...) {
       stop("No S4 method for object of class:", class(x))
     }
   } else if (length(class(x)) > 1) {
-    # If an object has multiple classes, we recursively try the next class. This is S3 style dispatching that doesn't work
-    # by default for formal method definitions There should be a more native way to accomplish this
+    # If an object has multiple classes, we recursively try the next class. This is
+    # S3 style dispatching that doesn't work by default for formal method definitions
+    # There should be a more native way to accomplish this
     return(asJSON(structure(x, class = class(x)[-1]), ...))
   } else if (isTRUE(force) && existsMethod("asJSON", class(unclass(x)))) {
     # As a last resort we can force encoding using the unclassed object

R/asJSON.Date.R

@@ -4,6 +4,7 @@ setMethod("asJSON", "Date", function(x, Date = c("ISO8601", "epoch"), ...) {
   Date <- match.arg(Date)
 
   # select a schema
-  output <- switch(Date, ISO8601 = as.iso(x), epoch = unclass(x), default = stop("Invalid argument for 'Date':", Date))
+  output <- switch(Date, ISO8601 = as.iso(x), epoch = unclass(x), default = stop("Invalid argument for 'Date':", 
+    Date))
   return(asJSON(output, ...))
 }) 

R/asJSON.POSIXt.R

@@ -1,5 +1,7 @@
-setMethod("asJSON", "POSIXt", function(x, POSIXt = c("string", "ISO8601", "epoch", "mongo"), UTC = FALSE, digits, ...) {
-  # note: UTC argument doesn't seem to be working consistently maybe use ?format instead of ?as.character
+setMethod("asJSON", "POSIXt", function(x, POSIXt = c("string", "ISO8601", "epoch", 
+  "mongo"), UTC = FALSE, digits, ...) {
+  # note: UTC argument doesn't seem to be working consistently maybe use ?format
+  # instead of ?as.character
 
   # Validate
   POSIXt <- match.arg(POSIXt)

R/asJSON.character.R

@@ -1,5 +1,5 @@
-setMethod("asJSON", "character", function(x, container = TRUE, na = c("default", "null", "string"), ...) {
-
+setMethod("asJSON", "character", function(x, container = TRUE, na = c("default", 
+  "null", "string"), ...) {
   # 0 vector is not handled properly by paste()
   if (!length(x)) 
     return("[]")

R/asJSON.classRepresentation.R

@@ -1,7 +1,9 @@
-# classRepresentation is an object that defines an S4 class encoding it usually doesn't serve much purpose, however as
-# we don't wnat to encode it as a regular S4 data object.
+# classRepresentation is an object that defines an S4 class encoding it usually
+# doesn't serve much purpose, however as we don't wnat to encode it as a regular
+# S4 data object.
 
-# it currently only encodes the slots. we could add encoding of methods of that would be desired.
+# it currently only encodes the slots. we could add encoding of methods of that
+# would be desired.
 
 setMethod("asJSON", "classRepresentation", function(x, ...) {
   return(asJSON(attributes(x)$slots, ...))

R/asJSON.complex.R

@@ -1,5 +1,5 @@
-setMethod("asJSON", "complex", function(x, digits = 5, container = TRUE, complex = c("string", "list"), na = "string", 
-  ...) {
+setMethod("asJSON", "complex", function(x, digits = 5, container = TRUE, complex = c("string", 
+  "list"), na = "string", ...) {
   # validate
   complex <- match.arg(complex)
 
@@ -20,8 +20,8 @@ setMethod("asJSON", "complex", function(x, digits = 5, container = TRUE, complex
   } else {
     mylist <- list(real = Re(x), imaginary = Im(x))
 
-    # this is a bit of a hack if container is false, this is length 1 vector so we have to actually apply this so the real
-    # and imaginary elements of the list
+    # this is a bit of a hack if container is false, this is length 1 vector so we
+    # have to actually apply this so the real and imaginary elements of the list
     if (!container) {
       mylist <- lapply(mylist, as.scalar)
     }

R/asJSON.data.frame.R

@@ -1,8 +1,9 @@
-setMethod("asJSON", "data.frame", function(x, na = c("default", "null", "string"), container = TRUE, dataframe = c("rows", 
-  "columns"), raw, ...) {
-  # Note: just as in asJSON.list we take the container argument to prevent it form being passed down through ... This is
-  # needed in the rare case that a dataframe contains new dataframes, and hence as.scalar is inappropriate check how we
-  # want to encode
+setMethod("asJSON", "data.frame", function(x, na = c("default", "null", "string"), 
+  container = TRUE, dataframe = c("rows", "columns"), raw, ...) {
+  # Note: just as in asJSON.list we take the container argument to prevent it form
+  # being passed down through ... This is needed in the rare case that a dataframe
+  # contains new dataframes, and hence as.scalar is inappropriate check how we want
+  # to encode
   dataframe <- match.arg(dataframe)
   na <- match.arg(na)
 
@@ -12,7 +13,8 @@ setMethod("asJSON", "data.frame", function(x, na = c("default", "null", "string"
   }
 
   if (dataframe == "columns") {
-    return(asJSON(as.list(x), na = na, container = container, dataframe = "columns", raw = "hex", ...))
+    return(asJSON(as.list(x), na = na, container = container, dataframe = "columns", 
+      raw = "hex", ...))
   }
 
   # if we have no rows, just return: []

R/asJSON.factor.R

@@ -1,5 +1,4 @@
 setMethod("asJSON", "factor", function(x, factor = c("string", "integer"), ...) {
-
   # validate
   factor <- match.arg(factor)
 

R/asJSON.function.R

@@ -1,4 +1,5 @@
-setMethod("asJSON", "function", function(x, container = TRUE, fun = c("source", "list"), ...) {
+setMethod("asJSON", "function", function(x, container = TRUE, fun = c("source", "list"), 
+  ...) {
   # validate
   fun <- match.arg(fun)
 

R/asJSON.int64.R

@@ -1,4 +1,5 @@
 setOldClass("int64")
-setMethod("asJSON", "int64", function(x, ...) asJSON(as.double(as.character(x)), digits = 0, ...))
+setMethod("asJSON", "int64", function(x, ...) asJSON(as.double(as.character(x)), 
+  digits = 0, ...))
 
 ## int64 does not have direct as.double or as.numeric ???? 

R/asJSON.integer.R

@@ -1,3 +1,4 @@
 setOldClass("integer")
-setMethod("asJSON", "integer", function(x, digits, ...) asJSON(as.double(x), digits = 0, ...))
-
+setMethod("asJSON", "integer", function(x, digits, ...) {
+  asJSON(as.double(x), digits = 0, ...)
+}) 

R/asJSON.list.R

@@ -1,7 +1,8 @@
 setMethod("asJSON", "list", function(x, container = TRUE, ...) {
 
-  # We are explicitly taking the container argument to prevent it from being passed down through ... (elipse) As scalar
-  # should never be applied to an entire list (unless it is POSIXlt or so)
+  # We are explicitly taking the container argument to prevent it from being passed
+  # down through ... (elipse) As scalar should never be applied to an entire list
+  # (unless it is POSIXlt or so)
 
   # coerse pairlist if needed
   if (is.pairlist(x)) {
@@ -13,8 +14,8 @@ setMethod("asJSON", "list", function(x, container = TRUE, ...) {
     return(if (is.null(names(x))) "[]" else "{}")
   }
 
-  # this condition appears when a dataframe contains a column with lists we need to do this, because the [ operator
-  # always returns a list of length 1
+  # this condition appears when a dataframe contains a column with lists we need to
+  # do this, because the [ operator always returns a list of length 1
   if (length(x) == 1 && is.null(names(x)) && container == FALSE) {
     return(asJSON(x[[1]], ...))
   }
@@ -28,11 +29,12 @@ setMethod("asJSON", "list", function(x, container = TRUE, ...) {
 
   if (length(names(x))) {
     objnames <- names(x)
-    objnames[objnames == ""] <- as.character(1:length(objnames))[objnames == ""]
+    objnames[objnames == ""] <- as.character(1:length(objnames))[objnames == 
+      ""]
     objnames <- make.unique(objnames)
-    return(paste("{", paste(deparse_vector(objnames), els, sep = " : ", collapse = ", "), "}"))
+    return(paste("{", paste(deparse_vector(objnames), els, sep = " : ", collapse = ", "), 
+      "}"))
   } else {
     return(paste("[", paste(els, collapse = ","), "]"))
   }
-})
-
+}) 

R/asJSON.logical.R

@@ -1,5 +1,4 @@
 setMethod("asJSON", "logical", function(x, container = TRUE, na = "null", ...) {
-
   # empty vector
   if (!length(x)) 
     return("[]")

R/asJSON.matrix.R

@@ -1,8 +1,7 @@
-# NOTE: opencpu.encode is never upposed to use this function, because it unclasses every object first.  it is included
-# for completeness.
+# NOTE: opencpu.encode is never upposed to use this function, because it
+# unclasses every object first.  it is included for completeness.
 
 setMethod("asJSON", "matrix", function(x, container = TRUE, ...) {
-
   # row based json
   tmp <- paste(apply(x, 1, asJSON, ...), collapse = ", ")
 

R/asJSON.numeric.R

@@ -1,7 +1,9 @@
-setMethod("asJSON", "numeric", function(x, container = TRUE, digits = 5, na = "string", ...) {
+setMethod("asJSON", "numeric", function(x, container = TRUE, digits = 5, na = "string", 
+  ...) {
   # empty vector
-  if (!length(x)) 
+  if (!length(x)) {
     return("[]")
+  }
 
   # pretty format numbers
   tmp <- trim(formatC(x, digits = digits, format = "f", drop0trailing = TRUE))

R/base64.R

@@ -1,5 +1,5 @@
-# These functions have been taken from the base64 package by Francois Romain. It was easier to copy then to import.
-# They will not be exported
+# These functions have been taken from the base64 package by Francois Romain. It
+# was easier to copy then to import.  They will not be exported
 
 
 base64_decode <- function(input) {

R/fixNativeSymbol.R

@@ -12,7 +12,8 @@ fixNativeSymbol <- function(symbol) {
       pkgDLL <- getLoadedDLLs()[[name]]
 
       # reconstruct the native symbol address
-      newsymbol <- getNativeSymbolInfo(name = symbol$name, PACKAGE = pkgDLL, withRegistrationInfo = TRUE)
+      newsymbol <- getNativeSymbolInfo(name = symbol$name, PACKAGE = pkgDLL, 
+        withRegistrationInfo = TRUE)
       symbol$address <- newsymbol$address
       return(symbol)
     } else if (rVersion >= "2.14") {

R/fromJSON.R

@@ -41,7 +41,8 @@
 #' 
 #' #parse it back
 #' fromJSON(jsoncars)
-fromJSON <- function(txt, simplifyVector = TRUE, simplifyDataFrame = simplifyVector, simplifyMatrix = simplifyVector) {
+fromJSON <- function(txt, simplifyVector = TRUE, simplifyDataFrame = simplifyVector, 
+  simplifyMatrix = simplifyVector) {
 
   # check type
   if (!is.character(txt)) {
@@ -52,7 +53,8 @@ fromJSON <- function(txt, simplifyVector = TRUE, simplifyDataFrame = simplifyVec
   if (length(txt) == 1 && nchar(txt) < 1000) {
     if (grepl("^https?://", txt)) {
       tryCatch(getNamespace("httr"), error = function(e) {
-        stop("Package httr not found. Please run: install.packages('httr')", call. = FALSE)
+        stop("Package httr not found. Please run: install.packages('httr')", 
+          call. = FALSE)
       })
       req <- httr::GET(txt, httr::add_headers(`User-Agent` = "RCurl-httr-jsonlite"))
       httr::stop_for_status(req)
@@ -77,7 +79,8 @@ fromJSON <- function(txt, simplifyVector = TRUE, simplifyDataFrame = simplifyVec
 
   # post processing
   if (any(isTRUE(simplifyVector), isTRUE(simplifyDataFrame), isTRUE(simplifyMatrix))) {
-    return(simplify(obj, simplifyVector = simplifyVector, simplifyDataFrame = simplifyDataFrame, simplifyMatrix = simplifyMatrix))
+    return(simplify(obj, simplifyVector = simplifyVector, simplifyDataFrame = simplifyDataFrame, 
+      simplifyMatrix = simplifyMatrix))
   } else {
     return(obj)
   }

R/helpfunctions.R

@@ -1,5 +1,6 @@
-# S4 to list object. Not quite sure if this really works in general. You probably shouldn't use S4 instances with JSON
-# anyway because you don't know the class definition.
+# S4 to list object. Not quite sure if this really works in general. You probably
+# shouldn't use S4 instances with JSON anyway because you don't know the class
+# definition.
 
 S4tolist <- function(x) {
   structure(lapply(slotNames(x), slot, object = x), .Names = slotNames(x))

R/makesymbol.R

@@ -1,5 +1,5 @@
-# Note: 'symbol' is the same thing as 'name' For some reason, as.name('') gives an error, even though it is needed
-# sometimes. This is a workaround
+# Note: 'symbol' is the same thing as 'name' For some reason, as.name('') gives
+# an error, even though it is needed sometimes. This is a workaround
 makesymbol <- function(x) {
   if (missing(x) || nchar(x) == 0) {
     return(substitute())

R/mongoexport.R

@@ -22,7 +22,8 @@ toMongo <- function(x, jsonArray = FALSE, ...) {
   } else {
     output <- rep(NA, nrow(x))
     for (i in 1:nrow(x)) {
-      output[i] <- asJSON(as.scalar(x[i, , drop = FALSE]), POSIXt = "mongo", raw = "mongo", pretty = FALSE, ...)
+      output[i] <- asJSON(as.scalar(x[i, , drop = FALSE]), POSIXt = "mongo", 
+        raw = "mongo", pretty = FALSE, ...)
     }
   }
   return(paste(output, collapse = "\n"))

R/pack.R

@@ -1,4 +1,5 @@
-# Note: For S4, the value is the class defintion. The slots (data) are in the attributes.
+# Note: For S4, the value is the class defintion. The slots (data) are in the
+# attributes.
 pack <- function(obj, ...) {
 
   # encode by storage mode
@@ -15,31 +16,39 @@ pack <- function(obj, ...) {
   }
 
   # encode recursively
-  list(type = as.scalar(encoding.mode), attributes = givename(lapply(attributes(obj), pack, ...)), value = switch(encoding.mode, 
-    `NULL` = obj, environment = NULL, externalptr = NULL, namespace = lapply(as.list(getNamespaceInfo(obj, "spec")), 
-      as.scalar), S4 = list(class = as.scalar(as.character(attr(obj, "class"))), package = as.scalar(attr(attr(obj, 
-      "class"), "package"))), raw = as.scalar(base64_encode(unclass(obj))), logical = as.vector(unclass(obj), mode = "logical"), 
-    integer = as.vector(unclass(obj), mode = "integer"), numeric = as.vector(unclass(obj), mode = "numeric"), double = as.vector(unclass(obj), 
-      mode = "double"), character = as.vector(unclass(obj), mode = "character"), complex = as.vector(unclass(obj), 
-      mode = "complex"), list = unname(lapply(obj, pack, ...)), pairlist = unname(lapply(as.vector(obj, mode = "list"), 
-      pack, ...)), closure = unname(lapply(obj, pack, ...)), builtin = as.scalar(base64_encode(serialize(unclass(obj), 
-      NULL))), special = as.scalar(base64_encode(serialize(unclass(obj), NULL))), language = deparse(unclass(obj)), 
-    name = deparse(unclass(obj)), symbol = deparse(unclass(obj)), expression = deparse(obj[[1]]), warning("No encoding has been defined for objects with storage mode ", 
+  list(type = as.scalar(encoding.mode), attributes = givename(lapply(attributes(obj), 
+    pack, ...)), value = switch(encoding.mode, `NULL` = obj, environment = NULL, 
+    externalptr = NULL, namespace = lapply(as.list(getNamespaceInfo(obj, "spec")), 
+      as.scalar), S4 = list(class = as.scalar(as.character(attr(obj, "class"))), 
+      package = as.scalar(attr(attr(obj, "class"), "package"))), raw = as.scalar(base64_encode(unclass(obj))), 
+    logical = as.vector(unclass(obj), mode = "logical"), integer = as.vector(unclass(obj), 
+      mode = "integer"), numeric = as.vector(unclass(obj), mode = "numeric"), 
+    double = as.vector(unclass(obj), mode = "double"), character = as.vector(unclass(obj), 
+      mode = "character"), complex = as.vector(unclass(obj), mode = "complex"), 
+    list = unname(lapply(obj, pack, ...)), pairlist = unname(lapply(as.vector(obj, 
+      mode = "list"), pack, ...)), closure = unname(lapply(obj, pack, ...)), 
+    builtin = as.scalar(base64_encode(serialize(unclass(obj), NULL))), special = as.scalar(base64_encode(serialize(unclass(obj), 
+      NULL))), language = deparse(unclass(obj)), name = deparse(unclass(obj)), 
+    symbol = deparse(unclass(obj)), expression = deparse(obj[[1]]), warning("No encoding has been defined for objects with storage mode ", 
       encoding.mode, " and will be skipped.")))
 }
 
 unpack <- function(obj) {
 
   encoding.mode <- obj$type
 
-  newdata <- c(list(.Data = switch(encoding.mode, `NULL` = NULL, environment = emptyenv(), namespace = getNamespace(obj$value$name), 
-    externalptr = NULL, S4 = getClass(obj$value$class, where = getNamespace(obj$value$package)), raw = base64_decode(obj$value), 
-    logical = as.logical(null2na(obj$value)), integer = as.integer(null2na(obj$value)), numeric = as.numeric(null2na(obj$value)), 
-    double = as.double(null2na(obj$value)), character = as.character(null2na(obj$value)), complex = buildcomplex(obj$value), 
+  newdata <- c(list(.Data = switch(encoding.mode, `NULL` = NULL, environment = emptyenv(), 
+    namespace = getNamespace(obj$value$name), externalptr = NULL, S4 = getClass(obj$value$class, 
+      where = getNamespace(obj$value$package)), raw = base64_decode(obj$value), 
+    logical = as.logical(null2na(obj$value)), integer = as.integer(null2na(obj$value)), 
+    numeric = as.numeric(null2na(obj$value)), double = as.double(null2na(obj$value)), 
+    character = as.character(null2na(obj$value)), complex = buildcomplex(obj$value), 
     list = lapply(obj$value, unpack), pairlist = lapply(obj$value, unpack), symbol = makesymbol(x = unlist(obj$value)), 
-    name = makesymbol(x = unlist(obj$value)), expression = parse(text = obj$value), language = as.call(parse(text = unlist(obj$value)))[[1]], 
-    special = unserialize(base64_decode(obj$value)), builtin = unserialize(base64_decode(obj$value)), closure = lapply(obj$value, 
-      unpack), stop("Switch falling through for encode.mode: ", encoding.mode))), lapply(obj$attributes, unpack))
+    name = makesymbol(x = unlist(obj$value)), expression = parse(text = obj$value), 
+    language = as.call(parse(text = unlist(obj$value)))[[1]], special = unserialize(base64_decode(obj$value)), 
+    builtin = unserialize(base64_decode(obj$value)), closure = lapply(obj$value, 
+      unpack), stop("Switch falling through for encode.mode: ", encoding.mode))), 
+    lapply(obj$attributes, unpack))
 
   # this is for serializing functions arguments: as.list(lm)$data
   if (identical(newdata[[1]], substitute())) {

R/parseJSON.R

@@ -9,5 +9,6 @@ parseJSON <- function(txt) {
   encoding <- mapEncoding(Encoding(txt))
 
   # libjson call
-  .Call("R_fromJSON", PACKAGE = "jsonlite", txt, as.integer(FALSE), NULL, simplifyWithNames, encoding, NULL, stringFunType = c(GARBAGE = 4L))
+  .Call("R_fromJSON", PACKAGE = "jsonlite", txt, as.integer(FALSE), NULL, simplifyWithNames, 
+    encoding, NULL, stringFunType = c(GARBAGE = 4L))
 } 

R/parseTimestamp.R

@@ -1,4 +1,5 @@
-# timestamps can either be: ISO8601 (various formats), R style print, GMT epoch ms, or mongo
+# timestamps can either be: ISO8601 (various formats), R style print, GMT epoch
+# ms, or mongo
 
 parseTimestamp <- function(x) {
   UseMethod("parseTimestamp")
@@ -8,7 +9,8 @@ parseTimestamp <- function(x) {
 #' @S3method parseTimestamp numeric
 parseTimestamp.numeric <- function(x) {
   if (any(x < 1e+10) && all(x < 1e+10)) {
-    warning("Timestamps seem low. Make sure they are milliseconds and not seconds:\n\n", x)
+    warning("Timestamps seem low. Make sure they are milliseconds and not seconds:\n\n", 
+      x)
   }
   structure(x/1000, class = c("POSIXct", "POSIXt"))
 }
@@ -34,9 +36,10 @@ parseTimestamp.character <- function(x) {
   substring(x, 11) <- "T"
 
   # select format
-  outtime <- switch(datepattern, ISODATE = strptime(x, "%Y-%m-%d"), ISOTIME = strptime(x, "%Y-%m-%dT%H:%M"), ISOTIMEUTC = strptime(x, 
-    "%Y-%m-%dT%H:%MZ", tz = "UTC"), ISOTIMESECONDS = strptime(x, "%Y-%m-%dT%H:%M:%S"), ISOTIMESECONDSUTC = strptime(x, 
-    "%Y-%m-%dT%H:%M:%SZ", tz = "UTC"), )
+  outtime <- switch(datepattern, ISODATE = strptime(x, "%Y-%m-%d"), ISOTIME = strptime(x, 
+    "%Y-%m-%dT%H:%M"), ISOTIMEUTC = strptime(x, "%Y-%m-%dT%H:%MZ", tz = "UTC"), 
+    ISOTIMESECONDS = strptime(x, "%Y-%m-%dT%H:%M:%S"), ISOTIMESECONDSUTC = strptime(x, 
+      "%Y-%m-%dT%H:%M:%SZ", tz = "UTC"), )
 
   # convert to POSIXct
   outtime <- as.POSIXct(outtime)