Skip to content

Instantly share code, notes, and snippets.

View yutannihilation's full-sized avatar
🍣
Nobody loves you

Hiroaki Yutani yutannihilation

🍣
Nobody loves you
516 followers · 232 following
View GitHub Profile
@yutannihilation
yutannihilation / do_mutate_by_templating_expression.md
Created February 17, 2019 04:07 
library(dplyr, warn.conflicts = FALSE)
library(purrr)

quo_tmpl <- quo(as.character(.))

quos <- iris %>%
  map_lgl(is.factor) %>%
  { syms(set_names(names(.)[.])) } %>%
  map(dplyr:::expr_substitute, expr = quo_tmpl, old = quote(.))
@yutannihilation
yutannihilation / gghighlight_example.md
Created February 16, 2019 15:00 
library(gghighlight)
#> Loading required package: ggplot2

ggplot(economics_long, aes(date, value01, colour = variable)) +
  geom_line() +
  gghighlight()
#> Warning: Detecting old grouped_df format, replacing `vars` attribute by
#> `groups`
#&gt; label_key: variable
@yutannihilation
yutannihilation / geom_sf_label_w_nudge_xy.md
Last active February 11, 2019 21:05 
library(ggplot2)


nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE)

ggplot(nc[1:2,]) +
  geom_sf(aes(fill = AREA)) +
  geom_sf_label(aes(label = NAME),
 nudge_x = c(-0.2, 0.2),
@yutannihilation
yutannihilation / named_capture_group.md
Created January 27, 2019 03:00
poor man's named capture group

See gagolews/stringi#153

Basic idea

Do this for all named capture group

stringi::stri_replace_all_regex("foo_bar", "(?<name>.*)_(?<value>.*)", "${value}")
#> [1] "bar"
@yutannihilation
yutannihilation / tibble_data_frame_column.md
Last active January 26, 2019 15:27 
library(dplyr, warn.conflicts = FALSE)
library(tibble)

d <- tibble(a = 1:3)

# fail
d %>% 
  mutate(b = tibble(x = 1:3))
#&gt; Error: Column `b` is of unsupported class data.frame
@yutannihilation
yutannihilation / mark_as_read_github_notifications.R
Created January 22, 2019 21:17
# get the URLs of locked pull requests ------------------------------------
# c.f.
p <- gh::gh("GET /repos/tidyverse/ggplot2/pulls",
state = "closed",
since = "2019-01-17T00:00:00Z", .limit = Inf)
p_locked <- purrr::keep(p, "locked")
p_locked_url <- purrr::map_chr(p_locked, "url")
@yutannihilation
yutannihilation / multi-spread.md
Last active January 19, 2019 21:25 
nest_column <- function(data, ..., .key = "data") {
  key_var <- rlang::as_string(rlang::ensym(.key))
  
  tie_vars <- unname(tidyselect::vars_select(names(data), ...))
  if (rlang::is_empty(tie_vars)) {
    tie_vars <- names(data)
  }
  
  if (dplyr::is_grouped_df(data)) {
@yutannihilation
yutannihilation / highlight_geom_sf.md
Created January 5, 2019 00:22

c.f. yutannihilation/gghighlight#81

library(ggplot2)
library(gghighlight)
library(sf)
#> Linking to GEOS 3.6.1, GDAL 2.2.3, PROJ 4.9.3

data(tornados, package = "GISTools")
@yutannihilation
yutannihilation / geom_liquid_area.md
Last active March 25, 2020 05:09
c.f. https://github.com/tidyverse/ggplot2/issues/2883 
library(ggplot2)

# functions -----------------------------------------------

geom_liquid_area <- function(mapping = NULL, data = NULL, stat = "identity",
                             position = "stack", na.rm = FALSE, show.legend = NA,
                             inherit.aes = TRUE, ...) {
  layer(
    data = data,
@yutannihilation
yutannihilation / mitmproxy.R
Created December 14, 2018 23:33
Use mitmproxy with R (not working yet)
tmp <- file.path(normalizePath(tempdir()), "certs")
dir.create(tmp)
download.file("https://curl.haxx.se/ca/cacert.pem", file.path(tmp, "cacert-mozilla.pem"), mode = "wb")
library(httr)
proxy_conf <- use_proxy("http://127.0.0.1", port = 8080)
res <- GET("http://mitm.it/cert/pem", config = proxy_conf)
writeBin(content(res), file.path(tmp, "cacert-mitm.pem"))