bliss.Rcheck/bliss-Ex.R
In pmgrollemund/bliss: Bayesian Functional Linear Regression with Sparse Step Functions
pkgname <- "bliss"
source(file.path(R.home("share"), "R", "examples-header.R"))
options(warn = 1)
base::assign(".ExTimings", "bliss-Ex.timings", pos = 'CheckExEnv')
base::cat("name\tuser\tsystem\telapsed\n", file=base::get(".ExTimings", pos = 'CheckExEnv'))
base::assign(".format_ptime",
function(x) {
if(!is.na(x[4L])) x[1L] <- x[1L] + x[4L]
if(!is.na(x[5L])) x[2L] <- x[2L] + x[5L]
options(OutDec = '.')
format(x[1L:3L], digits = 7L)
},
pos = 'CheckExEnv')
### * </HEADER>
library('bliss')
base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')
base::assign(".old_wd", base::getwd(), pos = 'CheckExEnv')
cleanEx()
nameEx("BIC_model_choice")
### * BIC_model_choice
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: BIC_model_choice
### Title: BIC_model_choice
### Aliases: BIC_model_choice
### ** Examples
## No test:
param_sim <- list(Q=1,n=100,p=c(50),grids_lim=list(c(0,1)))
data <- sim(param_sim,verbose=TRUE)
iter = 1e2
Ks <- 1:5
res_BIC <- BIC_model_choice(Ks,iter,data)
plot(res_BIC,xlab="K",ylab="BIC")
## End(No test)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("BIC_model_choice", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("Bliss_Gibbs_Sampler")
### * Bliss_Gibbs_Sampler
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: Bliss_Gibbs_Sampler
### Title: Bliss_Gibbs_Sampler
### Aliases: Bliss_Gibbs_Sampler
### ** Examples
## No test:
# May take a while
param_sim <- list(Q=1,n=25,p=50,grids_lim=list(c(0,1)),iter=1e4,K=2)
data_sim <- sim(param_sim,verbose=FALSE)
res_Bliss_Gibbs_Sampler <- Bliss_Gibbs_Sampler(data_sim,param_sim)
theta_1 <- res_Bliss_Gibbs_Sampler$trace[1,]
theta_1
# Resultat for few iterations
param_sim <- list(Q=1,n=25,p=50,grids_lim=list(c(0,1)),iter=5e2,K=2)
data_sim <- sim(param_sim,verbose=FALSE)
res_Bliss_Gibbs_Sampler <- Bliss_Gibbs_Sampler(data_sim,param_sim)
theta_1 <- res_Bliss_Gibbs_Sampler$trace[1,]
theta_1
## End(No test)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("Bliss_Gibbs_Sampler", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("Bliss_Simulated_Annealing")
### * Bliss_Simulated_Annealing
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: Bliss_Simulated_Annealing
### Title: Bliss_Simulated_Annealing
### Aliases: Bliss_Simulated_Annealing
### ** Examples
## No test:
data(data1)
data(param1)
param1$grids<-data1$grids
# result of res_bliss1<-fit_Bliss(data=data1,param=param1)
data(res_bliss1)
beta_sample <- compute_beta_sample(posterior_sample=res_bliss1$posterior_sample,
param=param1,Q=1)
param_test<-list(grid=param1$grids[[1]],iter=1e3,K=2)
test<-Bliss_Simulated_Annealing(beta_sample[[1]],
res_bliss1$posterior_sample$param$normalization_values[[1]],
param=param_test)
ylim <- range(range(test$Bliss_estimate),range(test$Smooth_estimate))
plot(param_test$grid,test$Bliss_estimate,type="l",ylim=ylim)
lines(param_test$grid,test$Smooth_estimate,lty=2)
## End(No test)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("Bliss_Simulated_Annealing", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("build_Fourier_basis")
### * build_Fourier_basis
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: build_Fourier_basis
### Title: build_Fourier_basis
### Aliases: build_Fourier_basis
### ** Examples
# See the function \code{sim_x}.
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("build_Fourier_basis", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("change_grid")
### * change_grid
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: change_grid
### Title: change_grid
### Aliases: change_grid
### ** Examples
grid <- seq(0,1,l=1e1)
new_grid <- seq(0,1,l=1e2)
fct <- 3*grid^2 + sin(grid*2*pi)
plot(grid,fct,type="o",lwd=2,cex=1.5)
lines(new_grid,change_grid(fct,grid,new_grid),type="o",col="red",cex=0.8)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("change_grid", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("choose_beta")
### * choose_beta
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: choose_beta
### Title: choose_beta
### Aliases: choose_beta
### ** Examples
### smooth
param <- list(p=100,grid=seq(0,1,length=100),shape="smooth")
beta_function <- choose_beta(param)
plot(param$grid,beta_function,type="l")
### random_smooth
param <- list(p=100,grid=seq(0,1,length=100),shape="random_smooth")
beta_function <- choose_beta(param)
plot(param$grid,beta_function,type="l")
### simple
param <- list(p=100,grid=seq(0,1,length=100),shape="simple")
beta_function <- choose_beta(param)
plot(param$grid,beta_function,type="s")
### simple_bis
param <- list(p=100,grid=seq(0,1,length=100),shape="simple_bis")
beta_function <- choose_beta(param)
plot(param$grid,beta_function,type="s")
### random_simple
param <- list(p=100,grid=seq(0,1,length=100),shape="random_simple")
beta_function <- choose_beta(param)
plot(param$grid,beta_function,type="s")
### sinusoid
param <- list(p=100,grid=seq(0,1,length=100),shape="sinusoid")
beta_function <- choose_beta(param)
plot(param$grid,beta_function,type="l")
### flat_sinusoid
param <- list(p=100,grid=seq(0,1,length=100),shape="flat_sinusoid")
beta_function <- choose_beta(param)
plot(param$grid,beta_function,type="l")
### sharp
param <- list(p=100,grid=seq(0,1,length=100),shape="sharp")
beta_function <- choose_beta(param)
plot(param$grid,beta_function,type="l")
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("choose_beta", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("compute_beta_posterior_density")
### * compute_beta_posterior_density
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: compute_beta_posterior_density
### Title: compute_beta_posterior_density
### Aliases: compute_beta_posterior_density
### ** Examples
## No test:
library(RColorBrewer)
data(data1)
data(param1)
# result of res_bliss1<-fit_Bliss(data=data1,param=param1)
data(res_bliss1)
q <- 1
param_beta_density <- list(grid= data1[["grids"]][[q]],
iter= param1[["iter"]],
p = param1[["p"]][q],
n = length(data1[["y"]]),
thin = param1[["thin"]],
burnin = param1[["burnin"]],
lims_kde = param1[["lims_kde"]][[q]],
new_grid = param1[["new_grids"]][[q]],
lims_estimate = range(res_bliss1$Smooth_estimate[[q]]))
density_estimate <- compute_beta_posterior_density(res_bliss1$beta_sample[[q]],param_beta_density)
image(density_estimate$grid_t,
density_estimate$grid_beta_t,
density_estimate$density,col=rev(heat.colors(100)))
## End(No test)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("compute_beta_posterior_density", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("compute_beta_sample")
### * compute_beta_sample
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: compute_beta_sample
### Title: compute_beta_sample
### Aliases: compute_beta_sample
### ** Examples
library(RColorBrewer)
data(data1)
data(param1)
param1$grids<-data1$grids
# result of res_bliss1<-fit_Bliss(data=data1,param=param1)
data(res_bliss1)
beta_sample <- compute_beta_sample(posterior_sample=res_bliss1$posterior_sample,
param=param1,Q=1)
indexes <- sample(nrow(beta_sample[[1]]),1e2,replace=FALSE)
cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(1e2)
matplot(param1$grids[[1]],t(beta_sample[[1]][indexes,]),type="l",lty=1,col=cols,
xlab="grid",ylab="")
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("compute_beta_sample", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("compute_chains_info")
### * compute_chains_info
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: compute_chains_info
### Title: compute_chains_info
### Aliases: compute_chains_info
### ** Examples
## No test:
param_sim <- list(Q=1,
n=100,
p=c(50),
grids_lim=list(c(0,1)))
data <- sim(param_sim,verbose=TRUE)
param <- list(iter=5e2,
K=c(3),
n_chains = 3)
res_bliss <- fit_Bliss(data,param,verbose=TRUE,compute_density=FALSE,sann=FALSE)
param$grids <- data$grids
chains_info1 <- compute_chains_info(res_bliss$chains[[1]],param)
chains_info2 <- compute_chains_info(res_bliss$chains[[2]],param)
chains_info3 <- compute_chains_info(res_bliss$chains[[3]],param)
# Smooth estimates
ylim <- range(range(chains_info1$estimates$Smooth_estimate),
range(chains_info2$estimates$Smooth_estimate),
range(chains_info3$estimates$Smooth_estimate))
plot(data$grids[[1]],chains_info1$estimates$Smooth_estimate,type="l",ylim=ylim,
xlab="grid",ylab="")
lines(data$grids[[1]],chains_info2$estimates$Smooth_estimate,col=2)
lines(data$grids[[1]],chains_info3$estimates$Smooth_estimate,col=3)
# Autocorrelation
plot(chains_info1$autocorr_lag[,1],type="h")
## End(No test)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("compute_chains_info", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("compute_random_walk")
### * compute_random_walk
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: compute_random_walk
### Title: compute_random_walk
### Aliases: compute_random_walk
### ** Examples
# see the sim_x() function.
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("compute_random_walk", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("compute_starting_point_sann")
### * compute_starting_point_sann
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: compute_starting_point_sann
### Title: compute_starting_point_sann
### Aliases: compute_starting_point_sann
### ** Examples
data(res_bliss1)
mystart<-compute_starting_point_sann(apply(res_bliss1$beta_sample[[1]],2,mean))
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("compute_starting_point_sann", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("corr_matrix")
### * corr_matrix
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: corr_matrix
### Title: corr_matrix
### Aliases: corr_matrix
### ** Examples
### Test 1 : weak autocorrelation
ksi <- 1
diagVar <- abs(rnorm(100,50,5))
Sigma <- corr_matrix(diagVar,ksi^2)
persp(Sigma)
### Test 2 : strong autocorrelation
ksi <- 0.2
diagVar <- abs(rnorm(100,50,5))
Sigma <- corr_matrix(diagVar,ksi^2)
persp(Sigma)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("corr_matrix", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("determine_intervals")
### * determine_intervals
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: determine_intervals
### Title: determine_intervals
### Aliases: determine_intervals
### ** Examples
data(data1)
data(param1)
# result of res_bliss1<-fit_Bliss(data=data1,param=param1)
data(res_bliss1)
intervals <- determine_intervals(res_bliss1$Bliss_estimate[[1]])
plot(data1$grids[[1]],res_bliss1$Bliss_estimate[[1]],type="s")
for(k in 1:nrow(intervals)){
segments(data1$grids[[1]][intervals[k,1]],intervals[k,3],
data1$grids[[1]][intervals[k,2]],intervals[k,3],col=2,lwd=4)
}
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("determine_intervals", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("dposterior")
### * dposterior
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: dposterior
### Title: dposterior
### Aliases: dposterior
### ** Examples
data(data1)
data(param1)
# result of res_bliss1<-fit_Bliss(data=data1,param=param1)
data(res_bliss1)
# Compute the posterior density of the MCMC sample :
res_poste <- dposterior(res_bliss1$posterior_sample,data1)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("dposterior", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("fit_Bliss")
### * fit_Bliss
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: fit_Bliss
### Title: fit_Bliss
### Aliases: fit_Bliss
### ** Examples
# see the vignette BlissIntro.
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("fit_Bliss", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("grapes-between-grapes")
### * grapes-between-grapes
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: %between%
### Title: between
### Aliases: %between%
### ** Examples
1 %between% c(0,2)
2 %between% c(0,2)
3 %between% c(0,2)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("grapes-between-grapes", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("image_Bliss")
### * image_Bliss
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: image_Bliss
### Title: image_Bliss
### Aliases: image_Bliss
### ** Examples
library(RColorBrewer)
data(data1)
data(param1)
data(res_bliss1)
param1$cols <- colorRampPalette(brewer.pal(9,"Reds"))(1e2)
image_Bliss(res_bliss1$beta_posterior_density,param1,q=1)
lines(res_bliss1$data$grids[[1]],res_bliss1$Bliss_estimate[[1]],type="s",lwd=2)
lines(res_bliss1$data$grids[[1]],res_bliss1$data$betas[[1]],col=3,lwd=2,type="s")
# ---- not run
param1$cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(1e2)
image_Bliss(res_bliss1$beta_posterior_density,param1,q=1)
lines(res_bliss1$data$grids[[1]],res_bliss1$Bliss_estimate[[1]],type="s",lwd=2)
lines(res_bliss1$data$grids[[1]],res_bliss1$data$betas[[1]],col=3,lwd=2,type="s")
param1$cols <- rev(heat.colors(12))
param1$col_scale <- "quantile"
image_Bliss(res_bliss1$beta_posterior_density,param1,q=1)
lines(res_bliss1$data$grids[[1]],res_bliss1$Bliss_estimate[[1]],type="s",lwd=2)
lines(res_bliss1$data$grids[[1]],res_bliss1$data$betas[[1]],col=3,lwd=2,type="s")
param1$cols <- rev(terrain.colors(12))
image_Bliss(res_bliss1$beta_posterior_density,param1,q=1)
lines(res_bliss1$data$grids[[1]],res_bliss1$Bliss_estimate[[1]],type="s",lwd=2)
lines(res_bliss1$data$grids[[1]],res_bliss1$data$betas[[1]],col=2,lwd=2,type="s")
param1$cols <- rev(topo.colors(12))
image_Bliss(res_bliss1$beta_posterior_density,param1,q=1)
lines(res_bliss1$data$grids[[1]],res_bliss1$Bliss_estimate[[1]],type="s",lwd=2)
lines(res_bliss1$data$grids[[1]],res_bliss1$data$betas[[1]],col=2,lwd=2,type="s")
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("image_Bliss", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("integrate_trapeze")
### * integrate_trapeze
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: integrate_trapeze
### Title: integrate_trapeze
### Aliases: integrate_trapeze
### ** Examples
x <- seq(0,1,le=1e2)
integrate_trapeze(x,x^2)
integrate_trapeze(data1$grids[[1]],t(data1$x[[1]]))
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("integrate_trapeze", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("interpretation_plot")
### * interpretation_plot
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: interpretation_plot
### Title: interpretation_plot
### Aliases: interpretation_plot
### ** Examples
data(data1)
data(param1)
# result of res_bliss1 <- fit_Bliss(data=data1,param=param1,verbose=TRUE)
data(res_bliss1)
interpretation_plot(data=data1,Bliss_estimate=res_bliss1$Bliss_estimate,q=1)
interpretation_plot(data=data1,Bliss_estimate=res_bliss1$Bliss_estimate,q=1,centered=TRUE)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("interpretation_plot", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("lines_bliss")
### * lines_bliss
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: lines_bliss
### Title: lines_bliss
### Aliases: lines_bliss
### ** Examples
### Plot the BLiss estimate on a suitable grid
## No test:
data(data1)
data(param1)
# res_bliss1 <- fit_Bliss(data=data1,param=param1,verbose=TRUE)
## End(No test)
data(res_bliss1)
### Plot the BLiss estimate on a suitable grid
plot_bliss(res_bliss1$data$grids[[1]],
res_bliss1$Bliss_estimate[[1]],lwd=2,bound=FALSE)
lines_bliss(res_bliss1$data$grids[[1]],
res_bliss1$Smooth_estimate[[1]],lty=2)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("lines_bliss", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("pdexp")
### * pdexp
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: pdexp
### Title: pdexp
### Aliases: pdexp
### ** Examples
pdexp(10,seq(0,1,1))
x <- seq(0,10,le=1e3)
plot(x,dexp(x,0.5),lty=2,type="l")
lines(pdexp(0.5,1:10),type="p")
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("pdexp", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("plot_bliss")
### * plot_bliss
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: plot_bliss
### Title: plot_bliss
### Aliases: plot_bliss
### ** Examples
## No test:
data(data1)
data(param1)
# res_bliss1 <- fit_Bliss(data=data1,param=param1,verbose=TRUE)
## End(No test)
data(res_bliss1)
### Plot the BLiss estimate on a suitable grid
plot_bliss(res_bliss1$data$grids[[1]],
res_bliss1$Bliss_estimate[[1]],lwd=2,bound=FALSE)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("plot_bliss", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("printbliss")
### * printbliss
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: printbliss
### Title: Print a bliss Object
### Aliases: printbliss
### ** Examples
# See fit_Bliss() function
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("printbliss", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("sigmoid")
### * sigmoid
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: sigmoid
### Title: sigmoid
### Aliases: sigmoid
### ** Examples
## Test 1 :
x <- seq(-7,7,0.1)
y <- sigmoid(x)
plot(x,y,type="l",main="Sigmoid function")
## Test 2 :
x <- seq(-7,7,0.1)
y <- sigmoid(x)
y2 <- sigmoid(x,asym=0.5)
y3 <- sigmoid(x,v = 5)
plot(x,y,type="l",main="Other sigmoid functions")
lines(x,y2,col=2)
lines(x,y3,col=3)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("sigmoid", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("sigmoid_sharp")
### * sigmoid_sharp
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: sigmoid_sharp
### Title: sigmoid_sharp
### Aliases: sigmoid_sharp
### ** Examples
## Test 1 :
x <- seq(-7,7,0.1)
y <- sigmoid_sharp(x)
plot(x,y,type="l",main="Sharp sigmoid")
## Test 2 :
x <- seq(-7,7,0.1)
y <- sigmoid_sharp(x,loc=3)
y2 <- sigmoid_sharp(x,loc=3,asym=0.5)
y3 <- sigmoid_sharp(x,loc=3,v = 5)
plot(x,y,type="l",main="Other sharp sigmoids")
lines(x,y2,col=2)
lines(x,y3,col=3)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("sigmoid_sharp", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("sim")
### * sim
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: sim
### Title: sim
### Aliases: sim
### ** Examples
library(RColorBrewer)
param <- list(Q=2,n=25,p=c(50,50),grids_lim=list(c(0,1),c(-1,2)))
data <- sim(param)
data$y
cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(10)
q=2
matplot(data$grids[[q]],t(data$x[[q]]),type="l",lty=1,col=cols)
plot(data$grids[[q]],data$betas[[q]],type="l")
abline(h=0,lty=2,col="gray")
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("sim", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("sim_x")
### * sim_x
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: sim_x
### Title: sim_x
### Aliases: sim_x
### ** Examples
library(RColorBrewer)
### Fourier
param <- list(n=15,p=100,grid=seq(0,1,length=100),x_shape="Fourier")
x <- sim_x(param)
cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(15)
matplot(param$grid,t(x),type="l",lty=1,col=cols)
### Fourier2
param <- list(n=15,p=100,grid=seq(0,1,length=100),x_type="Fourier2")
x <- sim_x(param)
cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(15)
matplot(param$grid,t(x),type="l",lty=1,col=cols)
### random_walk
param <- list(n=15,p=100,grid=seq(0,1,length=100),x_type="random_walk")
x <- sim_x(param)
cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(15)
matplot(param$grid,t(x),type="l",lty=1,col=cols)
### random_sharp
param <- list(n=15,p=100,grid=seq(0,1,length=100),x_type="random_sharp")
x <- sim_x(param)
cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(15)
matplot(param$grid,t(x),type="l",lty=1,col=cols)
### uniform
param <- list(n=15,p=100,grid=seq(0,1,length=100),x_type="uniform")
x <- sim_x(param)
cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(15)
matplot(param$grid,t(x),type="l",lty=1,col=cols)
### gaussian
param <- list(n=15,p=100,grid=seq(0,1,length=100),x_type="gaussian")
x <- sim_x(param)
cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(15)
matplot(param$grid,t(x),type="l",lty=1,col=cols)
### mvgauss
param <- list(n=15,p=100,grid=seq(0,1,length=100),x_type="mvgauss")
x <- sim_x(param)
cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(15)
matplot(param$grid,t(x),type="l",lty=1,col=cols)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("sim_x", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("support_estimation")
### * support_estimation
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: support_estimation
### Title: support_estimation
### Aliases: support_estimation
### ** Examples
data(data1)
data(param1)
# result of res_bliss1<-fit_Bliss(data=data1,param=param1)
data(res_bliss1)
res_support <- support_estimation(res_bliss1$beta_sample[[1]])
### The estimate
res_support$estimate
### Plot the result
grid <- res_bliss1$data$grids[[1]]
plot(grid,res_support$alpha,ylim=c(0,1),type="l",xlab="",ylab="")
for(k in 1:nrow(res_support$estimate)){
segments(grid[res_support$estimate[k,1]],0.5,
grid[res_support$estimate[k,2]],0.5,lwd=2,col=2)
points(grid[res_support$estimate[k,1]],0.5,pch="|",lwd=2,col=2)
points(grid[res_support$estimate[k,2]],0.5,pch="|",lwd=2,col=2)
}
abline(h=0.5,col=2,lty=2)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("support_estimation", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
### * <FOOTER>
###
cleanEx()
options(digits = 7L)
base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
grDevices::dev.off()
###
### Local variables: ***
### mode: outline-minor ***
### outline-regexp: "\\(> \\)?### [*]+" ***
### End: ***
quit('no')
pmgrollemund/bliss documentation built on July 15, 2024, 5:02 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
pkgname <- "bliss"
source(file.path(R.home("share"), "R", "examples-header.R"))
options(warn = 1)
base::assign(".ExTimings", "bliss-Ex.timings", pos = 'CheckExEnv')
base::cat("name\tuser\tsystem\telapsed\n", file=base::get(".ExTimings", pos = 'CheckExEnv'))
base::assign(".format_ptime",
function(x) {
if(!is.na(x[4L])) x[1L] <- x[1L] + x[4L]
if(!is.na(x[5L])) x[2L] <- x[2L] + x[5L]
options(OutDec = '.')
format(x[1L:3L], digits = 7L)
},
pos = 'CheckExEnv')
### * </HEADER>
library('bliss')
base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')
base::assign(".old_wd", base::getwd(), pos = 'CheckExEnv')
cleanEx()
nameEx("BIC_model_choice")
### * BIC_model_choice
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: BIC_model_choice
### Title: BIC_model_choice
### Aliases: BIC_model_choice
### ** Examples
## No test:
param_sim <- list(Q=1,n=100,p=c(50),grids_lim=list(c(0,1)))
data <- sim(param_sim,verbose=TRUE)
iter = 1e2
Ks <- 1:5
res_BIC <- BIC_model_choice(Ks,iter,data)
plot(res_BIC,xlab="K",ylab="BIC")
## End(No test)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("BIC_model_choice", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("Bliss_Gibbs_Sampler")
### * Bliss_Gibbs_Sampler
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: Bliss_Gibbs_Sampler
### Title: Bliss_Gibbs_Sampler
### Aliases: Bliss_Gibbs_Sampler
### ** Examples
## No test:
# May take a while
param_sim <- list(Q=1,n=25,p=50,grids_lim=list(c(0,1)),iter=1e4,K=2)
data_sim <- sim(param_sim,verbose=FALSE)
res_Bliss_Gibbs_Sampler <- Bliss_Gibbs_Sampler(data_sim,param_sim)
theta_1 <- res_Bliss_Gibbs_Sampler$trace[1,]
theta_1
# Resultat for few iterations
param_sim <- list(Q=1,n=25,p=50,grids_lim=list(c(0,1)),iter=5e2,K=2)
data_sim <- sim(param_sim,verbose=FALSE)
res_Bliss_Gibbs_Sampler <- Bliss_Gibbs_Sampler(data_sim,param_sim)
theta_1 <- res_Bliss_Gibbs_Sampler$trace[1,]
theta_1
## End(No test)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("Bliss_Gibbs_Sampler", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("Bliss_Simulated_Annealing")
### * Bliss_Simulated_Annealing
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: Bliss_Simulated_Annealing
### Title: Bliss_Simulated_Annealing
### Aliases: Bliss_Simulated_Annealing
### ** Examples
## No test:
data(data1)
data(param1)
param1$grids<-data1$grids
# result of res_bliss1<-fit_Bliss(data=data1,param=param1)
data(res_bliss1)
beta_sample <- compute_beta_sample(posterior_sample=res_bliss1$posterior_sample,
param=param1,Q=1)
param_test<-list(grid=param1$grids[[1]],iter=1e3,K=2)
test<-Bliss_Simulated_Annealing(beta_sample[[1]],
res_bliss1$posterior_sample$param$normalization_values[[1]],
param=param_test)
ylim <- range(range(test$Bliss_estimate),range(test$Smooth_estimate))
plot(param_test$grid,test$Bliss_estimate,type="l",ylim=ylim)
lines(param_test$grid,test$Smooth_estimate,lty=2)
## End(No test)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("Bliss_Simulated_Annealing", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("build_Fourier_basis")
### * build_Fourier_basis
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: build_Fourier_basis
### Title: build_Fourier_basis
### Aliases: build_Fourier_basis
### ** Examples
# See the function \code{sim_x}.
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("build_Fourier_basis", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("change_grid")
### * change_grid
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: change_grid
### Title: change_grid
### Aliases: change_grid
### ** Examples
grid <- seq(0,1,l=1e1)
new_grid <- seq(0,1,l=1e2)
fct <- 3*grid^2 + sin(grid*2*pi)
plot(grid,fct,type="o",lwd=2,cex=1.5)
lines(new_grid,change_grid(fct,grid,new_grid),type="o",col="red",cex=0.8)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("change_grid", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("choose_beta")
### * choose_beta
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: choose_beta
### Title: choose_beta
### Aliases: choose_beta
### ** Examples
### smooth
param <- list(p=100,grid=seq(0,1,length=100),shape="smooth")
beta_function <- choose_beta(param)
plot(param$grid,beta_function,type="l")
### random_smooth
param <- list(p=100,grid=seq(0,1,length=100),shape="random_smooth")
beta_function <- choose_beta(param)
plot(param$grid,beta_function,type="l")
### simple
param <- list(p=100,grid=seq(0,1,length=100),shape="simple")
beta_function <- choose_beta(param)
plot(param$grid,beta_function,type="s")
### simple_bis
param <- list(p=100,grid=seq(0,1,length=100),shape="simple_bis")
beta_function <- choose_beta(param)
plot(param$grid,beta_function,type="s")
### random_simple
param <- list(p=100,grid=seq(0,1,length=100),shape="random_simple")
beta_function <- choose_beta(param)
plot(param$grid,beta_function,type="s")
### sinusoid
param <- list(p=100,grid=seq(0,1,length=100),shape="sinusoid")
beta_function <- choose_beta(param)
plot(param$grid,beta_function,type="l")
### flat_sinusoid
param <- list(p=100,grid=seq(0,1,length=100),shape="flat_sinusoid")
beta_function <- choose_beta(param)
plot(param$grid,beta_function,type="l")
### sharp
param <- list(p=100,grid=seq(0,1,length=100),shape="sharp")
beta_function <- choose_beta(param)
plot(param$grid,beta_function,type="l")
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("choose_beta", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("compute_beta_posterior_density")
### * compute_beta_posterior_density
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: compute_beta_posterior_density
### Title: compute_beta_posterior_density
### Aliases: compute_beta_posterior_density
### ** Examples
## No test:
library(RColorBrewer)
data(data1)
data(param1)
# result of res_bliss1<-fit_Bliss(data=data1,param=param1)
data(res_bliss1)
q <- 1
param_beta_density <- list(grid= data1[["grids"]][[q]],
iter= param1[["iter"]],
p = param1[["p"]][q],
n = length(data1[["y"]]),
thin = param1[["thin"]],
burnin = param1[["burnin"]],
lims_kde = param1[["lims_kde"]][[q]],
new_grid = param1[["new_grids"]][[q]],
lims_estimate = range(res_bliss1$Smooth_estimate[[q]]))
density_estimate <- compute_beta_posterior_density(res_bliss1$beta_sample[[q]],param_beta_density)
image(density_estimate$grid_t,
density_estimate$grid_beta_t,
density_estimate$density,col=rev(heat.colors(100)))
## End(No test)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("compute_beta_posterior_density", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("compute_beta_sample")
### * compute_beta_sample
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: compute_beta_sample
### Title: compute_beta_sample
### Aliases: compute_beta_sample
### ** Examples
library(RColorBrewer)
data(data1)
data(param1)
param1$grids<-data1$grids
# result of res_bliss1<-fit_Bliss(data=data1,param=param1)
data(res_bliss1)
beta_sample <- compute_beta_sample(posterior_sample=res_bliss1$posterior_sample,
param=param1,Q=1)
indexes <- sample(nrow(beta_sample[[1]]),1e2,replace=FALSE)
cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(1e2)
matplot(param1$grids[[1]],t(beta_sample[[1]][indexes,]),type="l",lty=1,col=cols,
xlab="grid",ylab="")
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("compute_beta_sample", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("compute_chains_info")
### * compute_chains_info
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: compute_chains_info
### Title: compute_chains_info
### Aliases: compute_chains_info
### ** Examples
## No test:
param_sim <- list(Q=1,
n=100,
p=c(50),
grids_lim=list(c(0,1)))
data <- sim(param_sim,verbose=TRUE)
param <- list(iter=5e2,
K=c(3),
n_chains = 3)
res_bliss <- fit_Bliss(data,param,verbose=TRUE,compute_density=FALSE,sann=FALSE)
param$grids <- data$grids
chains_info1 <- compute_chains_info(res_bliss$chains[[1]],param)
chains_info2 <- compute_chains_info(res_bliss$chains[[2]],param)
chains_info3 <- compute_chains_info(res_bliss$chains[[3]],param)
# Smooth estimates
ylim <- range(range(chains_info1$estimates$Smooth_estimate),
range(chains_info2$estimates$Smooth_estimate),
range(chains_info3$estimates$Smooth_estimate))
plot(data$grids[[1]],chains_info1$estimates$Smooth_estimate,type="l",ylim=ylim,
xlab="grid",ylab="")
lines(data$grids[[1]],chains_info2$estimates$Smooth_estimate,col=2)
lines(data$grids[[1]],chains_info3$estimates$Smooth_estimate,col=3)
# Autocorrelation
plot(chains_info1$autocorr_lag[,1],type="h")
## End(No test)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("compute_chains_info", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("compute_random_walk")
### * compute_random_walk
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: compute_random_walk
### Title: compute_random_walk
### Aliases: compute_random_walk
### ** Examples
# see the sim_x() function.
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("compute_random_walk", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("compute_starting_point_sann")
### * compute_starting_point_sann
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: compute_starting_point_sann
### Title: compute_starting_point_sann
### Aliases: compute_starting_point_sann
### ** Examples
data(res_bliss1)
mystart<-compute_starting_point_sann(apply(res_bliss1$beta_sample[[1]],2,mean))
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("compute_starting_point_sann", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("corr_matrix")
### * corr_matrix
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: corr_matrix
### Title: corr_matrix
### Aliases: corr_matrix
### ** Examples
### Test 1 : weak autocorrelation
ksi <- 1
diagVar <- abs(rnorm(100,50,5))
Sigma <- corr_matrix(diagVar,ksi^2)
persp(Sigma)
### Test 2 : strong autocorrelation
ksi <- 0.2
diagVar <- abs(rnorm(100,50,5))
Sigma <- corr_matrix(diagVar,ksi^2)
persp(Sigma)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("corr_matrix", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("determine_intervals")
### * determine_intervals
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: determine_intervals
### Title: determine_intervals
### Aliases: determine_intervals
### ** Examples
data(data1)
data(param1)
# result of res_bliss1<-fit_Bliss(data=data1,param=param1)
data(res_bliss1)
intervals <- determine_intervals(res_bliss1$Bliss_estimate[[1]])
plot(data1$grids[[1]],res_bliss1$Bliss_estimate[[1]],type="s")
for(k in 1:nrow(intervals)){
segments(data1$grids[[1]][intervals[k,1]],intervals[k,3],
data1$grids[[1]][intervals[k,2]],intervals[k,3],col=2,lwd=4)
}
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("determine_intervals", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("dposterior")
### * dposterior
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: dposterior
### Title: dposterior
### Aliases: dposterior
### ** Examples
data(data1)
data(param1)
# result of res_bliss1<-fit_Bliss(data=data1,param=param1)
data(res_bliss1)
# Compute the posterior density of the MCMC sample :
res_poste <- dposterior(res_bliss1$posterior_sample,data1)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("dposterior", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("fit_Bliss")
### * fit_Bliss
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: fit_Bliss
### Title: fit_Bliss
### Aliases: fit_Bliss
### ** Examples
# see the vignette BlissIntro.
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("fit_Bliss", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("grapes-between-grapes")
### * grapes-between-grapes
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: %between%
### Title: between
### Aliases: %between%
### ** Examples
1 %between% c(0,2)
2 %between% c(0,2)
3 %between% c(0,2)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("grapes-between-grapes", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("image_Bliss")
### * image_Bliss
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: image_Bliss
### Title: image_Bliss
### Aliases: image_Bliss
### ** Examples
library(RColorBrewer)
data(data1)
data(param1)
data(res_bliss1)
param1$cols <- colorRampPalette(brewer.pal(9,"Reds"))(1e2)
image_Bliss(res_bliss1$beta_posterior_density,param1,q=1)
lines(res_bliss1$data$grids[[1]],res_bliss1$Bliss_estimate[[1]],type="s",lwd=2)
lines(res_bliss1$data$grids[[1]],res_bliss1$data$betas[[1]],col=3,lwd=2,type="s")
# ---- not run
param1$cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(1e2)
image_Bliss(res_bliss1$beta_posterior_density,param1,q=1)
lines(res_bliss1$data$grids[[1]],res_bliss1$Bliss_estimate[[1]],type="s",lwd=2)
lines(res_bliss1$data$grids[[1]],res_bliss1$data$betas[[1]],col=3,lwd=2,type="s")
param1$cols <- rev(heat.colors(12))
param1$col_scale <- "quantile"
image_Bliss(res_bliss1$beta_posterior_density,param1,q=1)
lines(res_bliss1$data$grids[[1]],res_bliss1$Bliss_estimate[[1]],type="s",lwd=2)
lines(res_bliss1$data$grids[[1]],res_bliss1$data$betas[[1]],col=3,lwd=2,type="s")
param1$cols <- rev(terrain.colors(12))
image_Bliss(res_bliss1$beta_posterior_density,param1,q=1)
lines(res_bliss1$data$grids[[1]],res_bliss1$Bliss_estimate[[1]],type="s",lwd=2)
lines(res_bliss1$data$grids[[1]],res_bliss1$data$betas[[1]],col=2,lwd=2,type="s")
param1$cols <- rev(topo.colors(12))
image_Bliss(res_bliss1$beta_posterior_density,param1,q=1)
lines(res_bliss1$data$grids[[1]],res_bliss1$Bliss_estimate[[1]],type="s",lwd=2)
lines(res_bliss1$data$grids[[1]],res_bliss1$data$betas[[1]],col=2,lwd=2,type="s")
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("image_Bliss", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("integrate_trapeze")
### * integrate_trapeze
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: integrate_trapeze
### Title: integrate_trapeze
### Aliases: integrate_trapeze
### ** Examples
x <- seq(0,1,le=1e2)
integrate_trapeze(x,x^2)
integrate_trapeze(data1$grids[[1]],t(data1$x[[1]]))
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("integrate_trapeze", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("interpretation_plot")
### * interpretation_plot
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: interpretation_plot
### Title: interpretation_plot
### Aliases: interpretation_plot
### ** Examples
data(data1)
data(param1)
# result of res_bliss1 <- fit_Bliss(data=data1,param=param1,verbose=TRUE)
data(res_bliss1)
interpretation_plot(data=data1,Bliss_estimate=res_bliss1$Bliss_estimate,q=1)
interpretation_plot(data=data1,Bliss_estimate=res_bliss1$Bliss_estimate,q=1,centered=TRUE)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("interpretation_plot", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("lines_bliss")
### * lines_bliss
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: lines_bliss
### Title: lines_bliss
### Aliases: lines_bliss
### ** Examples
### Plot the BLiss estimate on a suitable grid
## No test:
data(data1)
data(param1)
# res_bliss1 <- fit_Bliss(data=data1,param=param1,verbose=TRUE)
## End(No test)
data(res_bliss1)
### Plot the BLiss estimate on a suitable grid
plot_bliss(res_bliss1$data$grids[[1]],
res_bliss1$Bliss_estimate[[1]],lwd=2,bound=FALSE)
lines_bliss(res_bliss1$data$grids[[1]],
res_bliss1$Smooth_estimate[[1]],lty=2)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("lines_bliss", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("pdexp")
### * pdexp
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: pdexp
### Title: pdexp
### Aliases: pdexp
### ** Examples
pdexp(10,seq(0,1,1))
x <- seq(0,10,le=1e3)
plot(x,dexp(x,0.5),lty=2,type="l")
lines(pdexp(0.5,1:10),type="p")
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("pdexp", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("plot_bliss")
### * plot_bliss
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: plot_bliss
### Title: plot_bliss
### Aliases: plot_bliss
### ** Examples
## No test:
data(data1)
data(param1)
# res_bliss1 <- fit_Bliss(data=data1,param=param1,verbose=TRUE)
## End(No test)
data(res_bliss1)
### Plot the BLiss estimate on a suitable grid
plot_bliss(res_bliss1$data$grids[[1]],
res_bliss1$Bliss_estimate[[1]],lwd=2,bound=FALSE)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("plot_bliss", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("printbliss")
### * printbliss
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: printbliss
### Title: Print a bliss Object
### Aliases: printbliss
### ** Examples
# See fit_Bliss() function
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("printbliss", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("sigmoid")
### * sigmoid
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: sigmoid
### Title: sigmoid
### Aliases: sigmoid
### ** Examples
## Test 1 :
x <- seq(-7,7,0.1)
y <- sigmoid(x)
plot(x,y,type="l",main="Sigmoid function")
## Test 2 :
x <- seq(-7,7,0.1)
y <- sigmoid(x)
y2 <- sigmoid(x,asym=0.5)
y3 <- sigmoid(x,v = 5)
plot(x,y,type="l",main="Other sigmoid functions")
lines(x,y2,col=2)
lines(x,y3,col=3)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("sigmoid", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("sigmoid_sharp")
### * sigmoid_sharp
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: sigmoid_sharp
### Title: sigmoid_sharp
### Aliases: sigmoid_sharp
### ** Examples
## Test 1 :
x <- seq(-7,7,0.1)
y <- sigmoid_sharp(x)
plot(x,y,type="l",main="Sharp sigmoid")
## Test 2 :
x <- seq(-7,7,0.1)
y <- sigmoid_sharp(x,loc=3)
y2 <- sigmoid_sharp(x,loc=3,asym=0.5)
y3 <- sigmoid_sharp(x,loc=3,v = 5)
plot(x,y,type="l",main="Other sharp sigmoids")
lines(x,y2,col=2)
lines(x,y3,col=3)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("sigmoid_sharp", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("sim")
### * sim
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: sim
### Title: sim
### Aliases: sim
### ** Examples
library(RColorBrewer)
param <- list(Q=2,n=25,p=c(50,50),grids_lim=list(c(0,1),c(-1,2)))
data <- sim(param)
data$y
cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(10)
q=2
matplot(data$grids[[q]],t(data$x[[q]]),type="l",lty=1,col=cols)
plot(data$grids[[q]],data$betas[[q]],type="l")
abline(h=0,lty=2,col="gray")
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("sim", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("sim_x")
### * sim_x
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: sim_x
### Title: sim_x
### Aliases: sim_x
### ** Examples
library(RColorBrewer)
### Fourier
param <- list(n=15,p=100,grid=seq(0,1,length=100),x_shape="Fourier")
x <- sim_x(param)
cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(15)
matplot(param$grid,t(x),type="l",lty=1,col=cols)
### Fourier2
param <- list(n=15,p=100,grid=seq(0,1,length=100),x_type="Fourier2")
x <- sim_x(param)
cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(15)
matplot(param$grid,t(x),type="l",lty=1,col=cols)
### random_walk
param <- list(n=15,p=100,grid=seq(0,1,length=100),x_type="random_walk")
x <- sim_x(param)
cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(15)
matplot(param$grid,t(x),type="l",lty=1,col=cols)
### random_sharp
param <- list(n=15,p=100,grid=seq(0,1,length=100),x_type="random_sharp")
x <- sim_x(param)
cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(15)
matplot(param$grid,t(x),type="l",lty=1,col=cols)
### uniform
param <- list(n=15,p=100,grid=seq(0,1,length=100),x_type="uniform")
x <- sim_x(param)
cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(15)
matplot(param$grid,t(x),type="l",lty=1,col=cols)
### gaussian
param <- list(n=15,p=100,grid=seq(0,1,length=100),x_type="gaussian")
x <- sim_x(param)
cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(15)
matplot(param$grid,t(x),type="l",lty=1,col=cols)
### mvgauss
param <- list(n=15,p=100,grid=seq(0,1,length=100),x_type="mvgauss")
x <- sim_x(param)
cols <- colorRampPalette(brewer.pal(9,"YlOrRd"))(15)
matplot(param$grid,t(x),type="l",lty=1,col=cols)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("sim_x", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
cleanEx()
nameEx("support_estimation")
### * support_estimation
flush(stderr()); flush(stdout())
base::assign(".ptime", proc.time(), pos = "CheckExEnv")
### Name: support_estimation
### Title: support_estimation
### Aliases: support_estimation
### ** Examples
data(data1)
data(param1)
# result of res_bliss1<-fit_Bliss(data=data1,param=param1)
data(res_bliss1)
res_support <- support_estimation(res_bliss1$beta_sample[[1]])
### The estimate
res_support$estimate
### Plot the result
grid <- res_bliss1$data$grids[[1]]
plot(grid,res_support$alpha,ylim=c(0,1),type="l",xlab="",ylab="")
for(k in 1:nrow(res_support$estimate)){
segments(grid[res_support$estimate[k,1]],0.5,
grid[res_support$estimate[k,2]],0.5,lwd=2,col=2)
points(grid[res_support$estimate[k,1]],0.5,pch="|",lwd=2,col=2)
points(grid[res_support$estimate[k,2]],0.5,pch="|",lwd=2,col=2)
}
abline(h=0.5,col=2,lty=2)
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("support_estimation", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
### * <FOOTER>
###
cleanEx()
options(digits = 7L)
base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
grDevices::dev.off()
###
### Local variables: ***
### mode: outline-minor ***
### outline-regexp: "\\(> \\)?### [*]+" ***
### End: ***
quit('no')
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.