1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
## ----setup, include=FALSE-----------------------
knitr::opts_chunk$set(cache=TRUE)
library(Rcpp)
options("width"=50, digits=5)
## ----evalCpp------------------------------------
library("Rcpp")
evalCpp("2 + 2")
## ----isOddR, cache=TRUE-------------------------
isOddR <- function(num = 10L) {
result <- (num %% 2L == 1L)
return(result)
}
isOddR(42L)
## ----isOddRcpp----------------------------------
library("Rcpp")
cppFunction("
bool isOddCpp(int num = 10) {
bool result = (num % 2 == 1);
return result;
}")
isOddCpp(42L)
## ----microbenchmark_isOdd, dependson=c("isOddR", "isOddRcpp"), eval=FALSE----
# library("microbenchmark")
# results <- microbenchmark(isOddR = isOddR(12L),
# isOddCpp = isOddCpp(12L))
# print(summary(results)[, c(1:7)],digits=1)
## ----rnormScalar--------------------------------
evalCpp("R::rnorm(0, 1)")
## ----normWithSeed-------------------------------
set.seed(123)
evalCpp("R::rnorm(0, 1)")
## ----rnormWithSeedFromR-------------------------
set.seed(123)
# Implicit mean of 0, sd of 1
rnorm(1)
## ----rnormExCpp---------------------------------
set.seed(123)
evalCpp("Rcpp::rnorm(3)")
## ----rnormExR-----------------------------------
set.seed(123)
rnorm(3)
## ----bootstrap_in_r-----------------------------
# Function declaration
bootstrap_r <- function(ds, B = 1000) {
# Preallocate storage for statistics
boot_stat <- matrix(NA, nrow = B, ncol = 2)
# Number of observations
n <- length(ds)
# Perform bootstrap
for(i in seq_len(B)) {
# Sample initial data
gen_data <- ds[ sample(n, n, replace=TRUE) ]
# Calculate sample data mean and SD
boot_stat[i,] <- c(mean(gen_data),
sd(gen_data))
}
# Return bootstrap result
return(boot_stat)
}
## ----bootstrap_example--------------------------
# Set seed to generate data
set.seed(512)
# Generate data
initdata <- rnorm(1000, mean = 21, sd = 10)
# Set a new _different_ seed for bootstrapping
set.seed(883)
# Perform bootstrap
result_r <- bootstrap_r(initdata)
## ----dist_graphs, echo = FALSE, results = "hide"----
make_boot_graph <- function(ds, actual, type, ylim){
hist(ds, main = paste(type, "Bootstrap"), xlab = "Samples",
col = "lightblue", lwd = 2, prob = TRUE, ylim = ylim, cex.axis = .85, cex.lab = .90)
abline(v = actual, col = "orange2", lwd = 2)
lines(density(ds))
}
pdf("figures/bootstrap.pdf", width=6.5, height=3.25)
par(mfrow=c(1,2))
make_boot_graph(result_r[,1], 21, "Mean", c(0, 1.23))
make_boot_graph(result_r[,2], 10, "SD", c(0, 1.85))
dev.off()
## ----bootstrap_cpp------------------------------
# Use the same seed use in R and C++
set.seed(883)
# Perform bootstrap with C++ function
result_cpp <- bootstrap_cpp(initdata)
## ----check_r_to_cpp-----------------------------
# Compare output
all.equal(result_r, result_cpp)
## ----benchmark_r_to_cpp-------------------------
library(rbenchmark)
benchmark(r = bootstrap_r(initdata),
cpp = bootstrap_cpp(initdata))[, 1:4]
## ----skeleton, eval = FALSE---------------------
# library("Rcpp")
# Rcpp.package.skeleton("samplePkg")
|
