ggplot-sail

distdiff.R

dd1 <- c(21000, 23400, 26800)
dd2 <- c(29002, 10000, 70000)


    
library(viridis)
library(effsize)
library(sm)
library(magicaxis)
library(beanplot)

comp.dist.plot <- function(dist1, dist2, legend1 = "Distribution 1", legend2 = "Distribution 2", legendpos = "topright", col1 = "#C8C8C8", col2 = "#646464", xlab = "", cut = TRUE, paired = FALSE, ...) {

  jpeg('rplot.jpg')
  tmp_plot <- beanplot(dist2, dist1,
                       ll=0.05,
                       what=c(0,1,1,0),
                       col=list(c(col2),c(col1)),
                       beanlines = "median",
                       horizontal = TRUE,
                       side="both",
                       axes = FALSE,
                       ...)
  if (cut) {
    if (tmp_plot$log == "x") {
      cutmin = log(min(dist1, dist2))
      cutmax = log(max(dist1, dist2))
    } else {
      cutmin = min(dist1, dist2)
      cutmax = max(dist1, dist2)
    }
    beanplot(dist2, dist1,
             ll=0.05,
             what=c(0,1,1,0),
             col=list(c(col2),c(col1)),
             beanlines = "median",
             cutmin = cutmin,
             cutmax = cutmax,
             horizontal = TRUE,
             side="both",
             axes = FALSE,
             ...)
  }

  magaxis(side=1,xlab = xlab)
  box()
  legend(legendpos, fill = c(col1, col2),
         legend = c(legend1, legend2), box.lty=0, bg="transparent")

  cat(paste("Summary of ", legend1, ":\n"), sep = "")
  print(summary(dist1))
  cat(paste("Summary of ", legend2, ":\n"), sep = "")
  print(summary(dist2))

  #ggsave(filename="myPlot.jpg", plot=last_plot(), width = 10, height = 5)
  return(wilcox.test(dist1, dist2, paired = paired))
}

effsize.range.plot <- function(dist1, dist2, threshold = c(0.147, 0.330, 0.474), transparency = 150, col = viridis(4)) {
  low = as.double(cliff.delta(dist1, dist2)[[2]][1])
  dot = as.double(cliff.delta(dist1, dist2)[[1]][1])
  high = as.double(cliff.delta(dist1, dist2)[[2]][2])

  #note: always pass alpha on the 0-255 scale
  makeTransparent<-function(someColor, alpha=100)
  {
    newColor<-col2rgb(someColor)
    apply(newColor, 2, function(curcoldata){rgb(red=curcoldata[1], green=curcoldata[2],
                                                blue=curcoldata[3],alpha=alpha, maxColorValue=255)})
  }

  colorscheme = c(makeTransparent(col[1], transparency),
                  makeTransparent(col[2], transparency),
                  makeTransparent(col[3], transparency),
                  makeTransparent(col[4], transparency))

  boxplot(
    c(low, dot, dot, dot, high),
    range = 0,
    horizontal = TRUE,
    ylim = c(-1,1),
    axes = FALSE,
    staplewex = 1,
    medpch = 19,
    medlty = 0,
    boxlty = 0,
    at = 1
  )

  boxplot(
    c(-1, -threshold[3]),
    staplecol = colorscheme[1], staplewex = 1, boxcol = colorscheme[1], col = colorscheme[1],
    range = 0, add = TRUE, horizontal = TRUE, axes = FALSE, at = 1, boxwex = 0.5, boxlty = 1, medlty = 0
  )
  boxplot(
    c(1, threshold[3]),
    staplecol = colorscheme[1], staplewex = 1, boxcol = colorscheme[1], col = colorscheme[1],
    range = 0, add = TRUE, horizontal = TRUE, axes = FALSE, at = 1, boxwex = 0.5, boxlty = 1, medlty = 0
  )
  boxplot(
    c(-threshold[3], -threshold[2]),
    staplecol = colorscheme[2], staplewex = 1, boxcol = colorscheme[2], col = colorscheme[2],
    range = 0, add = TRUE, horizontal = TRUE, axes = FALSE, at = 1, boxwex = 0.5, boxlty = 1, medlty = 0
  )
  boxplot(
    c(threshold[3], threshold[2]),
    staplecol = colorscheme[2], staplewex = 1, boxcol = colorscheme[2], col = colorscheme[2],
    range = 0, add = TRUE, horizontal = TRUE, axes = FALSE, at = 1, boxwex = 0.5, boxlty = 1, medlty = 0
  )
  boxplot(
    c(-threshold[2], -threshold[1]),
    staplecol = colorscheme[3], staplewex = 1, boxcol = colorscheme[3], col = colorscheme[3],
    range = 0, add = TRUE, horizontal = TRUE, axes = FALSE, at = 1, boxwex = 0.5, boxlty = 1, medlty = 0
  )
  boxplot(
    c(threshold[2], threshold[1]),
    staplecol = colorscheme[3], staplewex = 1, boxcol = colorscheme[3], col = colorscheme[3],
    range = 0, add = TRUE, horizontal = TRUE, axes = FALSE, at = 1, boxwex = 0.5, boxlty = 1, medlty = 0
  )
  boxplot(
    c(-threshold[1], threshold[1]),
    staplecol = colorscheme[4], staplewex = 1, boxcol = colorscheme[4], col = colorscheme[4],
    range = 0, add = TRUE, horizontal = TRUE, axes = FALSE, at = 1, boxwex = 0.5, boxlty = 1, medlty = 0
  )

  boxplot(
    c(low, dot, dot, dot, high),
    range = 0,
    horizontal = TRUE,
    ylim = c(-1,1),
    axes = FALSE,
    staplewex = 1,
    medpch = 19,
    medlty = 0,
    boxlty = 0,
    at = 1,
    add = TRUE
  )

  axis(
    side = 1,
    at = c(1, -1, 0, round(low,3), round(dot,3), round(high,3)),
    las = 2, line = -3, lwd = 0, lwd.ticks = 1
  )
  legend(
    "top", horiz = TRUE,
    legend = c("Negligible", "Small", "Medium", "Large"),
    box.lty=1, fill = c(colorscheme[4], colorscheme[3], colorscheme[2], colorscheme[1])
  )
  mtext("Effect size (Cliff's Delta)", side=1, line = 1)

  return(cliff.delta(dist1, dist2))
}

plot.R

d0 <- read.csv(file="/home/local/SAIL/zhitao/Data/transcations_users_volume_for_graph_type_0.csv", header=TRUE, sep=",")
d1 <- read.csv(file="/home/local/SAIL/zhitao/Data/transcations_users_volume_for_graph_type_1.csv", header=TRUE, sep=",")
d2 <- read.csv(file="/home/local/SAIL/zhitao/Data/transcations_users_volume_for_graph_type_2.csv", header=TRUE, sep=",")

library(ggplot2)
d <- read.csv(file="/home/local/SAIL/zhitao/Data/transcations_users_volume_for_graph.csv", header=TRUE, sep=",")

GeomSplitViolin <- ggproto("GeomSplitViolin", GeomViolin, 
                           draw_group = function(self, data, ..., draw_quantiles = NULL) {
  data <- transform(data, xminv = x - violinwidth * (x - xmin), xmaxv = x + violinwidth * (xmax - x))
  grp <- data[1, "group"]
  newdata <- plyr::arrange(transform(data, x = if (grp %% 2 == 1) xminv else xmaxv), if (grp %% 2 == 1) y else -y)
  newdata <- rbind(newdata[1, ], newdata, newdata[nrow(newdata), ], newdata[1, ])
  newdata[c(1, nrow(newdata) - 1, nrow(newdata)), "x"] <- round(newdata[1, "x"])

  if (length(draw_quantiles) > 0 & !scales::zero_range(range(data$y))) {
    stopifnot(all(draw_quantiles >= 0), all(draw_quantiles <=
      1))
    quantiles <- ggplot2:::create_quantile_segment_frame(data, draw_quantiles)
    aesthetics <- data[rep(1, nrow(quantiles)), setdiff(names(data), c("x", "y")), drop = FALSE]
    aesthetics$alpha <- rep(1, nrow(quantiles))
    both <- cbind(quantiles, aesthetics)
    quantile_grob <- GeomPath$draw_panel(both, ...)
    ggplot2:::ggname("geom_split_violin", grid::grobTree(GeomPolygon$draw_panel(newdata, ...), quantile_grob))
  }
  else {
    ggplot2:::ggname("geom_split_violin", GeomPolygon$draw_panel(newdata, ...))
  }
})

geom_split_violin <- function(mapping = NULL, data = NULL, stat = "ydensity", position = "identity", ..., 
                              draw_quantiles = NULL, trim = TRUE, scale = "area", na.rm = FALSE, 
                              show.legend = NA, inherit.aes = TRUE) {
  layer(data = data, mapping = mapping, stat = stat, geom = GeomSplitViolin, 
        position = position, show.legend = show.legend, inherit.aes = inherit.aes, 
        params = list(trim = trim, scale = scale, draw_quantiles = draw_quantiles, na.rm = na.rm, ...))
}

#d1 <- d[c(0:1000)]
p <- ggplot(d, aes(y=numbers, fill = verified_type)) + geom_split_violin() + theme_bw() + scale_y_continuous(trans="log")
ggsave(filename="myPlot.jpg", plot=last_plot())

p <- ggplot(d,  aes(x=type, y=numbers, fill = verified_type)) + geom_split_violin() + theme_bw() + scale_y_continuous(trans="log") + coord_flip()


p <- ggplot(d,  aes(x=type, y=numbers, fill = verified_type), group=type) + geom_split_violin() + theme_bw() + scale_y_continuous(trans="log") + coord_flip()
ggsave(filename="myPlot.jpg", plot=last_plot(), width = 10, height = 5)

p <- ggplot(d1,  aes(x=type, y=numbers, fill = verified_type)) + geom_split_violin() + theme_bw() + scale_y_continuous(trans="log") + coord_flip()
ggsave(filename="myPlot.jpg", plot=last_plot(), width = 10, height = 5)

p <- ggplot(d2,  aes(x=type, y=numbers, fill = verified_type)) + geom_split_violin() + theme_bw() + scale_y_continuous(trans="log") + coord_flip()
ggsave(filename="myPlot.jpg", plot=last_plot(), width = 10, height = 5)