slwu89

// destination: array to fill the drawn "balls"
// source: number of "balls" in each "urn"
// n: number of draws to take
// k: number of "urns"
void rmhyper(int* destination, int const* source, int n, int k){
  int sum, x, y;
  size_t i;
  if(n < 0 || k < 0){Rcpp::stop("Invalid parameters of distribution");}
  
  // total number of "balls"

slwu89

// Example program
#include <iostream>
#include <string>
#include <list>
#include <algorithm>

#include <memory>

typedef struct widget {
    size_t i;

slwu89

//
//  main.cpp
//  test_humans
//
//  Created by Sean Wu on 5/31/18.
//  Copyright © 2018 Sean Wu. All rights reserved.
//

#include <iostream>
#include <string>

slwu89

//
//  main.cpp
//  test2
//  a slightly less horrible logging class
//
//  Created by Sean Wu on 12/17/18.
//  Copyright © 2018 Sean Wu. All rights reserved.
//

/* ######################################################################

slwu89

/* standard includes */
#include <stdio.h>
#include <iostream>

/* hash-table */
#include <unordered_map>
#include <string> /* for keys */

class parameters {
public:

slwu89

# continuous time rate
R <- 1/5

# mean time to next event in continuous time
mean(rexp(n = 1e6,rate = R))

# get a discrete time rate to plug into Euler approximation of continuous time process
get_r <- function(R,dt){
  log(1 + R*dt) / dt
}

slwu89

# Simulation of NHPP (CTDE style)
# based on: https://freakonometrics.hypotheses.org/724
# analytical functions from Mathematica

rm(list=ls());gc()

# intensity function
lambda <- function(x){
  100*(sin(x*pi)+1)
}

slwu89

/* the "vals" part of R's rle (run-length encoding) */
Rcpp::IntegerVector rle_vals(const Rcpp::IntegerVector& x){

  int n = x.size();

  /* y */
  Rcpp::IntegerVector head = x[Rcpp::seq(1,n-1)];
  Rcpp::IntegerVector tail = x[Rcpp::seq(0,n-2)];
  Rcpp::LogicalVector y = head != tail;

slwu89

smooth_kernels <- function(distances, tol = .Machine$double.eps^0.75){

  d_ecdf <- stats::ecdf(distances)
  d_knots <- stats::knots(d_ecdf)

  d_pmf <- vapply(d_knots, function(x,tol){
    d_ecdf(x+.Machine$double.eps^0.75) - d_ecdf(x-.Machine$double.eps^0.75)
  }, numeric(1), tol = tol)
  
  # might want to check into isotonic regression here to force monotonic increasing fn for smooth CDF

slwu89

################################################################################
# Definition 4
################################################################################

norm_for_Lp <- function(x,p){
  dnorm(x = x,mean = p,sd = 1,log = FALSE)
}

Lp <- function(p){
  integrate(f = norm_for_Lp,lower = -Inf,upper = Inf,p=p)$value