API tools faq
paste
Advertisement
Guest User

ärharkkatilp

a guest
Nov 20th, 2019
159
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 7.13 KB | None | 0 0
raw download clone embed print report
  1. ##tilp2 demo
  2.  
  3. ##teht1
  4. set.seed(123)
  5. n <- 10
  6. mu.hat <- 3
  7. y <- rpois (n , mu )
  8. y
  9.  
  10. # normitettu log-uskottavuus
  11. r <- function(mu) {-n*(mu-mu.hat) + n*mu.hat*log(mu/mu.hat)}
  12.  
  13. curve(r,from = 0,to=10,lwd=2,ylim=c(-10,0),xlab="mu",ylab="r")
  14. abline(h=log(0.5),lty=2) # vaakasuora, 50 % usk.taso
  15.  
  16. dr <- function(mu) {-n + n*mu.hat/mu} # r:n derivaatta
  17.  
  18. # ratkaistaan r(mu)-log(0.5) = 0 Newtonin menetelmalla
  19. nextmu <- function(mu) {mu-(r(mu)-log(0.5))/dr(mu)}
  20. mulimit <- function(mu) {
  21. mu2 <- nextmu(mu)
  22. while(abs(mu-mu2) > 0.000001) {
  23. mu <- mu2
  24. mu2 <- nextmu(mu)
  25. }
  26. mu2
  27. }
  28. muleft <- mulimit(0.6) # vasen paatepiste
  29. muright <- mulimit(4.0) # oikea paatepiste
  30. c(muleft,muright) # 50 % uskottavuusvali
  31.  
  32.  
  33. ##otos2
  34.  
  35.  
  36. set.seed(321)
  37. n.2 <- 100
  38. mu.hat.2 <- 3
  39. y.2 <- rpois (n , mu )
  40. y.2
  41.  
  42. # normitettu log-uskottavuus
  43. r.2 <- function(mu.2) {-n.2*(mu.2-mu.hat.2) + n.2*mu.hat.2*log(mu.2/mu.hat.2)}
  44.  
  45. curve(r.2,from = 0,to=10,lwd=2,ylim=c(-10,0),xlab="mu",ylab="r")
  46. abline(h=log(0.5),lty=2) # vaakasuora, 50 % usk.taso
  47.  
  48. dr.2 <- function(mu.2) {-n.2 + n.2*mu.hat.2/mu.2} # r:n derivaatta
  49.  
  50. # ratkaistaan r(mu)-log(0.5) = 0 Newtonin menetelmalla
  51. nextmu.2 <- function(mu.2) {mu.2-(r.2(mu.2)-log(0.5))/dr.2(mu.2)}
  52. mulimit.2 <- function(mu.2) {
  53. mu2.2 <- nextmu.2(mu.2)
  54. while(abs(mu.2-mu2.2) > 0.000001) {
  55. mu.2 <- mu2.2
  56. mu2.2 <- nextmu.2(mu.2)
  57. }
  58. mu2.2
  59. }
  60. muleft.2 <- mulimit.2(0.6) # vasen paatepiste
  61. muright.2 <- mulimit(4.0) # oikea paatepiste
  62. c(muleft.2,muright.2) # 50 % uskottavuusvali
  63.  
  64. ## otos3
  65.  
  66. set.seed(666)
  67. n.3 <- 1000
  68. mu.hat.3 <- 3
  69. y.3 <- rpois(n.3 , mu.3 )
  70. y.3
  71.  
  72. # normitettu log-uskottavuus
  73. r.3 <- function(mu.3) {-n.3*(mu.3-mu.hat.3) + n.3*mu.hat.3*log(mu.3/mu.hat.3)}
  74.  
  75. curve(r.3,from = 0,to=10,lwd=2,ylim=c(-10,0),xlab="mu",ylab="r")
  76. abline(h=log(0.5),lty=2) # vaakasuora, 50 % usk.taso
  77.  
  78. dr.3 <- function(mu.3) {-n.3 n.3*mu.hat.3/mu.3} # r:n derivaatta
  79.  
  80. # ratkaistaan r(mu)-log(0.5) = 0 Newtonin menetelmalla
  81. nextmu.3 <- function(mu.3) {mu.3-(r.3(mu.3)-log(0.5))/dr.3(mu.3)}
  82. mulimit.3 <- function(mu.3) {
  83. mu2.3 <- nextmu.3(mu.3)
  84. while(abs(mu.3-mu2.3) > 0.000001) {
  85. mu.3 <- mu2.3
  86. mu2.3 <- nextmu.3(mu.3)
  87. }
  88. mu2.3
  89. }
  90. muleft.3 <- mulimit.3(0.6) # vasen paatepiste
  91. muright.3 <- mulimit.3(4.0) # oikea paatepiste
  92. c(muleft.3,muright.3) # 50 % uskottavuusvali
  93.  
  94.  
  95. ##plot
  96.  
  97.  
  98. par(mfrow=(c(1,3)))
  99.  
  100. curve(r.3,from = min(y),to=max(y),lwd=2,ylim=c(-5,0),xlab="mu",ylab="r")
  101. abline(h=log(0.5),lty=2) # vaakasuora, 50 % usk.taso
  102. abline(v=c(muleft.3,muright.3),lty=2) # pystysuorat
  103.  
  104.  
  105. curve(r.2,from = min(y),to=max(y),lwd=2,ylim=c(-10,0),xlab="mu",ylab="r")
  106. abline(h=log(0.5),lty=2) # vaakasuora, 50 % usk.taso
  107. abline(v=c(muleft.2,muright.2),lty=2) # pystysuorat
  108.  
  109. curve(r,from = min(y),to=max(y),lwd=2,ylim=c(-10,0),xlab="mu",ylab="r")
  110. abline(h=log(0.5),lty=2) # vaakasuora, 50 % usk.taso
  111. abline(v=c(muleft,muright),lty=2) # pystysuorat
  112.  
  113.  
  114. ###Tehtävä2
  115. par(mfrow=c(1,1))
  116.  
  117. munat <- c(5,3,3,4,4,6)
  118. kuor <- c(4,3,2,2,4,5)
  119.  
  120.  
  121.  
  122. m<-sum(munat)
  123. k<- sum(kuor)
  124. mu.hat <- m/length(munat)
  125. t.hat <- k/m
  126. mu.hat
  127. L <- function (mu,t) {exp(-6*mu)*mu^m*t^k*(1-t)^(m-k)}
  128.  
  129. R <- function (mu,t) {L(mu,t)/L(mu.hat,t.hat)}
  130.  
  131. # diskretisoidaan r 100 x100 - hilan avulla
  132. x <- seq (0,10, length = 100)
  133. y <- seq (0,1, length =100)
  134. rd <- matrix ( rep (0 ,100 * 100) , nrow =100)
  135.  
  136. for ( i in 1:100)
  137. for ( j in 1:100)
  138. rd [i , j ] <- R ( x [ i ] , y [ j ])
  139.  
  140. # tasauskottavuuskayrat
  141. contour (x, y, rd, levels = c(0.5 ,0.1 ,0.01) ,
  142. xlim = c (2,7.5) , ylim = c(0.5 ,1) , asp =6)
  143. points(mu.hat, t.hat) # SU - piste##tilp2 demo
  144.  
  145. ##teht1
  146. set.seed(123)
  147. n <- 10
  148. mu.hat <- 3
  149. y <- rpois (n , mu )
  150. y
  151.  
  152. # normitettu log-uskottavuus
  153. r <- function(mu) {-n*(mu-mu.hat) + n*mu.hat*log(mu/mu.hat)}
  154.  
  155. curve(r,from = 0,to=10,lwd=2,ylim=c(-10,0),xlab="mu",ylab="r")
  156. abline(h=log(0.5),lty=2) # vaakasuora, 50 % usk.taso
  157.  
  158. dr <- function(mu) {-n + n*mu.hat/mu} # r:n derivaatta
  159.  
  160. # ratkaistaan r(mu)-log(0.5) = 0 Newtonin menetelmalla
  161. nextmu <- function(mu) {mu-(r(mu)-log(0.5))/dr(mu)}
  162. mulimit <- function(mu) {
  163. mu2 <- nextmu(mu)
  164. while(abs(mu-mu2) > 0.000001) {
  165. mu <- mu2
  166. mu2 <- nextmu(mu)
  167. }
  168. mu2
  169. }
  170. muleft <- mulimit(0.6) # vasen paatepiste
  171. muright <- mulimit(4.0) # oikea paatepiste
  172. c(muleft,muright) # 50 % uskottavuusvali
  173.  
  174.  
  175. ##otos2
  176.  
  177.  
  178. set.seed(321)
  179. n.2 <- 100
  180. mu.hat.2 <- 3
  181. y.2 <- rpois (n , mu )
  182. y.2
  183.  
  184. # normitettu log-uskottavuus
  185. r.2 <- function(mu.2) {-n.2*(mu.2-mu.hat.2) + n.2*mu.hat.2*log(mu.2/mu.hat.2)}
  186.  
  187. curve(r.2,from = 0,to=10,lwd=2,ylim=c(-10,0),xlab="mu",ylab="r")
  188. abline(h=log(0.5),lty=2) # vaakasuora, 50 % usk.taso
  189.  
  190. dr.2 <- function(mu.2) {-n.2 + n.2*mu.hat.2/mu.2} # r:n derivaatta
  191.  
  192. # ratkaistaan r(mu)-log(0.5) = 0 Newtonin menetelmalla
  193. nextmu.2 <- function(mu.2) {mu.2-(r.2(mu.2)-log(0.5))/dr.2(mu.2)}
  194. mulimit.2 <- function(mu.2) {
  195. mu2.2 <- nextmu.2(mu.2)
  196. while(abs(mu.2-mu2.2) > 0.000001) {
  197. mu.2 <- mu2.2
  198. mu2.2 <- nextmu.2(mu.2)
  199. }
  200. mu2.2
  201. }
  202. muleft.2 <- mulimit.2(0.6) # vasen paatepiste
  203. muright.2 <- mulimit(4.0) # oikea paatepiste
  204. c(muleft.2,muright.2) # 50 % uskottavuusvali
  205.  
  206. ## otos3
  207.  
  208. set.seed(666)
  209. n.3 <- 1000
  210. mu.hat.3 <- 3
  211. y.3 <- rpois(n.3 , mu.3 )
  212. y.3
  213.  
  214. # normitettu log-uskottavuus
  215. r.3 <- function(mu.3) {-n.3*(mu.3-mu.hat.3) + n.3*mu.hat.3*log(mu.3/mu.hat.3)}
  216.  
  217. curve(r.3,from = 0,to=10,lwd=2,ylim=c(-10,0),xlab="mu",ylab="r")
  218. abline(h=log(0.5),lty=2) # vaakasuora, 50 % usk.taso
  219.  
  220. dr.3 <- function(mu.3) {-n.3 n.3*mu.hat.3/mu.3} # r:n derivaatta
  221.  
  222. # ratkaistaan r(mu)-log(0.5) = 0 Newtonin menetelmalla
  223. nextmu.3 <- function(mu.3) {mu.3-(r.3(mu.3)-log(0.5))/dr.3(mu.3)}
  224. mulimit.3 <- function(mu.3) {
  225. mu2.3 <- nextmu.3(mu.3)
  226. while(abs(mu.3-mu2.3) > 0.000001) {
  227. mu.3 <- mu2.3
  228. mu2.3 <- nextmu.3(mu.3)
  229. }
  230. mu2.3
  231. }
  232. muleft.3 <- mulimit.3(0.6) # vasen paatepiste
  233. muright.3 <- mulimit.3(4.0) # oikea paatepiste
  234. c(muleft.3,muright.3) # 50 % uskottavuusvali
  235.  
  236.  
  237. ##plot
  238.  
  239.  
  240. par(mfrow=(c(1,3)))
  241.  
  242. curve(r.3,from = min(y),to=max(y),lwd=2,ylim=c(-5,0),xlab="mu",ylab="r")
  243. abline(h=log(0.5),lty=2) # vaakasuora, 50 % usk.taso
  244. abline(v=c(muleft.3,muright.3),lty=2) # pystysuorat
  245.  
  246.  
  247. curve(r.2,from = min(y),to=max(y),lwd=2,ylim=c(-10,0),xlab="mu",ylab="r")
  248. abline(h=log(0.5),lty=2) # vaakasuora, 50 % usk.taso
  249. abline(v=c(muleft.2,muright.2),lty=2) # pystysuorat
  250.  
  251. curve(r,from = min(y),to=max(y),lwd=2,ylim=c(-10,0),xlab="mu",ylab="r")
  252. abline(h=log(0.5),lty=2) # vaakasuora, 50 % usk.taso
  253. abline(v=c(muleft,muright),lty=2) # pystysuorat
  254.  
  255.  
  256. ###Tehtävä2
  257. par(mfrow=c(1,1))
  258.  
  259. munat <- c(5,3,3,4,4,6)
  260. kuor <- c(4,3,2,2,4,5)
  261.  
  262.  
  263.  
  264. m<-sum(munat)
  265. k<- sum(kuor)
  266. mu.hat <- m/length(munat)
  267. t.hat <- k/m
  268. mu.hat
  269. L <- function (mu,t) {exp(-6*mu)*mu^m*t^k*(1-t)^(m-k)}
  270.  
  271. R <- function (mu,t) {L(mu,t)/L(mu.hat,t.hat)}
  272.  
  273. # diskretisoidaan r 100 x100 - hilan avulla
  274. x <- seq (0,10, length = 100)
  275. y <- seq (0,1, length =100)
  276. rd <- matrix ( rep (0 ,100 * 100) , nrow =100)
  277.  
  278. for ( i in 1:100)
  279. for ( j in 1:100)
  280. rd [i , j ] <- R ( x [ i ] , y [ j ])
  281.  
  282. # tasauskottavuuskayrat
  283. contour (x, y, rd, levels = c(0.5 ,0.1 ,0.01) ,
  284. xlim = c (2,7.5) , ylim = c(0.5 ,1) , asp =6)
  285. points(mu.hat, t.hat) # SU - piste
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!