R/plot.decon.R

#' Default S3 plot method for decon objects (derived from `deconvolve()`)
#'
#' This function sets up the default plotting method
#' for outputs from deconvolve function
#'
#' @param x decon object as generated by deconvolve
#' @param bw logical argument indicating whether the plot
#' should be in black and white or colour
#' @param ... other options passed to plot
#' @return plot
#' @method plot decon
#' @importFrom graphics legend lines par plot
#'
#' @export

plot.decon <- function (x, bw = TRUE, ...) {

  temp <- seq(x$temp_bounds[1], x$temp_bounds[2], length.out = nrow(x$data))
  data <- x$data
  fit <- x$model_fit

  params <- as.data.frame(summary(fit)$coefficients[,1])

  par(mar = c(5, 5, 1, 1))
  plot(data$temp_C, data$deriv, xlab = 'Temperature (C)',
       ylab = expression(paste('Rate of mass loss (-dm/dT) (C'^'-1', ')')),
       yaxs = 'i', ylim = c(0, max(data$deriv) + 0.06*max(data$deriv)),
       pch = 20, cex = 0.5, cex.axis = 1.2, cex.lab = 1.5)

  if (isTRUE(bw)) {

    if (x$n_peaks == 4) {
      y1 <- fs_mixture(temp = temp,
                       height_1 = params['height_1',],
                       skew_1 = params['skew_1',],
                       position_1 = params['position_1',],
                       width_1 = params['width_1',],
                       height_2 = params['height_2',],
                       skew_2 = params['skew_2',],
                       position_2 = params['position_2',],
                       width_2 = params['width_2',],
                       height_3 = params['height_3',],
                       skew_3 = params['skew_3',],
                       position_3 = params['position_3',],
                       width_3 = params['width_3',],
                       height_0 = params['height_0',],
                       skew_0 = params['skew_0',],
                       position_0 = params['position_0',],
                       width_0 = params['width_0',])

      y5 <- fs_function(temp,
                        params['height_0',], params['skew_0',],
                        params['position_0',], params['width_0',])
      lines(temp, y5, lty = 5, lwd = 2)

      legend('topright',
             legend = c('DTG data', 'DTG modelled',
                        'Hemicellulose 1', 'Hemicellulose 2',
                        'Cellulose', 'Lignin'),
             ncol = 1,
             cex = 1.2,
             bty = 'n',
             lty = c(NA, 1, 6, 3, 4, 5),
             pch = c(20, NA, NA, NA, NA, NA),
             lwd = 2)

    }

    if (x$n_peaks == 3) {

      y1 <- fs_mixture(temp = temp,
                       height_1 = params['height_1',],
                       skew_1 = params['skew_1',],
                       position_1 = params['position_1',],
                       width_1 = params['width_1',],
                       height_2 = params['height_2',],
                       skew_2 = params['skew_2',],
                       position_2 = params['position_2',],
                       width_2 = params['width_2',],
                       height_3 = params['height_3',],
                       skew_3 = params['skew_3',],
                       position_3 = params['position_3',],
                       width_3 = params['width_3',])

      legend('topright',
             legend = c('DTG data', 'DTG modelled',
                        'Hemicellulose', 'Cellulose', 'Lignin'),
             ncol = 1,
             cex = 1.2,
             bty = 'n',
             lty = c(NA, 1, 3, 4, 5),
             pch = c(20, NA, NA, NA, NA),
             lwd = 2)

    }

    y2 <- fs_function(temp,
                      params['height_1',], params['skew_1',],
                      params['position_1',], params['width_1',])
    y3 <- fs_function(temp,
                      params['height_2',], params['skew_2',],
                      params['position_2',], params['width_2',])
    y4 <- fs_function(temp,
                      params['height_3',], params['skew_3',],
                      params['position_3',], params['width_3',])

    lines(temp, y1, lty = 1, lwd = 1.7)
    lines(temp, y2, lty = 3, lwd = 2)
    lines(temp, y3, lty = 4, lwd = 2)
    lines(temp, y4, lty = 5, lwd = 2)

  }

  if(!isTRUE(bw)) {

    if (x$n_peaks == 4) {
      y1 <- fs_mixture(temp = temp,
                       height_1 = params['height_1',],
                       skew_1 = params['skew_1',],
                       position_1 = params['position_1',],
                       width_1 = params['width_1',],
                       height_2 = params['height_2',],
                       skew_2 = params['skew_2',],
                       position_2 = params['position_2',],
                       width_2 = params['width_2',],
                       height_3 = params['height_3',],
                       skew_3 = params['skew_3',],
                       position_3 = params['position_3',],
                       width_3 = params['width_3',],
                       height_0 = params['height_0',],
                       skew_0 = params['skew_0',],
                       position_0 = params['position_0',],
                       width_0 = params['width_0',])

      y5 <- fs_function(temp,
                        params['height_0',], params['skew_0',],
                        params['position_0',], params['width_0',])

      lines(temp, y5, lty = 6, lwd = 2.5, col = '#33638DFF')

      legend('topright',
             legend = c('DTG data', 'DTG modelled',
                        'Hemicellulose 1', 'Hemicellulose 2',
                        'Cellulose', 'Lignin'),
             ncol = 1,
             cex = 1.2,
             bty = 'n',
             lty = c(NA, 1, 6, 3, 4, 5),
             pch = c(20, NA, NA, NA, NA, NA),
             col = c('black', 'black', '#33638DFF',
                     '#440154FF', '#B8DE29FF', '#3CBB75FF'),
             lwd = 2)

    }

    if (x$n_peaks == 3) {

      y1 <- fs_mixture(temp = temp,
                       height_1 = params['height_1',],
                       skew_1 = params['skew_1',],
                       position_1 = params['position_1',],
                       width_1 = params['width_1',],
                       height_2 = params['height_2',],
                       skew_2 = params['skew_2',],
                       position_2 = params['position_2',],
                       width_2 = params['width_2',],
                       height_3 = params['height_3',],
                       skew_3 = params['skew_3',],
                       position_3 = params['position_3',],
                       width_3 = params['width_3',])

      legend('topright',
             legend = c('DTG data', 'DTG modelled',
                        'Hemicellulose', 'Cellulose', 'Lignin'),
             ncol = 1,
             cex = 1.2,
             bty = 'n',
             lty = c(NA, 1, 3, 4, 5),
             pch = c(20, NA, NA, NA, NA),
             col = c('black', 'black', '#440154FF',
                     '#B8DE29FF', '#3CBB75FF'),
             lwd = 2)

    }

    y2 <- fs_function(temp,
                      params['height_1',], params['skew_1',],
                      params['position_1',], params['width_1',])
    y3 <- fs_function(temp,
                      params['height_2',], params['skew_2',],
                      params['position_2',], params['width_2',])
    y4 <- fs_function(temp,
                      params['height_3',], params['skew_3',],
                      params['position_3',], params['width_3',])

    lines(temp, y1, lty = 1, lwd = 2)
    lines(temp, y2, lty = 3, lwd = 3.5, col = '#440154FF')
    lines(temp, y3, lty = 4, lwd = 3.5, col = '#B8DE29FF')
    lines(temp, y4, lty = 5, lwd = 3.5, col = '#3CBB75FF')

  }

}
smwindecker/deconvolve documentation built on Sept. 20, 2023, 1:49 a.m.