Skip to content

Commit

Permalink
Replace txtplot with an internal text plotting function for cal objects
Browse files Browse the repository at this point in the history
And drop it as a dependency.
  • Loading branch information
joeroe committed Nov 30, 2020
1 parent 0f81a04 commit 8569415
Show file tree
Hide file tree
Showing 2 changed files with 64 additions and 3 deletions.
1 change: 0 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -32,7 +32,6 @@ Imports:
fs,
glue,
cli,
txtplot,
rlang,
stringr,
tidyr,
Expand Down
66 changes: 64 additions & 2 deletions R/cal.R
Original file line number Diff line number Diff line change
Expand Up @@ -83,7 +83,7 @@ new_cal <- function(x = data.frame(year = integer(0), p = numeric(0)), ...) {
# }


# S3 Methods ------------------------------------------------------------------
# Print methods --------------------------------------------------------------

#' @rdname cal
#' @export
Expand All @@ -101,7 +101,7 @@ print.cal <- function(x, ...) {

cli::cli_text("# Calibrated probability distribution from {start} to {end} {era}")
cli::cat_line()
txtplot::txtplot(x$year, x$p, height = 10)
cal_txtplot(x)
cli::cat_line()
# TODO: Messy – should probably refactor into its own function
if(!is.null(metadata$lab_id)) {
Expand All @@ -122,6 +122,68 @@ print.cal <- function(x, ...) {
invisible(x)
}

cal_txtplot <- function(x, height = 8, margin = 2) {
width <- cli::console_width()
if (width > 80) width <- 80

# Plot geometries
geom_area <- cal_txtplot_geom_area(x, width - margin, height - 2)

# Axis & labels
# TODO: Detect direction of year
nbreaks <- floor((width - margin) / (max(nchar(round(x$year))) * 3))
breaks <- pretty(x$year, nbreaks - 1)
while (sum(nchar(breaks)) >= (width - margin)) {
nbreaks <- nbreaks - 1
breaks <- pretty(x$year, nbreaks - 1)
}
xaxis <- cal_txtplot_scale(x$year, breaks, width - margin)
labels <- cal_txtplot_labels(x$year, breaks, width - margin)

# Print
cli::cat_line(stringr::str_pad(geom_area, width, side = "left"))
cli::cat_line(stringr::str_pad(xaxis, width, side = "left"))
cli::cat_line(stringr::str_pad(labels, width, side = "left"))
}

cal_txtplot_geom_area <- function(x, width, height) {
k <- stats::ksmooth(x$year, x$p,
bandwidth = abs(max(x$year) - min(x$year)) / width,
n.points = width)
k$y[is.na(k$y)] <- 0
k$y <- round((k$y / max(k$y)) * height)

stringr::str_dup("#", k$y) %>%
stringr::str_pad(height, side = "left") %>%
stringr::str_split(pattern = "", simplify = TRUE) %>%
apply(2, paste0, collapse = "")
}

cal_txtplot_scale <- function(x, breaks, width) {
breakpoints <- cal_txtplot_breakpoints(x, breaks, width)

axis <- rep("-", width)
axis[breakpoints] <- "|"
paste(axis, collapse = "")
}

cal_txtplot_labels <- function(x, breaks, width) {
breakpoints <- cal_txtplot_breakpoints(x, breaks, width)

labels <- stringr::str_pad(breaks[-1], c(diff(breakpoints)), side = "left")
paste(labels, collapse = "")
}

cal_txtplot_breakpoints <- function(x, breaks, width) {
if (x[1] > x[length(x)]) {
x <- -x
breaks <- -breaks
}
sort(round(findInterval(breaks, x) / length(x) * width))
}

# S3 Methods ------------------------------------------------------------------

#' @export
min.cal <- function(...) {
cals <- rlang::list2(...)
Expand Down

0 comments on commit 8569415

Please sign in to comment.