R/plotbar.R

# plotbar = function(x, y, group = NULL){
#   ############################################################################################################ make Numbers
#   mycol = 'white' ### set legend color
#   y.name <- paste(substitute(y))[[3]]
#   x.name <- paste(substitute(x))[[3]]
#
#   group       <- droplevels(as.factor(group))
#   gg          <- levels(as.factor(group))
#   lev         <- (as.numeric(as.factor(group)))
#   levels(lev) <- c("black", "red")
#
#   formula <- paste(y.name,x.name, sep = ' ~ ')
#   main <- formula
#
#
#   ############################################################################################################ Get data
#
#   result.all <- cor.test(x, y)
#   N <- paste('(N=',result.all$parameter+2,')', sep = '')
#   a.S <- summary(lm(y ~ x))
#   text.1G <- paste(paste('r =', round(result.all$estimate, 2)),
#                    paste('p =', round(result.all$p.value, 4)),N,
#                    paste('[R2=', round(a.S$r.squared,2),']', sep=''),
#                    sep = '; ')
#   results <- paste(formula, text.1G, sep = '\n')
#
#
#   a.S <- summary(lm(y ~ x))
#   black.S <- summary(lm(y[lev==1] ~ x[lev==1]))
#   red.S <- summary(lm(y[lev==2] ~ x[lev==2]))
#
#   result.black <- cor.test(x[lev==1], y[lev==1])
#   N <- paste('(N=',result.black$parameter+2,')', sep = '')
#   text.black <- paste(paste(paste(substitute(gg))[[1]],'(black) :',
#                             'r =', round(result.black$estimate, 2)),
#                       paste('p =', round(result.black$p.value, 4)),N,
#                       paste('[R2=', round(black.S$r.squared,2),']', sep=''),
#                       sep = '; ')
#
#   result.red <- cor.test(x[lev==2], y[lev==2])
#   N <- paste('(N=',result.red$parameter+2,')', sep = '')
#   text.red <- paste(paste(paste(substitute(gg))[[2]],'(red) :',
#                           'r =', round(result.red$estimate, 2)),
#                     paste('p =', round(result.red$p.value, 4)),N,
#                     paste('[R2=', round(red.S$r.squared,2),']', sep=''),
#                     sep = '; ')
#
#   text.2G <- paste(text.1G, text.black, text.red, sep = '\n')
#   results <- paste(formula, text.2G, sep = '\n')
#   xlim <- range(x, na.rm = T)
#   ylim <- range(y, na.rm = T)
#
#   ############################################################################################################ PLOT
#   d.x1 <- density(x[lev==1], na.rm = T)
#   d.x2 <- density(x[lev==2], na.rm = T)
#   d.y1 <- density(y[lev==1], na.rm = T)
#   d.y2 <- density(y[lev==2], na.rm = T)
#
#   layout( matrix( c(1,3,3,3,3,1,3,3,3,3,1,3,3,3,3,1,3,3,3,3,0,2,2,2,2),ncol=5) )
#
#
#   # plot(d.x$x, d.x$y, xlim=range(x), type='l')
#   plot(d.x1$x, d.x1$y, type='l', axes=FALSE, main = '', col = 'red')
#   abline(v=mean(x[lev==1], na.rm = T), col='red')
#   par(new=TRUE)
#   plot(d.x2$x, d.x2$y, type='l', axes=FALSE, main = '', col = 'black')
#   abline(v=mean(x[lev==2], na.rm = T), col='black')
#   legend("center", legend = paste('p =', round(t.test(x[lev==1], x[lev==2])$p.value,4)), adj = 0)
#
#   # plot(d.y$y, d.y$x, ylim=range(y, na.rm = T), xlim=rev(range(d.y$y)), type='l')
#   plot(d.y1$y, d.y1$x, type='l', axes=FALSE, main = '', col = 'red')
#   abline(h=mean(y[lev==1], na.rm = T), col='red')
#   par(new=TRUE)
#   plot(d.y2$y, d.y2$x, type='l', axes=FALSE, main = '', col = 'black')
#   abline(h=mean(y[lev==2], na.rm = T), col='black')
#   legend("center", legend = paste('p =', round(t.test(y[lev==1], y[lev==2])$p.value,4)), adj = 0)
#
#   plot(x, y, pch = lev, col = lev, main = main,
#        xlim = xlim,
#        ylim = ylim)
#
#   abline(lm(y ~ x), col = 'blue', lwd = 2, lty = 6)
#   abline(lm(y[lev==1] ~ x[lev==1]), col = 'black')
#   abline(lm(y[lev==2] ~ x[lev==2]), col = 'red')
#   legend('top', text.2G, xjust = 1, yjust = 0.5, adj = 0, box.lwd = 0, box.col = mycol, bg = mycol)
#
#   mtext(x.name, side=1, line=1, outer=TRUE, adj=0.5)
#   mtext(y.name, side=2, line=1, outer=TRUE, adj=0.5)
#
#
# }
# # plotbar(x = mtcars$mpg, y = mtcars$disp, group = as.factor(as.character(mtcars$vs)))
#
# # FLIP plot
# p1 <- explora::bartest(mtcars$mpg, mtcars$vs)
# p1 + coord_flip()
#
# # divide the plot space
# p1 <- explora::bartest(mtcars$mpg, mtcars$vs)
# p2 <- explora::bartest(mtcars$disp, mtcars$vs)
# ggpubr::ggarrange(p1, p2, heights = c(2, 0.7),
#                   ncol = 1, nrow = 2)
#
#
#
#
#
#
#
#
#
#
# #####################################################################################################################.
# #####################################################################################################################.
# #####################################################################################################################.
# #####################################################################################################################.
# #####################################################################################################################.
#
#
#
#
# # similar to plottest
# library(ggpubr)
# sp <- ggscatter(mtcars, x = "wt", y = "mpg",
#                 add = "reg.line",               # Add regression line
#                 conf.int = TRUE,                # Add confidence interval
#                 color = 'cyl', palette = "jco", # Color by groups "cyl"
#                 shape = 'cyl'                   # Change point shape by groups "cyl"
# )+stat_cor(aes(color = cyl));sp       # Add correlation coefficient
# sp
#
#
# ggscatterhist(mtcars,x = "wt", y = "mpg",color = 'cyl') + stat_cor(aes(color = 'cyl'), label.x = 3)
#
#
#
#
#
# # hist_high = density(LLU$NPY[LLU$G.RCI == 'high.R_mean'], na.rm = T)
# # hist_low = density(LLU$NPY[LLU$G.RCI == 'low.R_mean'], na.rm = T)
# #
# # barplot(hist_high, axes=FALSE, col=rgb(0,0,0,0.7), space=0)
# # barplot(hist_low, axes=FALSE,beside = T, col=rgb(1,0,0,0.4), space=0, add = TRUE)
# #
# # plot(hist_high, axes=FALSE, main = '', col = 'red'); par(new=TRUE); plot(hist_low, axes=FALSE, main = '',col = 'black', add = TRUE)
# # par(mfrow=c(2,1))
# # scatterhist(x = LLU$NPY, y = LLU$OXT, group = LLU$G.RCI)
# # par(mfrow=c(1,1))
#
#
#
# # plothist(x = LLU$NPY, y = LLU$OXT, group = LLU$G.RCI)
# # t.test(mtcars$mpg ~ mtcars$vs)
#
#
#
#
#
#
#
# plothist = function(x, y, group = NULL){
#   ############################################################################################################ make Numbers
#   mycol = 'white' ### set legend color
#   y.name <- paste(substitute(y))[[3]]
#   x.name <- paste(substitute(x))[[3]]
#
#   group       <- droplevels(as.factor(group))
#   gg          <- levels(as.factor(group))
#   lev         <- (as.numeric(as.factor(group)))
#   levels(lev) <- c("black", "red")
#
#   formula <- paste(y.name,x.name, sep = ' ~ ')
#   main <- formula
#
#   ############################################################################################################ Start plotting
#   zones=matrix(c(2,0,1,3), ncol=2, byrow=TRUE)
#   layout(zones, widths=c(4/5,1/5), heights=c(1/5,4/5))
#   x1hist = density(x[lev==1], na.rm = T)
#   y1hist = density(y[lev==1], na.rm = T)
#   x2hist = density(x[lev==2], na.rm = T)
#   y2hist = density(y[lev==2], na.rm = T)
#   # x1hist = hist(x[lev==1], 15, plot=FALSE)
#   # y1hist = hist(y[lev==1], 15,  plot=FALSE)
#   # x2hist = hist(x[lev==2], 15,  plot=FALSE)
#   # y2hist = hist(y[lev==2], 15,  plot=FALSE)
#   top = max(c(x1hist$counts, x2hist$counts, y1hist$counts, y2hist$counts))
#   par(mar=c(3,3,1,1))
#
#   ############################################################################################################ Scatter
#
#   result.all <- cor.test(x, y)
#   N <- paste('(N=',result.all$parameter+2,')', sep = '')
#   a.S <- summary(lm(y ~ x))
#   text.1G <- paste(paste('r =', round(result.all$estimate, 2)),
#                    paste('p =', round(result.all$p.value, 4)),N,
#                    paste('[R2=', round(a.S$r.squared,2),']', sep=''),
#                    sep = '; ')
#   results <- paste(formula, text.1G, sep = '\n')
#
#
#   a.S <- summary(lm(y ~ x))
#   black.S <- summary(lm(y[lev==1] ~ x[lev==1]))
#   red.S <- summary(lm(y[lev==2] ~ x[lev==2]))
#
#   result.black <- cor.test(x[lev==1], y[lev==1])
#   N <- paste('(N=',result.black$parameter+2,')', sep = '')
#   text.black <- paste(paste(paste(substitute(gg))[[1]],'(black) :',
#                             'r =', round(result.black$estimate, 2)),
#                       paste('p =', round(result.black$p.value, 4)),N,
#                       paste('[R2=', round(black.S$r.squared,2),']', sep=''),
#                       sep = '; ')
#
#   result.red <- cor.test(x[lev==2], y[lev==2])
#   N <- paste('(N=',result.red$parameter+2,')', sep = '')
#   text.red <- paste(paste(paste(substitute(gg))[[2]],'(red) :',
#                           'r =', round(result.red$estimate, 2)),
#                     paste('p =', round(result.red$p.value, 4)),N,
#                     paste('[R2=', round(red.S$r.squared,2),']', sep=''),
#                     sep = '; ')
#
#   text.2G <- paste(text.1G, text.black, text.red, sep = '\n')
#   results <- paste(formula, text.2G, sep = '\n')
#   xlim <- range(x, na.rm = T)
#   ylim <- range(y, na.rm = T)
#   plot(x, y, pch = lev, col = lev,
#        main = main,
#        xlim = xlim,
#        ylim = ylim
#   )
#   abline(lm(y ~ x), col = 'blue', lwd = 2, lty = 6)
#   abline(lm(y[lev==1] ~ x[lev==1]), col = 'black')
#   abline(lm(y[lev==2] ~ x[lev==2]), col = 'red')
#   legend('top', text.2G, xjust = 1, yjust = 0.5, adj = 0, box.lwd = 0, box.col = mycol, bg = mycol)
#
#   par(mar=c(0,3,1,1))
#   plot(hist_high, axes=FALSE, main = '', col = 'red')
#   par(new=TRUE)
#   plot(hist_low, axes=FALSE, main = '',col = 'black', add = TRUE)
#
#   # barplot(x1hist$counts, axes=FALSE, ylim=c(0, top), col=rgb(0,0,0,0.7), space=0)
#   # barplot(x2hist$counts, axes=FALSE, ylim=c(0, top),beside = T, col=rgb(1,0,0,0.4), space=0, add = TRUE)
#   # hist(x[LLU$G.RCI == 'high.R_mean'],breaks=10,col=rgb(1,1,0,0.7),main="",xlab="")
#   # par(new=TRUE)
#   # hist(x[LLU$G.RCI == 'low.R_mean'],breaks=10,col=rgb(0,1,1,0.4),main="",xlab="")
#   par(mar=c(3,0,1,1))
#   barplot(y1hist$counts, axes=FALSE, xlim=c(0, top), col=rgb(0,0,0,0.7), space=0, horiz=TRUE)
#   barplot(y2hist$counts, axes=FALSE, xlim=c(0, top), beside=T, col=rgb(1,0,0,0.4), space=0, horiz=TRUE, add = TRUE)
#   # hist(y[LLU$G.RCI == 'high.R_mean'],breaks=10,col=rgb(1,1,0,0.7),main="",xlab="")
#   # par(new=TRUE)
#   # hist(y[LLU$G.RCI == 'low.R_mean'],breaks=10,col=rgb(0,1,1,0.4),main="",xlab="")
#   par(oma=c(3,3,0,0))
#   mtext(x.name, side=1, line=1, outer=TRUE, adj=0.5)
#   mtext(y.name, side=2, line=1, outer=TRUE, adj=0.5)
# }; plothist(x = mtcars$mpg, y = mtcars$disp, group = as.factor(as.character(mtcars$vs)))
# # scatterhist(x = LLU$NPY, y = LLU$OXT, group = LLU$G.RCI)
#
alemiani/explora documentation built on May 28, 2019, 4:54 p.m.