inst/doc/Sampling_user_distributions.R

In stors: Step Optimised Rejection Sampling

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----echo = TRUE--------------------------------------------------------------

library(stors)

modes_bi <- c(0.00134865, 3.99865)

f_bi <- function(x) {
  0.5 * (sqrt(2 * pi))^(-1) * exp(-(x^2) / 2) + 0.5 * (sqrt(2 * pi))^(-1) * exp(-((x - 4)^2) / 2)
}

h_bi <- function(x) log(f_bi(x))


h_prime_bi <- function(x) {
  (-(exp(-1 / 2 * (-4 + x)^2) * 0.5 * (-4 + x)) / sqrt(2 * pi) - (exp(-x^2 / 2) * 0.5 * x) / sqrt(2 *  pi)) / ((exp(-x^2 / 2) * 0.5) / sqrt(2 * pi) + (exp(-1 / 2 * (-4 + x)^2) * 0.5) / sqrt(2 * pi))
}

bi_proposal <- build_proposal(lower = -Inf, upper = Inf, modes = modes_bi, f = f_bi, h = h_bi, h_prime = h_prime_bi)

plot(bi_proposal)


## ----echo = TRUE--------------------------------------------------------------

# Printing the properties of the custom proposal
print(bi_proposal)

# Visualizing the custom proposal
plot(bi_proposal)


## ----echo = TRUE--------------------------------------------------------------

# Creating a sampler function using the custom proposal
bi_sampler <- build_sampler(bi_proposal)

plot(bi_proposal)

# Generating samples from the target distribution
sample <- bi_sampler(10^3)

hist(sample, main = "Sample Generated From Multi-modal Distribution ", xlab = "Value", col = "lightblue", border = "white")



## ----echo = TRUE--------------------------------------------------------------

# Define modes for the multi-modal distribution
modes_bi <- c(0.00134865, 3.99865)

# Build a truncated proposal for the multi-modal distribution
bi_trunc_proposal <- build_proposal(
  lower = -1,
  upper = 6,
  modes = modes_bi,
  f = f_bi,
  h = h_bi,
  h_prime = h_prime_bi,
  steps = 2040
)

# Visualize the truncated proposal
plot(bi_trunc_proposal, main = "Truncated Multi-Modal Proposal (-1, 6)", xlab = "Value", col = "skyblue")

# Create a sampler for the truncated distribution
bi_sampler_trunc_sampler <- build_sampler(bi_trunc_proposal)

# Generate 10^3 samples from the truncated distribution
sample <- bi_sampler_trunc_sampler(10^3)

# Generate 10^3 samples from the truncated distribution
sample <- bi_sampler_trunc_sampler(10^3)

# Visualize the generated samples
hist(
  sample,
  main = "Histogram of Samples from Truncated Multi-Modal Distribution",
  xlab = "Value",
  col = "lightgreen",
  border = "white"
)




## ----echo = TRUE--------------------------------------------------------------

save_proposal(bi_proposal, "bimodal_proposal")


## ----include = FALSE----------------------------------------------------------
for (i in 1:3) {
  save_proposal(bi_proposal, paste0("bimodal_proposal_", i))
}


## ----echo = TRUE--------------------------------------------------------------

bi_proposal <- load_proposal("bimodal_proposal")


## ----echo = TRUE--------------------------------------------------------------

print_proposals()


## ----echo = TRUE--------------------------------------------------------------

delete_proposal("bimodal_proposal")

print_proposals()


## ----include = FALSE----------------------------------------------------------
for (i in 1:3) {
  delete_proposal(paste0("bimodal_proposal_", i))
}