Guest User

Untitled

a guest
Jan 19th, 2018
84
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.91 KB | None | 0 0
  1. ezLev=function(x,new_order){
  2. for(i in rev(new_order)){
  3. x=relevel(x,ref=i)
  4. }
  5. return(x)
  6. }
  7.  
  8. ggcorplot = function(data,var_text_size,cor_text_limits){
  9. # normalize data
  10. for(i in 1:length(data)){
  11. data[,i]=(data[,i]-mean(data[,i]))/sd(data[,i])
  12. }
  13. # obtain new data frame
  14. z=data.frame()
  15. i = 1
  16. j = i
  17. while(i<=length(data)){
  18. if(j>length(data)){
  19. i=i+1
  20. j=i
  21. }else{
  22. x = data[,i]
  23. y = data[,j]
  24. temp=as.data.frame(cbind(x,y))
  25. temp=cbind(temp,names(data)[i],names(data)[j])
  26. z=rbind(z,temp)
  27. j=j+1
  28. }
  29. }
  30. names(z)=c('x','y','x_lab','y_lab')
  31. z$x_lab = ezLev(factor(z$x_lab),names(data))
  32. z$y_lab = ezLev(factor(z$y_lab),names(data))
  33. z=z[z$x_lab!=z$y_lab,]
  34. #obtain correlation values
  35. z_cor = data.frame()
  36. i = 1
  37. j = i
  38. while(i<=length(data)){
  39. if(j>length(data)){
  40. i=i+1
  41. j=i
  42. }else{
  43. x = data[,i]
  44. y = data[,j]
  45. x_mid = min(x)+diff(range(x))/2
  46. y_mid = min(y)+diff(range(y))/2
  47. this_cor = cor(x,y)
  48. this_cor.test = cor.test(x,y)
  49. this_col = ifelse(this_cor.test$p.value<.05,'<.05','>.05')
  50. this_size = (this_cor)^2
  51. cor_text = ifelse(
  52. this_cor>0
  53. ,substr(format(c(this_cor,.123456789),digits=2)[1],2,4)
  54. ,paste('-',substr(format(c(this_cor,.123456789),digits=2)[1],3,5),sep='')
  55. )
  56. b=as.data.frame(cor_text)
  57. b=cbind(b,x_mid,y_mid,this_col,this_size,names(data)[j],names(data)[i])
  58. z_cor=rbind(z_cor,b)
  59. j=j+1
  60. }
  61. }
  62. names(z_cor)=c('cor','x_mid','y_mid','p','rsq','x_lab','y_lab')
  63. z_cor$x_lab = ezLev(factor(z_cor$x_lab),names(data))
  64. z_cor$y_lab = ezLev(factor(z_cor$y_lab),names(data))
  65. diag = z_cor[z_cor$x_lab==z_cor$y_lab,]
  66. z_cor=z_cor[z_cor$x_lab!=z_cor$y_lab,]
  67. #start creating layers
  68. points_layer = layer(
  69. geom = 'point'
  70. , data = z
  71. , mapping = aes(
  72. x = x
  73. , y = y
  74. )
  75. )
  76. lm_line_layer = layer(
  77. geom = 'line'
  78. , geom_params = list(colour = 'red')
  79. , stat = 'smooth'
  80. , stat_params = list(method = 'lm')
  81. , data = z
  82. , mapping = aes(
  83. x = x
  84. , y = y
  85. )
  86. )
  87. lm_ribbon_layer = layer(
  88. geom = 'ribbon'
  89. , geom_params = list(fill = 'green', alpha = .5)
  90. , stat = 'smooth'
  91. , stat_params = list(method = 'lm')
  92. , data = z
  93. , mapping = aes(
  94. x = x
  95. , y = y
  96. )
  97. )
  98. cor_text = layer(
  99. geom = 'text'
  100. , data = z_cor
  101. , mapping = aes(
  102. x=y_mid
  103. , y=x_mid
  104. , label=cor
  105. , size = rsq
  106. , colour = p
  107. )
  108. )
  109. var_text = layer(
  110. geom = 'text'
  111. , geom_params = list(size=var_text_size)
  112. , data = diag
  113. , mapping = aes(
  114. x=y_mid
  115. , y=x_mid
  116. , label=x_lab
  117. )
  118. )
  119. f = facet_grid(y_lab~x_lab,scales='free')
  120. o = opts(
  121. panel.grid.minor = theme_blank()
  122. ,panel.grid.major = theme_blank()
  123. ,axis.ticks = theme_blank()
  124. ,axis.text.y = theme_blank()
  125. ,axis.text.x = theme_blank()
  126. ,axis.title.y = theme_blank()
  127. ,axis.title.x = theme_blank()
  128. ,legend.position='none'
  129. )
  130. size_scale = scale_size(limits = c(0,1),to=cor_text_limits)
  131. return(
  132. ggplot()+
  133. points_layer+
  134. lm_ribbon_layer+
  135. lm_line_layer+
  136. var_text+
  137. cor_text+
  138. f+
  139. o+
  140. size_scale
  141. )
  142. }
Add Comment
Please, Sign In to add comment