Skip to content

Instantly share code, notes, and snippets.

View dirkschumacher's full-sized avatar
👶
I may be slow to respond.

Dirk Schumacher dirkschumacher

👶
I may be slow to respond.
View GitHub Profile
# based on a article from here https://dirkschumacher.github.io/ompr/articles/problem-graph-coloring.html
library(maptools)
library(dplyr)
# devtools::install_github("dirkschumacher/ompr@milp")
# CC by
map_data <- rgdal::readOGR("https://raw.githubusercontent.com/nvkelso/natural-earth-vector/master/geojson/ne_50m_admin_0_countries.geojson", "OGRGeoJSON")
# LICENSE MIT
# Data from RKI with special Terms
library(dplyr)
library(readr)
library(tidyr)
# go to https://survstat.rki.de/Content/Query/Create.aspx
# Selected calendar weeks for rows and diseases for columns.
# had to manually edit, because not a valid csv
# this is just a script to test the rhxl package, I just quickly looked at the data
# Ethiopia Who is doing What Where - 3W December 2017
# source: https://data.humdata.org/dataset/3w-december-2017
url <- "https://data.humdata.org/dataset/615416d2-457b-461a-8155-090f0ced0bf8/resource/f71bf111-8706-42f4-ba46-4ce3c8c949dc/download/3w_hxl.xlsx"
# load the rhxl package
# https://github.com/dirkschumacher/rhxl
library(rhxl)
download.file(url, "file.xlsx")
splice_df <- function(x, ...) {
  expr <- rlang::enquo(x)
  cols <- lapply(rlang::ensyms(..., .named = TRUE), as.character)
  lapply(cols, function(col_name) {
    rlang::quo(`[[`(!!expr, !!col_name))
  })
}
a <- Matrix::sparseVector(1:2, i = 1:2, length = 2)
b <- Matrix::sparseVector(1:2, i = 1:2, length = 2)
class(a * b)
#> [1] "dsparseVector"
#> attr(,"package")
#> [1] "Matrix"
class(a / b) # bug? numeric instead of sparseVector
#> [1] "numeric"
library(armacmp)

# taken from https://gallery.rcpp.org/articles/black-scholes-three-ways/
put_option_pricer_arma <- armacmp(function(s = type_colvec(),
                                           k = type_scalar_numeric(),
                                           r = type_scalar_numeric(),
                                           y = type_scalar_numeric(),
                                           t = type_scalar_numeric(),
 sigma = type_scalar_numeric()) {
library(armacmp)
# Arnold, T., Kane, M., & Lewis, B. W. (2019). A Computational Approach to Statistical Learning. CRC Press.
# logistic regression using the Newton-Raphson
log_reg <- armacmp(function(X, y) {
  beta <- rep.int(0, ncol(X))
  for (i in seq_len(25)) {
    b_old <- beta
    alpha <- X %*% beta
    p <- 1 / (1 + exp(-alpha))
library(armacmp)
# code from https://nextjournal.com/wolfv/how-fast-is-r-with-fastr-pythran
# which in turn comes in part from http://www.tylermw.com/throwing-shade/
# Author: Tyler Morgan-Wall

# first the R version

faster_bilinear <- function (Z, x0, y0){
  i = floor(x0)
library(armacmp)

# some of julia's microbenchmarks translated to C++
# https://github.com/JuliaLang/Microbenchmarks/blob/master/perf.R

fib_cpp <- armacmp(function(n = type_scalar_int()) {
  fib_rec <-  function(nr = type_scalar_int()) {
    if (nr < 2) {
      return(nr, type = type_scalar_int())
`?` <- function(lhs, rhs) {
  if (missing(rhs)) {
    return(eval(bquote(utils::`?`(.(substitute(lhs))))))
  }
  rhs <- substitute(rhs)
  envir <- parent.frame()
  split_colon <- strsplit(deparse(rhs), ":")
  stopifnot(length(split_colon) == 1L, length(split_colon[[1L]]) == 2L)
 rhs_chr &lt;- split_colon[[1L]]