Advertisement
Guest User

Untitled

a guest
Oct 22nd, 2014
158
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.39 KB | None | 0 0
  1. library(ggplot2)
  2. library(locfit)
  3. library(mgcv)
  4. library(plotrix)
  5.  
  6. set.seed(0)
  7. radius <- 1 # actual boundary
  8. n <- 10000 # data points
  9. jit <- 0.5 # noise factor
  10.  
  11. # Simulate random data, add polar coordinates
  12. df <- data.frame(x=runif(n,-3,3), y=runif(n,-3,3))
  13. df$r <- with(df, sqrt(x^2+y^2))
  14. df$theta <- with(df, atan(y/x))
  15.  
  16. # Noisy indicator for inside the boundary
  17. df$inside <- with(df, ifelse(r < radius + runif(nrow(df),-jit,jit),1,0))
  18.  
  19. # Plot data, shows ragged edge
  20. (ggplot(df, aes(x=x, y=y, color=inside)) + geom_point() + coord_fixed() + xlim(-4,4) + ylim(-4,4))
  21.  
  22. ### Model boundary condition using x,y coordinates
  23.  
  24. ### local regression finds the boundary pretty accurately
  25. m.locfit <- locfit(inside ~ lp(x,y, nn=0.3), data=df, family="binomial")
  26. plot(m.locfit, asp=1, xlim=c(-2,-2,2,2))
  27. draw.circle(0,0,1, border="red")
  28.  
  29. ### But GAM fits very poorly, also tried with fx=TRUE but didn't help
  30. m.gam <- gam(inside ~ s(x,y), data=df, family=binomial)
  31. plot(m.gam, trans=plogis, se=FALSE, rug=FALSE)
  32. draw.circle(0,0,1, border="red")
  33.  
  34. ### gam.check doesn't indicate a problem with the model itself
  35. gam.check(m.gam)
  36.  
  37. Method: UBRE Optimizer: outer newton
  38. full convergence after 8 iterations.
  39. Gradient range [5.41668e-10,5.41668e-10]
  40. (score -0.815746 & scale 1).
  41. Hessian positive definite, eigenvalue range [0.0002169789,0.0002169789].
  42.  
  43. Basis dimension (k) checking results. Low p-value (k-index<1) may
  44. indicate that k is too low, especially if edf is close to k'.
  45.  
  46. k' edf k-index p-value
  47. s(x,y) 29.000 13.795 0.973 0.08
  48.  
  49. #### Try using polar coordinates
  50.  
  51. ### Again, locfit works well
  52. m.locfit2 <- locfit(inside ~ lp(r, nn=0.3), data=df, family="binomial")
  53. plot(m.locfit2)
  54. abline(v=1, col="red")
  55.  
  56. ### But GAM misses again
  57. m.gam2 <- gam(inside ~ s(r, k=50), data=df, family=binomial)
  58. plot(m.gam2, se=FALSE, rug=FALSE, trans=plogis)
  59. abline(v=1, col="red")
  60.  
  61. ### Can also plot gam on link scale for alternate view
  62. plot(m.gam2, se=FALSE, rug=FALSE)
  63. abline(v=1, col="red")
  64.  
  65. gam.check(m.gam2)
  66.  
  67. Method: UBRE Optimizer: outer newton
  68. full convergence after 4 iterations.
  69. Gradient range [-3.29203e-08,-3.29203e-08]
  70. (score -0.8240065 & scale 1).
  71. Hessian positive definite, eigenvalue range [7.290233e-05,7.290233e-05].
  72.  
  73. Basis dimension (k) checking results. Low p-value (k-index<1) may
  74. indicate that k is too low, especially if edf is close to k'.
  75.  
  76. k' edf k-index p-value
  77. s(r) 49.000 10.537 0.979 0.06
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement