R/epicalc_profile.R

Defines functions epicalc_profile

Documented in epicalc_profile

#' Display Episode Calculation statistics for selected subject
#' @name epicalc_profile
#'
#' @inheritParams episode_calculation
#' @param subject String corresponding to subject id
#'
#' @return A plot displaying (1) the statistics for the episodes and (2) the episodes colored by level.
#'
#' @export
#'
#' @author Johnathan Shih, Jung Hoon Seo, Elizabeth Chun
#'
#' @seealso episode_calculation()
#'
#' @examples
#' epicalc_profile(example_data_1_subject)
#'

epicalc_profile <- function(data,lv1_hypo=70,lv2_hypo=54,lv1_hyper=180,lv2_hyper=250,
                            dur_length = 15, end_length = 15, subject = NULL,
                            dt0 = NULL, inter_gap = 45, tz = ""){

  #Clean up Global environment
  id = num_levels = NULL
  rm(list = c("id", "num_levels"))

  if (!is.null(subject)){
    data = data[data$id == subject, ]
  }

  #Checking for more than 1 subject
  ns = length(unique(data$id))
  if (ns > 1){
    subject = unique(data$id)[1]
    warning(paste("The provided data have", ns, "subjects. The plot will only be created for subject", subject))
    data = data[data$id == subject, ]
  }


  #Calling episode_calculation for data
  episodes = episode_calculation(data, lv1_hypo = lv1_hypo, lv2_hypo = lv2_hypo,
                                 lv1_hyper = lv1_hyper, lv2_hyper = lv2_hyper,
                                 return_data = TRUE, dur_length = dur_length,
                                 end_length = end_length, dt0 = dt0, inter_gap = inter_gap, tz = tz)

  ep_summary = episodes[[1]]
  ep_data = episodes[[2]]

  #Creating table 1(t1) -------------------------------------
  tableStat = data.frame("Hypoglycemia/Hyperglycemia episode metrics")
  tableStat[1, 1] = ""
  tableStat[1, 2] = "Hypoglycemia"
  tableStat[1, 3] = "Hypoglycemia"
  tableStat[1, 4] = "Hypoglycemia"
  tableStat[1, 5] = "Hyperglycemia"
  tableStat[1, 6] = "Hyperglycemia"
  tableStat[1, 7] = "Hypoglycemia"
  tableStat[1, 8] = "Hyperglycemia"

  tableStat[2, 1] = ""
  tableStat[2, 2] = "Level 1"
  tableStat[2, 3] = "Level 2"
  tableStat[2, 4] = "Extended"
  tableStat[2, 5] = "Level 1"
  tableStat[2, 6] = "Level 2"
  tableStat[2, 7] = "Level 1 excl"
  tableStat[2, 8] = "Level 1 excl"

  tableStat[3, 1] = "Thresholds"
  tableStat[3, 2] = paste0("<", as.character(lv1_hypo), " mg/dL")
  tableStat[3, 3] = paste0("<", as.character(lv2_hypo), " mg/dL")
  tableStat[3, 4] = paste0("<", as.character(lv1_hypo), " mg/dL")
  tableStat[3, 5] = paste0(">", as.character(lv1_hyper), " mg/dL")
  tableStat[3, 6] = paste0(">", as.character(lv2_hyper), " mg/dL")
  tableStat[3, 7] = paste0(as.character(lv1_hypo), "-", as.character(lv2_hypo), " mg/dL")
  tableStat[3, 8] = paste0(as.character(lv1_hyper), "-", as.character(lv2_hyper), " mg/dL")

  tableStat[4, 1] = "Avg Episodes/Day"
  tableStat[4, 2] = as.character(format(round(ep_summary$avg_ep_per_day[1], 2), nsmall = 2))
  tableStat[4, 3] = as.character(format(round(ep_summary$avg_ep_per_day[2], 2), nsmall = 2))
  tableStat[4, 4] = as.character(format(round(ep_summary$avg_ep_per_day[3], 2), nsmall = 2))
  tableStat[4, 5] = as.character(format(round(ep_summary$avg_ep_per_day[4], 2), nsmall = 2))
  tableStat[4, 6] = as.character(format(round(ep_summary$avg_ep_per_day[5], 2), nsmall = 2))
  tableStat[4, 7] = as.character(format(round(ep_summary$avg_ep_per_day[6], 2), nsmall = 2))
  tableStat[4, 8] = as.character(format(round(ep_summary$avg_ep_per_day[7], 2), nsmall = 2))

  tableStat[5, 1] = "Mean duration"
  tableStat[5, 2] = paste0(as.character(format(round(ep_summary$avg_ep_duration[1], 2), nsmall = 2)), " min")
  tableStat[5, 3] = paste0(as.character(format(round(ep_summary$avg_ep_duration[2], 2), nsmall = 2)), " min")
  tableStat[5, 4] = paste0(as.character(format(round(ep_summary$avg_ep_duration[3], 2), nsmall = 2)), " min")
  tableStat[5, 5] = paste0(as.character(format(round(ep_summary$avg_ep_duration[4], 2), nsmall = 2)), " min")
  tableStat[5, 6] = paste0(as.character(format(round(ep_summary$avg_ep_duration[5], 2), nsmall = 2)), " min")
  tableStat[5, 7] = paste0(as.character(format(round(ep_summary$avg_ep_duration[6], 2), nsmall = 2)), " min")
  tableStat[5, 8] = paste0(as.character(format(round(ep_summary$avg_ep_duration[7], 2), nsmall = 2)), " min")

  tableStat[6, 1] = "Mean glucose"
  tableStat[6, 2] = paste0(as.character(format(round(ep_summary$avg_ep_gl[1], 2), nsmall = 2)), " mg/dl")
  tableStat[6, 3] = paste0(as.character(format(round(ep_summary$avg_ep_gl[2], 2), nsmall = 2)), " mg/dl")
  tableStat[6, 4] = paste0(as.character(format(round(ep_summary$avg_ep_gl[3], 2), nsmall = 2)), " mg/dl")
  tableStat[6, 5] = paste0(as.character(format(round(ep_summary$avg_ep_gl[4], 2), nsmall = 2)), " mg/dl")
  tableStat[6, 6] = paste0(as.character(format(round(ep_summary$avg_ep_gl[5], 2), nsmall = 2)), " mg/dl")
  tableStat[6, 7] = paste0(as.character(format(round(ep_summary$avg_ep_gl[6], 2), nsmall = 2)), " mg/dl")
  tableStat[6, 8] = paste0(as.character(format(round(ep_summary$avg_ep_gl[7], 2), nsmall = 2)), " mg/dl")

  tableStat[7, 1] = "Total episodes"
  tableStat[7, 2] = paste0(as.character(format(round(ep_summary$total_episodes[1], 2), nsmall = 2)))
  tableStat[7, 3] = paste0(as.character(format(round(ep_summary$total_episodes[2], 2), nsmall = 2)))
  tableStat[7, 4] = paste0(as.character(format(round(ep_summary$total_episodes[3], 2), nsmall = 2)))
  tableStat[7, 5] = paste0(as.character(format(round(ep_summary$total_episodes[4], 2), nsmall = 2)))
  tableStat[7, 6] = paste0(as.character(format(round(ep_summary$total_episodes[5], 2), nsmall = 2)))
  tableStat[7, 7] = paste0(as.character(format(round(ep_summary$total_episodes[6], 2), nsmall = 2)))
  tableStat[7, 8] = paste0(as.character(format(round(ep_summary$total_episodes[7], 2), nsmall = 2)))

  #Styling the table
  mytheme <- gridExtra::ttheme_minimal(base_size = 10, padding = unit(c(4,2),"mm"))
  t1 <- gridExtra::tableGrob(tableStat, rows = NULL, cols = NULL, theme = mytheme )

  #Adding border(t1)
  t1 <- gtable::gtable_add_grob(t1,
                                grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 5)),
                                t = 1, b = 7, l = 1, r = 8)
  #Adding dotted separator(t1)
  separators <- replicate(ncol(t1) - 2,
                          grid::segmentsGrob(x1 = unit(0, "npc"), gp=grid::gpar(lty=2)),
                          simplify=FALSE)

  t1 <- gtable::gtable_add_grob(t1, grobs = separators,
                                t = 2, b = nrow(t1), l = seq_len(ncol(t1)-2)+2)
  padding <- unit(0.5,"line")

  #Adding title and footnote(t1)
  title <- grid::textGrob(paste0("Episode Metrics - ", data$id[1]),gp=grid::gpar(fontsize=18), x=0, hjust=0)
  footnote <- grid::textGrob(paste0("An episode is >= ", dur_length, " continuous minutes"), x=1, hjust=1,
                             gp=grid::gpar( fontface="italic", fontsize = 8))

  padding <- unit(0.5,"line")
  t1 <- gtable::gtable_add_rows(t1,
                                heights = grid::grobHeight(title) + padding,
                                pos = 0)
  t1 <- gtable::gtable_add_rows(t1,
                                heights = grid::grobHeight(footnote)+ padding)
  t1 <- gtable::gtable_add_grob(t1, list(title, footnote),
                                t=c(1, nrow(t1)), l=c(1,2),
                                r=ncol(t1))


  # Creating overall plot(p1) ---------------------------------

  # recode since lv2 is a subset of lv1
  labels = c("lv1_hypo", "lv2_hypo", "lv1_hyper", "lv2_hyper")
  plot_data = ep_data %>%
    dplyr::rowwise() %>%
    dplyr::mutate(
      num_levels = sum(c(lv1_hypo != 0, lv2_hypo != 0, lv1_hyper != 0, lv2_hyper != 0)),
      class = ifelse(
        # either no types - normal, one type - keep nonzero, subset - choose lv2
        num_levels == 0, "Normal",
        ifelse(num_levels == 1,
               labels[which(c(lv1_hypo != 0, lv2_hypo != 0, lv1_hyper != 0, lv2_hyper != 0))],
               c("lv2_hypo", "lv2_hyper")[which(c(lv2_hypo != 0, lv2_hyper != 0))])
      ),
      class = factor(class, levels = c("lv2_hypo", "lv1_hypo", "Normal", "lv1_hyper", "lv2_hyper"))
      )

  # match plot ranges colors (AGP)
  colors <- c("#8E1B1B", "#F92D00", "#48BA3C", "#F9F000", "#F9B500")
  p1 = ggplot(plot_data) +
    geom_point(aes(time, gl, color = class)) +
    scale_color_manual(values = colors, drop = FALSE,
                       labels = c("lv2_hypo", "lv1_hypo", "Normal", "lv1_hyper", "lv2_hyper")) +
    ggplot2::scale_x_datetime(name = 'Date') +
    ggplot2::scale_y_continuous(name = 'Glucose (mg/dL)')


  #adding all figures together ---------------------------

  pFinal = (

    wrap_elements(t1) + plot_layout()) / p1

  pFinal


  # }#end Function
}
irinagain/iglu documentation built on April 15, 2024, 4:20 p.m.