slwu89

#include <Rcpp.h>

#include <random>
#include <vector>

using namespace Rcpp;

// [[Rcpp::plugins(cpp11)]]

typedef std::mt19937 RNG;

slwu89

get_omega1 <- function(mu,lifespanReduction){
  lifespan <- (1/mu) * lifespanReduction
  get_omega_f <- function(omega,mu,lifespan){
    (1/(1-omega+(omega*mu)))-lifespan
  }
  return(uniroot(f=get_omega_f,interval=c(0,1),lifespan=lifespan,mu=mu,maxiter=1e4)$root)
}

# 10-25-2018
get_omega <- function(mu,lifespan){

slwu89

/* evaluate 2 functions with ... (but must take same named args) */
SEXP C_example(SEXP call, SEXP rho){

   SEXP args = CDR(call);

   /* make up some 'arguments' for our two functions we want to call */
   SEXP a1 = PROTECT(allocVector(REALSXP,1));
   SEXP b1 = PROTECT(allocVector(REALSXP,1));
   REAL(a1)[0] = 5.;
   REAL(b1)[0] = 10.;

slwu89

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

/* Release event */
template <typename T>
class release {
public:
    
  release(T x);  /* constructor */

slwu89

/*
 * still need to figure out how to more the lambda function into the class as a friend or something,
 * it will be annoying to write lambdas all over the code...
*/

#include <iostream>
#include <vector>
#include <memory>
#include <algorithm>

slwu89

//
//  main.cpp
//  main_only_test
//
//  Created by Sean Wu on 7/24/18.
//  Copyright © 2018 Sean Wu. All rights reserved.
//

#include <iostream>
#include <memory>

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

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

/* 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

# 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)
}