##' compare multi-variables in two dataset in terms of density.
##'
##' Produce density plots for common variables in two dataset
##' @title Visualisation
##' @param dataX
##' @param dataY
##' @param cols
##' @export
##' @author Yi Tang
Compare_XY_Density <- function(dataX, dataY, cols = names(dataX)){
require(data.table)
require(ggplot2)
require(reshape2)
df.name <- c(deparse(substitute(dataX)), deparse(substitute(dataY)))
x <- as.data.table(dataX)[, cols, with=F] ## subset
y <- as.data.table(dataY)[, cols, with=F]
xy <- rbind(x, y)
xy[, dataset := rep(df.name, c(NROW(dataX), NROW(dataY)))]
ggdf <- melt(xy, id="dataset")
p <- ggplot(ggdf, aes(x = value, col = dataset)) + geom_density() + facet_wrap(~ variable, scale = "free")
return(p)
}
# ' save a list of ggplot
gg.save.list <- function(p.list, file.name = c("var.name", "title")){
file.name <- match.arg(file.name)
nm <- names(p.list)
if (any(nm == ""))
stop("list must have name")
for (i in seq_along(p.list)){
elem <- p.list[[i]]
if (any(grepl("ggplot", class(elem)))){
my.png(elem, nm[i])
} else if (class(elem) == "list"){
for (j in 1:length(elem)){
if (any(grepl("ggplot", class(elem))))
my.png(elem[[j]], paste(nm[i], names(elem)[j]))
}
} else {
message("\n", i, "-th element is skipped")
}
}
}
#' ggpot defaul color scheme
gg_color_hue <- function(n) {
hues = seq(15, 375, length=n+1)
hcl(h=hues, l=65, c=100)[1:n]
}
##' Step Function, replaced by geom_step()
##'
##' add stepping to points (x1, y1), (x2, y2)...
##' @title this is title
##' @param x
##' @param y
##' @return a ggplot object
##' @export
##' @author Yi Tang
plotStepFunction <- function(x, y) {
formatLineSegDF <- function(x, y) {
x.start <- x[-length(x)]
x.end <- x[-1]
y.start <- y.end <- y[-length(y)]
data.table(x.start, x.end, y.start, y.end)
}
gg.df <- data.table(x, y)
line.seg.df <- formatLineSegDF(x, y)
ggplot(gg.df, aes(x = x, y = y)) + geom_point() +
geom_segment(data = line.seg.df, aes(x = x.start, xend = x.end, y = y.start, yend = y.end))
}
#' compare multi-variables in two dataset in terms of density.
density_facet_ggplot <- function(dataX, dataY, cols = names(dataX)){
require(data.table)
require(ggplot2)
require(reshape2)
df.name <- c(deparse(substitute(dataX)), deparse(substitute(dataY)))
x <- as.data.table(dataX)[, cols, with=F] ## subset
y <- as.data.table(dataY)[, cols, with=F]
xy <- rbind(x, y)
xy[, dataset := rep(df.name, c(NROW(dataX), NROW(dataY)))]
ggdf <- melt(xy, id="dataset")
p <- ggplot(ggdf, aes(x = value, col = dataset)) + geom_density() + facet_wrap(~ variable, scale = "free")
return(p)
}
#' ggMap
#' an world map as ggplot layer.
#' @example
#' data(hur)
#' gg.map <- ggMapLayer()
#' ggplot(hur, aes(x=long, y=lat)) + gg.map + geom_point(alpha=0.5)
ggMapLayer <- function(){
world <- ggplot2::map_data("world")
gg.map <- geom_polygon(data = world, aes(x = long, y= lat, group = group))
return(gg.map)
}
#' add a world map layer on top on current ggplot,
add_map_layer <- function (p, alpha = 0.2, border.col = "white", xylim.no.change = TRUE){
require(maps)
require(ggplot2)
world_data <- map_data("world")
dt <- as.data.frame(p$data)
xy <- as.character(p$mapping)
map <- geom_polygon(data = world_data, aes(x = long, y = lat,
group = group), col = border.col, alpha = alpha)
if (xylim.no.change)
p + map + coord_cartesian(xlim = range(dt[, xy[1]]),
ylim = range(dt[, xy[2]]))
else p + map
}
#' shorthand for plotting hazard map with rainbow color
gg.hazard <- function(df, x = "lon", y = "lat", z = "V1") {
p <- ggplot(df, aes_string(x = x, y = y)) + geom_tile(aes_string(fill = z)) + scale_fill_gradientn(colours = rev(rainbow(50, start = 0, end = 4/6)))
return(p)
}
####
##autoplot block
####
#' @reference http://librestats.com/2012/06/11/autoplot-graphical-methods-with-ggplot2/
#'
#' Check if point(x, y) cross x = a or y = b line or not.
#' @example
#' df <- structure(list(long = c(-34.2078157528796, -36.2074309699417,
#' -38.2792884737378, -40.2170974851064, -42.1780335768454, -44.1455967338515,
#' -46.4166770126002, -48.2943755413367, -50.0298281808574, -51.3114969986729,
#' -52.5441609178788, -53.7237533552569, -54.8823832918566, -55.8138670417713,
#' -56.722942918336, -57.6053794360869, -58.6228611648525, -59.5945636149565,
#' -60.591387403632, -61.5473518311293, -62.1877994852336, -62.6515082234799,
#' -63.0336967876415, -63.1144294155782, -63.3581282050358, -63.7885840015858,
#' -64.1370270967451, -64.5242218821295, -64.7156587993305, -64.5240440927702,
#' -63.6592485824048, -61.9361108628757, -59.9644036105799, -57.6850668652962,
#' -55.6269026718672), lat = c(25.220877237296, 25.0449951402138,
#' 24.2921987727861, 23.7331891023609, 22.882202932219, 21.9955804595675,
#' 21.3357658016897, 20.7665536331803, 20.4345722631771, 20.1713918488524,
#' 19.9607061210464, 19.803542676299, 19.6514829290709, 19.2946576063146,
#' 19.0185917630829, 18.6544443206195, 18.350027781835, 18.4634817877027,
#' 18.8968767697435, 19.5874567186624, 20.3871126308597, 21.1001662298256,
#' 21.6360080794085, 22.214195275253, 22.6741813775321, 23.2123449093717,
#' 24.0670696428687, 25.3393933451918, 27.2736476853658, 29.0676356902004,
#' 30.8813383987791, 32.49317150619, 33.1745910761416, 34.2677474173933,
#' 35.0450609158249)), .Names = c("long", "lat"), row.names = c(NA,
#' -35L))
#' x.grid <- seq(-70, -30, by = 10)
#' res <- CrossX(df$long, df$lat, x.grid)
#' plot(df$long, df$lat)
#' abline( v = x.grid, col = 2)
#' points(res$x, res$y, col = ifelse(res$dir == "negative", 2, 3), pch = 19)
CrossX <- function(x, y, x.grid){
cat('\n', 'positive means', '\n from left to right or \n bottom to top\n')
d <- c(0, diff( findInterval(x, x.grid)))
if (sum(d != 0) == 0)
return(NULL)
# negative direction
res1 <- res2 <- NULL
ind <- which(d < 0)
if(length(ind) != 0){
xx <- x.grid[ findInterval(x[ind], x.grid) + 1]
if (length(ind) == 1){
ind <- c(ind - 1, ind)
} else {
ind[1] <- ind[1] -1 # otherwise, the first interpolated will be NA.
}
res1 <- approx(x[ind], y[ind], xx)
res1$dir <- "negative"
}
# positive direction
ind <- which(d > 0)
if(length(ind) != 0){
xx <- x.grid[ findInterval(x[ind], x.grid) ]
if (length(ind) == 1){
ind <- c(ind - 1, ind)
} else {
ind[1] <- ind[1] -1 # otherwise, the first interpolated will be NA.
}
res2 <- approx(x[ind], y[ind], xx)
res2$dir <- "positive"
}
res <- rbind( as.data.table(res1), as.data.table(res2))
res
}
# ' save a list of ggplot
gg.save.list <- function(p.list, file.name = c("var.name", "title")){
file.name <- match.arg(file.name)
nm <- names(p.list)
if (any(nm == ""))
stop("list must have name")
for (i in seq_along(p.list)){
elem <- p.list[[i]]
if (any(grepl("ggplot", class(elem)))){
my.png(elem, nm[i])
} else if (class(elem) == "list"){
for (j in 1:length(elem)){
if (any(grepl("ggplot", class(elem))))
my.png(elem[[j]], paste(nm[i], names(elem)[j]))
}
} else {
message("\n", i, "-th element is skipped")
}
}
}
#' ggpot defaul color scheme
gg_color_hue <- function(n) {
hues = seq(15, 375, length=n+1)
hcl(h=hues, l=65, c=100)[1:n]
}
#' plot hazard map
gg.hazard <- function(df, x = "lon", y = "lat", z = "V1", ...) {
var <- df[[z]]
ticks <- seq(min(var), max(var), len = 5)
p <- ggplot(df, aes_string(x = x, y = y)) + geom_tile(aes_string(fill = z)) + scale_fill_gradientn(colours = rev(rainbow(50, start = 0, end = 4/6)), breaks = ticks, labels = round(ticks, 0), ...)
return(p)
}
#### ggplot, piechart
## help function
#' check also: https://github.com/jrnold/ggthemes
#' (especially for the color schemes)
#' define style for the charts ####
#' usage: g <- g +getstyle (text_size = 20)
#' ref: https://gist.github.com/nassimhaddad/4994317
getstyle <- function(text_size = 20){
theme_bw() +
theme(axis.title.x = element_text(colour="black", size=text_size)) +
theme(axis.text.x = element_text(size = text_size)) +
theme(axis.title.y = element_text(colour="black", size=text_size)) +
theme(axis.text.y = element_text(size = text_size)) +
theme(legend.position="none") +
theme(plot.title = element_text(face="bold", size = text_size+2, vjust = 2))
}
ggpie <- function(data, category = character(), value = numeric()){
require(ggplot2)
require(ggthemes)
data$category <- data[, category]
data$value <- data[, value]
data$category <- factor(data$category,
levels = data$category[order(data$value, decreasing=TRUE)])
p <- ggplot(data, aes(x = factor(1), fill = factor(category), y = (value)/sum(value),
order = (value)/sum(value))) +
geom_bar(stat = "identity", width = 1) +
labs(title = "", x = "", y= "") +
getstyle(10) + scale_fill_tableau("colorblind10")+
coord_polar(theta="y", direction = -1) +
theme(legend.position="right") +
theme(axis.ticks=element_blank(), axis.text.y = element_blank(), axis.text.x = element_blank(),
legend.text=element_text(size=14), legend.title=element_text(size=14) )+
guides(fill = guide_legend(title = category))
return(p)
}