Skip to content

Instantly share code, notes, and snippets.

View yjunechoe's full-sized avatar
🐣

June Choe yjunechoe

🐣
78 followers · 12 following
View GitHub Profile
@yjunechoe
yjunechoe / convert_to_zerocorr.R
Created May 6, 2024 16:15
Convert lme4 double-bar syntax to MixedModels.jl zerocorr()
library(rrapply)
expr <- y ~ x + (1 || z)
lobstr::ast(!!expr)
#> █─`~`
#> ├─y
#> └─█─`+`
#> ├─x
#> └─█─`(`
#> └─█─`||`
#> ├─1
@yjunechoe
yjunechoe / highlight_color_by.R
Created May 6, 2024 02:07
highlight_color_by()
# The reprex
library(ggplot2)
data <- tibble::tribble(
~x, ~group, ~y, ~measure, ~base,
"FY18", "aaa", 0.5603448, 260, 464,
"FY15", "aaa", 0.5081269, 1313, 2584,
"FY19", "aaa", 0.5799373, 185, 319,
"FY16", "aaa", 0.5225225, 580, 1110,
"FY13", "aaa", 0.4779116, 595, 1245,
"FY17", "aaa", 0.5502471, 334, 607,
@yjunechoe
yjunechoe / ternary.R
Created March 26, 2024 14:30
ternary op in R
lobstr::ast(T ? F : 1)
`%?%` <- function(e1, e2) {
e2_expr <- substitute(e2)
if (e1) {
return(eval.parent(e2_expr[[2]]))
} else {
return(eval.parent(e2_expr[[3]]))
}
}
@yjunechoe
yjunechoe / readr_yaml_roundtrip.R
Created March 24, 2024 15:24
order_by_name <- function(x) {
x[order(names(x))]
}
type_to_collector <- function(type) {
# Code adopted from `readr:::collector_find()`
get(paste0("col_", type), envir = asNamespace("readr"))
}
specs_to_list <- function(specs) {
if (inherits(specs, "col_spec")) {
specs <- specs$cols
@yjunechoe
yjunechoe / pkgdown-source-srcset.R
Created February 20, 2024 15:10
redirect <source> relpaths
library(xml2)
x <- read_html('
<picture>
<source media="(prefers-color-scheme: dark)" srcset="man/figures/README-/setup-io-dark.svg">
<img src="man/figures/README-/setup-io.svg" style="display: block; margin: auto;" />
</picture>
')
img_src <- xml_find_all(x, ".//img[not(starts-with(@src, 'http'))]")
source_srcset <- xml_find_all(x, ".//source[not(starts-with(@srcset, 'http'))]")
@yjunechoe
yjunechoe / stroop.csv
Last active February 5, 2024 13:38
subj word condition accuracy RT
S01 blue match 1 400
S01 blue mismatch 1 549
S01 green match 1 576
S01 green mismatch 1 406
S01 red match 1 296
S01 red mismatch 1 231
S01 yellow match 1 433
S01 yellow mismatch 0 1548
S02 blue match 1 561
@yjunechoe
yjunechoe / chromote_rvest.R
Created January 24, 2024 02:22
chromote + rvest
library(rvest)
library(chromote)
# Open page in headless chrome
url <- "https://www.kulturdirektoratet.no/web/guest/stotteordning/-/vis/digitalisering-mangfold-dialog-samarbeid/tildelinger"
b <- ChromoteSession$new()
b$Page$navigate(url, wait_ = TRUE); Sys.sleep(3)
# Get document
rootnode <- b$DOM$getDocument()$root$nodeId
@yjunechoe
yjunechoe / sprintf_fmt_bottom_linter.R
Last active September 30, 2023 18:31
Linter to check that the `fmt` argument of `sprintf()` comes last
sprintf_fmt_bottom_linter <- function() {
xpath <- "
//SYMBOL_FUNCTION_CALL[text() = 'sprintf']
/parent::expr/following-sibling::expr[last()]
/preceding-sibling::*[2][not(
self::SYMBOL_SUB[text() = 'f' or text() = 'fm' or text() = 'fmt']
)]
/preceding-sibling::expr[
preceding-sibling::*[2][
self::SYMBOL_SUB[text() = 'f' or text() = 'fm' or text() = 'fmt']
@yjunechoe
yjunechoe / gt_camcorder.R
Last active July 28, 2023 16:50
Make {camcorder} work for {gt}
# gt-camcorder prototype using examples from {gt} vignette
# -- https://gt.rstudio.com/articles/creating-summary-lines.html
library(devtools)
dev_mode(on = TRUE)
# Install my fork in dev-mode with gt camcorder draft
remotes::install_github("yjunechoe/camcorder@gt-support")
library(camcorder)
@yjunechoe
yjunechoe / quarto-arquero-interactive-grouped.qmd
Created June 22, 2023 12:33
Example of interactive grouped summary in Quarto using Arquero
---
title: "Interactive aggregation"
format: html
editor: visual
---
## Define data
```{r}
ojs_define(mydata = palmerpenguins::penguins)