Ecosyste.ms: Awesome
An open API service indexing awesome lists of open source software.
https://github.com/evamaerey/ggwaterfall
https://github.com/evamaerey/ggwaterfall
Last synced: 11 days ago
JSON representation
- Host: GitHub
- URL: https://github.com/evamaerey/ggwaterfall
- Owner: EvaMaeRey
- License: other
- Created: 2024-01-10T13:29:23.000Z (10 months ago)
- Default Branch: main
- Last Pushed: 2024-01-18T21:07:50.000Z (10 months ago)
- Last Synced: 2024-01-18T23:10:42.089Z (10 months ago)
- Language: R
- Size: 138 KB
- Stars: 0
- Watchers: 1
- Forks: 0
- Open Issues: 0
-
Metadata Files:
- Readme: README.Rmd
- License: LICENSE
Awesome Lists containing this project
README
---
output:
github_document:
toc: TRUE
---
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
```
# *README: Below, is readme that provides steps for building a package. This readme acts as a checklist, and control document as functions used in package building are included. 🚧 ✅ *
# Introducing the {ggwaterfall} package!
[](https://lifecycle.r-lib.org/articles/stages.html#experimental)
The goal of {ggwaterfall} is to make visualizing in-out flows with waterfall charts easier.
To install the dev version use the following:
```
remotes::install_github("EvaMaeRey/ggwaterfall")
```
## Example
Try in an interactive session: 🦄 🦄 🦄
```{r}
library(ggwaterfall)
library(tidyverse)
flow_df <- data.frame(event = c(
"Sales",
"Refunds",
"Payouts",
"Court Losses",
"Court Wins",
"Contracts",
"Fees"),
change = c(6400, -1100,
-100, -4200, 3800,
1400, -2800)) |>
mutate(event = factor(event))
flow_df
flow_df |>
ggplot() +
geom_hline(yintercept = 0) +
aes(change = change,
x = event) + # event in order
geom_waterfall() +
geom_waterfall_label() +
scale_y_continuous(expand = expansion(.1)) +
scale_fill_manual(values = c("springgreen4", "darkred"))
last_plot() +
aes(x = fct_reorder(event, change)) # in order neg to positive
last_plot() +
aes(x = fct_reorder(event, abs(change)))
```
# Part I. Work out functionality ✅
## Step 0. use base ggplot2 to get job done
This is by and large taken from https://vita.had.co.nz/papers/ggplot2-wires.pdf, but I removed 'starting cash' and 'grand total', because they don't seem like-in-kind with the other events. I starting cash could be added via an argument (and always put in the x = 1 position), and grand total could be calculated (argument grand_total = T).
```{r cars}
library(tidyverse)
data.frame(event = c(
"Sales",
"Refunds",
"Payouts",
"Court Losses",
"Court Wins",
"Contracts",
"Fees"),
change = c(6400, -1100,
-100, -4200, 3800,
1400, -2800)) %>%
mutate(event = factor(event)) ->
flow_df
flow_df %>% # maybe add factor in order if factor is not defined...
mutate(x_pos = event %>% as.numeric()) %>%
arrange(x_pos) %>%
mutate(balance = cumsum(c(0,
change[-nrow(.)]))) %>%
mutate(flow = factor(sign(change))) ->
balance_df
ggplot(balance_df) +
geom_rect(
aes(xmin = x_pos - 0.45,
xmax = x_pos + 0.45,
ymin = balance,
ymax = balance + change)) +
geom_text(aes(x = event,
y = pmin(balance,
balance + change) - 50,
label = balance))
```
## Step 1. & 2. write compute functions and pass to ggproto
```{r StatWaterfall}
#' Title
#'
#' @param data
#' @param scales
#' @param width
#'
#' @return
#' @export
#'
#' @examples
compute_panel_waterfall <- function(data, scales, width = .90){
data %>%
mutate(x_scale = x) %>%
mutate(x_pos = x %>% as.numeric()) %>%
arrange(x_pos) %>%
mutate(balance = cumsum(c(0,
change[-nrow(.)]))) %>%
mutate(direction = factor(sign(change))) %>%
mutate(xmin = x_pos - width/2,
xmax = x_pos + width/2,
ymin = balance,
ymax = balance + change) %>%
mutate(x = x_pos) %>%
mutate(y = ymax) %>%
mutate(gain_loss = ifelse(direction == 1, "gain", "loss"))
}
### Step 1.1 Test compute
# flow_df %>%
# rename(x = event) %>%
# compute_panel_waterfall()
## Step 2. Pass compute to ggproto
StatWaterfall <- ggplot2::ggproto(`_class` = "StatWaterfall",
`_inherit` = ggplot2::Stat,
required_aes = c("change", "x"),
compute_panel = compute_panel_waterfall,
default_aes = ggplot2::aes(label = ggplot2::after_stat(change),
fill = ggplot2::after_stat(gain_loss),
vjust = ggplot2::after_stat((direction == -1) %>%
as.numeric)))
```
## Step 3. pass to geom_ / stat_
```{r geom_waterfall}
#' Title
#'
#' @param geom
#' @param mapping
#' @param data
#' @param position
#' @param na.rm
#' @param show.legend
#' @param inherit.aes
#' @param ...
#'
#' @return
#' @export
#'
#' @examples
stat_waterfall <- function(geom = ggplot2::GeomRect,
mapping = NULL,
data = NULL,
position = "identity",
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE, ...) {
ggplot2::layer(
stat = StatWaterfall, # proto object from step 2
geom = geom, # inherit other behavior
data = data,
mapping = mapping,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
#' Title
#'
#' @param geom
#' @param mapping
#' @param data
#' @param position
#' @param na.rm
#' @param show.legend
#' @param inherit.aes
#' @param ...
#'
#' @return
#' @export
#'
#' @examples
geom_waterfall <- stat_waterfall
#' Title
#'
#' @param mapping
#' @param data
#' @param position
#' @param na.rm
#' @param show.legend
#' @param inherit.aes
#' @param ...
#'
#' @return
#' @export
#'
#' @examples
geom_waterfall_label <- function(..., lineheight = .8){
stat_waterfall(geom = "text",
lineheight = lineheight, ...)}
```
## Step 4. Enjoy (test)
```{r}
flow_df %>%
ggplot() +
geom_hline(yintercept = 0) +
aes(change = change,
x = event) + # event in order
geom_waterfall() +
geom_waterfall_label() +
scale_y_continuous(expand = expansion(.1)) +
scale_fill_manual(values = c("springgreen4", "darkred"))
last_plot() +
aes(x = fct_reorder(event, change)) # in order neg to positive
last_plot() +
aes(x = fct_reorder(event, abs(change))) # in order magnitude
```
## A non monetary example...
We can also think about things that 'fill us up' or don't. Here's an example about building packages...
```{r}
tibble::tribble(~activity, ~change,
"writing functions :-)", 50,
"trying functions out :-)", 180,
"writing formal tests :-(", -120
) |>
ggplot() +
aes(x = activity %>%
str_wrap(12) %>%
fct_inorder(), change = change) +
geom_waterfall(show.legend = F) +
geom_waterfall_label(aes(label = ifelse(change < 0,
"tedious",
"delightful")), size = 5) +
labs(title = "What affect do the develpment activities\nhave on your mood and energy?") +
geom_hline(yintercept = 0, linetype = "dashed", alpha = .2) +
theme_minimal(base_size = 15)
```
# Part II. Packaging and documentation 🚧 ✅
## Phase 1. Minimal working package
### Created files for package archetecture with `devtools::create(".")` ✅
### Moved functions R folder? ✅
```{r}
knitr::knit_code$get() |> names()
```
Use new {readme2pkg} function to do this from readme...
```{r}
readme2pkg::chunk_to_r(c(
"StatWaterfall",
"geom_waterfall")
)
```
### Added roxygen skeleton? ✅
Use a roxygen skeleton for auto documentation and making sure proposed functions are *exported*.
### Managed dependencies ? ✅
Package dependencies managed, i.e. `depend::function()` in proposed functions and declared in the DESCRIPTION
```{r}
usethis::use_package("ggplot2")
```
### Chosen a license? ✅
```{r}
usethis::use_mit_license()
```
### Run `devtools::check()` and addressed errors? ✅
```{r, results='hide', error=T}
devtools::check(pkg = ".")
```
### Build package 🚧
```{r}
devtools::build()
```
You need to do this before Part 0 in this document will work.
### Make aspirational part of readme real. 🚧
At this point, you could change *eval* chunk options to TRUE. You can remove the 🦄 emoji and perhaps replace it with construction site if you are still uncertain of the API, and want to highlight that it is subject to change.
### Add lifecycle badge (experimental)
```{r}
usethis::use_lifecycle_badge("experimental")
```
## Phase 2: Listen & iterate 🚧
Try to get feedback from experts on API, implementation, default decisions. Is there already work that solves this problem?
## Phase 3: Let things settle
### Settle on examples. Put them in the roxygen skeleton and readme. 🚧
### Written formal tests of functions? 🚧
That would look like this...
```{r test_calc_frequency_works, eval = F}
library(testthat)
test_that("calc frequency works", {
expect_equal(calc_frequency("A", 0), 440)
expect_equal(calc_frequency("A", -1), 220)
})
```
```{r, eval=F}
readme2pkg::chunk_to_tests_testthat("test_calc_frequency_works")
```
### Have you worked added a description and author information in the DESCRIPTION file? 🚧
### Addressed *all* notes, warnings and errors. 🚧
## Promote to wider audience...
### Package website built? 🚧
### Package website deployed? 🚧
## Phase 3: Harden/commit
### Submit to CRAN? Or don't. 🚧
# Appendix: Reports, Environment
## Description file extract
```{r}
```
## Environment
Here I just want to print the packages and the versions
```{r}
all <- sessionInfo() |> print() |> capture.output()
all[11:17]
```
## `devtools::check()` report
```{r, error = T, results="hide", warning=F}
devtools::check(pkg = ".")
```