###################################################
### chunk number 1: RExt
###################################################
library(MASS) 
library(boot)
storm.fm <- nls(Time ~ b*Viscosity/(Wt - c), stormer,
                start = c(b=29.401, c=2.2183))
st <- cbind(stormer, fit=fitted(storm.fm))
storm.bf <- function(rs, i) {
    st$Time <-  st$fit + rs[i]
    tmp <- nls(Time ~ (b * Viscosity)/(Wt - c), st,
               start = coef(storm.fm))
    tmp$m$getAllPars()
}
rs <- scale(resid(storm.fm), scale = FALSE) # remove the mean
Rprof("boot.out")
storm.boot <- boot(rs, storm.bf, R = 4999) # pretty slow
Rprof(NULL)


###################################################
### chunk number 2: RcmdRprof
###################################################
res.rcmd <- system("R CMD Rprof boot.out", intern = TRUE)
res.rcmd[1:40]
res.rcmd[178:218]


###################################################
### chunk number 3: summaryRprof
###################################################
res.sum <- summaryRprof("boot.out")
res.sum[["by.self"]][1:40,]
res.sum[["by.total"]][1:40,]


###################################################
### chunk number 4: profr0
###################################################
library(profr)


###################################################
### chunk number 5: profr
###################################################
boot.out <- parse_rprof("boot.out")


###################################################
### chunk number 6: profr1
###################################################
boot.out[1:40,]


###################################################
### chunk number 7: profrPlot
###################################################
plot(boot.out, minlabel = 0.03)


###################################################
### chunk number 8: profrggplot eval=FALSE
###################################################
## ggplot.profr(boot.out, minlabel = 0.03)


###################################################
### chunk number 9: proftools0
###################################################
library(proftools)


###################################################
### chunk number 10: proftools
###################################################
boot.out1 <- readProfileData("boot.out")


###################################################
### chunk number 11: proftools1
###################################################
flatProfile(boot.out1)[1:40,]
flatProfile(boot.out1, byTotal = FALSE)[1:40,]


###################################################
### chunk number 12: profileCallGraph eval=FALSE
###################################################
## plotProfileCallGraph(boot.out1)


###################################################
### chunk number 13: Summe
###################################################
Summe <- function(x){
  summe <- 0
  for(i in seq_len(length(x)))
    summe <- summe + x[i]
}
x <- rnorm(1e7)
system.time(Summe(x))


###################################################
### chunk number 14: inline
###################################################
library(inline)
Ccode <- "
    *summe = 0;
    for(int i = 0; i < *n; i++){
      *summe += x[i];
   }"
SummeC <- cfunction(sig = signature(x = "numeric", n = "integer", 
                                    summe = "numeric"), 
                    body = Ccode, language = "C", convention = ".C")


###################################################
### chunk number 15: inline1
###################################################
SummeC


###################################################
### chunk number 16: SummeC
###################################################
system.time(SummeC(x, length(x), numeric(1)))


###################################################
### chunk number 17: inline2
###################################################
SummeC <- cfunction(sig = signature(x = "numeric", n = "integer", 
                                    summe = "numeric"), 
                    body = Ccode, language = "C", convention = ".C", 
                    verbose = TRUE)


###################################################
### chunk number 18: inline3
###################################################
Fcode <- "
          DO I = 1, N(1)
            SUMME(1) = SUMME(1) + X(I)
          END DO
    "
SummeF <- cfunction(sig = signature(X = "numeric", N = "integer", 
                                    SUMME = "numeric"), 
                    body = Fcode, convention = ".Fortran", 
                    verbose = TRUE)


###################################################
### chunk number 19: inline4
###################################################
SummeF


###################################################
### chunk number 20: SummeF
###################################################
system.time(SummeF(x, length(x), numeric(1)))


###################################################
### chunk number 21: inline5
###################################################
Callcode <- "
    int i, xn;
    double *xsum, *xx;
    SEXP summe;
    PROTECT(x = AS_NUMERIC(x));
    PROTECT(summe = NEW_NUMERIC(1));
    xsum = NUMERIC_POINTER(summe);
    xn = LENGTH(x);
    xx = NUMERIC_POINTER(x);
    *xsum = 0;
    for(i = 0; i < xn; i++){
      *xsum += xx[i];
    }
    UNPROTECT(2);
    return summe;"
SummeCall <- cfunction(sig = signature(x = "numeric"), 
                       body = Callcode, language = "C", 
                       convention = ".Call", verbose = TRUE)


###################################################
### chunk number 22: SummeCall
###################################################
system.time(SummeCall(x))


###################################################
### chunk number 23: sum
###################################################
system.time(sum(x))