Advertisement
Guest User

Untitled

a guest
Aug 17th, 2017
60
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.40 KB | None | 0 0
  1. set.seed(123)
  2.  
  3. N <- 1e5
  4. mu <- c(2,4,6)
  5. sigma <- rep(0.5, 3)
  6. lambda <- (1:3)/6
  7.  
  8. dat <- c(
  9. rnorm(N*lambda[1], mu[1], sigma[1]),
  10. rnorm(N*lambda[2], mu[2], sigma[2]),
  11. rnorm(N*lambda[3], mu[3], sigma[3])
  12. )
  13.  
  14. xx <- seq(0, 8, by = 0.01)
  15. hist(dat, 100, freq = FALSE, col = "lightgray", border = 1, xlab = "", main = "")
  16. lines(xx, lambda[1]*dnorm(xx, mu[1], sigma[1]), col = "red", lwd = 2)
  17. lines(xx, lambda[2]*dnorm(xx, mu[2], sigma[2]), col = "blue", lwd = 2)
  18. lines(xx, lambda[3]*dnorm(xx, mu[3], sigma[3]), col = "orange", lwd = 2)
  19.  
  20.  
  21. fit <- mixtools::normalmixEM(dat, k = 3)
  22. summary(fit)
  23.  
  24.  
  25. f <- function(x, mu, sigma, lambda) {
  26. lambda[1]*dnorm(x, mu[1], sigma[1]) + lambda[2]*dnorm(x, mu[2], sigma[2]) + lambda[3]*dnorm(x, mu[3], sigma[3])
  27. }
  28.  
  29. f(1:10,mu,sigma,lambda)
  30.  
  31. y <- seq(0, 8, length.out = 25)
  32. points(y, f(y,mu,sigma,lambda), pch = 16)
  33.  
  34. plot(y, f(y,mu,sigma,lambda), pch = 16, type = "b")
  35.  
  36. fy <- f(y,mu,sigma,lambda)
  37.  
  38. optf <- function(par) {
  39. mu <- par[1:3]
  40. sigma <- par[4:6]
  41. lambda <- par[7:9]
  42. sum((fy - f(y, mu, sigma, lambda))^2)
  43. }
  44.  
  45. tmp <- optim(c(1,1,1,1,1,1,0.33,0.33,0.33),
  46. optf,
  47. method = "L-BFGS-B",
  48. lower = c(-Inf, -Inf, -Inf, 0, 0, 0, 0, 0, 0),
  49. upper = c(Inf, Inf, Inf, Inf, Inf, Inf, 1, 1, 1))
  50.  
  51. plot(y, f(y,mu,sigma,lambda), pch = 16, type = "b", xlab="y", ylab="fy", axes =FALSE)
  52. axis(1)
  53. axis(2)
  54.  
  55. yy <- sample(y, 5000, prob = fy, replace = TRUE)
  56. summary(mixtools::normalmixEM(yy, k = 3))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement