geotheory’s gists

geotheory / wayback-engine.R

Created October 8, 2021 23:20


	require(wayback)

	url = 'https://bbc.com'
	wb = wayback::archive_available(url)
	wb$closet_url

	wb_mems = wayback::get_mementos(u)
	wb_mems$link

geotheory / %IN%.R

Created October 2, 2021 13:41

	# String in text (vectorised)

	# A Python-style String in Text operator that ignores case. Either x or pattern must be a single value. Returns a logical value or vector.

	{\(pattern, x) stringi::stri_detect_regex(x, pattern, case_insensitive = TRUE)} -> `%IN%`

	# usage

	'dog' %IN% 'the nice dog said hello'
	#> [1] TRUE

geotheory / list-dependencies.R

Last active March 2, 2022 02:06


	# Function to report all explicit R dependencies in current directory (recursive)
	# This ignores dependencies of dependencies, but output can be piped to tools::package_dependencies()

	report_dependencies = function(path = './', print = FALSE, simple = TRUE){
	files = list.files(path = path, pattern = '.R$', recursive = TRUE, full.names = TRUE)
	scripts = lapply(files, readLines, warn = FALSE) \|> unlist() \|> paste(collapse = '\n')
	loaded = scripts \|> stringr::str_extract_all('(?<=(library\|require)\\()[a-zA-Z0-9_.]+') \|> unlist() \|>
	stringr::str_remove_all('["\']') \|> stringr::str_remove(',.*') \|> unique() \|> sort()
	invoked = scripts \|> stringr::str_extract_all('[a-zA-Z0-9_.]+(?=::)') \|> unlist() \|> unique() \|> sort()

geotheory / case_lump.R

Created September 22, 2021 12:46

	# replace strings with mode case

	require(dplyr)

	case_lump = function(x){
	x1 = tibble::enframe(x, name=NULL) \|> mutate(id = 1:n(), lower = tolower(value))
	x1 \|> count(value, lower, sort = TRUE) \|>
	group_by(lower) \|> slice(1) \|> ungroup() \|>
	rename(mode = value) \|>
	left_join(x1, by = 'lower') \|>

geotheory / bbcm-schema.json

Created September 10, 2021 11:34

geotheory / html_text_parent.R

Created September 3, 2021 01:27

	require(rvest)

	html_text_parent = function(x){
	x2 = rlang::duplicate(x, shallow = FALSE)
	children = html_children(x2)
	xml2::xml_remove(children)
	txt = html_text(x2)
	x = map(children, ~ xml2::xml_add_child(x, .value = .x))
	txt
	}

geotheory / gdelt-vgkg-example-codings.json

Created August 24, 2021 12:06

geotheory / dogs-on-the-titanic.csv

Created August 8, 2021 10:26

breed	name	owner	ticket	cabin	kenneled	survived
King Charles Spaniel	NA	William Ernest Carter	113760	B96 B98	TRUE	FALSE
Airedale Terrier	NA	William Ernest Carter	113760	B96 B98	TRUE	FALSE
Chow Chow	Chow-Chow	Harry Anderson	19952	E12	TRUE	FALSE
French Bulldog	Gamin de Pycombe	Robert Williams Daniel	113804	A	TRUE	FALSE
Airedale Terrier	Kitty	John Jacob Astor	11754	C62	TRUE	FALSE
Pomeranian	Bebe/Lady	Margaret Bechstein Hays	11767	C54	FALSE	TRUE
Pomeranian	NA	Elizabeth Jane Anne Rothschild	17603	C	FALSE	TRUE
Pekingese	Sun Yat Sen	Henry Sleeper Harper & Myra Raymond Harper	17572	D33	FALSE	TRUE
toy dog	Freu Freu	Helen Margaret Bishop	11967	B49	FALSE	FALSE

geotheory / join-overwrite.R

Created June 7, 2021 22:04

	# remotes::install_github("moodymudskipper/safejoin")
	require(safejoin)
	require(tidyverse)
	#> Loading required package: tidyverse

	d1 = tibble(id = c(1,2,3), x = c('A','B','C'), y = c(5,7,9))

	d2 = tibble(id = c(2,3,4), x = c('B','CC','D'), y = c(7,9,11))

	safe_full_join(d1, d2, by = 'id', conflict = ~ coalesce(.y, .x))

geotheory / string-markdown-to-html.R

Created March 15, 2021 17:01

	# string markdown to html conversion (HT https://github.com/matt-dray)

	purrr::map_chr(
	c("# title", "regular bold"),
	~ markdown::renderMarkdown(text = .x)
	)
	#> [1] "<h1>title</h1>\n"
	#> [2] "<p>regular <strong>bold</strong></p>\n"

	# replace strings with mode case

	require(dplyr)

	case_lump = function(x){
	x1 = tibble::enframe(x, name=NULL) \|> mutate(id = 1:n(), lower = tolower(value))
	x1 \|> count(value, lower, sort = TRUE) \|>
	group_by(lower) \|> slice(1) \|> ungroup() \|>
	rename(mode = value) \|>
	left_join(x1, by = 'lower') \|>

Robin Edwards geotheory