From ec47435f0212381d72a03da61d46bd0c8c114303 Mon Sep 17 00:00:00 2001 From: eleanorecc Date: Mon, 10 Sep 2018 13:48:15 -0700 Subject: [PATCH 1/4] readme update --- README.Rmd | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/README.Rmd b/README.Rmd index 5c88b14..9fc082f 100644 --- a/README.Rmd +++ b/README.Rmd @@ -24,10 +24,10 @@ The `ohicore` is a package of core functions for calculating the Ocean Health In You can install ohicore from github with: ```{r gh-installation, eval = FALSE} -## devtools is needed for installing packages from Github +# devtools is needed for installing packages from Github install.packages("devtools") -## install ohicore package +# install ohicore package devtools::install_github('ohi-science/ohicore') library(ohicore) ``` @@ -35,6 +35,6 @@ library(ohicore) ## Example ```{r example} -## basic example code +# basic example code # ohicore::FlowerPlot -need to add score data to demo folder... 8 regions, what assessment is this? what data to add? ``` \ No newline at end of file From 1da3826b720ad63934508e44da3592b57de90612 Mon Sep 17 00:00:00 2001 From: Melsteroni Date: Wed, 12 Sep 2018 14:05:28 -0700 Subject: [PATCH 2/4] Adding new PlotFlower --- DESCRIPTION | 2 - R/PlotFlower.R | 604 +++++++++++++++++++++++++++++-------------------- 2 files changed, 357 insertions(+), 249 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 855149a..eb0de26 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,9 +7,7 @@ Authors@R: c( person("Ben", "Best", email = "ben@ecoquants.com", role = c("aut")), person("Julia Stewart","Lowndes", email = "lowndes@nceas.ucsb.edu", role = c("aut")), person("Casey", "O'Hara", email = "ohara@nceas.ucsb.edu", role = c("aut")), - person("Ning Jiang", "Mendes", role = c("aut")), person("Jamie", "Afflerbach", email = "afflerbach@nceas.ucsb.edu", role = c("aut")), - person("Steve", "Hastings", role = c("aut")), person("Darren", "Hardy", role = c("aut"))) Description: A collection of functions for generically calculating the Ocean Health Index scores as well as individual goals and sub-goals. diff --git a/R/PlotFlower.R b/R/PlotFlower.R index 1f6421c..2bb24e3 100644 --- a/R/PlotFlower.R +++ b/R/PlotFlower.R @@ -1,265 +1,375 @@ -##' Plot flower plot -##' -##' @param lengths length of petal outward to extent of circle -##' @param widths width of petal -##' @param labels petal label outside of circel -##' @param disk relative radius of a central donut hole -##' @param max.length ... -##' @param center center value -##' @param main middle value -##' @param fill.col fill colors -##' @param plot.outline size of plot outline -##' @param label.offset label offset -##' @param xlim formatting -##' @param ylim formatting -##' @param uin formatting -##' @param tol formatting -##' @param cex size of middle text -##' @param bty formatting -##' @param lty line thickness -##' @param label.col label color -##' @param label.font label font -##' @param label.cex size of label text -##' @return Generate something akin to a rose plot in which the width and -##' length of each petal are directly specified by the user. Or to put it -##' differently, this is somewhat like a pie chart in which the radius of each -##' wedge is allowed to vary (along with the angular width, as pie charts do). -##' As an additional enhancement, one can specify a central disk of arbitrary -##' radius (from 0 to 1, assuming that the plot itself is scaled to the unit -##' circle), in which case the petal heights are always measured from the edge -##' of the disk rather than the center of the circle; if desired, text can be -##' added in the center. -##' -##' Although this kind of plot may already be well known in some circles (no -##' pun intended), I haven't seen it clearly defined or labeled anywhere, so -##' I'm anointing it an 'aster' plot because its component parts are -##' reminiscent of composite flower morphology. -##' -##' The 'lengths' dictates how far out each petal extends, 'widths' dictates -##' the (angular) width of each petal, and 'disk' gives the relative radius of -##' a central donut hole. If no widths are provided, all petals will have equal -##' widths. Additional function arguments can also control whether petals are -##' labeled, whether the petal lengths are rescaled to the maximum score or to -##' a user-input score, whether spokes delineating each petal are extended to -##' an outer circle, and more. I also wrote a quick convenience wrapper for -##' creating a legend plot. -##' -##' Note that the function here is a repurposed and very heavily modified -##' version of the windrose() function contained in the 'circular' package, -##' although sufficiently rewritten so as not to depend on any functionality in -##' that package. -##' @keywords layers_navigation -##' @author Created by Jim Regetz. Slight modifications by Darren Hardy and Ben Best. -##' @examples -##' -##' \dontrun{ -##' # generate some fake data -##' set.seed(1) -##' scores <- sample(1:10) -##' weights <- sample(1:10) -##' labels <- paste(LETTERS[1:10], "X", sep="") -##' -##' # do some plots -##' par(mfrow=c(2,2), xpd=NA) -##' aster(lengths=scores, widths=weights, disk=0, main="Example 1", -##' plot.outline=FALSE) -##' aster(lengths=scores, widths=weights, labels=labels, main="Example 2", -##' lty=2, fill.col="gray", plot.outline=FALSE) -##' aster.legend(labels=labels, widths=weights) -##' aster(lengths=scores, widths=weights, disk=0.5, main="Example 3", -##' center="Hello world") -##' } -##' @import ggplot2 -##' @export -PlotFlower = function (lengths, widths, labels, disk=0.5, max.length, - center=NULL, main=NULL, fill.col=NULL, plot.outline=TRUE, - label.offset=0.15, xlim=c(-1.2, 1.2), ylim=c(-1.2, 1.2), uin=NULL, - tol=0.04, cex=1, bty="n", lty=1, - label.col='black', label.font=3, label.cex=NULL, ...) { +#' Flower plots for OHI scores +#' By Casey O'Hara, Julia Lowndes, Melanie Frazier github.com/ohi-science +#' Assumes the following is present: +#' +#' * A csv file of scores (typically, scores.csv) generated by the calculate_score.R script. +#' * An updated conf/goals.csv file. This file provides a list of goals/subgoals and the +#' goal/subgoal names used for plotting +#' * Optional: A data layer called layers/fp_wildcaught_weight.csv that is used to weight +#' the contribution of the fisheries and mariculture subgoals to the food provision goal; this +#' information determines the relative width of these two subgoals in the flowerplot; +#' if not available, these subgoals will have equal widths. +#' +#' @param region_plot region_id/s to plot (i.e., region_plot = c(1,4,8)), defaults to plotting all regions plus the +#' weighted average of all regions +#' @param year_plot scenario year to plot if there are multiple scenario years in +#' scores.csv; if not provided, defaults to most recent year +#' @param assessment_name this is the name that will be given to the weighted +#' average of all regions (i.e., region_id=0, usually something like: "Global Average") +#' @scenario_folder name of the scenario folder within the repository +#' (this is the folder with scores.csv, conf and layers folders, etc.) +#' @scores_file name of the file with the score data used to create the flower plots, +#' typically: "scores.csv" +#' @dir_fig_save file path to the location the figures (and related csv file) will be +#' saved +#' @save whether to save csv and png files (otherwise figures are only displayed) +#' +#' @return png file/s of flowerplots will be saved in the dir_fig_save location; an +#' additional regions_figs.csv file will be saved that describes region_id, region_name, +#' and file paths to flower_.png files. +#' @export +#' +#' @examples +#' +#' + +PlotFlower <- function(region_plot = NA, + year_plot = NA, + assessment_name = "Average", + scenario_folder = "eez", + scores_file = "scores.csv", + dir_fig_save = file.path(scenario_folder, "reports/figures"), + legend_include = TRUE, + save = TRUE) { - # Custom R function to generate something akin to a rose plot in which - # the width and length of each petal are directly specified by the user. - # Or to put it differently, this is somewhat like a pie chart in which - # the radius of each wedge is allowed to vary (along with the angular - # width, as pie charts do). As an additional enhancement, one can - # specify a central disk of arbitrary radius (from 0 to 1, assuming that - # the plot itself is scaled to the unit circle), in which case the petal - # heights are always measured from the edge of the disk rather than the - # center of the circle; if desired, text can be added in the center. - # - # Although this kind of plot may already be well known in some circles - # (no pun intended), I haven't seen it clearly defined or labeled - # anywhere, so I'm anointing it an 'aster' plot because its component - # parts are reminiscent of composite flower morphology. - # - # As coded below, 'lengths' dictates how far out each petal extends, - # 'widths' dictates the (angular) width of each petal, and 'disk' gives - # the relative radius of a central donut hole. If no widths are - # provided, all petals will have equal widths. Additional function - # arguments can also control whether petals are labeled, whether the - # petal lengths are rescaled to the maximum score or to a user-input - # score, whether spokes delineating each petal are extended to an outer - # circle, and more. I also wrote a quick convenience wrapper for - # creating a legend plot. - # - # Note that the function here is a repurposed and very heavily modified - # version of the windrose() function contained in the 'circular' - # package, although sufficiently rewritten so as not to depend on any - # functionality in that package. - # - # Example invocations appear below. - # - # Jim Regetz - # NCEAS - # Created on 13-Sept-2011 - # - # Mods by Ben Best and Darren Hardy - # December 2011 - # - fix blank hairlines between circles and polygons in pedals - # - accepts more labeling and title options - # - accepts data frames for lengths - # - # Example plots... - # - # # generate some fake data - # set.seed(1) - # scores <- sample(1:10) - # weights <- sample(1:10) - # labels <- paste(LETTERS[1:10], "X", sep="") - # - # # do some plots - # png(file="aster-plots.png", height=600, width=600) - # par(mfrow=c(2,2), xpd=NA) - # aster(lengths=scores, widths=weights, disk=0, main="Example 1", - # plot.outline=FALSE) - # aster(lengths=scores, widths=weights, labels=labels, main="Example 2", - # lty=2, fill.col="gray", plot.outline=FALSE) - # aster.legend(labels=labels, widths=weights) - # aster(lengths=scores, widths=weights, disk=0.5, main="Example 3", - # center="Hello world") - # dev.off() - # main aster function definition + # dir_fig_save = 'global2018/figures/flowerplots' + ## scores data ---- + scores <- read.csv(here::here(scenario_folder, scores_file), stringsAsFactors = FALSE) - if (is.data.frame(lengths)) { - lengths <- as.numeric(lengths) + ## if there is no year variable in the data, the current year is assigned + if(sum(names(scores) == "year") == 0){ + scores$year <- substring(date(), 21, 24) } - n.petals <- length(lengths) - if (missing(widths)) { - widths <- rep(1, n.petals) - } - if (missing(max.length)) { - max.length <- max(lengths) - } - if (missing(labels)) { - labels <- names(lengths) - } - if (missing(label.cex)) { - label.cex <- 0.7 * cex - } - # determine radius of each petal - if (disk < 0 || 1 < disk) { - stop("disk radius must be between 0 and 1") + ## if there are multiple years in the dataset and no year_plot argument, + ## the most recent year of data is selected + if(is.na(year_plot)){ + scores <- scores %>% + dplyr::filter(year == max(year)) + } else { + scores <- scores %>% + dplyr::filter(year == year_plot) } - radii <- disk + (1-disk) * lengths/max.length - # define inner function for drawing circles - # (from original windrose function) - circles <- function(rad, sector=c(0, 2 * pi), lty=2, - col="white", border=NA, fill=FALSE) { - values <- seq(sector[1], sector[2], by=(sector[2] - sector[1])/360) - x <- rad * cos(values) - y <- rad * sin(values) - if (fill) { - polygon(x, y, xpd=FALSE, lty=lty, col=col, border=border) - } - lines(x, y, col=1, lty=lty) + ## filters the region of interest, otherwise all regions are printed + if ( !any(is.na(region_plot)) ){ + scores <- scores %>% + dplyr::filter(region_id %in% region_plot) } - # lots of low-level positional details - # (from original windrose function) - op <- par(mar=c(1, 1, 2, 1)) - mai <- par("mai") - on.exit(par(op)) - midx <- 0.5 * (xlim[2] + xlim[1]) - xlim <- midx + (1 + tol) * 0.5 * c(-1, 1) * (xlim[2] - xlim[1]) - midy <- 0.5 * (ylim[2] + ylim[1]) - ylim <- midy + (1 + tol) * 0.5 * c(-1, 1) * (ylim[2] - ylim[1]) - oldpin <- par("pin") - c(mai[2] + mai[4], mai[1] + mai[3]) - xuin <- oxuin <- oldpin[1]/diff(xlim) - yuin <- oyuin <- oldpin[2]/diff(ylim) - if (is.null(uin)) { - if (yuin > xuin) { - xuin <- yuin + ## filter only score dimension + scores <- scores %>% + dplyr::filter(dimension == 'score') + + ## labeling:: Index score for center labeling before join with conf + score_index <- scores %>% + dplyr::filter(goal == "Index") %>% + dplyr::select(region_id, score) %>% + dplyr::mutate(score = round(score)) + + + ## unique regions to plot + region_plots <- unique(scores$region_id) + + + ## goals.csv configuration info---- + + ## read in conf/goals.csv, start dealing with supra goals + conf <- read.csv(here::here(scenario_folder, 'conf/goals.csv'), stringsAsFactors = FALSE) + goals_supra <- na.omit(unique(conf$parent)) + supra_lookup <- conf %>% + dplyr::filter(goal %in% goals_supra) %>% + dplyr::select(parent = goal, name_supra = name) + + ## extract conf info for labeling + conf <- conf %>% + dplyr::left_join(supra_lookup, by = 'parent') %>% + dplyr::filter(!(goal %in% goals_supra)) %>% + dplyr::select(goal, order_color, order_hierarchy, + weight, name_supra, name_flower) %>% + dplyr::mutate(name_flower = gsub("\\n", "\n", name_flower, fixed = TRUE)) %>% + dplyr::arrange(order_hierarchy) + + ## join scores and conf ---- + score_df <- scores %>% + dplyr::inner_join(conf, by="goal") %>% + dplyr::arrange(order_color) + + + ## set up positions for the bar centers: + ## cumulative sum of weights (incl current) minus half the current weight + score_df <- score_df %>% + dplyr::group_by(region_id) %>% + dplyr::mutate(pos = sum(weight) - (cumsum(weight) - 0.5 * weight)) %>% + dplyr::mutate(pos_end = sum(weight)) %>% + dplyr::ungroup() %>% + dplyr::group_by(name_supra) %>% + ## calculate position of supra goals before any unequal weighting (ie for FP) + dplyr::mutate(pos_supra = ifelse(!is.na(name_supra), mean(pos), NA)) %>% + dplyr::ungroup() %>% + dplyr::filter(weight != 0) %>% + ## set up for displaying NAs + dplyr::mutate(plot_NA = ifelse(is.na(score), 100, NA)) + + + ## read if file for weights for FIS vs. MAR ---- + + w_fn <- list.files(here::here(scenario_folder, "layers"), pattern = "fp_wildcaught_weight.csv", + full.names = TRUE) + + # deal with weights + if ( length(w_fn)<1) { + message('Cannot find `layers/fp_wildcaught_weight*.csv`...plotting FIS and MAR with equal weighting\n') + w_fn = NULL + } else{ + + ## read in weights + w <- read.csv(w_fn, stringsAsFactors = FALSE) + + if(is.na(year_plot)){ + w <- w %>% + dplyr::filter(year == max(year)) %>% + dplyr::select(rgn_id, w_fis) } else { - yuin <- xuin + w <- w %>% + dplyr::filter(year == year_plot) %>% + dplyr::select(rgn_id, w_fis) } - } else { - if (length(uin) == 1) - uin <- uin * c(1, 1) - if (any(c(xuin, yuin) < uin)) - stop("uin is too large to fit plot in") - xuin <- uin[1] - yuin <- uin[2] + + + w <- rbind(w, data.frame(rgn_id = 0, w_fis = mean(w$w_fis))) %>% + dplyr::arrange(rgn_id) + + ## make sure weight regions match regions_plot regions + if ( any(!(region_plots %in% w$rgn_id)) ) { + message('`layers/fp_wildcaught_weight.csv` missing some regions...plotting FIS and MAR with equal weighting\n') + missing <- data.frame(rgn_id = setdiff(region_plots, w$rgn_id), w_fis=0.5) + w <- rbind(w, missing) %>% + dplyr::arrange(rgn_id) + } + } # end of dealing with weights + + ## create supra goal dataframe for position and labeling ---- + supra <- score_df %>% + dplyr::mutate(name_supra = ifelse(is.na(name_supra), name_flower, name_supra)) %>% + dplyr::mutate(name_supra = paste0(name_supra, "\n"), + name_supra = gsub("Coastal", "", name_supra, fixed = TRUE)) %>% + dplyr::select(name_supra, pos_supra) %>% + unique() %>% + as.data.frame() + + ## calculate arc: stackoverflow.com/questions/38207390/making-curved-text-on-coord-polar ---- + supra_df <- supra %>% + dplyr::mutate(myAng = seq(-70, 250, length.out = dim(supra)[1])) %>% + dplyr::filter(!is.na(pos_supra)) + + + ## more labeling and parameters ---- + goal_labels <- score_df %>% + dplyr::select(goal, name_flower) + + p_limits <- c(0, score_df$pos_end[1]) + blank_circle_rad <- 42 + light_line <- 'grey90' + white_fill <- 'white' + light_fill <- 'grey80' + med_line <- 'grey50' + med_fill <- 'grey52' + dark_line <- 'grey20' + dark_fill <- 'grey22' + + + ## Mel's color palette ---- + reds <- grDevices::colorRampPalette( + c("#A50026", "#D73027", "#F46D43", "#FDAE61", "#FEE090"), + space="Lab")(65) + blues <- grDevices::colorRampPalette( + c("#E0F3F8", "#ABD9E9", "#74ADD1", "#4575B4", "#313695"))(35) + myPalette <- c(reds, blues) + + + ## filenaming for labeling and saving ---- + region_names_all <- dplyr::bind_rows( + data_frame( ## order regions to start with whole study_area + region_id = 0, + region_name = assessment_name), + read.csv(paste(scenario_folder, 'spatial/regions_list.csv', sep="/"), stringsAsFactors = FALSE) %>% + dplyr::select(region_id = rgn_id, + region_name = rgn_name)) %>% + dplyr::mutate(flower_png = sprintf('%s/flower_%s.png', + here::here(dir_fig_save), + stringr::str_replace_all(region_name, ' ', ''))) + ## write out filenames + if(save){ + write.csv(region_names_all, here::here(dir_fig_save, 'regions_figs.csv')) } - xlim <- midx + oxuin/xuin * c(-1, 1) * diff(xlim) * 0.5 - ylim <- midy + oyuin/yuin * c(-1, 1) * diff(ylim) * 0.5 - # generate breaks (petal boundaries) based on the widths - breaks <- (2*pi*c(0, cumsum(widths))/sum(widths))[-(n.petals+1)] - breaks <- c(breaks, 2 * pi) - plot(c(-1.2, 1.2), c(-1.2, 1.2), xlab="", ylab="", main="", - xaxt="n", yaxt="n", pch=" ", xlim=xlim, ylim=ylim, - bty=bty, ...) - title(main=main, ...) + ## move into for loop only with region_names to plot + region_names <- region_names_all %>% + dplyr::filter(region_id %in% region_plots) %>% ## filter only regions to plot + dplyr::distinct() ## in case region_id 0 was included in regions_list.csv - # plot full petal outlines - if (plot.outline) { - # note: go to n.petals not n.breaks because we the last break is - # the same as the first - for (i in 1:n.petals) { - lines(c(0, cos(breaks[i])), c(0, sin(breaks[i])), lty=lty) + + ## loop through to save flower plot for each region ---- + for (region in region_plots) { # region =82 + + ## filter region info, setup to plot ---- + plot_df <- score_df %>% + dplyr::filter(region_id == region) + plot_score_index <- score_index %>% + dplyr::filter(region_id == region) + + ## fig_name to save + fig_save <- region_names$flower_png[region_names$region_id == region] + + ## labeling:: region name for title + region_name <- region_names %>% + dplyr::filter(region_id == region) %>% + dplyr::select(region_name) + + + ## inject weights for FIS vs. MAR ---- + if ( length(w_fn) > 0 ) { + ## inject FIS/MAR weights + plot_df$weight[plot_df$goal == "FIS"] <- w$w_fis[w$rgn_id == region] + plot_df$weight[plot_df$goal == "MAR"] <- 1 - w$w_fis[w$rgn_id == region] + + ## recalculate pos with injected weights arrange by pos for proper ordering + plot_df <- plot_df %>% + dplyr::mutate(pos = sum(weight) - (cumsum(weight) - 0.5 * weight)) %>% + dplyr::arrange(pos) } - circles(1, lty=lty) - } - # plot the petals themselves - if (is.null(fill.col)) { - fill.col <- rainbow(n.petals) - } - fill.col <- rep(fill.col, length.out=n.petals) - for (i in 1:n.petals) { - w1 <- breaks[i] - w2 <- breaks[i + 1] - rad <- radii[i] - xx <- rad * c(0, cos(w1), cos(w2), 0) - yy <- rad * c(0, sin(w1), sin(w2), 0) - polygon(xx, yy, xpd=FALSE, col=fill.col[i], border=fill.col[i]) - lines(xx[1:2], yy[1:2]) - lines(xx[3:4], yy[3:4]) - circles(rad=rad, sector=c(w1, w2), fill=TRUE, - lty=1, col=fill.col[i], border=fill.col[i]) - } - # plot petal labels, if given - if (!is.null(labels)) { - if (plot.outline) { - height <- label.offset + rep(1, n.petals) - } else { - height <- label.offset + radii + + + ## set up basic plot parameters ---- + plot_obj <- ggplot2::ggplot(data = plot_df, + ggplot2::aes(x = pos, y = score, fill = score, width = weight)) + + ## sets up the background/borders to the external boundary (100%) of plot + plot_obj <- plot_obj + + ggplot2::geom_bar(ggplot2::aes(y = 100), + stat = 'identity', color = light_line, fill = white_fill, size = .2) + + ggplot2::geom_errorbar(ggplot2::aes(x = pos, ymin = 100, ymax = 100, width = weight), + size = 0.5, color = light_line, show.legend = NA) + + ## lays any NA bars on top of background, with darker grey: + if(any(!is.na(plot_df$plot_NA))) { + plot_obj <- plot_obj + + ggplot2::geom_bar(ggplot2::aes(x = pos, y = plot_NA), + stat = 'identity', color = light_line, fill = light_fill, size = .2) } - mids <- breaks[1:n.petals] + diff(breaks)/2 - for (i in 1:n.petals) { - text(height[i] * cos(mids[i]), height[i] * sin(mids[i]), - labels=labels[i], cex=label.cex, - font=label.font, col=label.col) + + ## establish the basics of the flower plot + plot_obj <- plot_obj + + ## plot the actual scores on top of background/borders: + ggplot2::geom_bar(stat = 'identity', color = dark_line, size = .2) + + ## emphasize edge of petal + ggplot2::geom_errorbar(ggplot2::aes(x = pos, ymin = score, ymax = score), + size = 0.5, color = dark_line, show.legend = NA) + + ## plot zero as a baseline: + ggplot2::geom_errorbar(ggplot2::aes(x = pos, ymin = 0, ymax = 0), + size = 0.5, color = dark_line, show.legend = NA) + + ## turn linear bar chart into polar coordinates start at 90 degrees (pi*.5) + ggplot2::coord_polar(start = pi * 0.5) + + ## set petal colors to the red-yellow-blue color scale: + ggplot2::scale_fill_gradientn(colours=myPalette, na.value="black", + limits = c(0, 100)) + + ## use weights to assign widths to petals: + ggplot2::scale_x_continuous(labels = plot_df$goal, breaks = plot_df$pos, limits = p_limits) + + ggplot2::scale_y_continuous(limits = c(-blank_circle_rad, + ifelse(first(goal_labels == TRUE) | + is.data.frame(goal_labels), + 150, 100))) + + + ## add center number and title + plot_obj <- plot_obj + + ggplot2::geom_text(data = score_index, + inherit.aes = FALSE, + ggplot2::aes(label = plot_score_index$score), + x = 0, y = -blank_circle_rad, + hjust = .5, vjust = .5, + size = 12, + color = dark_line) + + ggplot2::labs(title = stringr::str_replace_all(region_name, '-', ' - ')) + + + ### clean up the theme + plot_obj <- plot_obj + + ggtheme_plot() + + ggplot2::theme(panel.grid.major = ggplot2::element_blank(), + axis.line = ggplot2::element_blank(), + axis.text = ggplot2::element_blank(), + axis.title = ggplot2::element_blank()) + + ## add goal names + plot_obj <- plot_obj + + ggplot2::geom_text(ggplot2::aes(label = name_flower, x = pos, y = 120), + hjust = .5, vjust = .5, + size = 3, + color = dark_line) + + + ## position supra arc and names. x is angle, y is distance from center + supra_rad <- 145 ## supra goal radius from center + + plot_obj <- plot_obj + + ## add supragoal arcs + ggplot2::geom_errorbar(data = supra_df, inherit.aes = FALSE, + ggplot2::aes(x = pos_supra, ymin = supra_rad, ymax = supra_rad), + size = 0.25, show.legend = NA) + + ggplot2::geom_text(data = supra_df, inherit.aes = FALSE, + ggplot2::aes(label = name_supra, x = pos_supra, y = supra_rad, angle = myAng), + hjust = .5, vjust = .5, + size = 3, + color = dark_line) + + # exclude legend if argument is legend=FALSE + if(!legend_include){ + plot_obj <- plot_obj + + ggplot2::theme(legend.position="none") } + + ### display/save options: print to graphics, save to file + suppressWarnings(print(plot_obj)) + + ## save plot + if(save){ + suppressWarnings( + ggplot2::ggsave(filename = fig_save, + plot = plot_obj, + device = "png", + height = 6, width = 8, units = 'in', dpi = 300) + ) + } + + ### ...then return the plot object for further use + # return(invisible(plot_obj)) ## can't return with this for loop } - - # add disk, if desired, with optional text in the middle - if (0 < disk) { - circles(disk, fill=TRUE, lty=1) - } - if (!is.null(center)) { - text(0, 0, labels=center, font=2, cex=2.2*cex) - } - invisible(NULL) +} + +## ggtheme_plot ---- + +ggtheme_plot <- function(base_size = 9) { + ggplot2::theme(axis.ticks = ggplot2::element_blank(), + text = ggplot2::element_text(family = 'Helvetica', color = 'gray30', size = base_size), + plot.title = ggplot2::element_text(size = ggplot2::rel(1.25), hjust = 0, face = 'bold'), + panel.background = ggplot2::element_blank(), + legend.position = 'right', + panel.border = ggplot2::element_blank(), + panel.grid.minor = ggplot2::element_blank(), + panel.grid.major = ggplot2::element_line(colour = 'grey90', size = .25), + # panel.grid.major = element_blank(), + legend.key = ggplot2::element_rect(colour = NA, fill = NA), + axis.line = ggplot2::element_blank()) # element_line(colour = "grey30", size = .5)) } \ No newline at end of file From 32b8eaea1089dcd73acab2dc264f8b8b5752e649 Mon Sep 17 00:00:00 2001 From: Melsteroni Date: Tue, 18 Sep 2018 13:47:09 -0700 Subject: [PATCH 3/4] For some reason the changes I made to score_check.R were overwritten by another push??!! --- R/score_check.R | 41 +++++++++++++++++++++-------------------- 1 file changed, 21 insertions(+), 20 deletions(-) diff --git a/R/score_check.R b/R/score_check.R index cca45ad..cec6bda 100644 --- a/R/score_check.R +++ b/R/score_check.R @@ -38,7 +38,7 @@ score_check = function(scenario_year, commit="previous", # get commit SHA if(commit=="previous"){ - commit2 = substring(git2r::commits(git2r::repository(repo_path))[[1]]@sha, 1, 7) + commit2 = substring(git2r::commits(git2r::repository(repo_path))[[1]][1], 1, 7) } else{ if (commit == "final_2014"){ commit2 = '4da6b4a' @@ -86,15 +86,16 @@ score_check = function(scenario_year, commit="previous", } suppressWarnings( - p <- ggplot2::ggplot(filter(data_new, year==scenario_year), aes(x=goal, y=change, color=dimension)) + + p <- ggplot2::ggplot(filter(data_new, year==scenario_year), ggplot2::aes(x=goal, y=change, color=dimension)) + #geom_point(shape=19, size=1) + - theme_bw() + - theme(axis.text.x = element_text(angle = 90, hjust = 1)) + - labs(title=paste("Score compared to commit:", commit, sep=" "), y="Change in score", x="") + - scale_x_discrete(limits = c("Index", "AO", "SPP", "BD", "HAB", "CP", "CS", "CW", "FIS", "FP", - "MAR", "ECO", "LE", "LIV", "NP", "LSP", "SP", "ICO", "TR")) + - scale_colour_brewer(palette="Dark2") + - geom_jitter(aes(text=paste0("rgn = ", region_id, "\n", rgn_name)), position = position_jitter(width=0.2, height=0), shape=19, size=1) + ggplot2::theme_bw() + + ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, hjust = 1)) + + ggplot2::labs(title=paste("Score compared to commit:", commit, sep=" "), y="Change in score", x="") + + ggplot2::scale_x_discrete(limits = c("Index", "AO", "SPP", "BD", "HAB", "CP", "CS", "CW", "FIS", "FP", + "MAR", "ECO", "LE", "LIV", "NP", "LSP", "SP", "ICO", "TR")) + + ggplot2::scale_colour_brewer(palette="Dark2") + + ggplot2::geom_jitter(ggplot2::aes(text=paste0("rgn = ", region_id, "\n", rgn_name)), + position = ggplot2::position_jitter(width=0.2, height=0), shape=19, size=1) ) plotly_fig <- plotly::ggplotly(p, width = 800, height = 450) @@ -103,7 +104,8 @@ score_check = function(scenario_year, commit="previous", # Function to save files in particular place my.file.rename <- function(from, to) { todir <- dirname(to) - if (!isTRUE(file.info(todir)$isdir)) dir.create(todir, recursive=TRUE) + if (!isTRUE(file.info(todir)$isdir)) + dir.create(todir, recursive=TRUE) file.rename(from = from, to = to) } @@ -124,14 +126,14 @@ score_check = function(scenario_year, commit="previous", if(NA_compare){ data_NA <- data_new %>% - filter(year == scenario_year) %>% - mutate(NA_same = ifelse(is.na(score) & is.na(old_score), 1, 0)) %>% - mutate(NA_new = ifelse(is.na(score), 1, 0)) %>% - mutate(NA_old = ifelse(is.na(old_score), 1, 0)) %>% - mutate(diff_new = NA_new - NA_same) %>% - mutate(diff_old = NA_old - NA_same) %>% - summarize(new = sum(diff_new), - old = sum(diff_old)) + dplyr::filter(year == scenario_year) %>% + dplyr::mutate(NA_same = ifelse(is.na(score) & is.na(old_score), 1, 0)) %>% + dplyr::mutate(NA_new = ifelse(is.na(score), 1, 0)) %>% + dplyr::mutate(NA_old = ifelse(is.na(old_score), 1, 0)) %>% + dplyr::mutate(diff_new = NA_new - NA_same) %>% + dplyr::mutate(diff_old = NA_old - NA_same) %>% + dplyr::summarize(new = sum(diff_new), + old = sum(diff_old)) cat("\n NA check results: \n") @@ -145,5 +147,4 @@ score_check = function(scenario_year, commit="previous", } } -} - +} \ No newline at end of file From 3fe94cf35206d5bb98641b28d1aa4321ff774c66 Mon Sep 17 00:00:00 2001 From: Melsteroni Date: Wed, 19 Sep 2018 09:06:46 -0700 Subject: [PATCH 4/4] adding na rm to CalculateTrend function --- R/CalculateTrend.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/CalculateTrend.R b/R/CalculateTrend.R index d822573..17c510b 100644 --- a/R/CalculateTrend.R +++ b/R/CalculateTrend.R @@ -32,6 +32,7 @@ CalculateTrend <- function(status_data, trend_years=trend_years){ status_data <- status_data %>% dplyr::select(region_id, year, status) %>% dplyr::filter(year %in% trend_years) %>% + dplyr::filter(!is.na(status)) %>% unique() adj_trend_year <- min(trend_years)