R/mdfrq.R

In ppcadelina/bucs: Bakawans Under Constrained Survey (BUCS) package

#' Size frequency table and visualization
#'
#' Creates a frequency table based on the given ranges for diameters at breast height
#' Also outputs a histogram plot for visualization
#'
#'
#'
#'
#' @param data Data frame containing at least the spatial level of grouping and diameters at breast height (DBH)
#' @param cluster  String to categorize at which spatial level of grouping the data analysis
#' @param breaks A list of breaks to be used in grouping the dbh sizes. Default is at: 5-15,15-30, and 30-max
#'
#' @return Outputs should include:
#' 1. '[cluster].freq', a data frame for dbh frequency table for the chosen cluster
#' 2. '[cluster].frqplot', a simple histogram showing the frequency of trees fallingunder the given ranges of tree diameter
#'
#' @keywords size frequency, dbh frequency, histogram
#'
#'
#'
#'
#' @export

mdfrq<- function(data = data,
                  cluster = cluster,
                  breaks=c(5,15,30)){

  # Set variables
  x = data
  clustlvl = cluster
  breaks = breaks

  # Rearranges the list by increasing order
  breaks<- breaks[order(breaks)]

  # Create a blank list for ranges
  ranges<- list()

  # Reads the supplied breaks to create the range
  for(listing in 1:(length(breaks))){
    if(listing == length(breaks)){
      ranges[[listing]] <- paste(">",floor(breaks[listing]), sep = "")
    } else{
      ranges[[listing]] <- paste(ceiling(breaks[listing]),floor(breaks[listing+1]), sep = "-")
    }
  }

  # Always add the maximum value
  breaks[length(breaks)+1]<- max(x$DBH)

  # Make a for-loop in case the clustlvl supplied was more than one
  for (i in 1:length(clustlvl)) {

    ### PART 1 ###

    ## Creates an empty data frame to catch all subgroups
    m.frq<- data.frame()

    ## Redeclaring a variable for the loop
    subclust<- unique(x[[clustlvl[i]]])

    ## Make a sub for-loop for frequency table
    for(j in 1:length(subclust)){

      ### Subset the data frame based on the chosen subgroup
      sfd<- subset(x, x[[clustlvl[i]]]==subclust[j])

      ### Splits values of dbh based on supplied breaks
      dbh.cut = cut(sfd$DBH, breaks, left=FALSE)

      ### Prepares the frequency table
      dbh.frq = as.data.frame(table(dbh.cut))

      ### Makes a column for the subcluster
      dbh.frq$subclust<- subclust[j]

      ### Combines the data frames within the loop
      m.frq<- rbind(m.frq, dbh.frq)
    }

    ## Renames the columns
    colnames(m.frq)<- c("cuts", "value", "subclust")

    ## Configures the data frame into wide format
    frq.spread<- reshape::cast(m.frq, cuts ~subclust)

    ## Renames data frame and outputs it back to the global environment
    assign(paste(tolower(clustlvl[i]), "freq", sep="."), frq.spread,
           pos = .GlobalEnv)

    ### End of Part 1 ####

    ### Part 2: plotting ###
    {
        ### Adds a ceiling variable for aesthetics of maximum value
       ceil<- ceiling(max(m.frq$value)/10)*10

       ### GGPLOT
       frqplot<-
         ggplot2::ggplot(data=m.frq, ggplot2::aes(x=cuts, y=value, fill=subclust))+
         ggplot2::geom_bar(stat='identity', width = 1, color='black') +
         ggplot2::theme_classic() +
         ggplot2::scale_y_continuous(limits=c(0,ceil+20),expand = c(0, 0)) +
         ggplot2::scale_x_discrete(labels=ranges) +
         ggplot2::labs(x="DBH (cm)", y="Frequency", fill=clustlvl[i]) +
         ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5),
                        axis.text.x = ggplot2::element_text(size=12),
                        axis.text.y = ggplot2::element_text(size=12),
                        legend.position = "none")

        ### If there are more than element in subgroup, the plot will split
       if(length(unique(subclust)>1)){
         frqplot<- frqplot +
                    ggplot2::facet_wrap(~subclust)
         }

       ## Renames the plot and outputs it back to the global environment
       assign(paste(tolower(clustlvl[i]), "frqplot", sep="."),frqplot,
              pos = .GlobalEnv)
    }
  }
}