#' Source code for the project
#' @import dplyr
#' @import readr
#' @import stringr
#' @import ggplot2
#' @import grid
#' @import leaflet
#'
#' @name eq_location_clean
#' @title clean location in raw data
#' @description This function is used in order to change name of Location in database to more convinient format: it keeps only Country name in Titlecase
#' @param location column of dataframe or simply a vector with names of locations to be changed
#' @return the vector of Country names in title case is returned
#' @examples \dontrun{cleaned_location<-eq_location_clean(location=database$COUNTRY)}
#' @export
eq_location_clean <- function(location){cleaned_location<-paste0(stringr::str_to_title(location), ":")
cleaned_location}
#'
#'
#' @name eq_clean_data
#' @title clean entire dataset
#' @description This function "cleans" the initial dataset so it can be further used in geoms: creates date column in POSTIXct format with given Year, Month and Day,
#' as well as convert LONGITUDE and LATITUDE to numeric and clean location name using previous function [func(eq_location_clean)]. Because the cleaning task is
#' quite specific to the current database, there is no option to choose columns, related to dates and coordinates. Instead, all of them are nested in the body of function
#' thus, the only arument is the name of \code{data.frame} in which base is stored
#' @param data a data frame that contains the imported base
#' @return cleaned dataframe is returned with country names in title case and coordinates as numeric insread of character
#' @examples \dontrun{eq_clean_data(database)->cleaned_base}
#' @export
eq_clean_data<-function(data){
data$DATE<-as.POSIXct(strptime("1994-02-03", format="%Y-%m-%d"))
data$DATE[data$YEAR<0]<-as.POSIXct(strptime(paste(data$YEAR[data$YEAR<0], data$MONTH[data$YEAR<0],data$DAY[data$YEAR<0],sep="-"),"-%Y-%m-%d"))
data$DATE[data$YEAR>=0]<-as.POSIXct(strptime(paste(data$YEAR[data$YEAR>=0], data$MONTH[data$YEAR>=0],data$DAY[data$YEAR>=0],sep="-"),"%Y-%m-%d"))
data$LONGITUDE<-as.numeric(gsub(" ", "", data$LONGITUDE))
data$LATITUDE<-as.numeric(gsub(" ", "", data$LATITUDE))
data$LOCATION_NAME<-eq_location_clean(data$COUNTRY)
data$DEATHS<-as.numeric(gsub(" ", "", data$DEATHS))
data
}
##############################Module2 Part one#################################
#'
#' @name draw_key_timeline
#' @title function to identify legend
#' @description This is function that is used in ggproto to make custom legend type in new geom_*.
#' @inheritParams ggplot2::draw_key_polygon
#'@examples \dontrun{ggplot2::ggproto("GeomTimeline_label", Geom,
#' required_aes = c("x"),
#' optional_aes=c("size", "n_max", "caption"),
#' non_missing_aes = c("fill", "colour", "y"),
#' default_aes = aes(shape = 19, colour = "black", fill = "black", size = 0.1,
#' linetype = 1, alpha = 0.25, fontsize = 1, y=0.5),
#' draw_key = draw_key_timline}
#' @export
draw_key_timline<-function(data, params, size){
lwd <- min(data$size, min(size)/4)
elem2<-circleGrob(x=0.6, y=0.5, r=data$size/10, gp=gpar(col=data$colour, fill=alpha(data$fill, data$alpha)))
result <- gTree(children = gList(elem2))
result
}
#'
#' @name GeomTimeline
#' @title function to build ggproto for geom
#' @description Here will be the usage of two functions, required to create custom geom: ggplot2:ggproto and geom_* (in this case geom_hurricane) in order to
#' create new geom_timeline, which shows magnitude and year of hurricane occured
#' @inheritParams ggplot2::ggproto
#' @examples \dontrun{ ggplot2::layer(
#' geom = GeomTimeline, mapping = mapping,
#' data = data, stat = stat, position = position,
#' show.legend = show.legend, inherit.aes = inherit.aes,
#' params = list(na.rm = na.rm, ...))}
GeomTimeline <- ggplot2::ggproto("GeomTimeline", Geom,
required_aes = c("x"),
optional_aes=c("size"),
non_missing_aes = c("fill", "colour", "y"),
default_aes = aes(shape = 19, colour = "black", fill = "black", size = 0.15,
linetype = 1, alpha = 0.45, fontsize = 1, y=0.5),
draw_key = draw_key_timline,
draw_panel = function(data, panel_scales, coord) {
coords<-coord$transform(data, panel_scales)
coords$size<-coords$size/50
coords<-coords[!is.na(coords$size),]
grid::pointsGrob(x=coords$x, y=coords$y, pch = coords$shape,size=unit(coords$size, "native"),
gp = grid::gpar(col = coords$colour, fill = coords$fill, alpha=coords$alpha))
}
)
#'
#' @name geom_timeline
#' @title custom geom to plot data
#' @description Geom to draw timeline
#' @inheritParams ggplot2::geom_point
#'@examples \dontrun{cleaned_base%>%filter(YEAR>=2000 & YEAR<=2010 & !is.na(EQ_MAG_ML))%>%ggplot()+
#' geom_timeline(aes(fill=DEATHS, colour=DEATHS, x=YEAR, size=EQ_MAG_ML))+theme_timeline}
#' @export
geom_timeline<- function(mapping = NULL, data = NULL, stat = "identity",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = FALSE, ...) {
ggplot2::layer(
geom = GeomTimeline, mapping = mapping,
data = data, stat = stat, position = position,
show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
#ggplot(test_df)+geom_timeline(aes(x=Year, y=Country, size=ML))+theme_classic()
##############################Module2 Part two#################################
#'
#' @name theme_timeline
#' @title modification of existing geom classic theme
#' @description Here is slight modification of existing classic theme: everything is the same except default position of the legend: it is at the bottom, instead of right side
#' @inheritParams ggplot2::theme_classic
#' @examples \dontrun{cleaned_base%>%filter(YEAR>=2000 & YEAR<=2010 & !is.na(EQ_MAG_ML))%>%ggplot()+
#' geom_timeline(aes(fill=DEATHS, colour=DEATHS, x=YEAR, size=EQ_MAG_ML))+theme_timeline}
#' @export
theme_timeline<-theme_classic() %+replace% theme(legend.position="bottom")
#'
#' @name GeomTimeline_label
#' @title ggproto for custom geom
#' @description It is modification of previous \code{geom_timeline} that can add captions to hurricanes plotted by date occured. Captions can be applyed to all observation,
#' or to first n observations, having maximum value of specified metric (for example, first 5 with the highest magnitude level)
#' @inheritParams ggplot2::ggproto
#' @examples \dontrun{ ggplot2::layer(
#' geom = GeomTimeline, mapping = mapping,
#' data = data, stat = stat, position = position,
#' show.legend = show.legend, inherit.aes = inherit.aes,
#' params = list(na.rm = na.rm, ...))}
GeomTimeline_label <- ggplot2::ggproto("GeomTimeline_label", Geom,
required_aes = c("x"),
optional_aes=c("size", "n_max", "caption"),
non_missing_aes = c("fill", "colour", "y"),
default_aes = aes(shape = 19, colour = "black", fill = "black", size = 0.1,
linetype = 1, alpha = 0.25, fontsize = 1, y=0.5),
draw_key = draw_key_timline,
draw_panel = function(data, panel_scales, coord) {
coords<-na.omit(coord$transform(data, panel_scales))
if(max(coords$size)>=1){coords$size<-((coords$size-min(coords$size))/(max(coords$size)-min(coords$size)))*0.1}
rank<-coords$size
rank[!is.na(rank)]<-rank(coords$size[!is.na(coords$size)], ties.method="min")
rank<-max(rank, na.rm=TRUE)+min(rank, na.rm=TRUE)-rank
points<-grid::pointsGrob(x=coords$x, y=coords$y, pch = 21,size=unit(coords$size, "native"),
gp = grid::gpar(col = coords$colour, fill = coords$fill, alpha=coords$alpha, fontsize=coords$fontsize))
coords<-coords[(!is.na(rank)&rank<=coords$n_max[1]) ,]
print(coords)
if(!is.null(coords$caption) | !is.null(coords$size)){
ticks<-grid::segmentsGrob(x0=unit(coords$x, "npc"), x1=unit(coords$x, "npc"),
y0=unit(coords$y, "npc"), y1=unit(coords$y+0.2, "npc"));
text<-grid::textGrob(label=coords$caption, x=unit(coords$x, "npc"), y=unit(coords$y+0.23, "npc"), rot=45)
} else {ticks<-NULL;text<-NULL}
result <- gTree(children = gList(points, ticks, text))
result
}
)
#'
#' @name geom_timeline_label
#' @title custom geom with labels
#' @description Geom to draw timeline label
#' @inheritParams ggplot2::geom_point
#' @examples \dontrun{cleaned_base%>%filter(YEAR>=2000 & YEAR<=2004 & !is.na(EQ_MAG_ML))%>%ggplot()+
#' geom_timeline_label(aes(fill=DEATHS, colour=DEATHS, x=YEAR, y=COUNTRY, caption=COUNTRY, size=EQ_MAG_ML, n_max=2))+
#' theme_timeline}
#' @export
geom_timeline_label<- function(mapping = NULL, data = NULL, stat = "identity",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = FALSE, ...) {
ggplot2::layer(
geom = GeomTimeline_label, mapping = mapping,
data = data, stat = stat, position = position,
show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
#ggplot(test_df)+geom_timeline_label(fill="blue",
# aes(fill="blue",x=Year, y=Country, caption=Country, size=Intensity, n_max=5))+theme_timeline
#ggplot(test_df)+
# geom_timeline_label(aes(fill=Deaths, x=Year, y=Country, caption=Country, size=Intensity, n_max=2))+
# theme_timeline+
# scale_colour_gradient(low = "#132B43", high = "#56B1F7")
#############################################Module 3#######################
#'
#' @name eq_create_label
#' @title Function to generate leaflet popup text
#' @description Function to automate creating popup labels in leaflet using html tags
#'@param data data used
#'@param location location
#'@param magnitude intensity
#'@param death numbet of deaths occured
#'@examples \dontrun{cleaned_base$popup_text<-eq_create_label(cleaned_base, "LOCATION", "EQ_MAG_ML", "DEATHS")}
#'@export
eq_create_label<-function(data, location, magnitude, death){
data<-as.data.frame(data)
xxx<-function(x, argument){
if(is.na(x)){x=""} else {x=paste0("<b>",argument, "</b> ",x, "<br>")}
x
}
Location_caption<-sapply(data[,colnames(data)==location], xxx, argument="Location")
Magnitude_caption<-sapply(data[,colnames(data)==magnitude], xxx, argument="Magnitude")
Death_caption<-sapply(data[,colnames(data)==death], xxx, argument="Deaths")
Whole_popup<-paste0(Location_caption,Magnitude_caption,Death_caption)
Whole_popup}
#'
#' @name eq_map
#' @title create interactive plots based on leaflet
#' @description Function to plot dots of hurricanes on ineractive maps with popus containing basic information
#' @param data data used
#' @param longitude x-coord
#' @param latitude y-cood
#' @param annot_col column to extract popup caption from
#' @examples \dontrun{eq_map(cleaned_base, "LONGITUDE", "LATITUDE", "popup_text")}
#' @export
eq_map<-function(data, longitude, latitude, annot_col){
keep<-c(longitude, latitude, annot_col)
data<-data[,colnames(data) %in% keep]
data<-as.data.frame(na.omit(data))
print(head(data))
caption<-eq_create_label(data, "Country", "Intensity", "Deaths")
m = leaflet() %>% addTiles()%>%
addCircleMarkers(lng=data[,colnames(data)==longitude], lat=data[,colnames(data)==latitude])%>%
addPopups(lng=data[,colnames(data)==longitude], lat=data[,colnames(data)==latitude], popup=data[,colnames(data)==annot_col] )
m
}
#eq_map(test_df, longitude = "Longitude", latitude="Latitude")
#eq_create_label(test_df, "Country", "Intensity", "Deaths")
#test_df%>%dplyr::mutate(popup_text = eq_create_label(.,location="Country", magnitude="Intensity", death="Deaths"))%>%
# eq_map(longitude="Longitude", latitude="Latitude", annot_col = "popup_text")
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.