Benzetim

Bu notta her dağılım için üç yol kullanıyorum: ters (ters dönüşüm veya en basit algoritma), rxxx (R’nin hazır r* fonksiyonu), qxxx (q* + runif). Her bölüm aynı akışta ilerler; isimler hep aynıdır.

# Yardımcı: üç yöntemi tek grafikte kıyasla
karsilastir <- function(ters, rxxx, qxxx, pdf_fun, baslik=""){
  df <- bind_rows(
    data.frame(x=ters, yol="ters"),
    data.frame(x=rxxx, yol="rxxx"),
    data.frame(x=qxxx, yol="qxxx")
  )
  ggplot(df, aes(x)) +
    geom_histogram(aes(y=after_stat(..density..)), bins=40, alpha=.55) +
    stat_function(fun=pdf_fun, linewidth=1) +
    facet_wrap(~yol, ncol=1, scales="free_y") +
    labs(title=baslik, y="Yoğunluk")
}

1 Sürekli Dağılımlar

1.1 1) Sürekli Tekdüze U(a,b)

Bu bölümde önce U(a,b)’yi üç yöntemle üretiyorum; ardından histogramları üst üste kıyaslıyorum.

set.seed(1); a <- 3; b <- 8; n <- 2000
u0 <- runif(n)

# ters (basit formül)
ters <- a + (b - a) * u0

# rxxx
rxxx <- runif(n, a, b)

# qxxx
qxxx <- qunif(runif(n), a, b)

karsilastir(ters, rxxx, qxxx, function(t) dunif(t, a, b), baslik="U(3,8) – üç yol aynı sonucu verir")

1.2 2) Üstel(β)

Burada β=2 (rate = 1/β).

set.seed(2); beta <- 2; rate <- 1/beta; n <- 2000
u0 <- runif(n)

# ters
ters <- -beta * log(1 - u0)

# rxxx
rxxx <- rexp(n, rate = rate)

# qxxx
qxxx <- qexp(runif(n), rate = rate)

karsilastir(ters, rxxx, qxxx, function(t) dexp(t, rate), baslik="Üstel(beta=2) – ters vs rxxx vs qxxx")

1.3 3) Ki-Kare χ²(r)

r=4 seçiyorum. Ters CDF yerine en sade algoritma: Z~N(0,1) karelerinin toplamı.

set.seed(3); r <- 4; n <- 2000

# ters (temel algoritma)
Z <- matrix(rnorm(n*r,0,1), nrow=n)
ters <- rowSums(Z^2)

# rxxx
rxxx <- rchisq(n, df=r)

# qxxx
qxxx <- qchisq(runif(n), df=r)

karsilastir(ters, rxxx, qxxx, function(t) dchisq(t, df=r), baslik="Ki-Kare(r=4) – üç yöntem")

1.4 4) Weibull(α, β)

set.seed(4); shape <- 1.25; scale <- 2.5; n <- 2000
u0 <- runif(n)

# ters
ters <- scale * (-log(1 - u0))^(1/shape)

# rxxx
rxxx <- rweibull(n, shape=shape, scale=scale)

# qxxx
qxxx <- qweibull(runif(n), shape=shape, scale=scale)

karsilastir(ters, rxxx, qxxx, function(t) dweibull(t, shape, scale), baslik="Weibull – üç yöntem")

1.5 5) Normal(µ, σ)

Normal için ters CDF’i doğrudan yazmak pratik değil; en sade algoritma Box–Muller.

set.seed(5); n <- 4000

# ters (Box–Muller)
u1 <- runif(n/2); u2 <- runif(n/2)
z1 <- sqrt(-2*log(u1)) * cos(2*pi*u2)
z2 <- sqrt(-2*log(u1)) * sin(2*pi*u2)
ters <- c(z1, z2)

# rxxx
rxxx <- rnorm(n, 0, 1)

# qxxx
qxxx <- qnorm(runif(n), 0, 1)

karsilastir(ters, rxxx, qxxx, function(t) dnorm(t,0,1), baslik="Normal(0,1) – üç yöntem")

1.6 6) Lognormal

Tanım: Y ~ N(0,1) ise X = exp(Y).

set.seed(6); n <- 3000

# ters (dönüşüm)
ters <- exp(rnorm(n, 0, 1))

# rxxx
rxxx <- rlnorm(n, 0, 1)

# qxxx
qxxx <- qlnorm(runif(n), 0, 1)

karsilastir(ters, rxxx, qxxx, function(t) dlnorm(t, 0, 1), baslik="Lognormal – üç yöntem")

2 Kesikli Dağılımlar

2.1 7) Kesikli Tekdüze KDD(a,b)

set.seed(7); a <- 6; b <- 10; n <- 2000
u0 <- runif(n)

# ters
ters <- a + floor((b - a + 1) * u0)

# rxxx (sample)
rxxx <- sample(a:b, size=n, replace=TRUE)

# qxxx (yok) – kesiklide qunif uygun değil, o yüzden rxxx ile kıyaslıyorum
qxxx <- rxxx

# ECDF gösterimi
plot(ecdf(ters), main="KDD(6,10) – ECDF (ters)"); lines(ecdf(rxxx), col="red"); legend("bottomright", c("ters","rxxx"), col=c("black","red"), lty=1)

2.2 8) Bernoulli(p)

set.seed(8); p <- .4; n <- 2000
u0 <- runif(n)

# ters (eşik)
ters <- as.integer(u0 >= 1 - p)

# rxxx
rxxx <- rbinom(n, size=1, prob=p)

# qxxx (teorik mümkün ama pedagojik değil); burada rxxx ile kıyaslıyorum
qxxx <- rxxx

barplot(rbind(table(ters), table(rxxx)), beside=TRUE, legend.text=c("ters","rxxx"), main="Bernoulli(0.4) – karşılaştırma")

2.3 9) Binom(n,p)

set.seed(9); ntrial <- 10; p <- .3; N <- 2000

# ters (Bernoulli toplamı)
mat <- matrix(runif(N*ntrial), nrow=N)
ters <- rowSums((mat >= 1 - p)*1)

# rxxx
rxxx <- rbinom(N, size=ntrial, prob=p)

# qxxx
qxxx <- qbinom(runif(N), size=ntrial, prob=p)

par(mfrow=c(1,2)); barplot(table(ters), main="Binom – ters"); barplot(table(rxxx), main="Binom – rxxx"); par(mfrow=c(1,1))

2.4 10) Geometrik(p)

set.seed(10); p <- .3; n <- 4000
u0 <- runif(n)

# ters
ters <- floor(log(1 - u0)/log(1 - p)) + 1

# rxxx (R 0-bazlı: +1)
rxxx <- rgeom(n, prob=p) + 1

# qxxx (0-bazlı: +1)
qxxx <- qgeom(runif(n), prob=p) + 1

plot(ecdf(ters), main="Geometrik(0.3) – ECDF"); lines(ecdf(rxxx), col="red"); lines(ecdf(qxxx), col="blue")
legend("bottomright", c("ters","rxxx","qxxx"), col=c("black","red","blue"), lty=1)

# --- Geometrik düzeltilmis ---
xlim <- range(c(ters, rxxx, qxxx))    # üç seri için ortak x ekseni
plot(ecdf(ters),
     xlim = xlim, ylim = c(0,1),
     main = "Geometrik(0.3) — ECDF",
     xlab = "x", ylab = "Fn(x)",
     do.points = FALSE, verticals = TRUE)
lines(ecdf(rxxx), col = "red",  do.points = FALSE, verticals = TRUE)
lines(ecdf(qxxx), col = "blue", do.points = FALSE, verticals = TRUE)
legend("bottomright", c("ters","rxxx","qxxx"),
       col = c("black","red","blue"), lty = 1, bty = "n")

2.5 11) Negatif Binom(k,p)

set.seed(11); k <- 2; p <- .3; N <- 2000

# ters (k tane geometrik toplami)
geom_once <- function(n,p){ floor(log(1 - runif(n))/log(1 - p)) + 1 }
ters <- replicate(k, geom_once(N,p)) %>% as.data.frame() %>% rowSums()

# rxxx
rxxx <- rnbinom(N, size=k, prob=p)

# qxxx
qxxx <- qnbinom(runif(N), size=k, prob=p)

plot(ecdf(ters), main="Negatif Binom(2,0.3) – ECDF"); lines(ecdf(rxxx), col="red"); lines(ecdf(qxxx), col="blue")
legend("bottomright", c("ters","rxxx","qxxx"), col=c("black","red","blue"), lty=1)

ters_d <- ters - k   # toplamdan k çıkar
plot(ecdf(ters_d), main="Negatif Binom(2,0.3) – ECDF (düzeltilmiş)")
lines(ecdf(rxxx), col="red")
lines(ecdf(qxxx), col="blue")
legend("bottomright", c("ters-k","rxxx","qxxx"), col=c("black","red","blue"), lty=1)

2.6 12) Poisson(λ)

Poisson için en sade algoritma: Knuth çarpım yöntemi.

set.seed(12); lambda <- 3; N <- 2000

# ters (Knuth)
rpois_knuth <- function(n, lambda){
  out <- integer(n)
  for(i in 1:n){
    L <- exp(-lambda); k <- 0; p <- 1
    repeat{
      k <- k + 1; p <- p * runif(1)
      if(p <= L){ out[i] <- k-1; break }
    }
  }
  out
}
ters <- rpois_knuth(N, lambda)

# rxxx
rxxx <- rpois(N, lambda)

# qxxx
qxxx <- qpois(runif(N), lambda)

par(mfrow=c(1,2)); barplot(table(ters), main="Poisson – ters"); barplot(table(rxxx), main="Poisson – rxxx"); par(mfrow=c(1,1))