Bitriangular

Objetivo: Construir uma função geradores de amostra aleatórias (parâmetro de tamanho n) de uma distribuição de probabilidade bi-triangular com discutido em sala.

Integração das funções de delimitação:

Função 1. \(\int -8x + 4 \ \partial x \ , \ x \in [\frac{1}{4},\frac{1}{2}]\);

integrate(function(x) -8*x + 4,1/4,1/2)

## 0.25 with absolute error < 2.8e-15

Função 2. \(\int 8x - 4 \ \partial x \ , \ x \in [\frac{1}{2},\frac{3}{4}]\);

integrate(function(x) 8*x - 4,1/2,3/4)

## 0.25 with absolute error < 2.8e-15

Função 3. \(\int -8x + 8 \ \partial x \ , \ x \in [\frac{3}{4},1]\);

integrate(function(x) -8*x + 8,3/4,1)

## 0.25 with absolute error < 2.8e-15

Criação da Distribuição a partir da Uniforme:

set.seed(78)

bt <- function(n,ru = FALSE){
  u <- runif(n,0,1)
  z <- ifelse(u<0.25,sqrt(u)/2, ifelse(u<0.5,0.5 - 0.5*sqrt(0.5-u), 
                                       ifelse(u<0.75,0.5 + 0.5*sqrt(u - 0.5), 1 - 0.5*sqrt(1- u))))
  
  if(ru==FALSE){return(z)}
  else{return(data.frame(z,u))}
}

bitriangular <- bt(1000,ru = TRUE)

Plotando o gráfico histograma e as retas para validação e visualização do comportamento da distribuição

hist(bitriangular$z, freq = FALSE, col = rainbow(10), main = "Histograma da distribuição Bi Triangular")

curve(8*x,0,1/4,add = T, lwd = 2)
curve(-8*x + 4,1/4,1/2,add = T, lwd = 2)
curve(8*x - 4,1/2,3/4, add = T, lwd = 2)
curve(-8*x + 8,3/4,1,add = T, lwd = 2)