# Read previous scripts
# source("R/dm02_pkg.r")
# If simulated data
# NOTE: not resembling real data although same variable names
# source("R/dm03_sim_data.R")
fbc <- df_tot

# Read in data ------------------------------------------------------------

# Fits from previous script
model_fits <- model_fits_scaled

# Table of contrasts at given grade

# Mutate

fbc_scaled <- fbc %>%
  mutate_at(vars(starts_with("time")), ~ {
    ("2003-05-31" %--% .) / years(1)
  }) %>%
  mutate_at(vars(!!vars_avera, !!vars_grade), scale)

# For non-scaled
# fbc_non_scaled <- fbc %>%
#   mutate_at(vars(starts_with("time")), ~ {
#     ("2003-05-31" %--% .) / years(1)
#   })

outcome_labels <- c(
  dg1  = "Diagnosis 1",
  dg2  = "Diagnosis 2",
  dg3  = "Diagnosis 3"
)

grades_labels <- c(
  Average         = "Average",
  subject_1       = "Subject 1",
  subject_2       = "Subject 2",
  subject_3       = "Subject 3",
  subject_4       = "Subject 4",
  subject_5       = "Subject 5",
  subject_6       = "Subject 6"
)

# For real data
# outcome_labels <- c(
#   psy  = "Non-affective psychosis",
#   bipo = "Bipolar disorder",
#   dep  = "Depression"
# )
#
# grades_labels <- c(
#   Average         = "Average",
#   Literature      = "Native language",
#   Mathematics     = "Mathematics",
#   Phys_Edu        = "Physical Education",
#   Handicrafts     = "Handicrafts",
#   Arts            = "Arts",
#   Music           = "Music"
# )
# Extract contrasts -------------------------------------------------------

# Scaled

# Do not include z-scores out of bound
tab_minmax <-
  fbc %>%
  filter(fas == 1) %>%
  select(fas_dg, vars_avera, vars_grade) %>%
  mutate_at(c(vars_avera, vars_grade), compose(c, scale)) %>%
  pivot_longer(-fas_dg,names_to = "subject", values_to = "grade") %>%
  group_by(fas_dg, subject) %>%
  summarise(
    min = min(grade),
    max = max(grade)
  ) %>%
  ungroup() %>%
  rename(
    outcome = fas_dg,
    grades = subject
  )

tab_minmax %>%
  summarise(
    min(min),
    max(min),
    min(max),
    max(max)
  )

model_fits <- model_fits_scaled

contrast_at <- function(model, x, at = seq(-5, 3, by = .05), ref = 0, ...) {
  new_data <- fbc_scaled %>%
    data_grid(.model = model, !!x := !!at)

  new_data$z_score <- new_data[[x]]
  new_data <- new_data %>%
    filter(z_score == !!ref) %>%
    bind_rows(new_data)

  contrast(new_data, model, ...)
}

# Non-scaled

# Do not include grades out of bound
# tab_minmax_non_scaled <-
#   fbc_all %>%
#   filter(fas == 1) %>%
#   select(fas_dg, vars_avera, vars_grade) %>%
#   pivot_longer(-fas_dg,names_to = "subject", values_to = "grade") %>%
#   group_by(fas_dg, subject) %>%
#   summarise(
#     min = min(grade),
#     max = max(grade)
#   ) %>%
#   ungroup() %>%
#   rename(
#     outcome = fas_dg,
#     grades = subject
#   )
#
# tab_minmax_non_scaled %>%
#   summarise(
#     min(min),
#     max(min),
#     min(max),
#     max(max)
#   )
#
# model_fits <- model_fits_non_scaled
#
# contrast_at <- function(model, x, at = seq(4, 10, by = .01), ref = 8, ...) {
#   new_data <- fbc_non_scaled %>%
#     data_grid(.model = model, !!x := !!at)
#
#   new_data$fine_grade <- new_data[[x]] # fine grid of grades
#   new_data <- new_data %>%
#     filter(fine_grade == !!ref) %>%
#     bind_rows(new_data)
#
#   contrast(new_data, model, ...)
# }

# Contrast

model_contrasts <-
  model_fits %>%
  filter(grades != "All") %>%
  mutate(adjustment = ifelse(adjusted,
                             "Multivariate with covariates",
                             "Univariate")) %>%
  bind_rows(
    model_fits %>%
      filter(grades == "All") %>%
      filter(adjusted) %>%
      mutate(grades = NULL) %>%
      expand_grid(grades = vars_grade) %>% # expand_grid instead of crossing https://github.com/tidyverse/tidyr/issues/735
      mutate(adjustment = "Multivariate with covariates and other grades")
  ) %>%
  unnest(estimate = map2(fit, grades, contrast_at)) %>%
  mutate(
    outcome_label = outcome_labels[outcome],
    grades_label = grades_labels[grades]
  ) %>%
  mutate(adjustment = fct_inorder(adjustment)) %>%
  # For simulation data
  mutate(
    outcome_label = fct_relevel(outcome_label, "Diagnosis 1"),
    grades_label = fct_relevel(grades_label,
                               "Subject 1",
                               "Subject 2",
                               "Subject 3",
                               "Subject 4",
                               "Subject 5",
                               "Subject 6"
    )
  )
# For real data
    # mutate(
    # outcome_label = fct_relevel(outcome_label, "Non-affective psychosis"),
    # grades_label = fct_relevel(grades_label,
    #                            "Native Language",
    #                            "Mathematics",
    #                            "Physical Education",
    #                            "Handicrafts",
    #                            "Arts",
    #                            "Music"
    # )
  # )

# Exclude z-scores out of bound (scaled)
model_contrasts <-
  model_contrasts %>%
  left_join(tab_minmax) %>%
  filter(z_score >= min, z_score <= max)

# Exclude grades out of bound (non-scaled)
# model_contrasts <-
#   model_contrasts %>%
#   left_join(tab_minmax_non_scaled) %>%
#   filter(fine_grade >= min, fine_grade <= max)

# Table of contrasts at given grades ------------------------------------

# Scaled

tab_contrast <-
  model_contrasts %>%
  # filter(z_score %in% seq(-2, 2, by = 0.05)) %>%
  select(outcome_label, adjustment,
         subject = grades, z_score,
         estimate, starts_with("conf")) %>%
  filter(!duplicated(.)) %>%
  arrange_all()

# openxlsx::write.xlsx(
#   tab_contrast,
#   paste0(
#     "figures/tab_contrast_scaled_bonf_",
#     Sys.Date(),
#     ".xlsx"
#   )
# )

# Non-scaled

# tab_contrast <-
#   model_contrasts %>%
#   filter(fine_grade %in% 4:10) %>%
#   filter(!duplicated(.)) %>%
#   select(outcome_label, adjustment,
#          subject = grades, fine_grade,
#          estimate, starts_with("conf")) %>%
#   arrange_all()

# openxlsx::write.xlsx(
#   tab_contrast,
#   paste0(
#     "figures/tab_contrast_non_scaled_bonf_contrast8_",
#     Sys.Date(),
#     ".xlsx"
#   )
# )

# FIGURES -----------------------------------------------------------------

# Figure of average scores ------------------------------------------------

fbc_scaled %>%
  group_by(fas_dg) %>%
  summarise(
    min(Average),
    max(Average)
  )

# Scaled
plot_avg <- model_contrasts %>%
  filter(grades == "Average") %>%
  ggplot(aes(z_score, estimate, fill = adjustment)) +
  facet_grid(grades_label ~ outcome_label) +
  scale_y_log10() +
  # scale_x_continuous(
  # breaks = c(-3.2:2.1)
  # ) +
  scale_colour_manual(
    "Analysis",
    aesthetics = c("colour", "fill"),
    values = c("#6b778d", "#ff6768", "#17223b"),
    labels = scales::wrap_format(20)
  ) +
  labs(y = "RR (Bonferroni-corrected CI)", x = "Z-score") +
  geom_hline(yintercept = 1, colour = "grey80", linetype = 2) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = 0.2) +
  geom_line(aes(colour = adjustment), size = 1)

plot_avg

# ggsave(
#   paste0(
#     "figures/Average_contrasts_scaled_",
#     Sys.Date(),
#     ".pdf"
#   ), h = 3, w = 6, s = 1.8)

# Non-scaled
# plot_avg <-
#   model_contrasts %>%
#   filter(grades == "Average") %>%
#   ggplot(aes(fine_grade, estimate, fill = adjustment)) +
#   facet_grid(grades_label ~ outcome_label) +
#   scale_y_log10() +
#   scale_x_continuous(
#     breaks = c(4:10),
#     label = c("4 (failed)", "5", "6", "7", "8", "9", "10 (excellent)")
#   ) +
#   scale_colour_manual(
#     "Analysis",
#     aesthetics = c("colour", "fill"),
#     values = c("#6b778d", "#ff6768", "#17223b"),
#     labels = scales::wrap_format(20)
#   ) +
#   labs(y = "RR (Bonferroni-corrected CI)", x = "Grade") +
#   geom_hline(yintercept = 1, colour = "grey80", linetype = 2) +
#   geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = 0.2) +
#   geom_line(aes(colour = adjustment), size = 1) +
#   theme_minimal() +
#   theme(axis.text.x = element_text(angle = 45, hjust = 1))

# plot_avg

# ggsave(
#   paste0(
#     "figures/Average_contrasts_non_scaled_",
#     "contrast8_",
#     Sys.Date(),
#     ".pdf"
#   ), h = 3, w = 6, s = 1.8)

# Figure of specific grades -----------------------------------------------

plot_all <- plot_avg %+%
  list(data = model_contrasts %>%
         filter(grades != "Average") %>%
         filter(adjustment != "Multivariate with covariates")
  )

plot_all

# Scaled
# ggsave(
#   paste0(
#     "figures/Subjects contrasts_scaled_",
#     Sys.Date(),
#     ".pdf"
#   )
#   , h = 7, w = 6, s = 1.8)

# Non-scaled
# ggsave(
#   paste0(
#     "figures/Subjects contrasts_non_scaled_",
#     "contrast8_",
#     Sys.Date(),
#     ".pdf"
#   )
#   , h = 7, w = 6, s = 1.8)

# One figure per diagnosis ------------------------------------------------

tab_minmax

model_contrasts %>%
  summarise(
    min(conf.low),
    max(conf.high)
  )

model_contrasts %>%
  summarise(
    min(z_score),
    max(z_score)
  )

model_contrasts %>%
  filter(z_score >= -2, z_score <= 2) %>%
  summarise(
    min(conf.low),
    max(conf.high)
  )

plot_dg1 <-
  model_contrasts %>%
  filter(grades != "Average") %>%
  filter(adjustment == "Multivariate with covariates and other grades") %>%
  filter(outcome == "dg1") %>%
  ggplot(aes(z_score, estimate, fill = adjustment)) +
  facet_wrap(. ~ grades_label, nrow = 2) +
  scale_y_log10(breaks = c(.25, .5, 1, 2, 4), limits = c(0.135, 6.7)) +
  scale_x_continuous(
    breaks = seq(-2, 2, by = 0.5),
    # label = c(),
    limits = c(-2, 2)
  ) +
  scale_colour_manual(
    "Analysis",
    aesthetics = c("colour", "fill"),
    values = c("#6b778d", "#ff6768", "#17223b"),
    labels = scales::wrap_format(20)
  ) +
  labs(y = "RR (Bonferroni-corrected CI)", x = "Z-score") +
  geom_hline(yintercept = 1, colour = "grey80", linetype = 2) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = 0.2) +
  geom_line(aes(colour = adjustment), size = 1) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    legend.position = "none"
  )

plot_dg1

plot_av_dg1 <-
  plot_dg1 %+%
  list(data = model_contrasts %>%
         filter(grades == "Average") %>%
         filter(adjustment == "Multivariate with covariates") %>%
         filter(outcome == "dg1")
  )

plot_av_dg1

cowplot::plot_grid(
  plot_av_dg1, plot_dg1,
  rel_widths = c(1, 1.35),
  labels = "AUTO")

# ggsave(
#   paste0(
#     "figures/dg1_av_spec_",
#     "onlymultivar_",
#     "scaled_",
#     "bonf_",
#     Sys.Date(),
#     ".pdf"
#   )
#   , h = 5, w = 11, s = 1.2)

# Additional figures for real data ----------------------------------------

# Check min and max grades as well as conf.low and conf.high for non-scaled

# fbc_non_scaled %>%
#   group_by(fas_dg) %>%
#   summarise(
#     min(Average),
#     max(Average)
#   )

# model_contrasts %>%
#   filter(grades == "Average") %>%
#   filter(
#     (outcome == "psy" & fine_grade >= 4.63 & fine_grade <= 9.78) |
#       (outcome == "bipo" & fine_grade >= 4.93 & fine_grade <= 9.88) |
#       (outcome == "dep" & fine_grade >= 4.7 & fine_grade <= 9.94)
#   ) %>%
#   group_by(outcome) %>%
#   summarise(
#     min(conf.low),
#     max(conf.high)
#   )

# Same for scaled
# tab_minmax
#
# model_contrasts %>%
#   summarise(
#     min(conf.low),
#     max(conf.high)
#   )
#
# model_contrasts %>%
#   summarise(
#     min(z_score),
#     max(z_score)
#   )
#
# model_contrasts %>%
#   filter(z_score >= -2, z_score <= 2) %>%
#   summarise(
#     min(conf.low),
#     max(conf.high)
#   )

# psy

# Scaled

# plot_psy <-
#   model_contrasts %>%
#   filter(grades != "Average") %>%
#   filter(adjustment == "Multivariate with covariates and other grades") %>%
#   # filter(adjustment != "Multivariate with covariates") %>%
#   filter(outcome == "psy") %>%
#   ggplot(aes(z_score, estimate, fill = adjustment)) +
#   facet_wrap(. ~ grades_label, nrow = 2) +
#   scale_y_log10(breaks = c(.25, .5, 1, 2, 4), limits = c(0.24, 4.1)) +
#   scale_x_continuous(
#     breaks = seq(-2, 2, by = 0.5),
#     # label = c(),
#     limits = c(-2, 2)
#   ) +
#   scale_colour_manual(
#     "Analysis",
#     aesthetics = c("colour", "fill"),
#     values = c("#6b778d", "#ff6768", "#17223b"),
#     labels = scales::wrap_format(20)
#   ) +
#   labs(y = "RR (Bonferroni-corrected CI)", x = "Z-score") +
#   geom_hline(yintercept = 1, colour = "grey80", linetype = 2) +
#   geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = 0.2) +
#   geom_line(aes(colour = adjustment), size = 1) +
#   theme_minimal() +
#   theme(
#     axis.text.x = element_text(angle = 45, hjust = 1),
#     legend.position = "none"
#   )
#
# plot_psy
#
# plot_av_psy <-
#   plot_psy %+%
#   list(data = model_contrasts %>%
#          filter(grades == "Average") %>%
#          filter(adjustment == "Multivariate with covariates") %>%
#          filter(outcome == "psy")
#   )
#
# plot_av_psy
#
# cowplot::plot_grid(
#   plot_av_psy, plot_psy,
#   rel_widths = c(1, 1.35),
#   labels = "AUTO")

# ggsave(
#   paste0(
#     "figures/psy_av_spec_",
#     "onlymultivar_",
#     "scaled_",
#     "bonf_",
#     Sys.Date(),
#     ".pdf"
#   )
#   , h = 5, w = 11, s = 1.2)

# Non-scaled

# plot_psy <-
#   model_contrasts %>%
#   filter(grades != "Average") %>%
#   filter(adjustment != "Multivariate with covariates") %>%
#   filter(outcome == "psy") %>%
#   ggplot(aes(fine_grade, estimate, fill = adjustment)) +
#   facet_wrap(. ~ grades_label, nrow = 2) +
#   scale_y_log10(breaks = c(.25, .5, 1, 2, 4), limits = c(0.166, 26.6)) +
#   scale_x_continuous(
#     breaks = c(4:10),
#     label = c("4 (failed)", "5", "6", "7", "8", "9", "10 (excellent)"),
#     limits = c(4, 10)
#   ) +
#   scale_colour_manual(
#     "Analysis",
#     aesthetics = c("colour", "fill"),
#     values = c("#6b778d", "#ff6768", "#17223b"),
#     labels = scales::wrap_format(20)
#   ) +
#   labs(y = "RR (Bonferroni-corrected CI)", x = "Grade") +
#   geom_hline(yintercept = 1, colour = "grey80", linetype = 2) +
#   geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = 0.2) +
#   geom_line(aes(colour = adjustment), size = 1) +
#   theme_minimal() +
#   theme(axis.text.x = element_text(angle = 45, hjust = 1))
#
# plot_psy
#
# plot_av_psy <-
#   plot_psy %+%
#   list(data = model_contrasts %>%
#          filter(grades == "Average") %>%
#          filter(fine_grade >= 4.63, fine_grade <= 9.78) %>%
#          filter(outcome == "psy")
#   )
#
# plot_av_psy
#
# cowplot::plot_grid(
#   plot_av_psy, plot_psy,
#   rel_widths = c(1, 1.35),
#   labels = "AUTO")
#
# ggsave(
#   paste0(
#     "figures/psy_av_spec_non_scaled_bonf_",
#     "contrast8_",
#     Sys.Date(),
#     ".pdf"
#   )
#   , h = 5, w = 11, s = 1.2)

# bipo

# plot_bipo <-
#   plot_psy %+%
#   list(data = model_contrasts %>%
#          filter(grades != "Average") %>%
#          filter(adjustment == "Multivariate with covariates and other grades") %>%
#          # filter(adjustment != "Multivariate with covariates") %>%
#          filter(outcome == "bipo")
#   )
#
# plot_bipo

# plot_av_bipo <-
#   plot_psy %+%
#   list(data = model_contrasts %>%
#          filter(grades == "Average") %>%
#          filter(adjustment == "Multivariate with covariates") %>%
#          # filter(fine_grade >= 4.93, fine_grade <= 9.88) %>%
#          filter(outcome == "bipo")
#   )

# plot_av_bipo

# cowplot::plot_grid(
#   plot_av_bipo, plot_bipo,
#   rel_widths = c(1, 1.35),
#   labels = "AUTO")

# Scaled
# ggsave(
#   paste0(
#     "figures/bipo_av_spec_",
#     "onlymultivar_",
#     "scaled_",
#     "bonf_",
#     Sys.Date(),
#     ".pdf"
#   )
#   , h = 5, w = 11, s = 1.2)

# Non-scaled
# ggsave(
#   paste0(
#     "figures/bipo_av_spec_non_scaled_bonf_",
#     "contrast8_",
#     Sys.Date(),
#     ".pdf"
#   )
#   , h = 5, w = 11, s = 1.2)

# dep

# plot_dep <-
#   plot_psy %+%
#   list(data = model_contrasts %>%
#          filter(grades != "Average") %>%
#          filter(adjustment == "Multivariate with covariates and other grades") %>%
#          # filter(adjustment != "Multivariate with covariates") %>%
#          filter(outcome == "dep")
#   )

# plot_dep

# plot_av_dep <-
#   plot_psy %+%
#   list(data = model_contrasts %>%
#          filter(grades == "Average") %>%
#          filter(adjustment == "Multivariate with covariates") %>%
#          # filter(fine_grade >= 4.7, fine_grade <= 9.94) %>%
#          filter(outcome == "dep")
#   )

# plot_av_dep

# cowplot::plot_grid(
#   plot_av_dep, plot_dep,
#   rel_widths = c(1, 1.35),
#   labels = "AUTO")

# Scaled
# ggsave(
#   paste0(
#     "figures/dep_av_spec_",
#     "onlymultivar_",
#     "scaled_",
#     "bonf_",
#     Sys.Date(),
#     ".pdf"
#   )
#   , h = 5, w = 11, s = 1.2)

# Non-scaled

# ggsave(
#   paste0(
#     "figures/dep_av_spec_non_scaled_bonf_",
#     "contrast8_",
#     Sys.Date(),
#     ".pdf"
#   )
#   , h = 5, w = 11, s = 1.2)

# Compare Multivariate with and without other covariates than grad --------

# plot_comp1 <- plot_avg %+%
#   list(data = model_contrasts %>%
#          filter(grades != "Average") %>%
#          filter(adjustment != "Multivariate with covariates and other grades")
#   )
#
# plot_comp1
#
# plot_comp2 <- plot_avg %+%
#   list(data = model_contrasts %>%
#          filter(grades != "Average") %>%
#          filter(adjustment != "Univariate")
#   )
#
# plot_comp2
#
# cowplot::plot_grid(
#   plot_comp1, plot_comp2,
#   labels = "AUTO")

# Scaled
# ggsave(
#   paste0(
#     "figures/comp_analyses_scaled_",
#     Sys.Date(),
#     ".pdf"
#   )
#   , h = 11, w = 11*1.6, s = 1)

# Non-scaled
# ggsave(
#   paste0(
#     "figures/comp_analyses_non_scaled_",
#     "contrast8_",
#     Sys.Date(),
#     ".pdf"
#   )
#   , h = 11, w = 11*1.6, s = 1)


#' Deviation Diverging Lollipop Chart.
#'
#' divlollipop function will draw Diverging Lollipop Chart for Deviation analysis.
#' @param data input data.frame
#' @param div.var diverging value variable
#' @param method "mean" or "median"
#' @param title main title
#' @param subtitle subtitle
#' @param xtitle x axis title
#' @param ytitle y axis title
#' @param caption caption
#' @return An object of class \code{ggplot}
#' @examples
#' plot<- divlollipop(data=mtcars,div.var="mpg",method="mean")
#' plot
#'
#' @import ggplot2
#' @import scales
#' @import reshape2
#' @import ggthemes
#' @import gganimate
#' @import gapminder
#' @import ggalt
#' @import ggExtra
#' @import ggcorrplot
#' @import dplyr
#' @import treemapify
#' @import ggfortify
#' @import zoo
#' @import ggdendro
#' @export
divlollipop<-function(data,div.var, method="mean",
                 title=NULL,subtitle=NULL,xtitle=NULL,ytitle=NULL,caption=NULL){
  df<- data
  div.var<- div.var

  if(method=="mean"){
    df$row<-rownames(df)
    df$z<-round((df[,div.var] - mean(df[,div.var])), 2)
    df$z_type <- ifelse(df$z < 0, "below", "above")
    df <- df[order(df$z), ]
    df$row <- factor(df$row, levels = df$row)
  }

  if(method=="median"){
    df$row<-rownames(df)
    df$z<-round((df[,div.var] - median(df[,div.var])), 2)
    df$z_type <- ifelse(df$z < 0, "below", "above")
    df <- df[order(df$z), ]
    df$row <- factor(df$row, levels = df$row)
  }

  p<-ggplot(df, aes_string(x="row", y="z", label="z")) +
    geom_point(stat='identity', fill="black", size=6)  +
    geom_segment(aes_string(y = 0,
                     x = "row",
                     yend = "z",
                     xend = "row"),
                 color = "black") +
    geom_text(color="white", size=2) +
    theme_fivethirtyeight() +
    theme(axis.title = element_text(),
          legend.title = element_text(face = 4,size = 10),
          legend.direction = "horizontal", legend.box = "horizontal")+
    labs(title=title,
         subtitle=subtitle,
         x=xtitle,
         y=ytitle,
         caption=caption) +
    coord_flip()

  return(p)
}


# compare speed of aging between diff-t tissues and sexes

# Total: 18 tissues

# Sexes:
# F
# M

# Create df:
# tis | sex | age | pred

# Read:
# Subject-Sample annotation -- fill (Subject | Age)

# Read:
# Confident tissue predictors

# Read:
# Tissue1_data -- use predictors to create RF, predict age, fill (| Age_Tissue1|) column

# tis = c('Kidney-Cortex')
tis = c(
    "Adipose-Subcutaneous",
    "Adipose-Visceral(Omentum)",
    "Artery-Aorta",
    "Artery-Tibial",
    "Breast-MammaryTissue",
    "Cells-Transformedfibroblasts",
    "Colon-Sigmoid",
    "Colon-Transverse",
    "Esophagus-GastroesophagealJunction",
    "Esophagus-Mucosa",
    "Esophagus-Muscularis",
    "Heart-AtrialAppendage",
    "Heart-LeftVentricle",
    "Lung",
    "Muscle-Skeletal",
    "Nerve-Tibial",
    "Pancreas",
    "Skin-NotSunExposed(Suprapubic)",
    "Skin-SunExposed(Lowerleg)",
    "Stomach",
    "Testis",
    "Thyroid",
    "WholeBlood"
)

sex = c('F', 'M')
conf = read.table('./v7/tested_sign_features(transcript).txt', stringsAsFactors = F, sep ='\t', header = 1, row.names = 1)

subj_samp = read.table('./v7/subj_sample_annot.txt', stringsAsFactors = F, sep = '\t', header = 1, row.names = 1)
subj_samp = subj_samp[substr(rownames(subj_samp),1,1) == 'G',]
subj_samp$Subject.ID = regmatches(rownames(subj_samp),regexpr("^GTEX-\\w+",rownames(subj_samp)))
subj_samp$Prediction = NA
subj_samp$Age = as.numeric(paste0(substr(subj_samp[['Age']], 1, 1),'5'))

subjects = as.data.frame(matrix(ncol = 2, nrow = length(unique(subj_samp$Subject.ID))))
colnames(subjects) = c('Age','ID')
rownames(subjects) = unique(subj_samp$Subject.ID)
for (i in rownames(subjects)){
  subjects[i,1] = subj_samp[subj_samp$Subject.ID == i,'Age'][1]
  subjects[i,2] = i
}

conf.all = na.omit(unique(unlist(strsplit(conf$Confirmed, split = ', '))))

tis.probs = as.data.frame(matrix(data = NA, ncol = 8, nrow = 0))
colnames(tis.probs) = c('Subject', 'Tissue', 'a25', 'a35', 'a45', 'a55', 'a65', 'a75')
for (t in tis[6:length(tis)]) {
  start = Sys.time()
  set.seed(1238)

  tis_samp = read.table(paste0('./v7/tissue_samples/samples_from_', t,'.txt'), stringsAsFactors = F,
                        check.names=F, header = 1, row.names = 1)

  tis_samp$gene_id <- NULL
  tis_samp = as.data.frame(t(tis_samp))
  tis_samp$Age = subj_samp[rownames(tis_samp),'Age']

  # conf_tis = strsplit(conf[t,1], split = ', ')[[1]]
  conf_tis = conf.all

  if (is.na(conf_tis[1])){next}

  insufficient_data = F
  for (i in table(tis_samp$Age)){if (i < 5) {insufficient_data = T}}
  if (insufficient_data){next}

  tis_samp = tis_samp[,c(conf_tis,'Age')]
  tis_samp = na.omit(tis_samp)

  for (s in rownames(tis_samp)){
    ID = regmatches(s,regexpr("^GTEX-\\w+",s))
    tis.probs[nrow(tis.probs) + 1, 'Subject'] = ID
    tis.probs[nrow(tis.probs),'Tissue'] = t

    feats = colnames(tis_samp)[1:(length(tis_samp)-1)]
    ages = c(25,35,45,55,65,75)

    for (a in ages){
      age_probs = c()
      for (tra in feats){
        tra_dist = tis_samp[tis_samp$Age == a, tra]
        med_tra = median(tra_dist)
        if (tis_samp[s,tra] < med_tra){
          prob = (sum(tis_samp[s,tra] >= tra_dist) + 1) / (length(tra_dist) + 1)
        }
        if (tis_samp[s,tra] > med_tra){
          prob = (sum(tis_samp[s,tra] <= tra_dist) + 1) / (length(tra_dist) + 1)
        }
        if (tis_samp[s,tra] == med_tra){
          prob = max(0.5, (sum(tra_dist == med_tra) / length(tra_dist)))
        }
        age_probs = c(age_probs, prob)
        tis.probs[nrow(tis.probs), paste0('a',a)] = sum(log(age_probs))
      }
    }
  }
  end = Sys.time()
}
print(end - start)

for (i in rownames(tis.probs)){
  tis.probs[i,'Age'] = subjects[tis.probs[i,'Subject'], 'Age']
  tis.probs[i,'Predicted'] = substr(
      colnames(tis.probs)[which(tis.probs[i,] == max(tis.probs[i,c(3,4,5,6,7,8)]))],
      2,3)
}
tis.probs$Predicted = as.numeric(tis.probs$Predicted)
rmse = (sum((tis.probs$Predicted - tis.probs$Age)**2)/length(tis.probs$Age))**0.5

for (i in rownames(subjects)){
  subjects[i,'Predicted'] = mean(tis.probs[tis.probs$Subject == i,'Predicted'])
}

rmse = (sum(na.omit(subjects$Predicted - subjects$Age)**2)/length(subjects$Age))**0.5

write.table(tis.probs, 'probabilities.txt', sep ='\t', quote = F, row.names = F)


# Copyright (c) 2020, SAS Institute Inc., Cary, NC, USA.  All Rights Reserved.
# SPDX-License-Identifier: Apache-2.0

args = commandArgs(trailingOnly=TRUE)
if (length(args)<2) {
  stop("Rscript score.R [model file] <inputfile> <outputfile>.n", call.=FALSE)
} else if (length(args)<3) {
  modelfile = ''
  inputfile = args[1]
  outputfile = args[2]
} else {
  modelfile = args[1]
  inputfile = args[2]
  outputfile = args[3]
}

inputdata <- read.csv(file=inputfile, header=TRUE, sep=",")

for(i in 1:ncol(inputdata)){
  if(i!= 5 && i!=6){
    inputdata[is.na(inputdata[,i]), i] <- mean(inputdata[,i], na.rm = TRUE)
  }
}

if (modelfile == '') {
  files <- list.files(pattern = "\\.rda$")

  if(length(files) == 0) {
     print("not found rda file in the directory!")
     stop()
  }

  modelfile<-files[[1]]
}

model<-load(modelfile)

# -----------------------------------------------
# SCORE THE MODEL
# -----------------------------------------------
score<- predict(get(model), inputdata, type="vector")

P_BAD1<-score
P_BAD0<-1-P_BAD1

# -----------------------------------------------
# MERGING PREDICTED VALUE WITH MODEL INPUT VARIABLES
# -----------------------------------------------
mm_outds <- cbind(inputdata, P_BAD0, P_BAD1)

#mm_outds <- cbind(P_BAD0, P_BAD1)
write.csv(mm_outds, file = outputfile, row.names=F)


plotdf <- function(df, xx, yy, multifit=TRUE, interval='conf', ...) {

    ## extract desired parts of df
    ## not quite sure why all_of() is needed; it was suggested in a warning when run without it
    dfnew <- select(df, c(all_of(xx), all_of(yy)))

    ## melt creates dataframe with only 3 paramters: id.vars,         variable.name, and "value"
    ##                                              "duration_years", "series",      and "value"
    dflong <- reshape2::melt(dfnew, id.vars=xx, variable.name='series')
    ## with(dflong, plotfit(xx, value, series, multifit=multifit, interval=interval, ...))
    plotfit(dflong[[1]], dflong[[3]], dflong[[2]],
            xlabel=xx, ylabel='value', bylabel='series',
            multifit=multifit, interval=interval, ...)

}
## plotspace(2,3)
## with(mtcars, plotfit(mpg, drat, ylimspec=c(0, 4)))
## with(mtcars, plotfit(mpg, cyl))
## plotdf(mtcars, 'mpg', c('cyl', 'drat'))
## plotdf(mtcars, 'mpg', c('cyl', 'drat'), multifit=FALSE)
## plotdf(mtcars, 'mpg', c('cyl', 'drat'), multifit=FALSE, interval='line')
## plotdf(mtcars, 'mpg', c('cyl', 'drat'), multifit=TRUE,  interval='line')


  cpue.aggregate = function( format="default"  ) {

    cpue = snowcrab_landings_db()
    # year is year of capture
    # yr is "fishing year" relative to the assessment cycle

    # if (format=="default") {
    #   landings.north = landings[ which(landings$cfa =="cfanorth"), ]
    #   ln = aggregate(landings.north$landings, list(yr=landings.north$yr), function(x) sum(x, na.rm=T))
    #   names(ln) = c("yr", "landings")
    #   ln = factor2number(ln, c("yr", "landings"))
    #   ln$id = paste(ln$yr, "cfanorth", sep=".")
    #
    #   landings.south = landings[ which(landings$cfa =="cfasouth") , ]
    #   ls = aggregate(landings.south$landings, list(yr=landings.south$yr), function(x) sum(x, na.rm=T))
    #   names(ls) = c("yr", "landings")
    #   ls = factor2number(ls, c("yr", "landings"))
    #   ls$id = paste(ls$yr, "cfasouth", sep=".")
    #
    #   landings.4x = landings[ which(landings$cfa =="cfa4x" ) , ]
    #   lx = aggregate(landings.4x$landings, list(yr=landings.4x$yr), function(x) sum(x, na.rm=T))
    #   names(lx) = c("yr", "landings")
    #   lx = factor2number(lx, c("yr", "landings"))
    #   lx$id = paste(lx$yr, "cfa4x", sep=".")
    #
    #   # lx$landings[2:(nrow(lx))] = lx$landings[1:(nrow(lx)-1)]  # offset due to the fishing season being after the Survey
    #
    #   la = rbind(ln, ls, lx)
    #   la$yr = NULL
    #   la$landings.kt = as.numeric(as.character(la$landings))/1000/1000
    #   return(la)
    # }

    if (format=="bugs") {
      regs =  c( "cfanorth", "cfasouth", "cfa4x" )
      cpue = cpue[ which (cpue$cfa %in% regs) , ]
      yrs = sort(unique( cpue$yr ) )
      L = tapply( cpue$landings, INDEX=cpue[,c("yr", "cfa")], FUN=sum, na.rm=T )
      L2 = tapply( cpue$effort, INDEX=cpue[,c("yr", "cfa")], FUN=sum, na.rm=T )
      L=L/L2
      L1 = tapply( cpue$landings, INDEX=cpue[,"yr"], FUN=sum, na.rm=T )
      L2 = tapply( cpue$effort, INDEX=cpue[,"yr"], FUN=sum, na.rm=T )
      cfaall = L1/L2
      L = cbind( L, cfaall )
      return (L)
    }

  }


library(MASS) # for lda
library(caret) # models and classification utils
library(igraph)

# custom utils
source('functions.r')

#here you have to change the path to use your own data. Probably you will need to tune the read_tps function inside functions.r
file_path = './data/Muestra_563_UC3M_fixed.TPS'

tps = read_tps(file_path, remove_point_5 = TRUE, n_cases = 563)

# some columns names to use it latter
x_coord_names = tps$x_colnames
y_coord_names = tps$y_colnames
x_procrustes_coord_names = sprintf("x_%s_proc",1:length(x_coord_names))
y_procrustes_coord_names = sprintf("y_%s_proc",1:length(y_coord_names))
x_allom_coord_names = sprintf("x_%s_allom",1:length(x_coord_names))
y_allom_coord_names = sprintf("y_%s_allom",1:length(y_coord_names))

# compute all the diagnosis types combinations
diagnosis_combinations = combn(levels(tps$df$diagnosis), 2, simplify = FALSE)

##### DEFINE GRAPH FUNCTIONS

methods_graph = graph_from_literal(DATA-+DISTANCES,
                                   DATA-+PROCRUSTES,
                                   PROCRUSTES-+DISTANCES,
                                   PROCRUSTES-+ALLOMETRIC_SHAPE_REDUCTION,
                                   PROCRUSTES-+CLASSIFICATION_MODEL,
                                   PROCRUSTES-+COLINEARITY_TRIM,
                                   PROCRUSTES-+PCA,
                                   DISTANCES-+COLINEARITY_TRIM,
                                   DISTANCES-+PCA,
                                   DISTANCES-+CLASSIFICATION_MODEL,
                                   PCA-+CLASSIFICATION_MODEL,
                                   ALLOMETRIC_SHAPE_REDUCTION-+COLINEARITY_TRIM,
                                   ALLOMETRIC_SHAPE_REDUCTION-+CLASSIFICATION_MODEL,
                                   COLINEARITY_TRIM-+CLASSIFICATION_MODEL)

plot(methods_graph)

all_paths = all_simple_paths(methods_graph, from=1, to=5)

# functions to perform the transformations and combine it using the graph
DATA = function(data){
  tps$df
}

PROCRUSTES = function(data){
  procrustes_df = perform_procrustes(data, x_coord_names, y_coord_names, plot_procrustes=FALSE)
  procrustes_df %>% dplyr::select(x_procrustes_coord_names, y_procrustes_coord_names)
}

DISTANCES = function(data){
  x_coords = colnames(data)[colnames(data) %>% str_detect('^x_')]
  y_coords = colnames(data)[colnames(data) %>% str_detect('^y_')]
  distances_raw = get_all_distances(data, x_coords, y_coords)
  distances_raw
}

PCA = function(data){
  pca_result = perform_pca_and_filter(data, columns=NULL, max_explained_var=0.95)
  pca_result
}

COLINEARITY_TRIM = function(data){
  x_columns = colnames(data)
  non_colinear_cols = get_noncolinear_columns(data, columns = x_columns, max_percentage=0.96, plot_correlation=FALSE)
  data %>% dplyr::select(non_colinear_cols)
}

ALLOMETRIC_SHAPE_REDUCTION = function(data){
  gpa = perform_procrustes(DATA(), x_coord_names, y_coord_names, plot_procrustes=FALSE, return_object=TRUE)
  data = remove_allometric_shape_effect(data, gpa)
  data %>% dplyr::select(c(x_allom_coord_names, y_allom_coord_names))
}

CLASSIFICATION_MODEL = function(data){
  x_columns = c(colnames(data), x_extra_columns)
  x_data = cbind(data, DATA() %>% dplyr::select(x_extra_columns, 'diagnosis'))

  res_svm = test_LOOCV_svmRadial(x_data, x_columns = x_columns, data_filter = data_filter, test_name=paste(t_name,'->SVM',sep=''))
  res_rf = test_LOOCV_rf(x_data, x_columns = x_columns, data_filter = data_filter, test_name=paste(t_name,'->RF',sep=''))
  res_nnet = test_LOOCV_nnet(x_data, x_columns = x_columns, data_filter = data_filter, test_name=paste(t_name,'->NNET',sep=''))
  rbind(res_svm, res_rf, res_nnet)
}

CLASSIFICATION_MODEL_FULL = function(data){
  x_columns = c(colnames(data), x_extra_columns)
  x_data = cbind(data, DATA() %>% dplyr::select(x_extra_columns, 'diagnosis'))

  res_svm = test_LOOCV_svmRadial(x_data, x_columns = x_columns, data_filter = data_filter, test_name=paste(t_name,'->SVM',sep=''), results_cols = c("Accuracy"))
  res_rf = test_LOOCV_rf(x_data, x_columns = x_columns, data_filter = data_filter, test_name=paste(t_name,'->RF',sep=''), results_cols = c("Accuracy"))
  res_nnet = test_LOOCV_nnet(x_data, x_columns = x_columns, data_filter = data_filter, test_name=paste(t_name,'->NNET',sep=''), results_cols = c("Accuracy"))
  rbind(res_svm, res_rf, res_nnet)
}

#####

# Binary-fashion way of modeling
for(x_extra_columns in list(NULL, c('sex'), c('age_group'), c('sex', 'age_group'))){
  for(comb in diagnosis_combinations){
    cat('Diagnosis:', comb, '\n')
    data_filter = function(x) x %>% filter(diagnosis==comb[1] | diagnosis==comb[2])

    results_cols = c("Accuracy", "Specificity", "Precision", "Recall", "F1")
    results = data.frame(matrix(ncol = length(results_cols), nrow = 0))
    colnames(results) = results_cols

    ##################################################################################
    ##################################################################################

    for(path in all_paths){
      t_name = path$name[-c(1,length(path$name))] %>% paste(collapse='->')
      cat(t_name,'\n')

      method_data = DATA()
      for(stage in path$name[-1]){
        method_data = match.fun(stage)(method_data)
      }
      results = results %>% rbind(method_data)
    }

    print(results)
    write.csv(results,file=paste("../results/results_",paste(x_extra_columns,collapse='-'),"_",paste(comb,collapse='_'),'.csv', sep=''))
  }

  # #################################################################################
  # # Multiclass models
  # data_filter = function(x) x
  #
  # results_cols = c("Accuracy")
  # results = data.frame(matrix(ncol = length(results_cols), nrow = 0))
  # colnames(results) = results_cols
  #
  # ##################################################################################
  # ##################################################################################
  #
  # for(path in all_paths){
  #   t_name = path$name[-c(1,length(path$name))] %>% paste(collapse='->')
  #   cat(t_name,'\n')
  #
  #   method_data = DATA()
  #   for(stage in path$name[-c(1,length(path$name))]){
  #     method_data = match.fun(stage)(method_data)
  #   }
  #   results = results %>% rbind(CLASSIFICATION_MODEL_FULL(method_data))
  # }
  #
  # print(results)
  # write.csv(results,file=paste("../results/results_",paste(x_extra_columns,collapse='-'),"_ALL_CLASES.csv", sep=""))
}


# 데이터 가져오기 Read.table(txt 파일, tab으로 구분된 파일),
# Read.csv (csv 파일 ","로 구분된 파일)
# Read_excel (excel 파일 가져오기, library 기능 추가 필요)
# 그외 spss, json 등의 파일도 연결 가능

gradetxt <- read.table("0201.grade.txt",
                     header=FALSE,
                     sep = "\t",
                     stringsAsFactor = FALSE,
                     na.strings = ".")

# Header = FALSE (변수명이 없을 때) 변수명을 인식할 것인가? default = true
# Sep(구분자) : "," "", ":" Wt(tab) 마지막 것은 탭으로 구분하는 것
# StringsAsFactor = 문자데이터를 요인으로 인식 (TRUE) 대부분은 숫자로 저장되어 있기 때문에 의미가 없다.
# na.strings = "", ".", "NA" 등이 있음 => 값이 안들어와 있으면 어떻게 넣을 것인가? .을 찍으면 missing 값으로 인식
# str(game) 속성보기

str(gradetxt)

# 데이터 가져오기 (read.csv)
gradecsv <- read.csv("0202.grade.csv",
                       header=TRUE, # T만 적어도 됨. FALSE 는 F만 적어도 됨
                       sep = ",", # 기본값이 R에서는 ,로 인식하기 때문에 빼주어도 됨
                       na.strings = ".")
str(gradecsv)

# 데이터 가져오기(read_excel)

# install.packages("readxl") # 패키지 : 데이터 프로그램을 미리 만들어 놓은 것
library(readxl)

gradexls <- read_excel("0203.grade.xlsx",
                       sheet = "grade",
                       col_names = TRUE,
                       na = "NA")

str(gradexls)

# 데이터 구조 보기

str(gradexls)
dim(gradexls) # 전체 데이터 개수(50개 행), 그중에 변수가 몇개인지 보여줌(열)
summary(gradexls) # 기술통계 분석석
summary(gradexls$msex) # $ 뒤에 붙는 것은 변수명, 즉, msex 변수만 요약해서 보여주어라라

# R에서 class(숫자일 경우 어떻게 해석하는지를 보여줌) mode (문자, 숫자, 함수, 리스트 등)의 차이

# factor (질적(범주형) 변수 처리 : 문자형을 숫자로

gradetxt <- read.table("0201.grade.txt",
                       header=FALSE,
                       sep = "\t",
                       stringsAsFactor = FALSE,
                       na.strings = "")

str(gradetxt) # 여기서 2번째 변수는 문자 이것을 그림으로 찍어보자

plot(x = gradetxt$V2, y = gradetxt$V4,
     levels=c("Male","Female")) # factor 형태로 바꾸지 않았기 때문에 오류가 발생함. factor로 바꾸어 주어야 함

gradetxt$V2 <- factor(gradetxt$V2,
                      levels=c("Male","Female"))
str(gradetxt$V2)
table(gradetxt$V2)
plot(x=gradetxt$V2, y=gradetxt$V4) # plot 함수는 다음시간에...

# factor 변수처리 2 : 숫자형을 문자로

gradetxt$V3 <- factor(gradetxt$V3,
                      levels = c(1,2))

str(gradetxt$V3)

plot(x = gradetxt$V3, y = gradetxt$V4,
     levels=c(1,2))

gradetxt$V3 <- factor(gradetxt$V3,
                      levels = c(1,2),
                      labels=c("남자","여자")) #factor 로 바꾸어주고 이름을 붙여라

str(gradetxt$V3)

# 실제 활용 하는 방법 : 위의 예제에서 숫자 1,2를 요인으로인식하게 하고 요인명을 붙인다음에 그래프를 그리는 작업
# 이것을 텍스트 파일로부터 읽어와서 처리하는 방식으로 하여 순서대로 해보자.

gradetxt <- read.table("0201.grade.txt",
                       header=FALSE,
                       sep = "\t",
                       stringsAsFactor = FALSE,
                       na.strings = "")

gradetxt$V3 <- factor(gradetxt$V3,
                      levels = c(1,2),
                      labels = c("남자","여자"))

str(gradetxt$V3)

table(gradetxt$V3)

plot(x = gradetxt$V3, y =  gradetxt$V4)

ch02 - 데이터 구조 및 입력/데이터입력.r

ch02 - 데이터 구조 및 입력/데이터입력.r

ch02 - 데이터 구조 및 입력/데이터입력.r


pdf_file<-"pdf/networks_heatmap.pdf"
cairo_pdf(bg="grey98", pdf_file,width=7,height=6)

par(mai=c(0.25,0.25,0.25,1.75),omi=c(0.25,0.25,0.75,0.85),
	family="Lato Light",las=1)

library(pheatmap)
library(RColorBrewer)
library(igraph)

# Import data and prepare chart

df0 <- read.csv("myData/reg_flow.csv", stringsAsFactors=FALSE)
df1 <- read.csv("myData/reg_plot.csv", stringsAsFactors=FALSE)

net <- graph_from_data_frame(d=df0, vertices=df1, directed=T)
netm <- get.adjacency(net, attr="flow", sparse=F)

# Create chart

plot.new()
pheatmap(netm, col=brewer.pal(6,"RdPu"),
	cluster_rows=F,cluster_cols=F,cellwidth=35,cellheight=24,
	border_color="white",fontfamily="Lato Light", display_numbers=T, number_color=matrix(ifelse(netm > 1.5, "white", "red"), nrow(netm)))

# Titling

mtext("Migration 2010-2015",3,line=1.5,adj=0,cex=1.75,family="Lato Black",outer=T)
mtext("All figures in millions. Data Source: https://github.com/cran/migest/tree/master/inst/vidwp",1,line=-1,adj=0,cex=0.85,font=3,outer=T)

par(family="Lato Black")
mtext("↙",1,line=-7,adj=0.9,cex=7,col="grey80",outer=T)

dev.off()


#---------
#Title
#---------
#Respiratory control and thermal sensibility in benthic
#life stages of porcelain crab (Petrolisthes laevigatus).
#-----------------------------------------------
#Cleaning working space
rm(list=ls())
#Creator: 20160817 FPL
#Modifications: 20170408 CG
today<-format(Sys.Date(),"%Y%m%d")
#--------------------------------------------
#From Linux
# get working directory
# setwd("~/Insync/Laboratorio.Poblaciones.Marinas/Publicaciones/Plasticidad pela/analisis/datos")
#From Windows
# setwd("D:/felix.leiva@ulagos.cl/Laboratorio.Poblaciones.Marinas/Publicaciones/Plasticidad pela/analisis/datos")
setwd("C:/Users/Invunche/Dropbox/Radboud University/publicaciones/Publicadas/3. Leiva et al Mar Biol 2018/data")
getwd()     #verifico directorio
#-----------------------------------------------
#Libraries
#-----------------------------------------------
library(nlme);library(car);library(multcomp)
#-----------------------------------------------
#reading my data
#------------------------------------------------
pela<-read.csv("data.pela.csv", header=TRUE,
               sep=",",dec=".", strip.white=TRUE)
names(pela)
summary(pela)
str(pela)
#------------------------------------------------

#---------------------------------------------------------------------------
#Units for each explicative variable
#---------------------------------------------------------------------------
#dry_weight_g: individual dry weight,expressed in grams
#mo2: metabolic rate, expressed as mg O2 por hour per individual
#mo2.1: metabolic rate, expressed as mg O2 per hour per gram dry weight
#mo2.2: metabolic rate, expressed as mmol O2 per hour per gram dry weight
#mo2.3: metabolic rate, expressed as umol O2 per hour per gram dry weight
#mo2.4: metabolic rate, expressed as umol O2 por hour per individual
#--------------------------------------------------------
#Transformation of variables wrongly assigned to numeric
#--------------------------------------------------------
pela$stage=as.factor(pela$stage)
pela$oxygen_mg=as.numeric(pela$oxygen_mg)
pela$saturation=as.numeric(pela$saturation)
pela$mo2=as.numeric(pela$mo2)
pela$kpa<-as.numeric(pela$kpa)
pela$temperature=as.factor(pela$temperature)
###########################################
#EXPORTO MEDIAS PARA METAZOA
grouped <- group_by(pela,stage,kpa.mean,temperature)
datos.mean<-summarise(grouped, mean=mean(mo2.4), sd=sd(mo2.4))

round_df <- function(datos.mean, digits) {
  nums <- vapply(datos.mean, is.numeric, FUN.VALUE = logical(1))
  datos.mean[,nums] <- round(datos.mean[,nums], digits = digits)

  (datos.mean)
}

datos.met<-round_df(datos.mean, digits=6)

data.pela.metazoa<-merge(datos.mass,datos.met,by=c("stage","kpa.mean","temperature"))
data.pela.metazoa<-rename(data.pela.metazoa,dry_mass_mean=mean.x)
data.pela.metazoa<-rename(data.pela.metazoa,dry_mass_sd=sd.x)
data.pela.metazoa<-rename(data.pela.metazoa,resp_mean=mean.y)
data.pela.metazoa<-rename(data.pela.metazoa,resp_sd=sd.y)
#write.csv(data.pela.metazoa,"6090 Supplementary data of respiration.csv",row.names = FALSE)
###########################################
#-------------------------------------------------------------
#Scaling of Metabolic rates
#--------------------------------------------------------
# subset by stage
#--------------------------------------------------------
datos<-pela
unique(pela$stage)
embrio<-subset(datos,datos$stage=="Embryo")
adult<-subset(datos,datos$stage=="Adult")
juvenil<-subset(datos,datos$stage=="Juvenile")
megalopa<-subset(datos,datos$stage=="Megalopae")
Embryo01<-c(1:588)
Embryo01[which(pela$stage!="Embryo")]<-0 #without embryos
Embryo01[which(pela$stage=="Embryo")]<-1 #with embryos
pela<-cbind(pela,Embryo01)
pela$Embryo01<- as.factor(pela$Embryo01)
#
sapply(datos,class)
#---------------------------------------------------
#Testing different models
#---------------------------------------------------

stag1<-lm(log10(mo2.4)~log10(dry_weight_g),data=pela) #
summary(stag1)
AIC(stag1)
anova(stag1)
stag2<-lm(log10(mo2.4)~log10(dry_weight_g)*as.numeric(temperature),data=pela)
summary(stag2)
AIC(stag2)
anova(stag2)
stag3<-lm(log10(mo2.4)~log10(dry_weight_g)*kpa.mean,data=pela)
summary(stag3)
AIC(stag3)
anova(stag3)
stag4<-lm(log10(mo2.4)~log10(dry_weight_g)*kpa.mean+as.numeric(temperature),data=pela)
summary(stag4)
anova(stag4)
AIC(stag4)

# Ajusto mejor modelo stag4, ahora considerando huevos como una grupo separado a las otras etapas
eggs<-lm(log10(mo2.4)~log10(dry_weight_g)*kpa.mean+as.numeric(temperature)+Embryo01,data=pela)
summary(eggs)
anova(eggs)
AIC(eggs)
eggs1<-lm(log10(mo2.4)~log10(dry_weight_g)*as.factor(kpa.mean)+as.numeric(temperature)+Embryo01,data=pela)
summary(eggs1)
anova(eggs1)
AIC(eggs1)

AIC(stag4)-AIC(eggs1) # diferencia
# coeficientes y anova
summary(eggs)
Anova(eggs)
# exploratory graphics
plot(log10(mo2.4)~log10(dry_weight_g), data=pela)
# pendiente stag4: todas las etapas como un solo grupo
abline(stag4$coefficients[1]+stag4$coefficients[3]*mean(pela$kpa)+stag4$coefficients[4]*mean(as.numeric(pela$temperature))
       +stag4$coefficients[5]*mean(pela$kpa)*mean(as.numeric(pela$temperature)),stag4$coefficients[2])
# pendiente eggs: huevos como un grupo diferente de las otras tres etapas
abline(eggs$coefficients[1]+eggs$coefficients[3]*mean(pela$kpa)+eggs$coefficients[4]*mean(as.numeric(pela$temperature))
       +eggs$coefficients[6]*mean(pela$kpa)*mean(as.numeric(pela$temperature)),eggs$coefficients[2], col="gray")

#---------------------------------------------------
#plots + predict
setwd("D:/Dropbox/FL+WB/PELA/manuscript")
#setwd("~/Insync/Laboratorio.Poblaciones.Marinas/Publicaciones/Plasticidad pela/analisis/Submission")
#setwd("D:/felix.leiva@ulagos.cl/Laboratorio.Poblaciones.Marinas/Publicaciones/Plasticidad pela/analisis/datos")
{png(filename="1.1. Figure 2.png",width=8,height=4,units="in",res=600)
par(mfrow=c(1,2), tcl=-0.3, family="Arial", oma=c(2,2,0,0))
par(mai=c(0.4,0.5,0.2,0.2))
# PLOT 1

plot(log10(mo2.4)~log10(dry_weight_g),cex=0.8,xlim=c(-5,1),ylim=c(-5,1),ylab="", xlab="",
     yaxs="i",xaxs="i",col="white",las=1,frame.plot=FALSE,data=pela)
points(log10(mo2.4)~log10(dry_weight_g), data =subset(pela,!stage=="Embryo"), col="black",cex=0.8)
points(log10(mo2.4)~log10(dry_weight_g), data =subset(pela,stage=="Embryo"), col="gray50",cex=0.8) #display embryo data in grey
# modelo todas las etapas= 1 solo grupo
clip(x1=-4.5,x2=0.9,y1=-4.5,y2=0.9) # limite para abline
abline(stag4$coefficients[1]+stag4$coefficients[3]*mean(pela$kpa)+stag4$coefficients[4]*mean(as.numeric(pela$temperature))
       +stag4$coefficients[5]*mean(pela$kpa)*mean(as.numeric(pela$temperature)),stag4$coefficients[2], lwd=2,col="gray50")
# modelo que considera huevos separado de las otras tres etapas
clip(x1=-3.5,x2=0.9,y1=-3,y2=0.95)
# clip(x1=-4.5,x2=0.9,y1=-4.5,y2=0.9) # limite para abline
abline(eggs$coefficients[1]+eggs$coefficients[3]*mean(pela$kpa.mean)+eggs$coefficients[4]*mean(as.numeric(pela$temperature))
       +eggs$coefficients[6]*mean(pela$kpa.mean)*mean(as.numeric(pela$temperature)),eggs$coefficients[2], lwd=2)
# axis labels
mtext(expression(paste(Log[10]," metabolic rate")),side=2,cex=1, outer = T)
mtext(expression(paste(Log[10]," body mass")),side=1, cex=1, outer=T)
# labels slope whit egg
text(-1.5,-3.6,paste("slope =",round(stag4$coefficients[2],2), "?",
                     round(summary(stag4)$coefficients[2,2],2) ," eggs"),cex = 0.8, col="gray50") #Mass exponent=1.05 + 0.016
# # labels slope whithout eggs
text(-1.33,-4,paste("slope =",round(eggs$coefficients[2],2), "?",
                    round(summary(eggs)$coefficients[2,2],2)," no eggs"),cex = 0.8, col="black") #Mass exponent=0.92
text(-4.5,0.8,"A)",font = 2)
#---------------------------------------------------------------------------------------------
# PLOT 2
# Ajusto Modelos por cada nivel de kpa y  a temperatura constante=12°C
#---------------------------------------------------------------------------------------------
#x<-seq(from = min(log10(pela$dry_weight_g)), to = max(log10(pela$dry_weight_g)), length.out = 1000)
# Plot 2
plot(log10(mo2.4)~log10(dry_weight_g),cex=0.8,xlim=c(-5,1),ylim=c(-5,1),yaxs="i",xaxs="i",col="white",
     xlab="", ylab="",las=1, frame.plot=FALSE,data=pela)
points(log10(mo2.4)~log10(dry_weight_g), data =subset(pela,!stage=="Embryo"), col="black",cex=0.8)
points(log10(mo2.4)~log10(dry_weight_g), data =subset(pela,stage=="Embryo"), col="gray50",cex=0.8) #display embryo data in grey
clip(x1=-3.5,x2=0.9,y1=-3,y2=0.95) # limite para abline
# kpa= 21
df21<-subset(pela,temperature==12 & kpa==21.21)
lmdf21<-lm(log10(mo2.4)~log10(dry_weight_g)+Embryo01,data=df21)
abline(lmdf21$coefficients[1]+lmdf21$coefficients[3]*0,lmdf21$coefficients[2]) # if Embryo=0, without eggs
summary(lmdf21)$coeff
# kpa= 14
df14<-subset(pela,temperature==12 & kpa==14.14)
lmdf14<-lm(log10(mo2.4)~log10(dry_weight_g)+Embryo01,data=df14)
abline(lmdf14$coefficients[1]+lmdf14$coefficients[3]*0,lmdf14$coefficients[2], lty=5) #  # if Embryo=0, without eggs
summary(lmdf14)$coeff
# kpa= 9
df9<-subset(pela,temperature==12 & kpa==9.43)
lmdf9<-lm(log10(mo2.4)~log10(dry_weight_g)+Embryo01,data=df9)#  if Embryo=0, without eggs
abline(lmdf9$coefficients[1]+lmdf9$coefficients[3]*0,lmdf9$coefficients[2], lty=2)
summary(lmdf9)$coeff
# kpa= 5
df5<-subset(pela,temperature==12 & kpa==4.71)
lmdf5<-lm(log10(mo2.4)~log10(dry_weight_g)+Embryo01,data=df5)#without embryos
abline(lmdf5$coefficients[1]+lmdf5$coefficients[3]*0,lmdf5$coefficients[2], lty=4)
summary(lmdf5)$coeff
# kpa= 2
df2<-subset(pela,temperature==12 & kpa==2.36)
lmdf2<-lm(log10(mo2.4)~log10(dry_weight_g)+Embryo01,data=df2)#without embryos
abline(lmdf2$coefficients[1]+lmdf2$coefficients[1]*0,lmdf2$coefficients[2], lty=3)
summary(lmdf2)$coeff

# labels slope models without embryos
clip(x1=-5,x2=0.9,y1=-5,y2=0.95) # limite para abline
text(-1,-3,paste("slope 21 kPa =",round(lmdf21$coefficients[2],2), "?",
                 round(summary(lmdf21)$coefficients[2,2],2)),cex = 0.8, col="black")
lines(x=c(-3.1,-2.7), y=c(-3,-3))

text(-1,-3.25,paste("slope 14 kPa =",round(lmdf14$coefficients[2],2), "?",
                   round(summary(lmdf14)$coefficients[2,2],2)),cex = 0.8, col="black")
lines(x=c(-3.1,-2.7), y=c(-3.25,-3.25),lty=5)

text(-1,-3.5,paste("slope"," ","9 kPa =",round(lmdf9$coefficients[2],2), "?",
                   round(summary(lmdf9)$coefficients[2,2],2)),cex = 0.8, col="black")
lines(x=c(-3.1,-2.7), y=c(-3.5,-3.5),lty=2)

text(-1,-3.75,paste("slope"," " ,"5 kPa =",round(lmdf5$coefficients[2],2), "?",
                   round(summary(lmdf5)$coefficients[2,2],2)),cex = 0.8, col="black")
lines(x=c(-3.1,-2.7), y=c(-3.75,-3.75),lty=4)

text(-1,-4,paste("slope", " ","2 kPa =",round(lmdf2$coefficients[2],2), "?",
                   round(summary(lmdf2)$coefficients[2,2],2)),cex = 0.8, col="black")
lines(x=c(-3.1,-2.7), y=c(-4,-4),lty=3)
text(-4.5,0.8,"B)",font = 2)
}
dev.off()

#Figure S2 Supplementary information

temp6.s<-lm(log10(mo2.4)~log10(dry_weight_g)*kpa+Embryo01,data=subset(pela, temperature==6))
temp12.s<-lm(log10(mo2.4)~log10(dry_weight_g)*kpa+Embryo01,data=subset(pela, temperature==12))
temp18.s<-lm(log10(mo2.4)~log10(dry_weight_g)*kpa+Embryo01,data=subset(pela, temperature==18))
{
png(filename="Figure S2.png",width=6,height=6,units="in",res=600)
par(mfrow=c(1,1), tcl=-0.3, family="Arial", oma=c(0,0,0,0))
plot(log10(mo2.4)~log10(dry_weight_g),cex=0.8,xlim=c(-5,1),ylim=c(-5,1),ylab="", xlab="",
     yaxs="i",xaxs="i",col="white",las=1,frame.plot=FALSE,data=pela)
points(log10(mo2.4)~log10(dry_weight_g), data=subset(pela, !stage=="Embryo"), col="black",cex=0.8)
points(log10(mo2.4)~log10(dry_weight_g), data=subset(pela, stage=="Embryo"), col="gray50",cex=0.8)
mtext(expression(paste(Log[10]," metabolic rate")),side=2,  line=2, outer=F)
mtext(expression(paste(Log[10]," body mass")),side=1, cex=1, outer=F, line=3)
# Without eggs at 6?C
clip(x1=-3.5,x2=0.9,y1=-4.5,y2=0.9) # limite para abline
abline(temp6.s$coefficients[1]+temp6.s$coefficients[3]*mean(pela$kpa)+temp6.s$coefficients[5]*mean(log10(pela$dry_weight_g))*mean(pela$kpa),
       temp6.s$coefficients[2], lty=1,col="black")
text(-1.0,-3.5,paste("slope  6°C =",round(temp6.s$coefficients[2],2), "±",
                     round(summary(temp6.s)$coefficients[2,2],2)),cex = 0.9, col="black")
lines(x=c(-2.3,-2.6), y=c(-3.5,-3.5),lty=1, col="black")

# Without eggs at 12?C
clip(x1=-3.5,x2=0.9,y1=-4.5,y2=0.9) # limite para abline
abline(temp12.s$coefficients[1]+temp12.s$coefficients[3]*mean(pela$kpa)+temp12.s$coefficients[5]*mean(log10(pela$dry_weight_g))*mean(pela$kpa),
       temp12.s$coefficients[2], lty=2,col="black")
text(-1.0,-3.75,paste("slope 12°C =",round(temp12.s$coefficients[2],2), "±",
                   round(summary(temp12.s)$coefficients[2,2],2)),cex = 0.9, col="black")
lines(x=c(-2.3,-2.6), y=c(-3.75,-3.75),lty=2, col="black")
# Without eggs at 18?C
clip(x1=-3.5,x2=0.9,y1=-4.5,y2=0.9) # limite para abline
abline(temp18.s$coefficients[1]+temp18.s$coefficients[3]*mean(pela$kpa)+temp18.s$coefficients[5]*mean(log10(pela$dry_weight_g))*mean(pela$kpa),
       temp18.s$coefficients[2], lty=3,col="black")
text(-1.0,-4,paste("slope 18°C =",round(temp18.s$coefficients[2],2), "±",
                   round(summary(temp18.s)$coefficients[2,2],2)),cex = 0.9, col="black")
lines(x=c(-2.3,-2.6), y=c(-4,-4),lty=3, col="black")
}
dev.off()

# #Figure S2 Supplementary information
#
# temp6<-lm(log10(mo2.4)~log10(dry_weight_g)*kpa,data=subset(pela, temperature==6))
# temp6.s<-lm(log10(mo2.4)~log10(dry_weight_g)*kpa+Embryo01,data=subset(pela, temperature==6))
# temp12<-lm(log10(mo2.4)~log10(dry_weight_g)*kpa,data=subset(pela, temperature==12))
# temp12.s<-lm(log10(mo2.4)~log10(dry_weight_g)*kpa+Embryo01,data=subset(pela, temperature==12))
# temp18<-lm(log10(mo2.4)~log10(dry_weight_g)*kpa,data=subset(pela, temperature==18))
# temp18.s<-lm(log10(mo2.4)~log10(dry_weight_g)*kpa+Embryo01,data=subset(pela, temperature==18))
#
# #png(filename="D:/Dropbox/FL+WB/PELA/manuscript/submission/ 1.1. Figure S2 Scaling of metabolic rate by tempeature.png",width=6,height=6,units="in",res=600)
# plot(log10(mo2.4)~log10(dry_weight_g),cex=0.8,xlim=c(-5,1),ylim=c(-5,1),ylab="", xlab="",
#      yaxs="i",xaxs="i",col="white",las=1,frame.plot=FALSE,data=pela)
# points(log10(mo2.4)~log10(dry_weight_g), data=subset(pela, !stage=="Embryo"), col="black",cex=0.8)
# points(log10(mo2.4)~log10(dry_weight_g), data=subset(pela, stage=="Embryo"), col="gray50",cex=0.8)
# mtext(expression(paste(Log[10]," metabolic rate")),side=2,  line=2, outer=F)
# mtext(expression(paste(Log[10]," body mass")),side=1, cex=1, outer=F, line=3)
#
# # Fit for all life stages at 6?C
# clip(x1=-4.5,x2=0.9,y1=-4.5,y2=0.9) # limite para abline
# abline(temp6$coefficients[1]+temp6$coefficients[3]*mean(pela$kpa)+temp6$coefficients[4]*mean(log10(pela$dry_weight_g))*mean(pela$kpa),
#        temp6$coefficients[2], lty=1,col="gray50")
#
# # Fit for all life stages at 12?C
# clip(x1=-4.5,x2=0.9,y1=-4.5,y2=0.9) # limite para abline
# abline(temp12$coefficients[1]+temp12$coefficients[3]*mean(pela$kpa)+temp12$coefficients[4]*mean(log10(pela$dry_weight_g))*mean(pela$kpa),
#        temp12$coefficients[2], lty=3,col="gray50")
#
# # Fit for all life stages at 18?C
# clip(x1=-4.5,x2=0.9,y1=-4.5,y2=0.9) # limite para abline
# abline(temp18$coefficients[1]+temp18$coefficients[3]*mean(pela$kpa)+temp18$coefficients[4]*mean(log10(pela$dry_weight_g))*mean(pela$kpa),
#        temp18$coefficients[2], lty=4,col="gray50")
#
# text(-0.81,-3,paste("slope 6?C =",round(temp6$coefficients[2],2), "?",
#                     round(summary(temp6)$coefficients[2,2],2)), col="gray50")
# lines(x=c(-2,-2.3), y=c(-3,-3),lty=1, col="gray50")
# text(-0.79,-3.5,paste("slope 12?C =",round(temp12$coefficients[2],2), "?",
#                       round(summary(temp12)$coefficients[2,2],2)), col="gray50")
# lines(x=c(-2,-2.3), y=c(-3.5,-3.5),lty=3, col="gray50")
#
# text(-0.79,-4,paste("slope 18?C =",round(temp18$coefficients[2],2), "?",
#                     round(summary(temp18)$coefficients[2,2],2)), col="gray50")
# lines(x=c(-2,-2.3), y=c(-4,-4),lty=4, col="gray50")
#
# #dev.off()
#
#
#
# #----------------------------------------------------------------------------------------
# # Modelo para cada temperatura version 2
# #----------------------------------------------------------------------------------------
# temp6<-lm(log10(mo2.4)~log10(dry_weight_g)*kpa,data=subset(pela, temperature==6))
# temp12<-lm(log10(mo2.4)~log10(dry_weight_g)*kpa,data=subset(pela, temperature==12))
# temp18<-lm(log10(mo2.4)~log10(dry_weight_g)*kpa,data=subset(pela, temperature==18))
#
# png(filename="D:/Dropbox/FL+WB/PELA/manuscript/submission/ 1.1. Figure S2b Scaling of metabolic rate by tempeature.png",width=8,height=8,units="in",res=600)
# par(mfrow=c(2,2))
#
# #6?C
# plot(log10(mo2.4)~log10(dry_weight_g),cex=0.8,xlim=c(-5,1),ylim=c(-5,1),ylab="", xlab="",
#      yaxs="i",xaxs="i",col="white",las=1,frame.plot=FALSE,data=pela)
# points(log10(mo2.4)~log10(dry_weight_g), data =subset(pela, temperature==6 & !stage=="Embryo"), col="black",cex=0.8)
# points(log10(mo2.4)~log10(dry_weight_g), data =subset(pela, temperature==6 & stage=="Embryo"), col="gray50",cex=0.8)
# mtext(expression(paste(Log[10]," metabolic rate")),side=2,  line=2, outer=F)
# mtext(expression(paste(Log[10]," body mass")),side=1, cex=1, outer=F, line=3)
# # All life stages at 6?C
# clip(x1=-4.5,x2=0.9,y1=-4.5,y2=0.9) # limite para abline
# abline(temp6$coefficients[1]+temp6$coefficients[3]*mean(pela$kpa)+temp6$coefficients[4]*mean(log10(pela$dry_weight_g))*mean(pela$kpa),
#        temp6$coefficients[2], lty=1,col="gray50")
# # Without eggs at 6?C
# clip(x1=-3.5,x2=0.9,y1=-4.5,y2=0.9) # limite para abline
# abline(temp6.s$coefficients[1]+temp6.s$coefficients[3]*mean(pela$kpa)+temp6.s$coefficients[5]*mean(log10(pela$dry_weight_g))*mean(pela$kpa),
#        temp6.s$coefficients[2], lty=1,col="black")
# # labels at 6?C
# text(-1.1,-3.5,paste("slope 6?C eggs =",round(temp6$coefficients[2],2), "?",
#                      round(summary(temp6)$coefficients[2,2],2)),cex = 0.9, col="gray50")
# lines(x=c(-3,-3.3), y=c(-3.5,-3.5),lty=1, col="gray50")
# text(-1.0,-4.0,paste("slope 6?C no eggs =",round(temp6.s$coefficients[2],2), "?",
#                      round(summary(temp6.s)$coefficients[2,2],2)),cex = 0.9, col="black")
# lines(x=c(-3,-3.3), y=c(-4,-4),lty=1, col="black")
#
# # 12?C
# plot(log10(mo2.4)~log10(dry_weight_g),cex=0.8,xlim=c(-5,1),ylim=c(-5,1),ylab="", xlab="",
#      yaxs="i",xaxs="i",col="white",las=1,frame.plot=FALSE,data=pela)
# points(log10(mo2.4)~log10(dry_weight_g), data =subset(pela, temperature==12 & !stage=="Embryo"), col="black",cex=0.8)
# points(log10(mo2.4)~log10(dry_weight_g), data =subset(pela, temperature==12 & stage=="Embryo"), col="gray50",cex=0.8)
# mtext(expression(paste(Log[10]," metabolic rates")),side=2,  line=2, outer=F)
# mtext(expression(paste(Log[10]," body mass")),side=1, cex=1, outer=F, line=3)
#
# # All life stages at 12?C
# clip(x1=-4.5,x2=0.9,y1=-4.5,y2=0.9) # limite para abline
# abline(temp12$coefficients[1]+temp12$coefficients[3]*mean(pela$kpa)+temp12$coefficients[4]*mean(log10(pela$dry_weight_g))*mean(pela$kpa),
#        temp12$coefficients[2], lty=1,col="gray50")
# # Without eggs at 12?C
# clip(x1=-3.5,x2=0.9,y1=-4.5,y2=0.9) # limite para abline
# abline(temp12.s$coefficients[1]+temp12.s$coefficients[3]*mean(pela$kpa)+temp12.s$coefficients[5]*mean(log10(pela$dry_weight_g))*mean(pela$kpa),
#        temp12.s$coefficients[2], lty=1,col="black")
# # labels at 12C?
# text(-1.1,-3.5,paste("slope 12?C eggs =",round(temp12$coefficients[2],2), "?",
#                      round(summary(temp12)$coefficients[2,2],2)),cex = 0.9, col="gray50")
# lines(x=c(-3,-3.3), y=c(-3.5,-3.5),lty=1, col="gray50")
# text(-1.0,-4,paste("slope 12?C no eggs =",round(temp12.s$coefficients[2],2), "?",
#                    round(summary(temp12.s)$coefficients[2,2],2)),cex = 0.9, col="black")
# lines(x=c(-3,-3.3), y=c(-4,-4),lty=1, col="black")
#
# # Without eggs at 12?C
# plot(log10(mo2.4)~log10(dry_weight_g),cex=0.8,xlim=c(-5,1),ylim=c(-5,1),ylab="", xlab="",
#      yaxs="i",xaxs="i",col="white",las=1,frame.plot=FALSE,data=pela)
# points(log10(mo2.4)~log10(dry_weight_g), data =subset(pela, temperature==18 & !stage=="Embryo"), col="black",cex=0.8)
# points(log10(mo2.4)~log10(dry_weight_g), data =subset(pela, temperature==18 & stage=="Embryo"), col="gray50",cex=0.8)
# mtext(expression(paste(Log[10]," metabolic rates")),side=2,  line=2, outer=F)
# mtext(expression(paste(Log[10]," body mass")),side=1, cex=1, outer=F, line=3)
# #
# # All life stages at 18?C
# clip(x1=-4.5,x2=0.9,y1=-4.5,y2=0.9) # limite para abline
# abline(temp18$coefficients[1]+temp18$coefficients[3]*mean(pela$kpa)+temp18$coefficients[4]*mean(log10(pela$dry_weight_g))*mean(pela$kpa),
#        temp18$coefficients[2], lty=1,col="gray50")
# # Without eggs at 18?C
# clip(x1=-3.5,x2=0.9,y1=-4.5,y2=0.9) # limite para abline
# abline(temp18.s$coefficients[1]+temp18.s$coefficients[3]*mean(pela$kpa)+temp18.s$coefficients[5]*mean(log10(pela$dry_weight_g))*mean(pela$kpa),
#        temp18.s$coefficients[2], lty=1,col="black")
# # labels at 18?C
# text(-1.1,-3.5,paste("slope 18?C eggs =",round(temp18$coefficients[2],2), "?",
#                      round(summary(temp18)$coefficients[2,2],2)),cex = 0.9, col="gray50")
# lines(x=c(-3,-3.3), y=c(-3.5,-3.5),lty=1, col="gray50")
# text(-1.0,-4,paste("slope 18?C no eggs =",round(temp18.s$coefficients[2],2), "?",
#                    round(summary(temp18.s)$coefficients[2,2],2)),cex = 0.9, col="black")
# lines(x=c(-3,-3.3), y=c(-4,-4),lty=1, col="black")
# dev.off()
#


## anova between cell types for DMP analysis
## sets double negative as baseline
## bumphunter for regional analysis
## use Zhou et al hg38 probe annotation to align with other omics data.

anovaModel<-function(row, celltype, age,sex){
	model<-lm(row ~ celltype + age + sex)
	null<-lm(row ~ age + sex)
	tmp<-summary(model)$coefficients
	regCoeffs<-c(t(tmp[c("celltypeNeuN +ve", "celltypeSox10 +ve", "celltypeIRF8 +ve"), c(1,4)]), anova(model,null)[2,6])
	return(regCoeffs)
}

library(ChIPseeker)
library(Gviz)
library(TxDb.Hsapiens.UCSC.hg38.knownGene)
library(doParallel)
library(data.table)

### test cell comp differences
source("rmdConfig.mrc")
setwd(dataDir)
load(normData)

## remove rs probes
celltypenormbeta<-celltypenormbeta[grep("rs", rownames(celltypenormbeta), invert = TRUE),]

## calc cell type means including Total
cellMeans<-NULL
for(each in sort(unique(pheno$Cell.type))){
	cellMeans<-cbind(cellMeans, apply(celltypenormbeta[,which(pheno$Cell.type == each)], 1, mean))
}
colnames(cellMeans)<-sort(unique(pheno$Cell.type))

## calc cell type SDs including Total
cellSDs<-NULL
for(each in sort(unique(pheno$Cell.type))){
	cellSDs<-cbind(cellSDs, apply(celltypenormbeta[,which(pheno$Cell.type == each)], 1, sd))
}
colnames(cellSDs)<-sort(unique(pheno$Cell.type))

## filter to just cell fractions
pheno<-pheno[pheno$Cell.type %in% c("Double -ve","NeuN +ve","Sox10 +ve", "IRF8 +ve"),]
celltypenormbeta<-celltypenormbeta[,pheno$Basename]
pheno$Cell.type<-factor(pheno$Cell.type)

## anova for cell type differences at individual positions
ctOut<-apply(celltypenormbeta, 1, anovaModel, pheno$Cell.type, pheno$Age, pheno$Sex)
ctOut<-t(ctOut)
colnames(ctOut)<-c("NeuN:Coeff", "NeuN:P", "Sox10:Coeff", "Sox10:P",  "IRF8:Coeff", "IRF8:P", "ANOVA:P")

annoObj <-  minfi::getAnnotationObject("IlluminaHumanMethylationEPICanno.ilm10b4.hg19")
all <- minfi:::.availableAnnotation(annoObj)$defaults
newfData <- do.call(cbind, lapply(all, function(wh) {
        minfi:::.annoGet(wh, envir = annoObj@data)
}))

newfData<-newfData[rownames(celltypenormbeta),]

## filter out sites with missing location info
ctOut<-ctOut[!is.na(newfData$pos),]
celltypenormbeta<-celltypenormbeta[rownames(ctOut),]
newfData <- newfData[rownames(ctOut), ]

## looking at ucsc the middle of start,end gives the C position
probeAnno<-fread("../References/EPICArray/EPIC.anno.GRCh38.tsv", sep = "\t", header = TRUE)
probeAnno<-probeAnno[match(rownames(celltypenormbeta), probeAnno$probeID),]
probeAnno<-as.data.frame(probeAnno)

ctOut<-cbind(ctOut, probeAnno[,c("chrm","start", "end", "GeneNames", "GeneClasses", "TranscriptIDs")])
ctOut<-ctOut[which(ctOut$chrm != "*"),]
save(ctOut, file="Analysis/CellType/ANOVABrainCellTypes.rdata")

length(which(ctOut[,7] < 9e-8))
length(which(ctOut[,2] < 9e-8))
length(which(ctOut[,4] < 9e-8))
length(which(ctOut[,6] < 9e-8))

pdf("Analysis/CellType/QQplot.pdf")
par(mfrow = c(2,2))
qq(ctOut[,7], main = "Any")
qq(ctOut[,2], main = "NeuNvsDoubleNeg")
qq(ctOut[,4], main = "Sox10vsDoubleNeg")
qq(ctOut[,6], main = "IRF8vsDoubleNeg")
dev.off()

index<-which(ctOut[,7] < 9e-8)

## look at direction of effect
pdf("Analysis/CellType/HistDMPsMeanDifferences.pdf", width = 12, height = 4)
par(mfrow = c(1,3))
hist(ctOut[which(ctOut[,2] < 9e-8),1], xlab = "Mean Difference", main = "NeuNvsDoubleNegative", ylab = "nDMPs")
signTab<-table(sign(ctOut[which(ctOut[,2] < 9e-8),1]))
signTest<-binom.test(signTab[1], sum(signTab))
text(x =  par("usr")[2],y =  par("usr")[4], pos = 2, offset = -1, paste(signif(signTab[2]/sum(signTab)*100,3), "% DMPs hypermethylated.\nP =", signif(signTest$p.value, 3)), xpd= TRUE)
hist(ctOut[which(ctOut[,4] < 9e-8),3], xlab = "Mean Difference", main = "Sox10vsDoubleNegative", ylab = "nDMPs")
signTab<-table(sign(ctOut[which(ctOut[,4] < 9e-8),3]))
signTest<-binom.test(signTab[1], sum(signTab))
text(x =  par("usr")[2],y =  par("usr")[4], pos = 2, offset = -1, paste(signif(signTab[2]/sum(signTab)*100,3), "% DMPs hypermethylated.\nP =", signif(signTest$p.value, 3)), xpd= TRUE)
hist(ctOut[which(ctOut[,6] < 9e-8),5], xlab = "Mean Difference", main = "IRF8vsDoubleNegative", ylab = "nDMPs")
signTab<-table(sign(ctOut[which(ctOut[,6] < 9e-8),5]))
signTest<-binom.test(signTab[1], sum(signTab))
text(x =  par("usr")[2],y =  par("usr")[4], pos = 2, offset = -1, paste(signif(signTab[2]/sum(signTab)*100,3), "% DMPs hypermethylated.\nP =", signif(signTest$p.value, 3)), xpd= TRUE)
dev.off()

library(VennDiagram)
library(minfi)

# Chart
venn.diagram(
  x = list(rownames(ctOut)[which(ctOut[,2] < 9e-8)], rownames(ctOut)[which(ctOut[,4] < 9e-8)], rownames(ctOut)[which(ctOut[,6] < 9e-8)]),
  category.names = c("NeuNvsDoubleNeg" , "Sox10vsDoubleNeg" , "IRF8vsDoubleNeg"),
  filename = 'Analysis/CellType/VennDiagramCelltypeDMPs.png',
  output=TRUE
)

## for probes that are DMPs in two cell types, same direction and magnitude?

Neun.ES<-cut(ctOut[,1], seq(-1,1,0.05))
Sox10.ES<-cut(ctOut[,3], seq(-1,1,0.05))
Irf8.ES<-cut(ctOut[,5], seq(-1,1,0.05))

pdf("Analysis/CellType/HeatmapSharedDMPsBetweenCellTypes.pdf")
index<-which(ctOut[,2] < 9e-8 & ctOut[,4] < 9e-8)
heatmap(table(Neun.ES[index], Sox10.ES[index]), Rowv = NA, Colv = NA, xlab = "NeuN+ve vs Double-ve", ylab = "Sox10+ve vs Double-ve")
index<-which(ctOut[,2] < 9e-8 & ctOut[,6] < 9e-8)
heatmap(table(Neun.ES[index], Irf8.ES[index]), Rowv = NA, Colv = NA, xlab = "NeuN+ve vs Double-ve", ylab = "Irf8+ve vs Double-ve")
index<-which(ctOut[,4] < 9e-8 & ctOut[,6] < 9e-8)
heatmap(table(Sox10.ES[index], Irf8.ES[index]), Rowv = NA, Colv = NA, xlab = "Sox10+ve vs Double-ve", ylab = "Irf8+ve vs Double-ve")
dev.off()

## how many loci?
dat<-data.frame("ids" = rownames(ctOut), "pval" = ctOut[,"NeuN:P"], "chr" = newfData$chr, "pos" = newfData$pos)
clump.neun<-clump(dat, thres1 = 9e-28, thres2 = 9e-28)

## how many genes?

## bumphunter to call regions

## filter samples with missing Age
celltypenormbeta<-celltypenormbeta[,!is.na(pheno$Age)]
pheno<-pheno[!is.na(pheno$Age),]
## sort
ctOut<-ctOut[order(ctOut$chrm, ctOut$start),]
celltypenormbeta<-celltypenormbeta[rownames(ctOut),]

cl<-clusterMaker(ctOut$chrm, ctOut$start, maxGap = 500)

## use probes in clusters with > 1 probe to determine background genes for pathway analysis
tab<-table(cl)
tab<-tab[which(tab > 1)]
backgroundDMRs<-GRanges(seqnames = ctOut$chrm[which(cl %in% names(tab))], strand = "*", ranges = IRanges(start = ctOut$start[which(cl %in% names(tab))], end = ctOut$end[which(cl %in% names(tab))]))
save(backgroundDMRs, file = "Analysis/CellType/BackgroundDMRProbes.rdata")
#segs <- getSegments(ctOut[,1], cl, cutoff=0.05, assumeSorted = FALSE)
#tabs<-regionFinder(ctOut[,1],newfData$chr, newfData$pos, cl, cutoff = 0.05)
nCor<-detectCores()
registerDoParallel(cores = nCor)

designMat<-model.matrix(formula( ~ pheno$Cell.type + pheno$Age + pheno$Sex))
## need to run twice to compare Neun+ to all others and then Sox10+ to all others
tab.neun<-bumphunter(celltypenormbeta, designMat, ctOut$chrm, as.numeric(ctOut$start), cl, coef = 3, cutoff = 0.1, nullMethod="bootstrap")
tab.irf8<-bumphunter(celltypenormbeta, designMat, ctOut$chrm, ctOut$start, cl, coef = 2,cutoff = 0.1, nullMethod="bootstrap")
tab.sox10<-bumphunter(celltypenormbeta, designMat, ctOut$chrm, ctOut$start, cl, coef = 4,cutoff = 0.1, nullMethod="bootstrap")
save(tab.neun, tab.sox10, tab.irf8,file="Analysis/CellType/BumpHunterBrainCellTypes.rdata")

## as bootstrapping takes too long/never seems to finish even with a handful of iterations look at overlap of significant DMPs in these regions

dmps<-GRanges(seqnames = ctOut$chrm, strand = "*", ranges = IRanges(start = ctOut$start, end = ctOut$end))
mcols(dmps)<-ctOut[,1:7]
neun.regions<-GRanges(seqnames = tab.neun$table$chr, strand = "*", ranges = IRanges(start = tab.neun$table$start, end = tab.neun$table$end))
mcols(neun.regions)<-tab.neun$table[,-c(1:3)]
sox10.regions<-GRanges(seqnames = tab.sox10$table$chr, strand = "*", ranges = IRanges(start = tab.sox10$table$start, end = tab.sox10$table$end))
mcols(sox10.regions)<-tab.sox10$table[,-c(1:3)]
irf8.regions<-GRanges(seqnames = tab.irf8$table$chr, strand = "*", ranges = IRanges(start = tab.irf8$table$start, end = tab.irf8$table$end))
mcols(irf8.regions)<-tab.irf8$table[,-c(1:3)]

## filter to regions with at least 2 sites
neun.regions<-neun.regions[neun.regions$L > 1]
sox10.regions<-sox10.regions[sox10.regions$L > 1]
irf8.regions<-irf8.regions[irf8.regions$L > 1]

## calculate proportion of probes in bump from cluster
summary(neun.regions$L/neun.regions$clusterL)
summary(sox10.regions$L/sox10.regions$clusterL)
summary(irf8.regions$L/irf8.regions$clusterL)

## for each region count significant DMPs
interDmpsNeun<-findOverlaps(dmps, neun.regions)
nDMPs<-table(subjectHits(interDmpsNeun)[which(mcols(dmps)[queryHits(interDmpsNeun), "NeuN:P"] < 9e-8)])
neun.regions$nDMPs<-as.numeric(nDMPs[match(1:length(neun.regions), names(nDMPs))])
neun.regions$nDMPs[is.na(neun.regions$nDMPs)]<-0

interDmpsSox10<-findOverlaps(dmps, sox10.regions)
nDMPs<-table(subjectHits(interDmpsSox10)[which(mcols(dmps)[queryHits(interDmpsSox10), "Sox10:P"] < 9e-8)])
sox10.regions$nDMPs<-as.numeric(nDMPs[match(1:length(sox10.regions), names(nDMPs))])
sox10.regions$nDMPs[is.na(sox10.regions$nDMPs)]<-0

interDmpsIrf8<-findOverlaps(dmps, irf8.regions)
nDMPs<-table(subjectHits(interDmpsIrf8)[which(mcols(dmps)[queryHits(interDmpsIrf8), "IRF8:P"] < 9e-8)])
irf8.regions$nDMPs<-as.numeric(nDMPs[match(1:length(irf8.regions), names(nDMPs))])
irf8.regions$nDMPs[is.na(irf8.regions$nDMPs)]<-0

summary(neun.regions$nDMPs)
summary(neun.regions$nDMPs/neun.regions$L)
length(which(neun.regions$nDMPs/neun.regions$L == 1))
summary(sox10.regions$nDMPs)
summary(sox10.regions$nDMPs/sox10.regions$L)
length(which(sox10.regions$nDMPs/sox10.regions$L == 1))
summary(irf8.regions$nDMPs)
summary(irf8.regions$nDMPs/irf8.regions$L)
length(which(irf8.regions$nDMPs/irf8.regions$L == 1))

## summarise size of bumps
summary(width(neun.regions))
summary(width(sox10.regions))
summary(width(irf8.regions))
summary(width(neun.regions[which(neun.regions$nDMPs > 0),]))
summary(width(sox10.regions[which(sox10.regions$nDMPs > 0),]))
summary(width(irf8.regions[which(irf8.regions$nDMPs > 0),]))
summary(width(neun.regions[which(neun.regions$nDMPs/neun.regions$L == 1),]))
summary(width(sox10.regions[which(sox10.regions$nDMPs/sox10.regions$L == 1),]))
summary(width(irf8.regions[which(irf8.regions$nDMPs/irf8.regions$L == 1),]))

## identify regions specific to each cell type
neun.specific<-neun.regions[unique(subjectHits(findOverlaps(setdiff(neun.regions, reduce(c(sox10.regions, irf8.regions))), neun.regions))),]
sox10.specific<-sox10.regions[unique(subjectHits(findOverlaps(setdiff(sox10.regions,reduce(c(neun.regions, irf8.regions))), sox10.regions))),]
irf8.specific<-irf8.regions[unique(subjectHits(findOverlaps(setdiff(irf8.regions,reduce(c(neun.regions, sox10.regions))), irf8.regions))),]

## noticed some specific regions are consecuative
neun.conseq<-unique(c(neun.specific[queryHits(findOverlaps(neun.specific, sox10.specific)),], neun.specific[queryHits(findOverlaps(neun.specific, irf8.specific)),]))
sox10.conseq<-unique(c(sox10.specific[subjectHits(findOverlaps(neun.specific, sox10.specific)),],sox10.specific[subjectHits(findOverlaps(irf8.specific, sox10.specific)),]))
irf8.conseq<-unique(c(irf8.specific[subjectHits(findOverlaps(neun.specific, irf8.specific)),],irf8.specific[subjectHits(findOverlaps(sox10.specific, irf8.specific)),]))

## how many DMPs are not located within

singleProbeCl<-names(table(cl))[which(table(cl) == 1)]
table(unique(cl[which(ctOut[,2] < 9e-8)]) %in% singleProbeCl)
table(unique(cl[which(ctOut[,4] < 9e-8)]) %in% singleProbeCl)
table(unique(cl[which(ctOut[,6] < 9e-8)]) %in% singleProbeCl)

## annotate with genes
txdb <- TxDb.Hsapiens.UCSC.hg38.knownGene
neunRegionAnno <- annotatePeak(neun.regions, tssRegion=c(-3000, 3000), TxDb=txdb)
sox10RegionAnno <- annotatePeak(sox10.regions, tssRegion=c(-3000, 3000), TxDb=txdb)
irf8RegionAnno <- annotatePeak(irf8.regions, tssRegion=c(-3000, 3000), TxDb=txdb)
save(neunRegionAnno, sox10RegionAnno, irf8RegionAnno, file = "Analysis/CellType/AnnotatedBumps.rdata")

## plot examples select those with the most DMPs
plotCols<-c("darkgreen", "darkblue", "darkmagenta", "deeppink", "darkgray") ## assumes celltypes are ordered alphabetically

axTrack <- GenomeAxisTrack()

pdf("Analysis/CellType/NeuNSpecificDMRs.pdf", width = 8, height = 8)
for(i in order(neun.specific$nDMPs, decreasing = TRUE)[1:10]){
	start <- as.numeric(start(neun.specific)[i])
	end <- as.numeric(end(neun.specific)[i])
	chr <- as.character(seqnames(neun.specific)[i])

	## add in window around region
	windowSize<-end-start
	start<-start-windowSize
	end<-end+windowSize
	probesInCluster<-rownames(newfData)[which(newfData$chr == chr & newfData$pos <= end+1000000 & newfData$pos >= start-1000000)] ### add in extra sites so that plot starts and finishes outside of plotting region

	idxTrack <- IdeogramTrack(genome="hg19", chromosome=chr)
	refGenes <- UcscTrack(genome="hg19", chromosome=chr, table="ncbiRefSeq", track = 'NCBI RefSeq',from=start, to=end, trackType="GeneRegionTrack", rstarts="exonStarts", rends="exonEnds", gene="name",
							symbol="name2", transcript="name", strand="strand", fill="#8282d2",
							  name="NCBI RefSeq", transcriptAnnotation="symbol", collapseTranscripts = "longest")
	cpgIslands <- UcscTrack(genome="hg19", chromosome=chr, track="cpgIslandExt", from=start, to=end,trackType="AnnotationTrack", start="chromStart", end="chromEnd", id="name",shape="box", fill="#006400", name="CpG Islands")

	cellMeans.granges<-GRanges(seqnames = newfData[probesInCluster, "chr"], strand = "*", ranges = IRanges(start = newfData[probesInCluster, "pos"], end = newfData[probesInCluster, "pos"]), cellMeans[probesInCluster, ])
	dTrack1<-DataTrack(range = cellMeans.granges, genome = "hg19", type = "p", chromosome=chr, name = "DNAm Mean", col = plotCols[1:4], type = "smooth", groups = c("Double -ve", "IRF8+ve", "NeuN+ve", "Sox10+ve"), lwd = 2, baseline = seq(0,1,0.2), col.baseline = "gray", lwd.baseline = 1)
	coeffs.granges<-GRanges(seqnames = newfData[probesInCluster, "chr"], strand = "*", ranges = IRanges(start = newfData[probesInCluster, "pos"], end = newfData[probesInCluster, "pos"]), ctOut[probesInCluster, c("IRF8:Coeff", "NeuN:Coeff", "Sox10:Coeff")])
	pvals.granges<-GRanges(seqnames = newfData[probesInCluster, "chr"], strand = "*", ranges = IRanges(start = newfData[probesInCluster, "pos"], end = newfData[probesInCluster, "pos"]), "IRF8:log10P" = -log10(ctOut[probesInCluster, c("IRF8:P")]),"NeuN:log10P" =  -log10(ctOut[probesInCluster, c("NeuN:P")]), "Sox10:log10P" = -log10(ctOut[probesInCluster, c("Sox10:P")]))
	dTrack2<-DataTrack(range = coeffs.granges, genome = "hg19", type = "p", chromosome=chr, name = "Reg. Coeffs", col = plotCols[c(2:4)], type = "smooth", groups = c("IRF8+ve", "NeuN+ve", "Sox10+ve"), lwd = 2, baseline = seq(-1,1,0.2), col.baseline = "gray", lwd.baseline = 1)
	dTrack3<-DataTrack(range = pvals.granges, genome = "hg19", type = "p", chromosome=chr, name = "-logP", ylim = c(0, max(mcols(pvals.granges)[,1])), groups = c("IRF8+ve", "NeuN+ve", "Sox10+ve"), baseline = 0, col.baseline = "gray", lwd.baseline = 1, col = plotCols[c(2:4)])
	ht <- HighlightTrack(trackList=list(axTrack, refGenes,cpgIslands, dTrack1,dTrack2, dTrack3), start=as.numeric(start(neun.specific)[i]), end = as.numeric(end(neun.specific)[i]),chromosome=chr)

	## set plot to just inside
	plotTracks(list(idxTrack, ht), from=start, to=end, showTitle=TRUE)
}
dev.off()

pdf("Analysis/CellType/Sox10DMRs.pdf", width = 8, height = 8)
for(i in order(sox10.regions$nDMPs, decreasing = TRUE)[1:10]){
	start <- tab.sox10$table$start[i]
	end <- tab.sox10$table$end[i]
	chr <- tab.sox10$table$chr[i]

	## add in window around region
	windowSize<-end-start
	start<-start-windowSize
	end<-end+windowSize

	idxTrack <- IdeogramTrack(genome="hg19", chromosome=chr)
	refGenes <- UcscTrack(genome="hg19", chromosome=chr, table="ncbiRefSeq", track = 'NCBI RefSeq',from=start, to=end, trackType="GeneRegionTrack", rstarts="exonStarts", rends="exonEnds", gene="name",
							symbol="name2", transcript="name", strand="strand", fill="#8282d2",
							  name="NCBI RefSeq", transcriptAnnotation="symbol", collapseTranscripts = "longest")
	cpgIslands <- UcscTrack(genome="hg19", chromosome=chr, track="cpgIslandExt", from=start, to=end,trackType="AnnotationTrack", start="chromStart", end="chromEnd", id="name",shape="box", fill="#006400", name="CpG Islands")

	probesInCluster<-rownames(newfData)[which(newfData$chr == chr & newfData$pos <= end & newfData$pos >= start)]

	cellMeans.granges<-GRanges(seqnames = newfData[probesInCluster, "chr"], strand = "*", ranges = IRanges(start = newfData[probesInCluster, "pos"], end = newfData[probesInCluster, "pos"]), cellMeans[probesInCluster, ])
	dTrack1<-DataTrack(range = cellMeans.granges, genome = "hg19", type = "p", chromosome=chr, name = "DNAm Mean", col = plotCols[1:4], type = "smooth", groups = c("Double -ve", "IRF8+ve", "NeuN+ve", "Sox10+ve"), lwd = 2, baseline = seq(0,1,0.2), col.baseline = "gray", lwd.baseline = 1)
	coeffs.granges<-GRanges(seqnames = newfData[probesInCluster, "chr"], strand = "*", ranges = IRanges(start = newfData[probesInCluster, "pos"], end = newfData[probesInCluster, "pos"]), ctOut[probesInCluster, c("IRF8:Coeff", "NeuN:Coeff", "Sox10:Coeff")])
	pvals.granges<-GRanges(seqnames = newfData[probesInCluster, "chr"], strand = "*", ranges = IRanges(start = newfData[probesInCluster, "pos"], end = newfData[probesInCluster, "pos"]), "IRF8:log10P" = -log10(ctOut[probesInCluster, c("IRF8:P")]),"NeuN:log10P" =  -log10(ctOut[probesInCluster, c("NeuN:P")]), "Sox10:log10P" = -log10(ctOut[probesInCluster, c("Sox10:P")]))
	dTrack2<-DataTrack(range = coeffs.granges, genome = "hg19", type = "p", chromosome=chr, name = "Reg. Coeffs", col = plotCols[c(2:4)], type = "smooth", groups = c("IRF8+ve", "NeuN+ve", "Sox10+ve"), lwd = 2, baseline = seq(-1,1,0.2), col.baseline = "gray", lwd.baseline = 1)
	dTrack3<-DataTrack(range = pvals.granges, genome = "hg19", type = "p", chromosome=chr, name = "-logP", ylim = c(0, max(mcols(pvals.granges)[,1])), groups = c("IRF8+ve", "NeuN+ve", "Sox10+ve"), baseline = 0, col.baseline = "gray", lwd.baseline = 1, col = plotCols[c(2:4)])
	ht <- HighlightTrack(trackList=list(axTrack, refGenes,cpgIslands, dTrack1,dTrack2, dTrack3), start=tab.sox10$table$start[i], end = tab.sox10$table$end[i],chromosome=chr)

	## set plot to just inside
	plotTracks(list(idxTrack, ht), from=start, to=end, showTitle=TRUE)
}
dev.off()

pdf("Analysis/CellType/IRF8DMRs.pdf", width = 8, height = 8)
for(i in order(irf8.regions$nDMPs, decreasing = TRUE)[1:10]){
	start <- tab.irf8$table$start[i]
	end <- tab.irf8$table$end[i]
	chr <- tab.irf8$table$chr[i]

	## add in window around region
	windowSize<-end-start
	start<-start-windowSize
	end<-end+windowSize

	idxTrack <- IdeogramTrack(genome="hg19", chromosome=chr)
	refGenes <- UcscTrack(genome="hg19", chromosome=chr, table="ncbiRefSeq", track = 'NCBI RefSeq',from=start, to=end, trackType="GeneRegionTrack", rstarts="exonStarts", rends="exonEnds", gene="name",
							symbol="name2", transcript="name", strand="strand", fill="#8282d2",
							  name="NCBI RefSeq", transcriptAnnotation="symbol", collapseTranscripts = "longest")
	cpgIslands <- UcscTrack(genome="hg19", chromosome=chr, track="cpgIslandExt", from=start, to=end,trackType="AnnotationTrack", start="chromStart", end="chromEnd", id="name",shape="box", fill="#006400", name="CpG Islands")

	probesInCluster<-rownames(newfData)[which(newfData$chr == chr & newfData$pos <= end & newfData$pos >= start)]

	cellMeans.granges<-GRanges(seqnames = newfData[probesInCluster, "chr"], strand = "*", ranges = IRanges(start = newfData[probesInCluster, "pos"], end = newfData[probesInCluster, "pos"]), cellMeans[probesInCluster, ])
	dTrack1<-DataTrack(range = cellMeans.granges, genome = "hg19", type = "p", chromosome=chr, name = "DNAm Mean", col = plotCols[1:4], type = "smooth", groups = c("Double -ve", "IRF8+ve", "NeuN+ve", "Sox10+ve"), lwd = 2, baseline = seq(0,1,0.2), col.baseline = "gray", lwd.baseline = 1)
	coeffs.granges<-GRanges(seqnames = newfData[probesInCluster, "chr"], strand = "*", ranges = IRanges(start = newfData[probesInCluster, "pos"], end = newfData[probesInCluster, "pos"]), ctOut[probesInCluster, c("IRF8:Coeff", "NeuN:Coeff", "Sox10:Coeff")])
	pvals.granges<-GRanges(seqnames = newfData[probesInCluster, "chr"], strand = "*", ranges = IRanges(start = newfData[probesInCluster, "pos"], end = newfData[probesInCluster, "pos"]), "IRF8:log10P" = -log10(ctOut[probesInCluster, c("IRF8:P")]),"NeuN:log10P" =  -log10(ctOut[probesInCluster, c("NeuN:P")]), "Sox10:log10P" = -log10(ctOut[probesInCluster, c("Sox10:P")]))
	dTrack2<-DataTrack(range = coeffs.granges, genome = "hg19", type = "p", chromosome=chr, name = "Reg. Coeffs", col = plotCols[c(2:4)], type = "smooth", groups = c("IRF8+ve", "NeuN+ve", "Sox10+ve"), lwd = 2, baseline = seq(-1,1,0.2), col.baseline = "gray", lwd.baseline = 1)
	dTrack3<-DataTrack(range = pvals.granges, genome = "hg19", type = "p", chromosome=chr, name = "-logP", ylim = c(0, max(mcols(pvals.granges)[,1])), groups = c("IRF8+ve", "NeuN+ve", "Sox10+ve"), baseline = 0, col.baseline = "gray", lwd.baseline = 1, col = plotCols[c(2:4)])
	ht <- HighlightTrack(trackList=list(axTrack, refGenes,cpgIslands, dTrack1,dTrack2, dTrack3), start=tab.irf8$table$start[i], end = tab.irf8$table$end[i],chromosome=chr)

	## set plot to just inside
	plotTracks(list(idxTrack, ht), from=start, to=end, showTitle=TRUE)
}
dev.off()


require(stringr)
require(parallel)

source("import_data_V2.r")

ids = data$ids
nids = length(ids)

source("euk_bayesian_fulldataset_V2.r")

source("euk_heuristic_fulldataset.r")

## average both methods

Bayesian_pairwisedistancematrix_norm_temp = (2-Bayesian_pairwisedistancematrix)
Bayesian_pairwisedistancematrix_norm_temp = Bayesian_pairwisedistancematrix_norm_temp - min(Bayesian_pairwisedistancematrix_norm_temp)
Bayesian_pairwisedistancematrix_norm = Bayesian_pairwisedistancematrix_norm_temp  / (max(Bayesian_pairwisedistancematrix_norm_temp ))

write.csv(Bayesian_pairwisedistancematrix_norm,"Bayesian_pairwisedistancematrix_norm.csv")

Heuristic_pairwisedistancematrix_norm_temp = (Heuristic_pairwisedistancematrix - min(Heuristic_pairwisedistancematrix,na.rm=TRUE))
Heuristic_pairwisedistancematrix_norm = Heuristic_pairwisedistancematrix_norm_temp  / (max(Heuristic_pairwisedistancematrix_norm_temp,na.rm=TRUE ))

D = sort(Bayesian_pairwisedistancematrix_norm)[rank(Heuristic_pairwisedistancematrix_norm,ties.method="random")]

ensemble_pairwisedistancematrix = matrix(NA,nids,nids)
ensemble_pairwisedistancematrix = list(Bayesian_pairwisedistancematrix_norm,Heuristic_pairwisedistancematrix_norm)

arraytemp = array(NA, dim=c(nids,nids,2))
arraytemp[,,1] = D
arraytemp[,,2] = Heuristic_pairwisedistancematrix_norm
ensemble_pairwisedistancematrix = apply(arraytemp,c(1,2),function (x) mean(x,na.rm=TRUE))
colnames(ensemble_pairwisedistancematrix) = colnames(Bayesian_pairwisedistancematrix_norm )
rownames(ensemble_pairwisedistancematrix) = rownames(Bayesian_pairwisedistancematrix_norm )

ensemble_pairwisedistancematrix = ensemble_pairwisedistancematrix/max(ensemble_pairwisedistancematrix)

write.csv(ensemble_pairwisedistancematrix,"Ensemble_pairwisedistancematrix.csv")

print("Analysis complete")


setwd("path")
function_name <- function(x) {
  #assuming x is the file name
  data <- read.xlsx("x") #depending on requirement read specific file or all files in a format (pattern = "*.xlsx")
  if(!missing(data)){
    specific_data <- #select data of interest
    if(!missing(specific_data)){
      proportion <- prop.test(specific_data) # for proportion test. will require parameters like Confidence interval, etc
      fisher <- fisher.test(specific_data) # alternative R function
      print (proportion) # or print (fisher)
    }
    else print("missing data of interest")
  }
  else print("missing data")
}


sessionInfo()
library(dHRUM)
nHrus <- 2
# Areas <- runif(nHrus,min = 1,max  = 100)
Areas <- c(2.23,1.05)#les 2.23 Zem_puda 1.05
IdsHrus <- paste0("ID",seq(1:length(Areas)))
dhrus <- initdHruModel(nHrus,Areas,IdsHrus)

# wrong order of precip and temperatures
filname2 = "../tests/indata/KL_1960_01_01.txt"

setPTInputsToAlldHrusFromFile(dHRUM_ptr = dhrus, filname2)
calcPetToAllHrus(dHRUM_ptr = dhrus,50.1,"Hamon")

ParDF1 = data.frame( B_SOIL = 1.6, C_MAX = 500, B_EVAP = 1,  KS = 0.01, KF = 0.03, ADIV = 0.8, CDIV = 0.3,
SDIV = 0.3, CAN_ST = 1., STEM_ST = 1., CSDIV = 0.8, TETR = 0, DDFA = 0.75, TMEL = 0.0,
RETCAP = 10 )

ParDFup1 = data.frame( B_SOIL = 2., C_MAX = 200, B_EVAP = 2,  KS = 0.4, KF = 0.7, ADIV = 0.9, CDIV = 0.1,
                    SDIV = 0.05, CAN_ST = 2., STEM_ST = 2., CSDIV = 0.8, TETR = 4, DDFA = 0.8, TMEL = 2.0,
                    RETCAP = 2 )
ParDFlow1 = data.frame( B_SOIL = 0.6, C_MAX = 10, B_EVAP = 0.6,  KS = 0.002, KF = 0.2, ADIV = 0.01, CDIV = 0.05,
                      SDIV = 0.01, CAN_ST = 0.1, STEM_ST = 0.1, CSDIV = 0.01, TETR = 0, DDFA = 0.08, TMEL = -10.0,
                      RETCAP = 1 )

ParDF2 = data.frame( B_SOIL = 1.6, C_MAX = 200, B_EVAP = 1,  KS = 0.01, KF = 0.03, ADIV = 0.8, CDIV = 0.3,
                     SDIV = 0.3, CAN_ST = 1., STEM_ST = 1., CSDIV = 0.8, TETR = 0, DDFA = 0.75, TMEL = 0.0,
                     RETCAP = 2 )

ParDFup2 = data.frame( B_SOIL = 2., C_MAX = 70, B_EVAP = 2,  KS = 0.4, KF = 0.7, ADIV = 0.9, CDIV = 0.1,
                       SDIV = 0.05, CAN_ST = 2., STEM_ST = 2., CSDIV = 0.8, TETR = 4, DDFA = 0.8, TMEL = 1.0,
                       RETCAP = 5 )
ParDFlow2 = data.frame( B_SOIL = 0.6, C_MAX = 5, B_EVAP = 0.6,  KS = 0.002, KF = 0.2, ADIV = 0.01, CDIV = 0.05,
                        SDIV = 0.01, CAN_ST = 1., STEM_ST = 1., CSDIV = 0.01, TETR = 0, DDFA = 0.08, TMEL = -10.0,
                        RETCAP = 1 )
nPars1HRU= ncol(ParDFlow1)

dny=c(30,60,90,120,150,180,210,240,270,300,330,355,364)
p_OBS=dny/365.25

RaKL = 96# odhad Martin Hanel
# ZHU Qa
Qa=10
# mdenni Q
QmKL = c(22, 15, 12, 10, 8.5, 6.5, 6.0, 5.0, 3.5, 3.0, 2.0, 1.0, 0.5)
A=3.28*1000*1000# plocha KL
RmKL = QmKL * (3600*24) / A #CHMU ZHU
Ra =Qa*3600*24*365/A
# simRM=as.numeric(quantile(dF$TOTR,probs=(1-p_OBS)))
ParDF = data.frame( B_SOIL = 1.6, C_MAX = 100, B_EVAP = 2,  KS = 0.1, KF = 0.2, ADIV = 0.3, CDIV = 0.03,
                    SDIV = 0.03, CAN_ST = 2, STEM_ST = 2, CSDIV = 0.3, TETR = 5, DDFA = 0.5, TMEL = 0, RETCAP = 10 )

mae = function(myPar){
  # parrvv=as.numeric(c(ParDFlow1[1,],ParDFlow2[1,]))
  # Par1 = parrvv[1:nPars1HRU]
  # Par2 = as.numeric(parrvv[(nPars1HRU+1):(2*nPars1HRU)])
  # Par1 =ParDF1[1,]
  # Par2 =ParDF2[1,]
  Par1 = myPar[1:nPars1HRU]
  Par2 = as.numeric(myPar[(nPars1HRU+1):(2*nPars1HRU)])
  setParamsToOnedHru(dHRUM_ptr = dhrus,as.numeric(Par1),names(ParDF),0)
  setParamsToOnedHru(dHRUM_ptr  = dhrus,as.numeric(Par2),names(ParDF),1)
  # # for( i in 1:1000){
  calcHBInAlldHrus(dHRUM_ptr = dhrus)
  gatherHBdata(dHRUM_ptr = dhrus)
  # # }
  dta <- getOutput(dHRUM_ptr = dhrus)
  dF <-data.frame(dta$outDta)
  names(dF) <- dta$VarsNams
  simRM=as.numeric(quantile(dF$TOTR,probs=(1-p_OBS), na.rm = TRUE))
  mymae =as.double(sum(abs(simRM - RmKL)))
  # # mymae=NA
  # if(is.na(mymae)) mymae = 9999
  # (return as.double(mymae))
}

library(RcppDE)
itermaxW=10
decntr<-DEoptim.control(VTR = 0, strategy = 2, bs = FALSE, NP = 300,
                itermax = itermaxW, CR = 0.25, F = 0.58, trace = TRUE,
                initialpop = NULL, storepopfrom = itermaxW + 1,
                storepopfreq = 1, p = 0.2, c = 0, reltol = sqrt(.Machine$double.eps),
                steptol = itermaxW)

u=DEoptim( lower=as.numeric(c(ParDFlow1[1,],ParDFlow2[1,])),
           upper=as.numeric(c(ParDFup1[1,],ParDFup2[1,])), fn=mae, control = decntr)

u$optim$bestmem

ParBest = as.numeric(u$optim$bestmem)
# ParDF
setParamsToOnedHru(dHRUM_ptr = dhrus,as.numeric(ParBest[1:nPars1HRU]),names(ParDF),0)
setParamsToOnedHru(dHRUM_ptr  = dhrus,as.numeric(ParBest[(nPars1HRU+1):(2*nPars1HRU)]),names(ParDF),1)

calcHBInAlldHrus(dHRUM_ptr = dhrus)
gatherHBdata(dHRUM_ptr = dhrus)
# # }
dta <- getOutput(dHRUM_ptr = dhrus)
dF <-data.frame(dta$outDta)

names(dF) <- dta$VarsNams

plot(dF$TOTR, type='l')
plot(dF$BASF, type='l')
plot(dF$DIRR, type='l')
plot(dF$SOIS, type='l')
plot(dF$GROS, type='l')
plot(dF$SNOW, type='l')

simBest=as.numeric(quantile(dF$TOTR,probs=(1-p_OBS), na.rm = TRUE))

plot(RmKL, simBest)

plot(p_OBS,RmKL, pch=19, main = "Karlův Luh - kalibrace dHRUM - 2 HRU",xlab="P(Qm)", ylab="Qm [mm/den]")
points(p_OBS,simBest,col="red",pch=19)
grid()

ParBest[1:nPars1HRU]
ParBest[(nPars1HRU+1):(2*nPars1HRU)]

require(data.table)
pars=data.table(ParDF1)

ParDF11=ParDF1
ParDF11[1,] = ParBest[1:nPars1HRU]

ParDF11=rbind(ParDF11,ParBest[(nPars1HRU+1):(2*nPars1HRU)])

pars2hru_kl <-cbind(ParDF11,Areas=Areas)

saveRDS(pars2hru_kl,file = "./data/Params/Amalie/KL_2HRU.rds")


########################################################
#####       Author: Diego Valle Jones
#####       Website: www.diegovalle.net
#####       Date Created: Wed Mar 24 11:44:12 2010
########################################################
#Compare the homicide rate with the execution rate and the homicide
#with firearm rate

source("library/utilities.r")

########################################################
#Homicides, Homicides with Firearm, and Executions
########################################################
homr <- read.csv("accidents-homicides-suicides/output/homicide.csv")
exe <- read.csv("guns-executions/data/firearm-executions.csv")

#Average the data from Reforma and Milenio
exe$Executions[4:8] <- exe$Renglones[4:8]
exe$Executions[9] <- (exe$Reforma[9] + exe$Renglones[9]) / 2
exe$Executions[10:12] <- (exe$Reforma[10:12] + exe$Milenio[10:12]) / 2
exe <- exe[,1:4]

exe$Homicides <- c(homr$Tot[9:19], NA)
exer <- exe
exer[,c(2,3,5)] <- sapply(exer[,c(2,3,5)],
                         function(x) x / exer$Population * 100000)
mexer <- melt(exer[,c(1:3,5)], id = "Year")
mexer$variable <- factor(factor(mexer$variable),
                         levels = c("Homicides",
                                     "Executions",
                                     "Firearm.Homicides"))

p <- ggplot(mexer, aes(Year, value, group = variable,
                       color = variable)) +
    geom_line() + ylab("Rate") +
    opts(title = "") +
    ylim(c(0, max(mexer$value, na.rm = TRUE)))
mid.points <- dl.indep(data.frame(d[4,],hjust=-0.2,vjust=-0.8))
print(direct.label(p, mid.points))
dev.print(png, "guns-executions/output/homicides-executions.png",
          width = 500, height = 400)

#murder with firearm as a percentage of total homicides,
#the proportion of murders with firearm has risen mostly because it
#has decreased *more slowly* than the overall homicide rate
print(ggplot(exe, aes(Year, Firearm.Homicides / Homicides)) +
    geom_line() +
    scale_y_continuous(formatter = "percent"),
    limits = c(0,.63))
dev.print(png, "guns-executions/output/percent-by-firearm.png",
          width = 500, height = 400)

############################################################
#Small Multiples of Homicide and Homicide with Firearm Rates
#############################################################
fir.state <- read.csv("guns-executions/data/firearm-hom-statetot.csv")
state <- read.csv("accidents-homicides-suicides/output/states.csv")
pop <- read.csv("conapo-pop-estimates/conapo-states.csv")

fir.state$State <- iconv(fir.state$State,
                         "windows-1252",
                         "utf-8")

#state$State <- iconv(state$State,
#                         "windows-1252",
#                         "utf-8")

pop$State <- iconv(pop$State,
                         "windows-1252",
                         "utf-8")

#pop$State fir.state$State state$State
state <- merge(fir.state, state[,c(1,10:20)], by = "State")
state <- merge(state, pop[ ,c(1,10:20)], by = "State")

popclmns <- 24:34
firclmns <- 2:12
homclmns <- 13:23
state[firclmns] <- state[firclmns] / state[, popclmns] * 100000
state[homclmns] <- state[homclmns] / state[, popclmns] *100000

mstate <- melt(state[,1:23], id ="State")
mstate$type <- factor(rep(c("Firearm\nHomicides", "Homicides"),
                          each = 32*11))
mstate$variable <- rep(1998:2008, each = 32)

mstate$type <- factor(mstate$type, levels = rev(levels(mstate$type)))

#Is the data cointegrated?
#unitRoot <- function(df){
#    f <- subset(df, type == "Firearm\nHomicides")$value
#    h <- subset(df, type == "Homicides")$value
#    reg <- lm(h ~ f)
#    ht <- adf.test(residuals(reg))
#    ht
#}
#FFFFFFFFFFFFFFFCCCCCCCCC  they are cointegrated
#dlply(hom, .(County), unitRoot)

#Simple error correction, with eight samples per state there's not much
#info
coint <- function(df){
    f <- subset(df, type == "Firearm\nHomicides")$value
    h <- subset(df, type == "Homicides")$value
    coint.res <- residuals(lm(h ~ f))
    coint.res <- coint.res[-c(7:8)]
    d_h <- diff(h)
    d_f <- diff(f)
    diff.dat <- data.frame(embed(cbind(d_h, d_f), 2))
    colnames(diff.dat) <- c("d_h", "d_f", "d_h.1", "d_f.1")
    reg <- lm(d_h ~ coint.res + d_h.1 + d_f.1, data = diff.dat)
    print(df$State)
    print(summary(reg))
    print(plot(coint.res), type = "l")
}
#Doesn't work :(
dlply(mstate, .(State), coint)

correl <- function(df){
    f <- subset(df, type == "Firearm\nHomicides")$value
    h <- subset(df, type == "Homicides")$value
    cor(f, h)[1]
}

#mstate <- merge(mstate, ddply(mstate, .(State), correl), by = "State")
mstate$State <- cleanNames(mstate, "State")
mstate <- subset(mstate, State %in% c("Chihuahua", "Sinaloa", "Durango", "Sonora", "Guerrero", "Baja California","Michoacán", "Tamaulipas"))
#mstate$State <- paste(mstate$State,"-", round(mstate$V1,2))

#mstate$State <- with(mstate, reorder(factor(State), dif))
scale_color <- scale_colour
print(ggplot(mstate, aes(variable, value,
                         color = type, group = type)) +
    geom_line() +
    facet_wrap(~ State) +
    ylab("Rate") + xlab("Year") +
    scale_x_continuous(breaks = c(2000, 2004, 2007),
                         labels = c("00","04", "07")) +
    opts(title = "Homicides and Homicides with Firearm"))
dev.print(png, "guns-executions/output/homicides-firearm-st.png",
          width = 600, height = 400)

###############################################################
##Now homicides committed with a firearm as a proportion of
#all homicides
##############################################################
pstate <- state[2:12] / state [13:23]
pstate$State <- state$State
mpstate <- melt(pstate, id = "State")
mpstate$variable <- rep(1998:2008, each = 32)
mpstate$State <- factor(cleanNames(mpstate, "State"))

mpstate <- ddply(mpstate, .(State), transform,
                 dif = value[5] - value[length(value)])

mpstate$State <- reorder(mpstate$State, mpstate$dif)
print(ggplot(mpstate, aes(variable, value)) +
    geom_line() +
    facet_wrap(~ State) +
    ylab("Proportion") + xlab("Year") +
    scale_x_continuous(breaks = c(2000, 2006, 2008),
                         labels = c("00","06", "08"),
                       limits = c(2004,2008)) +
    scale_y_continuous(formatter = "percent") +
    stat_smooth(method = lm, se = FALSE) +
    opts(title = "Proportion of Homicides commited with a Firearm (ordered by difference in proportions from 2004 to 2008)"))
dev.print(png, "guns-executions/output/homicides-firearm-st-p2005.png",
          width = 960, height = 600)

mpstate <- subset(mpstate, State %in% c("Chihuahua", "Sinaloa", "Durango", "Sonora", "Guerrero", "Baja California","Michoacán", "Tamaulipas"))
m <- function(df){
    lm(df$variable ~ df$value)$coef[2]
}
mpstate <- merge(mpstate, ddply(mpstate, .(State), m),
                 by = c("State"))
mpstate$State <- reorder(mpstate$State, mpstate$"df$value")
print(ggplot(mpstate, aes(variable, value)) +
    geom_line() +
    facet_wrap(~ State) +
    ylab("Proportion") + xlab("Year") +
    scale_x_continuous(breaks = c(2000, 2004, 2007),
                         labels = c("00","04", "07")) +
    scale_y_continuous(formatter = "percent") +
    stat_smooth(method = lm, se = FALSE) +
    opts(title = "Proportion of Homicides commited with a Firearm"))
dev.print(png, "guns-executions/output/homicides-firearm-st-p.png",
          width = 600, height = 400)

#Guns traced to the US
#c(3090, 5260, 1950, 3060, 6700)
#2004:2008

#Total guns seized in Mexico
#30000  #hmmm, according to PGR it was 28,000 over two years
#Guns submitted for tracking
#7200

#Assault by rifle shotgun and larger firearm discharge
asweap <-  c(105, 80, 54, 50, 61, 48, 54, 55, 42, 41, 104)
#pop9808 <- c(95790135, 97114831, 98438557, 99715527, 100909374, 101999555, 103001867, 103946866, 104874282, 105790725, 106682518)
print(qplot(1998:2008, asweap, geom="line") +
    geom_line() +
 #   geom_point(aes(size = asweap)) +
    xlab("Year") + ylab("Number of Deaths") +
    opts(title="Number of deaths in Mexico by\nassault by rifle, shotgun and larger firearm discharge"))
dev.print(png, "guns-executions/output/long-guns.png",
          width = 500, height = 400)