R/gotm_heatmap.R

In tadhg-moore/gotmtools: Tools to work with GOTM input data and also process the output data

#' Create heatmap from GOTM output
#'
#' This function runs creates an interpolated heatmap from GOTM text output. It loads in a
#' water temp file generated by GOTM. It requires the depth '_z.txt' file also
#' output from GOTM to assign the depths to each measurement.
#' The level of interpolation can be adjusted to increase the accuracy
#' of the plot.
#'
#' @param data dataframe; values loaded with load.3d
#' @param depths dataframe; depths loaded with load.depths
#' @param fixed.level logical; If the lake level is a fixed elevation
#' @param res numeric; Resolution of the approximated surface along the x/y axis. Defaults to 100
#' @param title character; Title of the graph. Defaults to 'Heatmap'
#' @param points logical; Plot points of measured temp. Defaults to FALSE
#' @param rev.y.ax logical; Reverse y axis. Defaults to FALSE
#' @param facet logical; option to plot a facet grid of the year data. Defaults to FALSE
#' @param surface logical; Plot surface level of the lake. Defaults to TRUE
#' @param ylim vector; Limits for the y-axis. Defaults to range of depths in the data
#' @param zlab character; Label for the Z axis
#' @return Plot of interpolated heatmap
#' @importFrom colorRamps matlab.like2
#' @import lubridate
#' @import ggplot2
#' @importFrom MBA mba.surf
#' @import reshape2
#' @export

gotm_heatmap <- function(data, depths, res = 100, title = 'Heatmap',
                         #contour = FALSE, ncol =2, nrow =2,
                         points = FALSE, rev.y.ax = FALSE,surface = FALSE, fixed.level = TRUE, facet = FALSE,ylim = NULL,zlab = '', ...){
  my.cols <- RColorBrewer::brewer.pal(11, 'Spectral') #Colours for temp plot
  nc = ncol(data)
  temp = as.vector(t(data[,2:nc]))
  deps = as.vector(t(depths[,2:nc]))
  if(is.null(ylim)){
    ylim = range(deps)
  }
  time = rep(data[,1],(nc-1))
  tm = time[order(time)]
  time = decimal_date(tm)
  tim = decimal_date(data[,1])
  wat = data.frame(date = tm, dep = deps,temp = temp)
  surf = data.frame(date = tim, surf.d = depths[,2])
  if(fixed.level == TRUE){
    if(facet == TRUE){
      wat$year = year(tm)
      wat$yday = yday(tm)
      p = ggplot(wat, aes(x = yday, y = dep, z = temp, fill = temp)) +
        geom_tile() +
        ggtitle(title)+
        {if(rev.y.ax == TRUE)
          scale_y_reverse()
        }+
        {if(contour == TRUE)
          geom_contour(aes(z = temp), inherit.aes = TRUE)
        }+
        scale_fill_gradientn(colours = rev(my.cols), na.value = 'gray',...) +
        facet_wrap(~year, ncol = ncol, nrow = nrow) +
        ylab('Depth (m)')+
        xlab('Time')+
        coord_cartesian(ylim = ylim)+
        labs(fill = zlab)+
        theme_bw()
      return(p)
    }else{
      p = ggplot(wat, aes(x = date, y = dep, z = temp, fill = temp)) +
        geom_tile() +
        ggtitle(title)+
        {if(rev.y.ax == TRUE)
          scale_y_reverse()
        }+
        {if(contour == TRUE)
          geom_contour(aes(z = temp), inherit.aes = TRUE)
        }+
        scale_fill_gradientn(colours = rev(my.cols), na.value = 'gray',...) +
        ylab('Depth (m)')+
        xlab('Time')+
        coord_cartesian(ylim = ylim)+
        labs(fill = zlab)+
        theme_bw()
      return(p)
    }
  }
}

# mba = mba.surf(wat, res, res)
# dimnames(mba$xyz.est$z) = list(mba$xyz.est$x, mba$xyz.est$y)
# df3 = melt(mba$xyz.est$z, varnames = c('date', 'depth'), value.name = 'temp')
#
# if(facet ==T){
#   df3$year = year(date_decimal(df3[,1]))
#   df3$dec = df3[,1]-trunc(df3[,1])
#   surf$dec = surf[,1]-trunc(surf[,1])
#   Fig =
#     ggplot(data=df3, aes(dec, depth))+
#     ggtitle(title)+
#     geom_raster(aes(fill = temp), interpolate = TRUE) +
#     {if(contour == TRUE)
#       geom_contour(aes(z = temp))
#     }+
#     {if(points == TRUE)
#       geom_point(data = wat, aes(yday, dep), colour = 'white', size =0.001)
#     }+
#     {if(rev.y.ax == TRUE)
#       scale_y_reverse()
#     }+
#     scale_fill_gradientn(colours = matlab.like2(7), ...)+
#     facet_wrap(~year, ncol = ncol, nrow = nrow) +
#     {if(surface ==T)
#       geom_line(data = surf,aes(x = dec,y= surf.d), size =1, color ='black')
#     }+
#     coord_cartesian(ylim = ylim)+
#     labs(fill = zlab)+
#     theme_bw()
#   return(Fig)
# }
# Fig =
#   ggplot(data=df3, aes(date, depth))+
#   ggtitle(title)+
#   geom_raster(aes(fill = temp), interpolate = TRUE, hjust = 0.5, vjust = 0.5) +
#   {if(contour == TRUE)
#     geom_contour(aes(z = temp))
#   }+
#   {if(points == TRUE)
#     geom_point(data = wat, aes(date, dep), colour = 'white', size =0.001)
#   }+
#   {if(rev.y.ax == TRUE)
#     scale_y_reverse()
#   }+
#   scale_fill_gradientn(colours = matlab.like2(7),...)+
#   {if(surface ==T)
#     geom_line(data = surf,aes(x = date,y= surf.d), size =1, color ='black')
#   }+
#   coord_cartesian(ylim = ylim)+
#   labs(fill = zlab)+
#   theme_bw()
# return(Fig)
# }