Embarrassing reference to old code.
This commit is contained in:
avimallu
318
glean.R
318
glean.R
@@ -1,148 +1,170 @@
|
|||||||
|
|
||||||
library(data.table)
|
library(data.table)
|
||||||
library(bit64)
|
library(bit64)
|
||||||
library(stringi)
|
library(stringi)
|
||||||
library(crayon)
|
library(crayon)
|
||||||
library(glue)
|
|
||||||
library(numform)
|
DT <- data.table(
|
||||||
|
logical = sample(c(TRUE, FALSE), 100, replace = TRUE),
|
||||||
# DT <- data.table(
|
states = state.name,
|
||||||
# logical = sample(c(TRUE, FALSE), 100, replace = TRUE),
|
species = iris$Species,
|
||||||
# states = state.name,
|
order_of_letters = factor(letters[1:26], ordered = TRUE),
|
||||||
# species = iris$Species,
|
integral_numbers = as.integer(rnorm(100) * 100),
|
||||||
# order_of_letters = factor(letters[1:26], ordered = TRUE),
|
numeric_values = rnorm(100) * 100,
|
||||||
# integral_numbers = as.integer(rnorm(100) * 100),
|
integer64 = as.integer64("231982787612") +
|
||||||
# numeric_values = rnorm(100) * 100,
|
(as.integer64(rnorm(1e4) * 1000)),
|
||||||
# integer64 = as.integer64("231982787612") +
|
range_of_date_values = seq.Date(
|
||||||
# (as.integer64(rnorm(1e4) * 1000)),
|
as.Date("2019-01-01"), by = "1 month", length.out = 100),
|
||||||
# range_of_date_values = seq.Date(
|
range_of_time_values =
|
||||||
# as.Date("2019-01-01"), by = "1 month", length.out = 100),
|
as.POSIXct(rnorm(1e4), origin = as.Date("2019-01-01")),
|
||||||
# range_of_time_values =
|
list_columns_also = list(letters[1:26], LETTERS[1:26], 1:26)
|
||||||
# as.POSIXct(rnorm(1e4), origin = as.Date("2019-01-01")),
|
)
|
||||||
# list_columns_also = list(letters[1:26], LETTERS[1:26], 1:26)
|
|
||||||
# )
|
vapply_1c = function (x, fun, ..., use.names = TRUE) {
|
||||||
|
vapply(X = x, FUN = fun, ..., FUN.VALUE = NA_character_, USE.NAMES = use.names)
|
||||||
vapply_1c = function (x, fun, ..., use.names = TRUE) {
|
}
|
||||||
vapply(X = x, FUN = fun, ..., FUN.VALUE = NA_character_, USE.NAMES = use.names)
|
|
||||||
}
|
format_lines <- function(lines, classes) {
|
||||||
|
|
||||||
format_lines <- function(lines, classes) {
|
# The purpose of these colours is not to differentiate each possible data
|
||||||
|
# type, but to have a visual cue on different data types in a print
|
||||||
# The purpose of these colours is not to differentiate each possible data
|
|
||||||
# type, but to have a visual cue on different data types in a print
|
class_colour = list(
|
||||||
|
# Logical will be a mild red - not very visible, but relatively unimportant
|
||||||
class_colour = list(
|
logical = make_style("sienna2"),
|
||||||
# Logical will be a mild red - not very visible, but relatively unimportant
|
# Character will be a bland medium green
|
||||||
logical = make_style("sienna2"),
|
character = make_style("limegreen"),
|
||||||
# Character will be a bland medium green
|
# Integer is blue - lighter to darker to show range of storage
|
||||||
character = make_style("limegreen"),
|
integer = make_style("steelblue1"),
|
||||||
# Integer is blue - lighter to darker to show range of storage
|
integer64 = make_style("steelblue2"),
|
||||||
integer = make_style("steelblue1"),
|
numeric = make_style("steelblue3"),
|
||||||
integer64 = make_style("steelblue2"),
|
# Factor will be a mild yellow if unordered, and yellow if ordered
|
||||||
numeric = make_style("steelblue3"),
|
factor = make_style("yellow2"),
|
||||||
# Factor will be a mild yellow if unordered, and yellow if ordered
|
ordered = make_style("yellow3"),
|
||||||
factor = make_style("yellow2"),
|
# A normal date (or IDate) will be in wheaty spectrum
|
||||||
ordered = make_style("yellow3"),
|
Date = make_style("wheat3"),
|
||||||
# A normal date (or IDate) will be in wheaty spectrum
|
IDate = make_style("wheat3"),
|
||||||
Date = make_style("wheat3"),
|
POSIXct = make_style("wheat4"),
|
||||||
IDate = make_style("wheat3"),
|
# Other "exotic" data types for completeness
|
||||||
POSIXct = make_style("wheat4"),
|
list = make_style("rosybrown"),
|
||||||
# Other "exotic" data types for completeness
|
expression = make_style("plum"),
|
||||||
list = make_style("rosybrown"),
|
complex = make_style("palegreen3"),
|
||||||
expression = make_style("plum"),
|
raw = make_style("orange1")
|
||||||
complex = make_style("palegreen3"),
|
)
|
||||||
raw = make_style("orange1")
|
|
||||||
)
|
colours = class_colour[classes]
|
||||||
|
|
||||||
colours = class_colour[classes]
|
lines = mapply(function(x, y) { match.fun(x)(y) },
|
||||||
|
colours, lines, SIMPLIFY = TRUE)
|
||||||
lines = mapply(function(x, y) { match.fun(x)(y) },
|
|
||||||
colours, lines, SIMPLIFY = TRUE)
|
unname(lines)
|
||||||
|
|
||||||
unname(lines)
|
}
|
||||||
|
|
||||||
}
|
number_format <- function(x) {
|
||||||
|
|
||||||
glean_colnames <- function(col_names, col_len) {
|
number_split <- strsplit(as.character(x), "")
|
||||||
|
|
||||||
paste0(substr(
|
add_underline <- function(s_char) {
|
||||||
vapply_1c(col_names, paste, collapse = ",", use.names = FALSE),
|
|
||||||
1, ifelse(nchar(col_names) > col_len, col_len - 3, col_len)),
|
for (i in rev(seq_along(s_char))) {
|
||||||
ifelse(nchar(col_names) > col_len, "...", ""))
|
|
||||||
|
j = length(s_char) - i
|
||||||
}
|
|
||||||
|
if (((j %/% 3) %% 2 != 0)) {
|
||||||
glean_values <- function(head, val_len) {
|
s_char[i] = underline(s_char[i])
|
||||||
|
}
|
||||||
head = as.data.table(head)
|
|
||||||
numeric_cols = names(which(sapply(head, is.numeric)))
|
}
|
||||||
head[, (numeric_cols) := lapply(.SD, function(x) {
|
|
||||||
x = signif(x, 3)
|
return(s_char)
|
||||||
f_denom(x, mix.denom = TRUE, digits = 2)
|
|
||||||
}),
|
}
|
||||||
.SDcols = numeric_cols]
|
|
||||||
|
vapply_1c(lapply(number_split, add_underline), paste0, collapse = "")
|
||||||
# browser()
|
|
||||||
|
}
|
||||||
values = substr(
|
|
||||||
vapply_1c(head, paste, collapse = ",", use.names = FALSE),
|
glean_colnames <- function(col_names, col_len) {
|
||||||
1, val_len)
|
|
||||||
|
paste0(substr(
|
||||||
}
|
vapply_1c(col_names, paste, collapse = ",", use.names = FALSE),
|
||||||
|
1, ifelse(nchar(col_names) > col_len, col_len - 3, col_len)),
|
||||||
glean <- function(x) {
|
ifelse(nchar(col_names) > col_len, "...", ""))
|
||||||
|
|
||||||
width = getOption("width")
|
}
|
||||||
max_col_len = as.integer(width * 0.55)
|
|
||||||
col_len = min(max(nchar(names(x))), max_col_len)
|
glean_values <- function(head, val_len) {
|
||||||
|
|
||||||
# browser()
|
head = as.data.table(head)
|
||||||
|
numeric_cols = names(which(sapply(head, is.numeric)))
|
||||||
col_nm = glean_colnames(names(x), col_len)
|
head[, (numeric_cols) := lapply(.SD, signif, 3),
|
||||||
|
.SDcols = numeric_cols]
|
||||||
# browser()
|
|
||||||
|
# browser()
|
||||||
# 2 (align with #) + 5 (type separator) + 5 (end) = 12
|
|
||||||
val_len = getOption("width") - col_len - 12 - fifelse(
|
values = substr(
|
||||||
max_col_len == col_len, 3, 0)
|
vapply_1c(head, paste, collapse = ",", use.names = FALSE),
|
||||||
|
1, val_len)
|
||||||
# browser()
|
|
||||||
|
}
|
||||||
# Determine values to print
|
|
||||||
values = glean_values(head(x, 100), val_len)
|
glean <- function(x) {
|
||||||
|
|
||||||
# browser()
|
width = getOption("width")
|
||||||
|
max_col_len = as.integer(width * 0.55)
|
||||||
rows = nrow(x)
|
col_len = min(max(nchar(names(x))), max_col_len)
|
||||||
columns = length(x)
|
|
||||||
|
# browser()
|
||||||
class_abb = c(
|
|
||||||
list = "<lst>", integer = "<int>", numeric = "<num>",
|
col_nm = glean_colnames(names(x), col_len)
|
||||||
character = "<chr>", Date = "<Dat>", complex = "<cmp>",
|
|
||||||
factor = "<fct>", POSIXct = "<D&T>", logical = "<lgl>",
|
# browser()
|
||||||
IDate = "<IDt>", integer64 = "<i64>", raw = "<raw>",
|
|
||||||
expression = "<exp>", ordered = "<ord>")
|
# 2 (align with #) + 5 (type separator) + 5 (end) = 12
|
||||||
|
val_len = getOption("width") - col_len - 12 - fifelse(
|
||||||
classes = vapply_1c(x, function(col) class(col)[1L], use.names=FALSE)
|
max_col_len == col_len, 3, 0)
|
||||||
abbs = class_abb[classes]
|
|
||||||
|
# browser()
|
||||||
lines = format_values(
|
|
||||||
paste0(
|
# Determine values to print
|
||||||
" ",
|
values = glean_values(head(x, 100), val_len)
|
||||||
stri_pad(col_nm, col_len, "right"), " ",
|
|
||||||
stri_pad(paste0(abbs, ": "), 7, "right"),
|
# browser()
|
||||||
stri_pad(values, val_len, "right"), "..."),
|
|
||||||
classes)
|
rows = nrow(x)
|
||||||
|
columns = length(x)
|
||||||
# browser()
|
|
||||||
|
class_abb = c(
|
||||||
cat(paste0(" Rows: ", rows, ", Columns: ", columns, "\n"))
|
list = "<lst>", integer = "<int>", numeric = "<num>",
|
||||||
cat(paste0(lines, collapse = "\n"))
|
character = "<chr>", Date = "<Dat>", complex = "<cmp>",
|
||||||
|
factor = "<fct>", POSIXct = "<D&T>", logical = "<lgl>",
|
||||||
# browser()
|
IDate = "<IDt>", integer64 = "<i64>", raw = "<raw>",
|
||||||
invisible(NULL)
|
expression = "<exp>", ordered = "<ord>")
|
||||||
|
|
||||||
}
|
classes = vapply_1c(x, function(col) class(col)[1L], use.names=FALSE)
|
||||||
|
abbs = class_abb[classes]
|
||||||
#glean(DT)
|
|
||||||
#glean(Lahman::People)
|
lines = format_lines(
|
||||||
|
paste0(
|
||||||
|
" ",
|
||||||
|
stri_pad(col_nm, col_len, "right"), " ",
|
||||||
|
stri_pad(paste0(abbs, ": "), 7, "right"),
|
||||||
|
stri_pad(values, val_len, "right"), "..."),
|
||||||
|
classes)
|
||||||
|
|
||||||
|
# browser()
|
||||||
|
|
||||||
|
cat(paste0(" Rows: ", rows, ", Columns: ", columns, "\n"))
|
||||||
|
cat(paste0(lines, collapse = "\n"))
|
||||||
|
|
||||||
|
# browser()
|
||||||
|
invisible(NULL)
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
glean(DT)
|
||||||
|
glean(Lahman::People)
|
||||||
|
|
||||||
|
print.data.table <- function(x) { print("Hahahahah") }
|
||||||
|
rm(print.data.table)
|
||||||
|
|||||||
Reference in New Issue
Block a user