Skip to content

Instantly share code, notes, and snippets.

View coolbutuseless's full-sized avatar

mikefc coolbutuseless

View GitHub Profile
@coolbutuseless
coolbutuseless / zstd-quick-bench.R
Created September 10, 2020 22:09
zstd quick bench
library(zstdlite)
set.seed(1)
bytes <- sample(as.raw(1:30), 1e6, replace = TRUE)
cz <- zstdlite::zstd_compress(bytes)
cb_gzip <- memCompress(bytes, type = 'gzip')
cb_bzip2 <- memCompress(bytes, type = 'bzip2')
@coolbutuseless
coolbutuseless / user-callbacks.R
Created September 8, 2020 04:32
mouse callbacks in rgl
library(rgl)
pan3d <- function(button, dev = rgl.cur(), subscene = currentSubscene3d(dev)) {
start <- list()
begin <- function(x, y) {
activeSubscene <- par3d("activeSubscene", dev = dev)
start$listeners <<- par3d("listeners", dev = dev, subscene = activeSubscene)
for (sub in start$listeners) {
@coolbutuseless
coolbutuseless / ceramic.R
Last active June 6, 2020 04:09
ceramic test
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Define the extents of the image
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
roi <- raster::extent(110, 160, -45, -12)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Grab the satellite image and the elevation map
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
im <- ceramic::cc_location(roi)
el <- ceramic::cc_elevation(roi)
require(ggplot2)
ggplot() + annotate(x = -10, y=1, xend = -1.38, yend=3, geom='segment', col='white') +
geom_segment(data = data.frame(x = -1.38, y = seq(3.0, 3.0, len=30),
xend = seq(1.4, 1.1, len=30), yend = seq(3.0, 3.5, len=30)),
aes(x, y, xend=xend, yend=yend), col='#ffffff10') +
geom_segment(data = data.frame(id=1:30, x = seq(1.1, 1.35, len=30), y = seq(3.5, 3.0, len=30),
xend = seq(10, 10, len=30), yend = seq(2.0, 1.0, len=30)),
aes(x, y, xend = xend, yend = yend, col = factor(id))) +
geom_path(data=NULL, aes(c(-3, 0, 3, -3), y = c(0,5.5,0,0)), col='white') +
@coolbutuseless
coolbutuseless / reinstall-CRAN.R
Created May 30, 2020 01:05 — forked from tjmahr/reinstall-CRAN.R
maybe reinstall the github packages?
df <- as.data.frame(installed.packages(fields = c("RemoteType", "Repository")))
to_reinstall <- df[df$Repository %in% "CRAN", "Package"]
install.packages(to_reinstall)
@coolbutuseless
coolbutuseless / as.mesh3d.terrainmeshr.R
Last active May 29, 2020 06:58
terrainmesh to mesh3d with normals
library(terrainmeshr)
library(rgl)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Create triangles from heigh-map
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
tris <- terrainmeshr::triangulate_matrix(
volcano, maxError = 30, verbose = TRUE, y_up = FALSE
)
#remotes::install_cran(c("anglr", "silicate"))

library(silicate)
library(anglr)
library(rgl)
## volcano is heightmap, doesn't exist in geo-space in R so we map it do the extent of
## these spatial polygons 
poly <- silicate::minimal_mesh
# xmin : 0 
@coolbutuseless
coolbutuseless / defaultlist.R
Last active May 12, 2020 10:58
defaultlist.R
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Create a list with a default value
#'
#' This behaves exactly like a 'list()' object, except if the requested value
#' does not exist, a default value is returned (instead of NULL).
#'
#' Similar to a `defaultdict` in Python
#'
#' @param value default value to return if item not in list
#'
@coolbutuseless
coolbutuseless / safe_system.R
Last active April 12, 2020 00:50
Is it possible to have a safe system2 call in R?
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Detect special characters in a character vector of args
#'
#' This is implemented as a whitelist of characters to accept. The presence
#' of anything outside this whitelist is considered a 'special character'
#'
#' @param args character vector of args to check
#'
@coolbutuseless
coolbutuseless / close-points.R
Created February 18, 2020 10:53
Find points close to an outline. Help needed!
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# A bunch of points
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
N <- 10
point_coords <- cbind(
rep(seq(0, 1, length.out = N), times = N),
rep(seq(0, 1, length.out = N), each = N)
)
points <- sf::st_multipoint(point_coords)