Skip to content

Instantly share code, notes, and snippets.

View strboul's full-sized avatar

Metin Yazici strboul

36 followers · 77 following
View GitHub Profile
@strboul
strboul / roll-dice.R
Created December 16, 2019 22:06
Monte Carlo simulation of rolling dice in R
### ----------------------------------------------------------------- ###
### SET UP THE PROBS ----
### ----------------------------------------------------------------- ###
roll_dice <- function() {
dice <- sample(seq(100L), 1L)
if (dice <= 51L) {
FALSE
} else if (dice > 51L) {
@strboul
strboul / rmarkdown-knit-hooks.Rmd
Last active December 16, 2019 21:50
RMarkdown set custom language prompts with knitr::knit_hooks
---
title: "RMarkdown knit_hooks"
date: "`r Sys.Date()`"
output:
html_document:
highlight: textmate
---
```{r setup, include=FALSE}
## Source: https://stackoverflow.com/a/39025054
@strboul
strboul / style-knitr-kable.R
Created December 15, 2019 21:31
Style the table output from knitr::kable
table <- knitr::kable(mtcars, "html")
tmp_path <- tempfile()
html_tmp_path <- paste0(tmp_path, ".html")
## styles are from: Duckett, J. (2013) HTML & CSS p. 338
styles <- '
body {
font-family: Arial, Verdana, sans-serif;
@strboul
strboul / gdp.R
Created December 15, 2019 10:43
The variation of the GDP over time in 41 European countries
gdp <- data.frame(
"Luxembourg" = c(90661, 92969, 92102, 94823, 99738, 101255, 103286, 106373, 110870, 112622),
"Ireland" = c(43291, 45359, 46058, 47422, 52133, 65656, 69248, 75538, 79925, 81686),
"Norway" = c(61601, 62656, 64699, 65673, 67377, 68795, 69807, 71830, 74065, 76620),
"Switzerland" = c(53263, 54769, 55728, 57098, 58808, 59423, 60365, 61421, 63380, 66780),
"Netherlands" = c(44839, 46309, 46491, 47015, 48363, 49780, 51248, 53634, 56435, 59105),
"Iceland" = c(38594, 40022, 41005, 42953, 44220, 46146, 49683, 51841, 54121, 56915),
"Germany" = c(40850, 43249, 44266, 45127, 46627, 47429, 48532, 50425, 52801, 54984),
"Denmark" = c(41957, 43193, 43933, 44882, 46223, 47202, 48338, 49883, 51643, 54564),
@strboul
strboul / birthday-prob-mc.R
Created November 8, 2019 20:46
Birthday problem (paradox) with MC simulation
## The birthday paradox is very famous in probability. If you take 23 people,
## there's about a 50/50 chance that two of them share a birthday. With 50
## people, it's a 97% chance.
## Source: https://twitter.com/3blue1brown/status/1192570973439946754
library(ggplot2)
birthday <- function(n, iterations) {
res <- vapply(seq(iterations), function(.) {
@strboul
strboul / lang.R
Created October 22, 2019 19:11
Create language elements in R at C level
## Create language elements in R at C level
## Create class with Rf_lang
inline::cfunction(c(x = "numeric"), '
SEXP class_call = PROTECT(Rf_lang2(R_ClassSymbol, x));
UNPROTECT(1);
return class_call;
') -> class_expr
@strboul
strboul / two-ints-avg.R
Last active October 14, 2019 14:22
Calculating the average of two integer numbers (decimal results are rounded down towards zero) in R
inline::cfunction(c(asexp = "integer", bsexp = "integer"), '
int a = Rf_asInteger(asexp);
int b = Rf_asInteger(bsexp);
int avg = (a>>1)+(b>>1)+(a&b&1);
SEXP out = PROTECT(allocVector(INTSXP, 1));
out = Rf_ScalarInteger(avg);
UNPROTECT(1);
return out;
') -> avg_two_ints
@strboul
strboul / gh-user-star-analyzing.R
Created October 1, 2019 21:36
User stars analyzing in GitHub
library(tidyverse)
library(gh)
## NOTE:
## Don't forget to introduce token not to be constrained by rate limit of GH.
## Sys.setenv(GITHUB_TOKEN = "blabla")
## (ask more page than it needs and then eliminate the empty ones in the second step)
n_pages <- 10L
@strboul
strboul / c-value-assign.R
Created September 28, 2019 20:58
R's C API value assignment #profiling #optimization #benchmark
## Verdict: memset doesn't have a clear performance advantage and it has
## restrictive use.
## Pointer is important to use.
## Resources:
## http://adv-r.had.co.nz/C-interface.html
library(inline)
library(microbenchmark)
library(profmem)
@strboul
strboul / get_git_logs.R
Created September 22, 2019 19:18
Analyze git logs
get_git_logs <- function(https) {
## temporarily set locale to EN/US:
old_locale <- Sys.getlocale("LC_TIME")
Sys.setlocale("LC_TIME", "en_US.UTF-8")
on.exit(Sys.setlocale("LC_TIME", old_locale), add = TRUE)
hash <- paste(sample(c(seq(1, 49), letters, LETTERS), 5), collapse = "")
path <- file.path("var", "tmp", hash)