vankesteren’s gists

vankesteren / glasso_emp_copula.R

Last active March 18, 2022 09:58

Penalized Gaussian copula with empirical marginals for data synthetization in R

	# Graphical LASSO copula model
	library(glasso)
	library(MASS)
	library(Matrix)
	set.seed(45)

	glasso_copula <- function(df, rho, penalize.diagonal = FALSE, ...) {
	N <- nrow(df)
	P <- ncol(df)
	if (missing(rho)) rho <- 2*sqrt(log(P)/N) # sls ch 9 p 252

vankesteren / vpglm.R

Last active February 23, 2022 13:25

fast vertically partitioned glms

vankesteren / rotation_translation.R

Last active December 16, 2021 14:58

Finding rotation (R) and translation (t) to transform a reference point set A into a target point set B = R * (A + t)

	set.seed(45)
	N <- 100
	P <- 2
	A <- matrix(rnorm(N*P), N)
	translation <- c(-0.9, .6)
	rotation <- function(theta) matrix(c(cos(theta), sin(theta), -sin(theta), cos(theta)), 2)
	R <- rotation(pi/5)
	B <- t(apply(A, 1, function(x) R %*% (x + translation)))

vankesteren / utr_house.R

Last active November 22, 2021 12:51

Where do people living in Utrecht look for a house?

	# load packages
	library(tidyverse)
	library(sf)

	# read data
	flow <- read_csv("https://data.mendeley.com/public-files/datasets/rtn8t47t6j/files/7f85a66d-a80d-4e3d-ada8-694a9c6e0a28/file_downloaded")
	gem <- st_read("WFS:https://geodata.nationaalgeoregister.nl/wijkenbuurten2018/wfs?&request=GetCapabilities&service=WFS",
	"wijkenbuurten2018:gemeenten2018")

	# clean gemeente dataset

vankesteren / tensorsem_lavpredict.R

Last active November 8, 2021 19:01

creating a lavaan object for using in lavPredict from a tensorsem parameter table

	# lavPredict from tensorsem parameters
	library(lavaan)
	library(tensorsem)

	mod <- "
	# three-factor model
	visual =~ x1 + x2 + x3
	textual =~ x4 + x5 + x6
	speed =~ x7 + x8 + x9
	"

vankesteren / em_mixture.R

Last active October 25, 2022 13:10

Unidimensional gaussian mixture modeling using EM

	# gaussian mixture modeling with EM
	priorp <- 0.6
	m1 <- 0
	m2 <- 2
	s1 <- 1
	s2 <- 0.707

	# generate some data with 2 classes
	N <- 1000
	cl <- rbinom(N, 1, priorp)

vankesteren / kmedoids.R

Created November 3, 2021 13:58

	kmedoids <- function(X, K, max_iter = 100) {
	X <- as.matrix(X)
	N <- nrow(X)
	P <- ncol(X)
	C <- matrix(0, nrow = K, ncol = P)
	clus <- sample(K, N, replace = TRUE)
	converged <- FALSE
	iter <- 0
	while (!converged && iter < max_iter) {
	old_clus <- clus

vankesteren / intransitivity_mc.R

Last active May 7, 2021 08:29

Bayesian monte carlo test for partial intransitivity

	# Bayesian test for partial intransitivity using monte-carlo posterior approximation
	# (c) Erik-Jan van Kesteren, 2021
	# Based on an e-mail discussion with Tony Marley
	library(expm)
	library(tidyverse)

	# Beta prior (1, 1 means uniform)
	prior_a <- 1
	prior_b <- 1

vankesteren / meuse_kriging.R

Last active September 14, 2021 12:00

Meuse data universal kriging with OpenStreetMaps enrichment

	# Meuse universal kriging for a large grid
	# The grid is enriched with osm data
	# CC-BY @vankesteren

	# load packages ----
	library(tidyverse)
	library(sf)
	library(ggspatial)
	library(osmdata)
	library(gstat)

vankesteren / gierzwaluw.R

Created February 15, 2021 10:53

Gierzwaluw in Utrecht analysis with osmenrich

	# Gierzwaluw (common swift) analysis using osmenrich
	# Last edited 2021-02-09 by @vankesteren
	# CC-BY ODISSEI SoDa team

	# Packages
	# Data
	library(tidyverse)
	library(sf)
	library(osmenrich)

Erik-Jan van Kesteren vankesteren