1.Geradores para a distribuição Pareto

mat <-013
resul <-mat%%3
resul
## [1] 1

Função Quantílica: Para X ~ Pareto(xₘ, α), a CDF é F(x) = 1 - (xₘ/x)^α A inversa é: F⁻¹(u) = xₘ/(1-u)^(1/α)

# Gerador Pareto usando método da inversa
rpareto_custom <- function(n, xm, alpha) {
  U <- runif(n)
  xm / (1 - U)^(1/alpha)
}

# Exemplo de uso:
set.seed(123)
x_pareto <- rpareto_custom(1000, xm = 1, alpha = 2.5)
hist(x_pareto[x_pareto < 10], prob = TRUE, main = "Distribuição Pareto")

Comentários Finais

Aplicação direta da função quantílica de Pareto, verificamos que ela contém uma cauda pesada visível,é aplicada,por exemplo, em fenômenos com distribuição de lei de potência.

2. Método da Inversa para a CDF dada

Função Quantílica: F⁻¹(u)=(−1+ √(1+8u))/2

# Função quantílica
qcustom <- function(u) {
  sqrt(2 * u + 0.25) - 0.5
}
# Método da inversa para gerar amostras
rcustom <- function(n) {
  U <- runif(n)
  qcustom(U)
}
# Gerar amostras
set.seed(666)
X <- rcustom(2000)
# Histograma vs densidade teórica
hist(X, freq = FALSE, breaks = 50, main = "Densidade de X")
curve(x + 0.5, from = 0, to = 1, add = TRUE, col = "blue", lwd = 2)

# Teste KS para verificar se a amostra segue F_X(x)
k <- ks.test(X, function(x) (x^2 + x) / 2)
k
## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  X
## D = 0.015222, p-value = 0.743
## alternative hypothesis: two-sided
# CDF empírica vs teórica
plot(ecdf(X), main = "CDF Empírica vs Teórica")
curve((x^2 + x)/2, from = 0, to = 1, add = TRUE, col = "red", lwd = 2)
legend("topleft", legend = c("Empírica", "Teórica"), col = c("black", "red"), lwd = 2)

Comentários Finais

O método da inversa implementado com a função quantílica gera amostras que seguem exatamente a distribuição alvo. A verificação gráfica e estatística confirma a precisão do gerador.

3.Método da Transformação Inversa para a PDF f(x) = e^{-2|x|}

rlaplace_custom <- function(n) {
  U <- runif(n)
  X <- ifelse(U >= 0.5,
              -0.5 * log(2 * (1 - U)),  # Parte positiva
              0.5 * log(2 * U))         # Parte negativa
  return(X)
}

# Teste
set.seed(123)
X <- rlaplace_custom(1000)

# Verificação gráfica
hist(X, breaks = 50, prob = TRUE, main = "Densidade Gerada vs Teórica")
curve(exp(-2 * abs(x)), add = TRUE, col = "red", lwd = 2)

Comentários Finais

A função implementada utiliza o método da transformação inversa para gerar variáveis aleatórias com distribuição Laplace bilateral (exponencial dupla) de parâmetro λ = 2. Dividindo a geração em duas partes (valores positivos e negativos) Para U ≥ 0.5: -0.5 * log(2 * (1 - U)) (valores positivos) Para U < 0.5: 0.5 * log(2 * U) (valores negativos) O histograma mostra a densidade característica “em forma de tenda” centrada em zero, a curva teórica exp(-2 * abs(x)) se ajusta perfeitamente aos dados gerados, usado muitas vezes para modelar dados com excesso de curtose (caudas mais pesadas que a normal).

4. Variável Aleatória Logística

A CDF da Logística padrão é: Fx(X)= 1/(1+e⁻x) a função quantílica é: F⁻¹(u)=ln(u/(1-u)

# Gerador Logística(0,1) usando transformação inversa
rlogistic_std <- function(n) {
  U <- runif(n)
  log(U / (1 - U))
}

# Teste
set.seed(123)
X <- rlogistic_std(1000)

# Verificação gráfica
hist(X, breaks = 50, prob = TRUE, main = "Logística(0,1) Gerada vs Teórica")
curve(dlogis(x), add = TRUE, col = "red", lwd = 2)

# Gerador Logística(μ, β) generalizada
rlogistic <- function(n, mu = 0, beta = 1) {
  U <- runif(n)
  mu + beta * log(U / (1 - U))
}

# Exemplo: Logística(2, 0.5)
set.seed(123)
X_gen <- rlogistic(1000, mu = 2, beta = 0.5)

# Verificação
hist(X_gen, breaks = 50, prob = TRUE, main = "Logística(2, 0.5)")
curve(dlogis(x, location = 2, scale = 0.5), add = TRUE, col = "blue", lwd = 2)

# Para Logística(0,1)
ks.test(X, "plogis")
## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  X
## D = 0.014051, p-value = 0.9891
## alternative hypothesis: two-sided
# Para Logística(2, 0.5)
ks.test(X_gen, function(x) plogis(x, location = 2, scale = 0.5))
## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  X_gen
## D = 0.014051, p-value = 0.9891
## alternative hypothesis: two-sided
qqplot(X, rlogistic_std(1000))
abline(0, 1, col = "red")

Comentários Finais

A função F⁻¹(u) transforma uniformes em uma distribuição com caudas mais pesadas que a normal, simétrica em torno de μ. Útil em modelos de regressão logística e aprendizado de máquina.

5.Geração de Uniforme(0, α)

runif_alpha_reject <- function(n, alpha) {
  result <- numeric(n)
  for (i in 1:n) {
    repeat {
      U <- runif(1)
      if (U < alpha) {
        result[i] <- U
        break
      }
    }
  }
  return(result)
}
runif_alpha_direct <- function(n, alpha) {
  alpha * runif(n)
}
alpha <- 0.1
n <- 1000

# Amostras
X_reject <- runif_alpha_reject(n, alpha)
X_direct <- runif_alpha_direct(n, alpha)

# Verificação gráfica
par(mfrow = c(1, 2))
hist(X_reject, main = paste("Rejeição (α =", alpha, ")"), xlim = c(0, alpha))
hist(X_direct, main = paste("Transformação Direta (α =", alpha, ")"), xlim = c(0, alpha))

library(microbenchmark)
alpha <- 0.99  # Caso favorável ao algoritmo de rejeição

microbenchmark(
  rejeição = runif_alpha_reject(1000, alpha),
  direta = runif_alpha_direct(1000, alpha),
  times = 100
)
## Unit: microseconds
##      expr   min    lq    mean median     uq    max neval
##  rejeição 577.1 586.3 636.748  590.6 601.65 2285.8   100
##    direta  12.6  13.0  24.840   13.2  13.60 1079.0   100
alphas <- seq(0.1, 0.99, length.out = 10)
times <- sapply(alphas, function(a) {
  median(microbenchmark(
    runif_alpha_reject(1000, a),
    times = 10
  )$time)
})

plot(alphas, times, type = "b", 
     xlab = "α", ylab = "Tempo (ns)",
     main = "Custo do Algoritmo de Rejeição")

X_reject <- runif_alpha_reject(1000, alpha)
X_direct <- runif_alpha_direct(1000, alpha)

# Verificação
ks.test(X_reject, "punif", 0, alpha)
## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  X_reject
## D = 0.02564, p-value = 0.5266
## alternative hypothesis: two-sided
ks.test(X_direct, "punif", 0, alpha)
## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  X_direct
## D = 0.021213, p-value = 0.7591
## alternative hypothesis: two-sided

Comentários Finais

Um algoritmo de aceitação/rejeição para gerar variáveis uniformes no intervalo (0, α), embora matematicamente correto, essa abordagem apresenta desafios práticos significativos,como:Custo de Rejeição,Complexidade Temporal.Mas têm suas aplicações, como por exemplo em Implementação em Sistemas Embarcados, onde apenas um gerador 𝒰(0,1) básico está disponível. Em outros casos, use a transformação direta (alpha * runif(n)) para melhor legibilidade, desempenho otimizado, estabilidade numérica.

6.Gerador Linear Congruencial (GLC)

## a. Implementação do gerador congruencial multiplicativo
glc <- function(n, a, m, x0 = 1) {
  x <- numeric(n)
  x[1] <- (a * x0) %% m
  for (i in 2:n) {
    x[i] <- (a * x[i-1]) %% m
  }
  return(x)
}

## Parâmetros iniciais (partes b-e)
m <- 2^31 - 1  # Módulo (2147483647)
a1 <- 17       # Primeiro multiplicador
a2 <- 85       # Segundo multiplicador
n <- 500       # Número de valores a gerar

# b. Gerar 500 números com a = 17
set.seed(666)
x_17 <- glc(n, a = a1, m = m)

# c. Correlação entre pares sucessivos (x_i+1, x_i)
cor_17 <- cor(x_17[-n], x_17[-1])

# d. Plotar pares sucessivos
par(mfrow = c(1, 2))
plot(x_17[-n], x_17[-1], pch = 20, col = "blue",
     main = paste("a = 17"),
     xlab = expression(x[i]), ylab = expression(x[i+1]))

# e. Gerar 500 números com a = 85
x_85 <- glc(n, a = a2, m = m)

# Correlação entre pares sucessivos
cor_85 <- cor(x_85[-n], x_85[-1])

# Plotar pares sucessivos
plot(x_85[-n], x_85[-1], pch = 20, col = "red",
     main = paste("a = 85"),
     xlab = expression(x[i]), ylab = expression(x[i+1]))

# Correlação para a = 17
cor_17_lag2 <- cor(x_17[1:(n-2)], x_17[3:n])

# Correlação para a = 85
cor_85_lag2 <- cor(x_85[1:(n-2)], x_85[3:n])

# Plotar
par(mfrow = c(1, 2))
plot(x_17[1:(n-2)], x_17[3:n], pch = 20, col = "darkblue",
     main = paste("a = 17"),
     xlab = expression(x[i]), ylab = expression(x[i+2]))

plot(x_85[1:(n-2)], x_85[3:n], pch = 20, col = "darkred",
     main = paste("a = 85"),
     xlab = expression(x[i]), ylab = expression(x[i+2]))

Comentários Finais

A análise mostrou que a qualidade dos Geradores Lineares Congruenciais (GLC) depende fortemente da escolha dos parâmetros, especialmente do multiplicador. Parâmetros mal escolhidos, como a=17, geram correlação serial elevada e padrões previsíveis, comprometendo a aleatoriedade. Mesmo valores melhores, como a=85, reduzem mas não eliminam totalmente esses problemas.

Os GLCs apresentam limitações intrínsecas, como padrões geométricos em múltiplas dimensões e dependência entre os termos, tornando-os inadequados para aplicações críticas. Apesar disso, continuam sendo úteis para fins didáticos, desde que acompanhados de testes estatísticos e com compreensão clara de suas limitações.

7. Geração da Distribuição de Cauchy

Sejam \(X_1\) e \(X_2\) variáveis aleatórias independentes e identicamente distribuídas (i.i.d.) com distribuição normal padrão \(\mathcal{N}(0,1)\). Então, a variável \(Y = \frac{X_1}{X_2}\) segue uma distribuição de Cauchy padrão.

  1. A função densidade de probabilidade conjunta de \(X_1\) e \(X_2\) é: \[ f_{X_1,X_2}(x_1, x_2) = \frac{1}{2\pi} e^{-\frac{x_1^2 + x_2^2}{2}} \]

  2. Considere a transformação: \[ Y = \frac{X_1}{X_2}, \quad Z = X_2 \] com transformação inversa: \[ X_1 = YZ, \quad X_2 = Z \]

  3. O Jacobiano da transformação é: \[ J = \begin{vmatrix} \frac{\partial x_1}{\partial y} & \frac{\partial x_1}{\partial z} \\ \frac{\partial x_2}{\partial y} & \frac{\partial x_2}{\partial z} \end{vmatrix} = \begin{vmatrix} z & y \\ 0 & 1 \end{vmatrix} = z \] Portanto, \(|J| = |z|\).

  4. A densidade conjunta de \((Y,Z)\) é: \[ f_{Y,Z}(y,z) = f_{X_1,X_2}(yz, z) \cdot |J| = \frac{|z|}{2\pi} e^{-\frac{z^2(y^2 + 1)}{2}} \]

  5. Para encontrar a densidade marginal de \(Y\), integramos sobre \(z\): \[ f_Y(y) = \int_{-\infty}^{\infty} \frac{|z|}{2\pi} e^{-\frac{z^2(y^2 + 1)}{2}} dz \]

  6. Como a função é par em \(z\), simplificamos para: \[ f_Y(y) = 2 \int_{0}^{\infty} \frac{z}{2\pi} e^{-\frac{z^2(y^2 + 1)}{2}} dz \]

  7. Fazendo a substituição \(u = \frac{z^2(y^2 + 1)}{2}\), \(du = z(y^2 + 1)dz\): \[ f_Y(y) = \frac{1}{\pi(y^2 + 1)} \int_{0}^{\infty} e^{-u} du = \frac{1}{\pi(y^2 + 1)} \]

  8. Esta é a função densidade da distribuição de Cauchy padrão: \[ f_Y(y) = \frac{1}{\pi(1 + y^2)} \quad \square \]

# Configuração inicial
set.seed(123)
n <- 1e4  # Tamanho da amostra
# Método 1: Razão de Normais (Box-Muller)
r.cauchy1 <- function(n) {
  # Gera normais via Box-Muller (evitando divisão por zero)
  u1 <- runif(n)
  u2 <- runif(n)
  z1 <- sqrt(-2*log(u1)) * cos(2*pi*u2)
  z2 <- sqrt(-2*log(u1)) * sin(2*pi*u2)
  
  # Substitui zeros (improvável, mas possível)
  while(any(z2 == 0)) {
    zeros <- which(z2 == 0)
    u1_new <- runif(length(zeros))
    u2_new <- runif(length(zeros))
    z1[zeros] <- sqrt(-2*log(u1_new)) * cos(2*pi*u2_new)
    z2[zeros] <- sqrt(-2*log(u1_new)) * sin(2*pi*u2_new)
  }
  return(z1/z2)
}

# Método 2: Transformação Inversa
r.cauchy2 <- function(n) {
  tan(pi * (runif(n) - 0.5))
}
# Gera amostras
cauchy1 <- r.cauchy1(n)
cauchy2 <- r.cauchy2(n)

# Testes de qualidade
test_quality <- function(sample, method_name) {

  # Teste KS
  ks <- ks.test(sample, "pcauchy")
  cat("Teste KS: p-value =", format.pval(ks$p.value, digits = 3), "\n")
  
  # Estatísticas descritivas
  cat("Extremos: [", min(sample), ",", max(sample), "]\n")
  cat("Mediana:", median(sample), "\n")
}

test_quality(cauchy1, "Razão de Normais")
## Teste KS: p-value = 0.628 
## Extremos: [ -10365.84 , 6352.719 ]
## Mediana: -0.00998624
test_quality(cauchy2, "Transformação Inversa")
## Teste KS: p-value = 0.73 
## Extremos: [ -1296.168 , 4213.894 ]
## Mediana: -0.007065307
# Comparação gráfica
par(mfrow = c(2, 2))

# Histogramas
hist(cauchy1, breaks = 50, prob = TRUE, 
     main = "Método 1: Razão de Normais",
     xlim = c(-10, 10))

hist(cauchy2, breaks = 50, prob = TRUE,
     main = "Método 2: Transformação Inversa",
     xlim = c(-10, 10))

par(mfrow = c(2, 2))

sample_sizes <- c(3, 50, 500, 1e4)

for(n_size in sample_sizes) {
  sample_means <- replicate(1000, mean(r.cauchy2(n_size)))
  
  hist(sample_means, breaks = 50, prob = TRUE,
       main = paste("Médias de Cauchy (n =", n_size, ")"),
       xlim = c(-50, 50))
}

Comentários Finais

Nas simulações com n = 3, 50, 500, 10.000, as médias amostrais não convergem para uma distribuição normal. A distribuição de Cauchy é um contraexemplo clássico onde o TCL não se aplica,já que a existência de média e variância finitas é essencial para o TCL

8.Geração de Variáveis Aleatórias Beta(α,β)

Implementar dois algoritmos de aceitação/rejeição para gerar números da distribuição Beta(α,β) com α = 2.7 e β = 6.3.

# Parâmetros fixos
alpha <- 2.7
beta <- 6.3
n <- 10000

# Função para cálculo da eficiência
calc_eficiencia <- function(aceitos, total) {
  round(aceitos / total, 4)
}

# 8.a) Aceitação/Rejeição com Uniforme
beta_ar_unif <- function(n, alpha, beta) {
  max_dens <- optimize(function(x) dbeta(x, alpha, beta), interval = c(0, 1), maximum = TRUE)$objective
  samples <- numeric(n)
  tentativas <- 0
  
  for(i in 1:n) {
    repeat {
      x <- runif(1)
      u <- runif(1)
      tentativas <- tentativas + 1
      if(u * max_dens <= dbeta(x, alpha, beta)) break
    }
    samples[i] <- x
  }
  
  return(list(samples = samples, 
              eficiencia = calc_eficiencia(n, tentativas),
              tentativas = tentativas))
}

# 8.b) Aceitação/Rejeição com Beta(2,6)
beta_ar_beta <- function(n, alpha, beta) {
  gen_beta26 <- function(k) {
    y <- rgamma(k, 2, 1)
    z <- rgamma(k, 6, 1)
    y / (y + z)
  }
  
  c <- optimize(function(x) dbeta(x, alpha, beta)/dbeta(x, 2, 6), interval = c(0, 1), maximum = TRUE)$objective
  samples <- numeric(n)
  tentativas <- 0
  
  for(i in 1:n) {
    repeat {
      x <- gen_beta26(1)
      u <- runif(1)
      tentativas <- tentativas + 1
      if(u <= dbeta(x, alpha, beta)/(c * dbeta(x, 2, 6))) break
    }
    samples[i] <- x
  }
  
  return(list(samples = samples, 
              eficiencia = calc_eficiencia(n, tentativas),
              tentativas = tentativas))
}

# Execução dos métodos
set.seed(123)
result_unif <- beta_ar_unif(n, alpha, beta)
result_beta <- beta_ar_beta(n, alpha, beta)

# Teste KS
ks_unif <- ks.test(result_unif$samples, "pbeta", alpha, beta)
ks_beta <- ks.test(result_beta$samples, "pbeta", alpha, beta)

# Tabela de resultados
resultados <- data.frame(
  Método = c("Uniforme", "Beta(2,6)"),
  Eficiência = c(result_unif$eficiencia, result_beta$eficiencia),
  KS_pvalue = c(ks_unif$p.value, ks_beta$p.value),
  Tentativas = c(result_unif$tentativas, result_beta$tentativas),
  Descartados = c(round((1 - result_unif$eficiencia)*100, 2), 
                 round((1 - result_beta$eficiencia)*100, 2))
)

# Visualização dos resultados
print(resultados)
##      Método Eficiência KS_pvalue Tentativas Descartados
## 1  Uniforme     0.3788 0.8413586      26398       62.12
## 2 Beta(2,6)     0.5988 0.9435562      16700       40.12
# Gráficos de distribuição
par(mfrow = c(1, 2))
hist(result_unif$samples, prob = TRUE, breaks = 50, 
     main = "Método Uniforme", xlab = "x", ylim = c(0, 3.5))
curve(dbeta(x, alpha, beta), add = TRUE, col = "red", lwd = 2)

hist(result_beta$samples, prob = TRUE, breaks = 50, 
     main = "Método Beta(2,6)", xlab = "x", ylim = c(0, 3.5))
curve(dbeta(x, alpha, beta), add = TRUE, col = "blue", lwd = 2)

# Gráficos de aceitação/rejeição (primeiros 1000 pontos)
plot_ar <- function(samples, method) {
  if(method == "uniform") {
    c_val <- optimize(function(x) dbeta(x, alpha, beta), 
                     interval = c(0, 1), 
                     maximum = TRUE)$objective
    y <- runif(length(samples)) * c_val
  } else {
    c_val <- optimize(function(x) dbeta(x, alpha, beta)/dbeta(x, 2, 6), 
                     interval = c(0, 1), 
                     maximum = TRUE)$objective
    y <- runif(length(samples)) * c_val * dbeta(samples, 2, 6)
  }
  
  accepted <- y <= dbeta(samples, alpha, beta)
  plot(samples, y, col = ifelse(accepted, "green", "red"),
       pch = 20, main = paste("Pontos", method),
       xlab = "x", ylab = "u*c*g(x)")
  curve(dbeta(x, alpha, beta), add = TRUE, lwd = 2)
}

par(mfrow = c(1, 2))
plot_ar(result_unif$samples[1:1000], "uniform")
plot_ar(result_beta$samples[1:1000], "beta")

# Configuração inicial
alpha <- 2.7
beta <- 6.3
n <- 10000

# Função para calcular porcentagem de aceitação
calc_porcentagem_ar <- function(samples, method) {
  if(method == "uniform") {
    c_val <- optimize(function(x) dbeta(x, alpha, beta), 
                     interval = c(0, 1), 
                     maximum = TRUE)$objective
    y <- runif(length(samples)) * c_val
  } else {
    c_val <- optimize(function(x) dbeta(x, alpha, beta)/dbeta(x, 2, 6), 
                     interval = c(0, 1), 
                     maximum = TRUE)$objective
    y <- runif(length(samples)) * c_val * dbeta(samples, 2, 6)
  }
  
  accepted <- y <= dbeta(samples, alpha, beta)
  porcentagem_aceitos <- mean(accepted) * 100
  porcentagem_rejeitados <- 100 - porcentagem_aceitos
  
  return(data.frame(
    Método = method,
    Aceitos = porcentagem_aceitos,
    Rejeitados = porcentagem_rejeitados
  ))
}

# Execução para ambos os métodos
resultados_ar <- rbind(
  calc_porcentagem_ar(result_unif$samples, "uniform"),
  calc_porcentagem_ar(result_beta$samples, "beta")
)

# Tabela de resultados formatada
knitr::kable(resultados_ar, digits = 2, align = 'c',
             caption = "Porcentagem de Pontos Aceitos/Rejeitados")
Porcentagem de Pontos Aceitos/Rejeitados
Método Aceitos Rejeitados
uniform 73.47 26.53
beta 67.94 32.06

Comentários Finais

Apesar de ambos métodos passaram no teste KS (p-valores > 0.05), confirmando a fidelidade às distribuições alvo, para estes parâmetros (α=2.7, β=6.3), o método de aceitação/rejeição utilizando Beta(2,6) como distribuição proposta é claramente superior, oferecendo melhor eficiência computacional sem comprometer a qualidade das amostras geradas. O método Uniforme, embora mais simples, se mostra inadequado devido a maior taxa de rejeição.

9.Variável Exponencial

\[ f_X(x) = \begin{cases} \dfrac{e^{-x}}{1 - e^{-0{,}05}}, & 0 < x < 0{,}05 \\ 0, & \text{caso contrário} \end{cases} \]

set.seed(666)

n <- 1000
limite <- 0.05

# Gera variáveis Exponenciais até encontrar n dentro do intervalo
amostras <- numeric(0)

while(length(amostras) < n){
  candidatos <- rexp(n, rate = 1)
  aceitos <- candidatos[candidatos < limite]
  amostras <- c(amostras, aceitos)
}
amostras <- amostras[1:n]  # garante exatamente 1000 valores

# Estima a esperança condicional
esperanca_estimada <- mean(amostras)
esperanca_estimada
## [1] 0.02550574

Sabemos que a densidade condicional de \(X\) é dada por:

\[ f_X(x) = \frac{e^{-x}}{1 - e^{-0{,}05}}, \quad 0 < x < 0{,}05 \] A esperança condicional é:

\[ \mathbb{E}[X \mid X < 0{,}05] = \int_0^{0{,}05} x \cdot \frac{e^{-x}}{1 - e^{-0{,}05}} dx \]

# valor exato
f_exata <- function(x) x * exp(-x) / (1 - exp(-0.05))
valor_exato <- integrate(f_exata, lower = 0, upper = 0.05)$value
valor_exato
## [1] 0.02479168
# Comparação
dif <- abs(esperanca_estimada - valor_exato)
paste("Diferença absoluta entre estimativa e valor exato:", round(dif, 6))
## [1] "Diferença absoluta entre estimativa e valor exato: 0.000714"

Comentários Finais

A simulação usando o método de rejeição fornece uma estimativa bastante próxima do valor exato de \(\mathbb{E}[X \mid X < 0{,}05]\), validando o método.

10.

n <- 1E3
X <- numeric(n)

# 1- Gerar números aleatórios uniformes
V <- runif(n)

# 2- Gerar X usando o método da transformação inversa
for (i in 1:n) {
  if (V[i] < 0.5) {
    # Para a primeira parte da distribuição (0 < x < 1)
    X[i] <- -log(1 - 2*V[i])
  } else {
    # Para a segunda parte da distribuição (x > 1)
    X[i] <- -log(2 - 2*V[i])
  }
}

# Visualização dos resultados
hist(X, freq = FALSE, breaks = 25, main = "Histograma de X", xlab = "x")

# Plot da função de distribuição empírica vs teórica
plot(ecdf(X), lwd = 2, main = "Função de Distribuição Acumulada")
curve(ifelse(x < 1, (1-exp(-x))/2, (2-exp(-x))/2), 
      add = TRUE, col = "green", lty = 2, lwd = 2)
legend("bottomright", legend = c("Empírica", "Teórica"),
       lty = c(1, 2), col = c("black", "green"), lwd = 2, bty = "n")

# Calcular F(X)
FX <- ifelse(X < 1, (1-exp(-X))/2, (2-exp(-X))/2)

# Teste de uniformidade
hist(FX, freq = FALSE, main = "Histograma de F(X)")

ks.test(FX, "punif")  # Teste de Kolmogorov-Smirnov
## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  FX
## D = 0.32566, p-value < 2.2e-16
## alternative hypothesis: two-sided

Comentários Finais

Como hà uma descontinuidade em x=1,a transformação F(X) não segue uma distribuição uniforme em [0,1], como demonstrado pelo teste de Kolmogorov-Smirnov (p-valor < 0.05).