-
Notifications
You must be signed in to change notification settings - Fork 13
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
[Do not Merge] Add mixed columns to jaspTable (#149)
* start on mixedColumns and mixedRows * mixedRows now also working * some updates, ready for js changes * mostly functional * cleanup * finally functional * simplify weird listlength handling
- Loading branch information
Showing
8 changed files
with
359 additions
and
15 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,99 @@ | ||
| validateCellTypes <- function(types) { | ||
| permittedTypes <- c("integer", "number", "pvalue", "string", "separator") | ||
| if (!all(types %in% permittedTypes)) { | ||
| badTypes <- unique(setdiff(types, permittedTypes)) | ||
| stop(sprintf("Valid types are `%s` but got: %s", | ||
| paste(permittedTypes, collapse = ", "), | ||
| paste(badTypes, collapse = ", "))) | ||
| } | ||
| } | ||
|
|
||
| validateCellFormats <- function(formats, types, lengthOfValues) { | ||
| if (is.null(formats)) { | ||
| formats <- vector("list", length(types)) | ||
| if (any(types %in% c("number", "pvalue"))) { | ||
|
|
||
| formats[types == "number"] <- list("sf:4;dp:3") | ||
| formats[types == "pvalue"] <- list("dp:3;p:.001") | ||
|
|
||
| } | ||
| } else { | ||
| stopifnot(length(types) == length(formats)) | ||
| } | ||
| stopifnot(lengthOfValues == length(types)) | ||
| return(formats) | ||
| } | ||
|
|
||
| #' @export | ||
| createMixedColumn <- function(values, types, formats = NULL) { | ||
|
|
||
| validateCellTypes(types) | ||
| formats <- validateCellFormats(formats, types, length(values)) | ||
|
|
||
| # NOTE: names are not actually used | ||
| data <- Map(\(v, t, f) list(value = v, type = t, format = f), values, types, formats) | ||
|
|
||
| result <- vctrs::new_vctr(data, column = TRUE, class = "mixed") | ||
|
|
||
| return(result) | ||
|
|
||
| } | ||
|
|
||
| #' @export | ||
| createMixedRow <- function(value, type, format = NULL) { | ||
| # TODO: support multiple values and types? | ||
| validateCellTypes(type) | ||
| format <- validateCellFormats(format, type, length(value)) | ||
| data <- list(value = value, type = type, format = format[[1L]]) | ||
| result <- vctrs::new_vctr(list(data), column = FALSE, class = "mixed") | ||
| return(result) | ||
| } | ||
|
|
||
| isMixedColumn <- function(x) { | ||
| isTRUE(attr(x, "column")) | ||
| } | ||
|
|
||
|
|
||
| formatMixedHelper <- function(x, showFormat = FALSE, shortTypes = TRUE, usePillar = FALSE) { | ||
|
|
||
| # TODO: formatting with Pillar is way nicer, but maybe not always compatible with all terminals... | ||
| # it also would require overwriting the print function, which I'm not very keen about | ||
|
|
||
| mixedAbbreviations <- c( | ||
| "pvalue" = "pval", | ||
| "number" = "num", | ||
| "string" = "str", | ||
| "integer" = "int" | ||
| ) | ||
|
|
||
| value <- x[["value"]] | ||
| type <- x[["type"]] | ||
| format <- x[["format"]] | ||
|
|
||
| if (usePillar) { | ||
| style_num <- pillar::style_num | ||
| style_subtle <- pillar::style_subtle | ||
| } else { | ||
| style_num <- style_subtle <- function(x, ...) x | ||
| } | ||
|
|
||
| paste0( | ||
| if (type == "string") value else style_num(value, negative = value < 0), | ||
| style_subtle(paste0(if (showFormat || !usePillar) "<" else "", if (shortTypes) mixedAbbreviations[type] else type)), | ||
| if (showFormat) style_subtle(paste0("|", format, ">")) else if (!usePillar) ">" | ||
| ) | ||
| } | ||
|
|
||
| #' @exportS3Method | ||
| format.mixed <- function(x, showFormat = FALSE, shortTypes = TRUE, usePillar = FALSE, ...) { | ||
|
|
||
| data <- vctrs::vec_data(x) | ||
| return(vapply(X = data, FUN = formatMixedHelper, FUN.VALUE = character(1L), showFormat = showFormat, shortTypes = shortTypes, usePillar = usePillar)) | ||
|
|
||
| } | ||
|
|
||
| #' @export | ||
| # So we don't need I(...) when putting mixed in a data.frame | ||
| as.data.frame.mixed <- function(x, row.names = NULL, optional = FALSE, ...) { | ||
| as.data.frame.AsIs(x, row.names = row.names, optional = optional, ...) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,165 @@ | ||
| library(jaspBase) | ||
|
|
||
| # Example 1: assign columns directy using createMixedColumn (using createMixedColumn is the recommended approach) ---- | ||
| tb <- createJaspTable() | ||
|
|
||
| data <- createMixedColumn( | ||
| values = list(1.23, 0.04, "hoi", 123), | ||
| types = c("number", "pvalue", "string", "integer") | ||
| ) | ||
|
|
||
| tb[["col"]] <- data | ||
| tb[["col2"]] <- seq(length(data)) | ||
| tb | ||
|
|
||
| tbR <- tb$toRObject() | ||
| all.equal(tbR$col0, data) # TRUE | ||
| all.equal(tbR$col1, seq(length(data))) # TRUE | ||
|
|
||
| # Example 2: use setData with createMixedColumn ---- | ||
| tb <- createJaspTable() | ||
|
|
||
| df <- data.frame( | ||
| col = createMixedColumn( | ||
| values = list(1.23, 0.04, "hoi", 123), | ||
| types = c("number", "pvalue", "string", "integer") | ||
| ), | ||
| col2 = 1:4 | ||
| ) | ||
|
|
||
|
|
||
| df | ||
| tb$setData(df) | ||
| tb | ||
|
|
||
| # Example 3a, addColumns pass data.frame ---- | ||
| tb <- createJaspTable() | ||
|
|
||
| df <- data.frame( | ||
| col = createMixedColumn( | ||
| values = list(1.23, 0.04, "hoi", 123), | ||
| types = c("number", "pvalue", "string", "integer") | ||
| ), | ||
| col2 = 1:4 | ||
| ) | ||
|
|
||
|
|
||
| tb$addColumns(cols = df) | ||
| tb | ||
|
|
||
| tbR <- tb$toRObject() | ||
| all.equal(tbR$col, df$col) # TRUE | ||
| all.equal(tbR$col2, df$col2) # TRUE | ||
| all.equal(tbR, df, check.attributes = FALSE) # TRUE | ||
|
|
||
|
|
||
| # Example 3b, addColumns pass list ---- | ||
| tb <- createJaspTable() | ||
|
|
||
| lst <- list( | ||
| col = createMixedColumn( | ||
| values = list(1.23, 0.04, "hoi", 123), | ||
| types = c("number", "pvalue", "string", "integer") | ||
| ), | ||
| col2 = 1:4 | ||
| ) | ||
|
|
||
|
|
||
| tb$addColumns(cols = lst) | ||
| tb | ||
|
|
||
| # Example 4a, addRows pass data.frame ---- | ||
| tb <- createJaspTable() | ||
|
|
||
| df <- data.frame( | ||
| name1 = createMixedColumn( | ||
| values = list(1.23, 0.04, "hoi", 123), | ||
| types = c("number", "pvalue", "string", "integer") | ||
| ), | ||
| name2 = 1:4 | ||
| ) | ||
|
|
||
| rowList <- lapply(seq_len(nrow(df)), function(i) { | ||
| list( | ||
| name1 = createMixedRow( | ||
| value = df$name1[[i]]$value, | ||
| type = df$name1[[i]]$type | ||
| ), | ||
| name2 = i | ||
| ) | ||
| }) | ||
|
|
||
| # one by one | ||
| tb | ||
| tb$addRows(rows = rowList[[1]]) | ||
| tb | ||
| tb$addRows(rows = rowList[[2]]) | ||
| tb | ||
| tb$addRows(rows = rowList[[3]]) | ||
| tb | ||
| tb$addRows(rows = rowList[[4]]) | ||
| tb | ||
|
|
||
| # all at once | ||
| tb <- createJaspTable() | ||
| tb$addRows(rows = rowList) | ||
| tb | ||
|
|
||
|
|
||
| # Example 5a, addColumnInfo pass data.frame ---- | ||
| tb <- createJaspTable() | ||
| tb$addColumnInfo(name = "m", title = "mixed Column", type = "mixed") | ||
| tb$addColumnInfo(name = "i", title = "int", type = "integer") | ||
|
|
||
| data <- createMixedColumn( | ||
| values = list(1.23, 0.04, "hoi", 123), | ||
| types = c("number", "pvalue", "string", "integer") | ||
| ) | ||
| tb[["m"]] <- data | ||
|
|
||
| # temporary for comparison with master | ||
| library(jaspBase) | ||
| tb1 <- createJaspTable() | ||
| tb1$addRows(rows = list(a = 1, b = 2, c = 3)) | ||
| tb1 | ||
| tb1$addRows(rows = list(a = 2, b = 4, c = 6)) | ||
| tb1 | ||
| tb1$addRows(rows = list(d = 3, f = 5)) | ||
| tb1 | ||
|
|
||
|
|
||
| rowList2 <- list( | ||
| list(a = 1, b = 2), | ||
| list(a = 2, b = 4), | ||
| list(a = 3, b = 6), | ||
| list(c = 3, d = 4), | ||
| list(c = 6, d = 8) | ||
| ) | ||
|
|
||
| tb2 <- createJaspTable() | ||
| tb2$addRows(rows = rowList2) | ||
| tb2 | ||
|
|
||
| # this crashes! | ||
| tb1 <- createJaspTable() | ||
| for (l in letters[1:6]) | ||
| tb1$addColumnInfo(name = l, title = l, type = "integer") | ||
| tb1$addRows(rows = list(a = 1, b = 2, c = 3)) | ||
| tb1 | ||
| tb1$addRows(rows = list(a = 2, b = 4, c = 6)) | ||
| tb1 | ||
| tb1$addRows(rows = list(d = 3, e = 5)) | ||
| tb1 | ||
|
|
||
|
|
||
| rowList2 <- list( | ||
| list(a = 1, b = 2), | ||
| list(a = 2, b = 4), | ||
| list(a = 3, b = 6), | ||
| list(c = 3, d = 4), | ||
| list(c = 6, d = 8) | ||
| ) | ||
|
|
||
| tb2 <- createJaspTable() | ||
| tb2$addRows(rows = rowList2) | ||
| tb2 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.