Skip to content

Commit

Permalink
Fix #17 and fix #4 (#18)
Browse files Browse the repository at this point in the history
  • Loading branch information
chainsawriot authored Mar 15, 2024
1 parent 063621d commit bfe9ab6
Show file tree
Hide file tree
Showing 7 changed files with 23 additions and 167 deletions.
5 changes: 3 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -22,12 +22,13 @@ Language: en-US
Roxygen: list(markdown = TRUE, r6 = FALSE)
RoxygenNote: 7.3.1
Imports:
cli,
rlang,
tzdb
Suggests:
knitr,
stringi,
testthat,
withr,
hms
hms,
readr

8 changes: 0 additions & 8 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,18 +1,11 @@
# Generated by roxygen2: do not edit by hand

S3method(as.character,col_spec)
S3method(as.col_spec,"NULL")
S3method(as.col_spec,character)
S3method(as.col_spec,col_spec)
S3method(as.col_spec,data.frame)
S3method(as.col_spec,default)
S3method(as.col_spec,list)
S3method(format,col_spec)
S3method(print,col_spec)
S3method(print,collector)
S3method(print,date_names)
S3method(print,locale)
S3method(str,col_spec)
S3method(type_to_col,Date)
S3method(type_to_col,POSIXct)
S3method(type_to_col,default)
Expand All @@ -39,7 +32,6 @@ export(date_names)
export(date_names_lang)
export(date_names_langs)
export(default_locale)
export(guess_parser)
export(locale)
export(parse_character)
export(parse_date)
Expand Down
115 changes: 12 additions & 103 deletions R/parser.R
Original file line number Diff line number Diff line change
Expand Up @@ -13,11 +13,6 @@ collector <- function(type, ...) {

is.collector <- function(x) inherits(x, "collector")

#' @export
print.collector <- function(x, ...) {
cat("<", class(x)[1], ">\n", sep = "")
}

collector_find <- function(name) {
if (is.na(name)) {
return(col_character())
Expand Down Expand Up @@ -186,13 +181,14 @@ col_number <- function() {

#' Parse using the "best" type
#'
#' `parse_guess()` returns the parser vector; `guess_parser()`
#' returns the name of the parser. These functions use a number of heuristics
#' `parse_guess()` returns the parser vector. This function uses a number of heuristics
#' to determine which type of vector is "best". Generally they try to err of
#' the side of safety, as it's straightforward to override the parsing choice
#' if needed.
#'
#' @inheritParams parse_atomic
#' @param guess_integer If `TRUE`, guess integer types for whole numbers, if
#' `FALSE` guess numeric type for all numbers.
#' @family parsers
#' @export
#' @examples
Expand All @@ -204,11 +200,9 @@ col_number <- function() {
#' parse_guess(c("1.6", "2.6", "3.4"))
#'
#' # Numbers containing grouping mark
#' guess_parser("1,234,566")
#' parse_guess("1,234,566")
#'
#' # ISO 8601 date times
#' guess_parser(c("2010-10-10"))
#' parse_guess(c("2010-10-10"))
parse_guess <- function(x, na = c("", "NA"), locale = default_locale(), trim_ws = TRUE, guess_integer = FALSE, .return_problems = FALSE) {
parse_vector(x, guess_parser(x, locale, guess_integer = guess_integer, na = na), na = na, locale = locale, trim_ws = trim_ws,
Expand All @@ -221,10 +215,6 @@ col_guess <- function() {
collector("guess")
}

#' @rdname parse_guess
#' @param guess_integer If `TRUE`, guess integer types for whole numbers, if
#' `FALSE` guess numeric type for all numbers.
#' @export
guess_parser <- function(x, locale = default_locale(), guess_integer = FALSE, na = c("", "NA")) {
x[x %in% na] <- NA_character_

Expand Down Expand Up @@ -534,19 +524,6 @@ locale <- function(date_names = "en",

is.locale <- function(x) inherits(x, "locale")

#' @export
print.locale <- function(x, ...) {
cat("<locale>\n")
cat("Numbers: ", prettyNum(123456.78,
big.mark = x$grouping_mark,
decimal.mark = x$decimal_mark, digits = 8
), "\n", sep = "")
cat("Formats: ", x$date_format, " / ", x$time_format, "\n", sep = "")
cat("Timezone: ", x$tz, "\n", sep = "")
cat("Encoding: ", x$encoding, "\n", sep = "")
print(x$date_names)
}

#' @export
#' @rdname locale
default_locale <- function() {
Expand Down Expand Up @@ -645,28 +622,6 @@ date_names_langs <- function() {
names(date_symbols)
}

#' @export
print.date_names <- function(x, ...) {
cat("<date_names>\n")

if (identical(x$day, x$day_ab)) {
day <- paste0(x$day, collapse = ", ")
} else {
day <- paste0(x$day, " (", x$day_ab, ")", collapse = ", ")
}

if (identical(x$mon, x$mon_ab)) {
mon <- paste0(x$mon, collapse = ", ")
} else {
mon <- paste0(x$mon, " (", x$mon_ab, ")", collapse = ", ")
}
am_pm <- paste0(x$am_pm, collapse = "/")

cat_wrap("Days: ", day)
cat_wrap("Months: ", mon)
cat_wrap("AM/PM: ", am_pm)
}

is.date_names <- function(x) inherits(x, "date_names")

cat_wrap <- function(header, body) {
Expand Down Expand Up @@ -877,21 +832,6 @@ col_to_short <- function(x, ...) {
)
}

#' @export
as.character.col_spec <- function(x, ...) {
paste0(
collapse = "",
vapply(x$cols, col_to_short, character(1))
)
}

#' @export
print.col_spec <- function(x, n = Inf, condense = NULL, ...) {
cat(format.col_spec(x, n = n, condense = condense, ...))

invisible(x)
}

cols_condense <- function(x) {
types <- vapply(x$cols, function(xx) class(xx)[[1]], character(1))
counts <- table(types)
Expand All @@ -902,8 +842,8 @@ cols_condense <- function(x) {
x
}

#' @export
format.col_spec <- function(x, n = Inf, condense = NULL, ...) {
## Change from S3
format_col_spec <- function(x, n = Inf, condense = NULL, ...) {
if (n == 0) {
return("")
}
Expand Down Expand Up @@ -971,32 +911,13 @@ format.col_spec <- function(x, n = Inf, condense = NULL, ...) {

# Used in read_delim(), read_fwf() and type_convert()
show_cols_spec <- function(spec, n = getOption("readr.num_columns", 20)) {
if (n > 0) {
cli_block(class = "readr_spec_message", {
cli::cli_h1("Column specification")
txt <- strsplit(format(spec, n = n, condense = NULL), "\n")[[1]]
cli::cli_verbatim(txt)
if (length(spec$cols) >= n) {
cli::cli_alert_info("Use {.fn spec} for the full column specifications.")
}
})
}
}

# This allows str() on a tibble object to print a little nicer.
#' @export
str.col_spec <- function(object, ..., indent.str = "") {

# Split the formatted column spec into strings
specs <- strsplit(format(object), "\n")[[1]]
cat(
sep = "",
"\n",

# Append the current indentation string to the specs
paste(indent.str, specs, collapse = "\n"),
"\n"
)
if (n > 0) {
message("Column specification: ")
message(strsplit(format_col_spec(spec, n = n, condense = NULL), "\n")[[1]])
if (length(spec$cols) >= n) {
message("Only the first ", n, " columns are printed.", "\n")
}
}
}

col_concise <- function(x) {
Expand Down Expand Up @@ -1222,18 +1143,6 @@ check_string <- function(x, nm = deparse(substitute(x)), optional = FALSE) {
stop("`", nm, "` must be a string.", call. = FALSE)
}

cli_block <- function(expr, class = NULL, type = rlang::inform) {
msg <- ""
withCallingHandlers(
expr,
message = function(x) {
msg <<- paste0(msg, x$message)
invokeRestart("muffleMessage")
}
)
type(msg, class = class)
}

`%||%` <- function(a, b) if (is.null(a)) b else a

deparse2 <- function(expr, ..., sep = "\n") {
Expand Down
14 changes: 1 addition & 13 deletions R/type_convert.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@
#'
#' If `NULL`, column types will be imputed using all rows.
#' @param verbose whether to print messages
#' @inheritParams guess_parser
#' @inheritParams parse_guess
#' @note `type_convert()` removes a 'spec' attribute,
#' because it likely modifies the column data types.
#' (see [spec()] for more information about column specifications).
Expand Down Expand Up @@ -100,15 +100,3 @@ keep_character_col_types <- function(df, col_types) {

col_types
}

#' @rdname parse_guess
#' @param guess_integer If `TRUE`, guess integer types for whole numbers, if
#' `FALSE` guess numeric type for all numbers.
#' @export
guess_parser <- function(x, locale = default_locale(), guess_integer = FALSE, na = c("", "NA")) {
x[x %in% na] <- NA_character_

stopifnot(is.locale(locale))

collectorGuess(x, locale, guessInteger = guess_integer)
}
3 changes: 1 addition & 2 deletions README.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -122,7 +122,7 @@ data <- readr::type_convert(text_only)
data
```

`verbose` option is added if you like those messages, default to `FALSE`.
`verbose` option is added if you like those messages, default to `FALSE`. To keep this package as minimal as possible, these optional messages are printed with base R (not `cli`).

```{r}
data <- minty::type_convert(text_only, verbose = TRUE)
Expand All @@ -145,4 +145,3 @@ For parsing ambiguous date(time)
* [timeless](https://github.com/schochastics/timeless)
* [anytime](https://github.com/eddelbuettel/anytime)


23 changes: 4 additions & 19 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -158,15 +158,6 @@ data

``` r
data <- readr::type_convert(text_only)
#> Registered S3 methods overwritten by 'readr':
#> method from
#> as.character.col_spec minty
#> format.col_spec minty
#> print.col_spec minty
#> print.collector minty
#> print.date_names minty
#> print.locale minty
#> str.col_spec minty
#>
#> ── Column specification ────────────────────────────────────────────────────────
#> cols(
Expand All @@ -184,19 +175,13 @@ data
```

`verbose` option is added if you like those messages, default to
`FALSE`.
`FALSE`. To keep this package as minimal as possible, these optional
messages are printed with base R (not `cli`).

``` r
data <- minty::type_convert(text_only, verbose = TRUE)
#>
#> ── Column specification ────────────────────────────────────────────────────────
#> cols(
#> maybe_age = col_character(),
#> maybe_male = col_logical(),
#> maybe_name = col_character(),
#> some_na = col_character(),
#> dob = col_date(format = "")
#> )
#> Column specification:
#> cols( maybe_age = col_character(), maybe_male = col_logical(), maybe_name = col_character(), some_na = col_character(), dob = col_date(format = ""))
```

At the moment, `minty` does not use [the `problems`
Expand Down
22 changes: 2 additions & 20 deletions man/parse_guess.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit bfe9ab6

Please sign in to comment.