library(dplyr)
library(lubridate)
source("Subnational_Analysis/code/plotting/format_data_plotting.R")

make_scenario_comparison_plots_mobility <- function(JOBID, StanModel, len_forecast, last_date_data,
                                                    baseline, mobility_increase = 20){
  print(paste0("Making scenario comparision plots for ", mobility_increase , "%"))
  load(paste0('Subnational_Analysis/results/sim-constant-mob-', StanModel, '-', len_forecast, '-0-', JOBID, '-stanfit.Rdata'))
  out <- rstan::extract(fit)

  mob_data <- NULL
  for (i in 1:length(countries)){
    data_state_plot <- format_data(i = i, dates = dates, countries = countries,
                                   estimated_cases_raw = estimated_cases_raw,
                                   estimated_deaths_raw = estimated_deaths_raw,
                                   reported_cases = reported_cases,
                                   reported_deaths = reported_deaths,
                                   out = out, forecast = 0, SIM = TRUE)
    # Cuts data on last_data_date
    data_state_plot <- data_state_plot[which(data_state_plot$date <= last_date_data),]

    subset_data <- select(data_state_plot, country, date, reported_deaths, estimated_deaths,
                          deaths_min, deaths_max)
    subset_data$key <- rep("Constant mobility", length(subset_data$country))
    mob_data <- rbind(mob_data, subset_data)
  }

  if (baseline == TRUE){
    load(paste0('Subnational_Analysis/results/sim-increase-mob-baseline-', StanModel, '-', len_forecast, '-', mobility_increase, '-', JOBID, '-stanfit.Rdata'))
  } else {
    load(paste0('Subnational_Analysis/results/sim-increase-mob-current-', StanModel, '-', len_forecast, '-', mobility_increase, '-', JOBID, '-stanfit.Rdata'))
  }
  out <- rstan::extract(fit)

  for (i in 1:length(countries)){
    data_state_plot <- format_data(i = i, dates = dates, countries = countries,
                                   estimated_cases_raw = estimated_cases_raw,
                                   estimated_deaths_raw = estimated_deaths_raw,
                                   reported_cases = reported_cases,
                                   reported_deaths = reported_deaths,
                                   out = out, forecast = 0, SIM = TRUE)
    # Cuts data on last_data_date
    data_state_plot <- data_state_plot[which(data_state_plot$date <= last_date_data),]
    subset_data <- select(data_state_plot, country, date, reported_deaths, estimated_deaths,
                          deaths_min, deaths_max)
    subset_data$key <- rep("Increased mobility", length(subset_data$country))
    mob_data <- rbind(mob_data, subset_data)
  }

  data_half <- mob_data[which(mob_data$key == "Increased mobility"),]
  mob_data$key <- factor(mob_data$key)
  data_half$key <- factor(data_half$key)

  nametrans <- read.csv("Subnational_Analysis/Italy/province_name_translation.csv")

  mob_data <- mob_data %>% filter(!(country %in% c("Lombardia","Marche","Veneto","Toscana","Piemonte","Emilia-Romagna","Liguria"))) %>%
                            droplevels()

  mob_data$country<-recode(mob_data$country, Lombardia="Lombardy",Piemonte="Piedmont",Toscana="Tuscany",P.A._Bolzano="Bolzano",
                           P.A._Trento="Trento",Puglia="Apulia",Sardegna="Sardinia",Sicilia="Sicily",Valle_dAosta="Aosta")

  data_half <- data_half %>% filter(!(country %in% c("Lombardia","Marche","Veneto","Toscana","Piemonte","Emilia-Romagna","Liguria"))) %>%
                              droplevels()

  data_half$country<-recode(data_half$country, Lombardia="Lombardy",Piemonte="Piedmont",Toscana="Tuscany",P.A._Bolzano="Bolzano",
                            P.A._Trento="Trento",Puglia="Apulia",Sardegna="Sardinia",Sicilia="Sicily",Valle_dAosta="Aosta")

  last_date_data<-mob_data$date[nrow(mob_data)]

  p <- ggplot(mob_data) +
    geom_bar(data = data_half, aes(x = date, y = reported_deaths), stat='identity') +
    geom_ribbon(aes(x = date, ymin = deaths_min, ymax = deaths_max, group = key, fill = key), alpha = 0.5) +
    #geom_line(aes(date,deaths_max),color="black",size=0.2)+
    #geom_line(aes(date,deaths_min),color="black",size=0.2)+
    #geom_line(aes(date,estimated_deaths),color="black",size=0.3)+
    #geom_ribbon(aes(x = date, ymin = deaths_min, ymax = deaths_max, fill = "ICL"), alpha = 0.5) +
    scale_fill_manual(name = "", values = c("pink", "skyblue")) +
    scale_x_date(date_breaks = "2 weeks", labels = date_format("%e %b"), limits = c(as.Date("2020-03-02"), last_date_data)) +
    facet_wrap(~country, scales = "free") +
    xlab("") + ylab("Daily number of deaths") +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1,size = 14), axis.title = element_text( size = 14 ),axis.text = element_text( size = 14 ),
          legend.position = "right",strip.text = element_text(size = 14),legend.text=element_text(size=14))

  ggsave(paste0("Subnational_Analysis/figures/scenarios_increase_baseline-", len_forecast, '-', mobility_increase, '-', JOBID, "top_7.pdf"), p, height = 15, width = 20)

  if (baseline == TRUE){
    ggsave(paste0("Subnational_Analysis/figures/scenarios_increase_baseline-", len_forecast, '-', mobility_increase, '-', JOBID, ".pdf"), p, height = 15, width = 20)
  } else {
    ggsave(paste0("Subnational_Analysis/figures/scenarios_increase_current-", len_forecast, '-', mobility_increase, '-', JOBID, ".pdf"), p, height = 15, width = 20)
  }
}


#' ssvm: Simple SVM
#'
#' @description
#' A simple two-class linear SVM implementation using
#' the Pegasos algorithm.
#'
#' @useDynLib ssvm, R_svm_pegasos_fit, R_svm_pegasos_pred,
#'   R_svm_recode_response
#'
#' @docType package
#' @name ssvm-package
#' @author Drew Schmidt
#' @keywords package
NULL


library(tidyverse)

# read in data
county <- read.csv("county.csv")

# calculate supervisors per 100,000 population
county$pc.supervisor <- county$supervisors/(county$pop17/100000)

# create annotation

annot <- read.table(text=
  "county|number|just|text
  15.5|0.625|0|Broward & Orange County, FL are the median county
with 0.45 supervisors per 100,000 residents.
  40.5|0.375|1|Some of the largest U.S. counties have the
fewest supervisors per 100,000 residents.",
  sep="|", header=TRUE, stringsAsFactors=FALSE)
# 2.75|1.375|0|Both Nashville & Louisville are consolidated,
city-county governments.
annot$text <- gsub("
", "\n", annot$text)

# plot
p <- ggplot(data=county,
  aes(x=reorder(county, -pc.supervisor), y=pc.supervisor, width=0.9))+
  geom_bar(stat="identity", fill="#617A89")+
  scale_y_continuous(breaks=seq(0, 1.75, by=0.25))+
  # read in annotations
  geom_label(data=annot, aes(x=county, y=number, label=text, hjust=just),
    family="Open Sans Condensed Light", lineheight=0.95,
    size=3.5, label.size=0, color="#2b2b2b")+
  # Theming
  labs(
    title="Boards of supervisors tend to be small relative to population",
    subtitle="County supervisors/commissioners per 100,000 residents, 40 largest U.S. counties, 2017",
    caption="Author: Chris Goodman (@cbgoodman), Data: U.S. Census Bureau & Author's calculations.",
    y=NULL,
    x=NULL) +
  theme_minimal(base_family="Open Sans Condensed Light") +
  # light, dotted major y-grid lines only
  theme(panel.grid=element_line())+
  theme(panel.grid.major.y=element_line(color="#2b2b2b", linetype="dotted", size=0.15))+
  theme(panel.grid.major.x=element_blank())+
  theme(panel.grid.minor.x=element_blank())+
  theme(panel.grid.minor.y=element_blank())+
  # light x-axis line only
  theme(axis.line=element_line())+
  theme(axis.line.y=element_blank())+
  theme(axis.line.x=element_blank())+
  # tick styling
  theme(axis.ticks=element_line())+
  theme(axis.ticks.x=element_blank())+
  theme(axis.ticks.y=element_blank())+
  theme(axis.ticks.length=unit(5, "pt"))+
  # x-axis labels
  theme(axis.text.x=element_text(size=10, angle=90, hjust=0.95,vjust=0.2))+
  # breathing room for the plot
  theme(plot.margin=unit(rep(0.5, 4), "cm"))+
  # move the y-axis tick labels over a bit
  #theme(axis.text.y=element_text(margin=margin(r=-5)))+
  # make the plot title bold and modify the bottom margin a bit
  theme(plot.title=element_text(family="Open Sans Condensed Bold", margin=margin(b=15)))+
  # make the subtitle italic
  theme(plot.subtitle=element_text(family="Open Sans Condensed Light Italic"))+
  theme(plot.caption=element_text(size=8, hjust=0, margin=margin(t=15)))

ggsave(plot=p, "supervisors.png", width=10, height=6, units="in", dpi="retina")


library(RColorBrewer)
library(rgdal)
library(raster)
library(sp)
library(ggplot2)
proj_latlon<<-"+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
#source("/home/sinan/workspace/visotmed/R/getRegularGrid.r")
#source("/home/sinan/workspace/visotmed/R/getProjRaster.r")
#source("/home/sinan/workspace/visotmed/R/mapProjection.r")

source("/home/sinan/workspace/visotmed/R/mapConvert.r")
source("/home/sinan/workspace/visotmed/R/mapConvert.nc.r")

source("/home/sinan/workspace/visotmed/R/mapProjection.r")
source("/home/sinan/workspace/visotmed/R/addPolygons.r")
source("/home/sinan/workspace/visotmed/R/saveMap.r")
source("/home/sinan/workspace/visotmed/R/graticules.r")


# Load packages
library(tidyverse)
library(gggibbous)
library(ggridges)
library(showtext)
library(ggimage)
library(magick)
library(patchwork)
library(ggtext)

# Import tidytuesday data - Week 44
ultra_rankings <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-10-26/ultra_rankings.csv')
race <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-10-26/race.csv')

# Add goofle fonts for the plots
font_add_google("Roboto Condensed", "roboto condensed")
font_add_google("Bitter", "Bitter")
font_add_google("Playfair Display", "Playfair Display")
showtext_opts(dpi = 320)
showtext_auto(enable = TRUE)

# Clean Ultra Marathons races
# Calculate average elevation_gain per event and country (can vary a little bit from year to year)
race_clean <- race %>%
  mutate(year = format(date, format="%Y"),
         event = str_to_upper(event)) %>% # everything to upper case
  filter(distance > 100) %>%
  group_by(event, country) %>%
  summarise(avg_elevgain = mean(elevation_gain, na.rm = TRUE),
            avg_elevloss= mean(elevation_loss, na.rm = TRUE),
            avg_distance = mean(distance, na.rm = TRUE)) %>%
  ungroup()

# Take only countries with at least 10 Ultra Marathons referenced in the data
race_clean_country <- race_clean %>%
  group_by(country) %>%
  mutate(n = n()) %>%
  ungroup() %>%
  filter(n > 10) %>%
  mutate(country = fct_reorder(country, n)) %>%
  arrange(country, n, desc(avg_elevgain)) %>%
  mutate(country_num = as.numeric(fct_rev(country)))

# Pull country order for display
country_order <- race_clean_country %>%
  group_by(country) %>%
  filter(avg_elevgain == max(avg_elevgain)) %>%
  ungroup() %>%
  arrange(n) %>%
  pull(country)

n <- race_clean_country %>%
  group_by(country) %>%
  filter(avg_elevgain == max(avg_elevgain)) %>%
  ungroup() %>%
  arrange(n) %>%
  pull(n)

# Color countries
color_country <- c()
color_country[country_order] <- colorRampPalette(c("#fafaf4", "#00429d", "#2d5f47"))(8)

# Label country
label_country <- tibble(label = rev(country_order),
                        x = c(4000,4700,8350,5900,5970,4300,6080,6500),
                        y = c(9,25,13,32,36.2,44.5,39.7,42.3),
                        idy = seq(1:8),
                        n = rev(n),
                        nred = n /100)

# Axis ticks of 1st plot
axis_ticks <- tibble(x = -500,
                     xend = c(850, 1600, 2250, 3100),
                     y = seq(10,40,10),
                     yend = seq(10,40,10))

# Area plot (cumulative by country) of number of events per D+
area_plot <- ggplot(race_clean_country,
            aes(x = avg_elevgain)) +
  geom_area(aes(fill = country),
            stat = "bin", bins = 10, alpha=0.7) +
  scale_fill_manual(values = color_country) +
  scale_color_manual(values = color_country) +
  scale_x_continuous(breaks = seq(0,12000,2500),
                     labels = glue::glue("{seq(0,12000,2500)} m"),
                     limits = c(-500,12000)) +
  geom_segment(data = label_country, aes(x = 8000, xend = 12500, y = 32, yend = 32), color = "black", size = 0.5) +
  geom_segment(data = axis_ticks, aes(x= x, xend = xend, y =y, yend = yend), linetype = "13", color = "white") +
  geom_text(data = axis_ticks, aes(x = 700, y = y, label = glue::glue("{y} Ultra Marathons")), hjust = 1, nudge_y = 1.2, color = "white", family = "roboto condensed", face = "italic", size = 2.5) +
  geom_text(data = label_country,
            aes(x = x, y = y, label = label), hjust = 0.5, color = "grey90", size = 4, family = "Playfair Display") +
  guides(fill = "none") +
  labs(x = "Elevation gain (D+) in Ultra Marathons") +
  theme_light() +
  theme(plot.background = element_rect(fill = "grey20", color = NA),
        panel.border = element_rect(fill = NA,
                                    colour = NA),
        panel.background = element_rect(fill = "grey20",
                                        colour = NA),
        panel.grid = element_blank(),
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank(),
        axis.title.y = element_blank(),
        axis.line.x = element_line(color = "grey88", size = 3),
        axis.ticks.x = element_blank(),
        axis.text.x = element_text(color = "grey88", vjust=-1, size = 12, family = "roboto condensed"),
        axis.title.x = element_text(color = "grey88",  vjust=-2, size = 14, family = "Playfair Display"),
        plot.margin = margin(10,5,15,40))

# Customize legend
legend <- ggplot(label_country,
                 aes(x = 1,y = idy)) +
  geom_moon(aes(ratio = 0.7, size = n),
            stat = "identity",
            fill = colorspace::lighten(rev(color_country)),
            color = rev(color_country),
            stroke = .3,
            right = FALSE) +
  geom_moon(aes(ratio = 0.3, size = n),
            stat = "identity",
            fill = rev(color_country),
            color = rev(color_country),
            stroke = .3) +
  geom_text(aes(label = n), hjust = 0.9, color = colorspace::darken(rev(color_country),0.8), family = "Bitter", fontface = "italic", size = 4) +
  geom_text(aes(label = label), color = colorspace::lighten("#c6c6a9",0.4), hjust = .5, nudge_y = 0.5, family = "Playfair Display", fontface = "bold", size = 5) +
  scale_size_continuous(range = c(9, 24)) +
  scale_y_continuous(limits = c(.4,9)) +
  guides(size = "none") +
  coord_cartesian(expand = FALSE, clip = "off") +
  theme_void() +
  theme(plot.background = element_rect(fill = "grey20", color = NA))

# density ridges by country of races per D+
density_ridges <- ggplot(race_clean_country,
         aes(x = avg_elevgain, y = country_num, fill = country, color = country)) +
  geom_density_ridges(
    jittered_points = FALSE, quantile_lines = FALSE, scale = 1.1, alpha = 0.7,
    vline_size = 0.5, vline_color = "grey88",
    point_size = 0.4, point_alpha = 1,
    position = position_raincloud(adjust_vlines = FALSE)
  ) +
  scale_fill_cyclical(values = colorspace::lighten(color_country,0.2)) +
  scale_color_cyclical(values = color_country) +
  geom_boxplot(
    aes(y = country_num - .15),
    width = .15,
    outlier.shape = NA
  ) +
  geom_point(
    aes(y = country_num - .3, group = country, fill = after_scale(colorspace::darken(color, .2))),
    shape = "|",
    size = 2.5,
    alpha = .33
  ) +
  scale_x_continuous(breaks = seq(0,12000, 2500),
                     labels = glue::glue("{seq(0,12000,2500)} m"),
                     limits = c(0,12000)) +
  labs(x = "Elevation gain (D+) in Ultra Marathons") +
  coord_cartesian(expand = TRUE, clip = "on") +
  theme_light() +
  theme(plot.background = element_rect(fill = "grey20", color = NA),
        panel.border = element_rect(fill = NA,
                                    colour = NA),
        panel.background = element_rect(fill = "grey20",
                                        colour = NA),
        panel.grid = element_blank(),
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank(),
        axis.title.y = element_blank(),
        axis.line.x = element_line(color = "grey88", size = 3),
        axis.ticks.x = element_blank(),
        axis.text.x = element_text(color = "grey88", vjust=-1, size = 12, family = "roboto condensed"),
        axis.title.x = element_text(color = "grey88",  vjust=-2, size = 14, family = "Playfair Display"),
        plot.margin = margin(10,5,15,5)
        )

# Import image and transform it with transparent background
image <- image_read(here::here("running-man-color3.jpg"))
image <- image_fill(image, "transparent", fuzz = 40) %>%
  image_scale("400")
image_write(image, path = "running-man-color3.png", format = "png")
image_runner <- here::here("running-man-color3.png")

# Create image plot
image_runner_p <- ggplot() +
  geom_image(aes(x = 0, y = 0, image = image_runner), size = 1) +
  scale_x_continuous(limits = c(-10,10)) +
  scale_y_continuous(limits = c(-10,10)) +
  coord_fixed(ratio = 1) +
  theme_void()+
  theme(panel.background = element_rect(fill = "transparent", color = NA),
        plot.background = element_rect(fill = "transparent", color = NA),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank())

# Assembling elements to create final plot
final <-
  area_plot + inset_element(image_runner_p,0.001, 0.835, 0.9, 1, align_to = 'full') +
  legend + density_ridges +
  plot_layout(widths = c(1,0.25,1)) +
  plot_annotation(
    caption = "Visualization: Guillaume Abgrall • Data: Benjamin Nowak from International Trail Running Association (ITRA)",
    title = "Ultra Marathons : Where elevation gain (D+) make runs harder",
    subtitle = "
 The distance isn’t the only problem, as competitors are asked to wrestle with mountains where elevation gain (D+) make the runs even harder !

                 Since they’re events that allow you to experience the world in a unique way, I've chosen to show countries where you can find races with the best D+ *(at least 10 ultra marathons in each country)*

                 While **United Stated**  has the most ultra marathon races referenced **(92)**, **France**  is by far the first grantor of highest D+ in their Ultra Marathons !",
    theme=theme(
      plot.title =  element_text(color = "grey88", size = 21, family = "Playfair Display", hjust = .5),
      plot.subtitle =  element_markdown(color = "grey88", size = 10, family = "Bitter", hjust = .5),
      plot.caption =  element_markdown(color = "grey88", size = 6, family = "Playfair Display", hjust = .985),
      plot.background = element_rect(fill = "grey20", color = NA),
      plot.margin = margin(10,25,20,25)))

# Save data
ragg::agg_png(here::here(paste0("ultra_marathons", ".png")), res = 320, width = 16, height = 10, units = "in")
final
dev.off()


PlotNMDS = function(NMDS1, # results of the NMDS you want to plot
                    data, # Environmental data (not species matrix)
                    textp = T, # do you want to plot text for the species centroids?
                    group, # Group you want to put hulls around
                    group2= NA, # Group you want to put spiders around
                    taxa = NA) { # Vector of relative percentages of a given taxa from your species matrix, used to scale the points.
  require(vegan)
  #set up colors
  cols = c("red", "blue", "green", "purple", "yellow",
           "pink1", "brown", "orangered", "black", "cyan")
  #set up sapes
  shapes = c(1,2,3,4,5,6)
  #set up group
  names(data)[(which(names(data)== group))] = "group"
  #number of groups
  data = droplevels(data)
  m = length(levels(data$group))

  #set parameters so the legend is outside the plot area
  par(xpd=NA,oma=c(3,0,0,0))

  # plot the sample points
  plot(NMDS1, type="n", shrink = T, cex=1, xlim=c(-1, 1))
  if (is.na(taxa[1])) points(NMDS1, pch=as.numeric(data$group), cex=1, col=cols[as.numeric(data$group)])  else {
    # scale the points by relative abundance of a certain taxa
    scalef = max(taxa) - min(taxa)
    points(NMDS1, pch=as.numeric(data$group), cex=.1 + taxa/mean(taxa), col="blue")
  }

  # plot text for species, if desired
  if(textp) text(NMDS1, dis="species", cex=.8)

  # draw a hull around each group
  for (i in 1:m) {

    with(data, ordiellipse(NMDS1, kind = "sd", conf = 0.95, groups = group,
                           show = levels(group)[i], col=cols[i], lwd=2, lty = 1:length(group)))
  }

  #second group with spiders
  if (is.na(group2)==F) {
    names(data)[(which(names(data)== group2))] = "group2"
    for (j in 1:length(levels(data$group2))) {
      with(data, ordispider(NMDS1, group = group2, show = levels(group2)[j], col=cols[j + length(levels(group))], lwd=1))
    }
    legend(par("usr")[1],par("usr")[3], legend = c(levels(data$group),levels(data$group2)),
           col = cols[1:(length(c(levels(data$group), levels(data$group2))))],
           lwd=c(rep(2, length(levels(data$group))), rep(1, length(levels(data$group2)))))
  } else legend(par("usr")[1],par("usr")[3], legend = levels(data$group),
                col = cols[1:length(levels(data$group))],
                lty = 1:length(levels(data$group)),
                pch = shapes[1:length(levels(data$group))], lwd=2, bty = "o")
#  legend(par("usr")[1]+1,par("usr")[3], legend = levels(data$group),
 #        pch = shapes[1:length(levels(data$group))], col = "blue", bty = "n")

}

PlotNMDS2 = function(NMDS1, # results of the NMDS you want to plot
                    data, # Environmental data (not species matrix)
                    textp = T, # do you want to plot text for the species centroids?
                    lines, #variables to use for ordisurf
                    group #group to change color/shape
                    ) {
  require(vegan)
  #set up colors
  cols = c("red", "blue", "green", "purple", "yellow",
           "pink1", "brown", "orangered", "black", "cyan")
  #set up sapes
  shapes = c(1,2,3,4,5,6)
  #set up group
  names(data)[(which(names(data)== group))] = "group"
  names(data)[(which(names(data)== lines))] = "lines"
  #number of groups
  data = droplevels(data)

  #set parameters so the legend is outside the plot area
  par(xpd=NA,oma=c(3,0,0,0))

  # plot the sample points
  plot(NMDS1, type="n", shrink = T, cex=1, xlim=c(-1, 1))
  points(NMDS1, pch=as.numeric(data$group), cex=1, col=cols[as.numeric(data$group)])

  # plot text for species, if desired
  if(textp) text(NMDS1, dis="species", cex=.8)

  #
  with(data, ordisurf(NMDS1~lines, data = data, add=T, col = "black"))

  legend(par("usr")[1],par("usr")[3], legend = levels(data$group),
                col = cols[1:length(levels(data$group))],
                lty = 1:length(levels(data$group)),
                pch = shapes[1:length(levels(data$group))], lwd=2, bty = "o")
  #  legend(par("usr")[1]+1,par("usr")[3], legend = levels(data$group),
  #        pch = shapes[1:length(levels(data$group))], col = "blue", bty = "n")

}


#' # **** action **** ----
#' #' household_incomes_and_house_prices_fit_model_and_find_outliers (action)
#' #' @param data Data
#' #' @param argset Argset
#' #' @param schema DB Schema
#' #' @export
#' household_incomes_and_house_prices_fit_model_and_find_outliers_action <- function(data, argset, schema) {
#'   # tm_run_task("household_incomes_and_house_prices_fit_model_and_find_outliers")
#'
#'   if(plnr::is_run_directly()){
#'     # sc::tm_get_plans_argsets_as_dt("household_incomes_and_house_prices_fit_model_and_find_outliers")
#'
#'     index_plan <- 1
#'     index_analysis <- 1
#'
#'     data <- sc::tm_get_data("household_incomes_and_house_prices_fit_model_and_find_outliers", index_plan = index_plan)
#'     argset <- sc::tm_get_argset("household_incomes_and_house_prices_fit_model_and_find_outliers", index_plan = index_plan, index_analysis = index_analysis)
#'     schema <- sc::tm_get_schema("household_incomes_and_house_prices_fit_model_and_find_outliers")
#'   }
#'
#'   # code goes here
#'   # special case that runs before everything
#'   if(argset$first_analysis == TRUE){
#'
#'   }
#'
#'   d <- merge(
#'     data$income,
#'     data$price,
#'     by = c("location_code", "calyear")
#'   )
#'
#'   d_pred <- d |> {\(x)
#'     lme4::lmer(
#'       new_house_price_per_m2_nok ~
#'         household_income_median_all_households_nok +
#'         (1|location_code),
#'       data = x
#'     )}() |>
#'     merTools::predictInterval(d, level = 0.95) |>
#'     {\(x) cbind(d, x)}() |>
#'     data.table()
#'
#'   setnames(
#'     d_pred,
#'     c(
#'       "fit",
#'       "upr",
#'       "lwr"
#'     ),
#'     c(
#'       "new_house_price_per_m2_baseline_nok",
#'       "new_house_price_per_m2_nok_predinterval_q97x5",
#'       "new_house_price_per_m2_nok_predinterval_q02x5"
#'     )
#'   )
#'
#'   d_pred[, new_house_price_per_m2_nok_status := "normal"]
#'   d_pred[new_house_price_per_m2_baseline_nok > new_house_price_per_m2_nok_predinterval_q97x5, new_house_price_per_m2_nok_status := "high"]
#'
#'   xtabs(~d_pred$new_house_price_per_m2_nok_status)
#'
#'   # put data in db table
#'   sc::fill_in_missing_v8(d_pred, border = config$border)
#'   schema$anon_example_house_prices_outliers_after_adjusting_for_income$drop_all_rows_and_then_insert_data(d_pred)
#'
#'   # check that it uploaded
#'   nrow(d_pred)
#'   schema$anon_example_house_prices_outliers_after_adjusting_for_income$tbl() |> dplyr::summarize(n()) |> dplyr::collect()
#'
#'   # special case that runs after everything
#'   # copy to anon_web?
#'   if(argset$last_analysis == TRUE){
#'     # sc::copy_into_new_table_where(
#'     #   table_from = "anon_X",
#'     #   table_to = "anon_webkht"
#'     # )
#'   }
#' }
#'
#' # **** data_selector **** ----
#' #' household_incomes_and_house_prices_fit_model_and_find_outliers (data selector)
#' #' @param argset Argset
#' #' @param schema DB Schema
#' #' @export
#' household_incomes_and_house_prices_fit_model_and_find_outliers_data_selector = function(argset, schema){
#'   if(plnr::is_run_directly()){
#'     # sc::tm_get_plans_argsets_as_dt("household_incomes_and_house_prices_fit_model_and_find_outliers")
#'
#'     index_plan <- 1
#'
#'     argset <- sc::tm_get_argset("household_incomes_and_house_prices_fit_model_and_find_outliers", index_plan = index_plan)
#'     schema <- sc::tm_get_schema("household_incomes_and_house_prices_fit_model_and_find_outliers")
#'   }
#'
#'   # The database schemas can be accessed here
#'   # schema$anon_example_income$print_dplyr_select()
#'   d_income <- schema$anon_example_income$tbl() %>%
#'     sc::mandatory_db_filter(
#'       granularity_time = "calyear",
#'       granularity_time_not = NULL,
#'       granularity_geo = "county",
#'       granularity_geo_not = NULL,
#'       country_iso3 = NULL,
#'       location_code = NULL,
#'       age = "total",
#'       age_not = NULL,
#'       sex = "total",
#'       sex_not = NULL
#'     ) %>%
#'     dplyr::filter(calyear %in% 2000:2019) %>%
#'     dplyr::select(
#'       granularity_time,
#'       granularity_geo,
#'       # country_iso3,
#'       location_code,
#'       # border,
#'       age,
#'       sex,
#'       #
#'       # date,
#'       #
#'       # isoyear,
#'       # isoweek,
#'       # isoyearweek,
#'       # season,
#'       # seasonweek,
#'
#'       calyear,
#'       # calmonth,
#'       # calyearmonth,
#'
#'       household_income_median_all_households_nok
#'       # household_income_median_singles_nok,
#'       # household_income_median_couples_without_children_nok,
#'       # household_income_median_couples_with_children_nok,
#'       # household_income_median_single_with_children_nok
#'     ) %>%
#'     dplyr::collect() %>%
#'     as.data.table() %>%
#'     setorder(
#'       location_code,
#'       calyear
#'     )
#'
#'   # schema$anon_example_house_prices$print_dplyr_select()
#'   d_price <- schema$anon_example_house_prices$tbl() %>%
#'     sc::mandatory_db_filter(
#'       granularity_time = "calyear",
#'       granularity_time_not = NULL,
#'       granularity_geo = "county",
#'       granularity_geo_not = NULL,
#'       country_iso3 = NULL,
#'       location_code = NULL,
#'       age = "total",
#'       age_not = NULL,
#'       sex = "total",
#'       sex_not = NULL
#'     ) %>%
#'     dplyr::filter(calyear %in% 2000:2019) %>%
#'     dplyr::select(
#'       # granularity_time,
#'       # granularity_geo,
#'       # country_iso3,
#'       location_code,
#'       # border,
#'       # age,
#'       # sex,
#'       #
#'       # date,
#'       #
#'       # isoyear,
#'       # isoweek,
#'       # isoyearweek,
#'       # season,
#'       # seasonweek,
#'
#'       calyear,
#'       # calmonth,
#'       # calyearmonth,
#'
#'       new_house_price_per_m2_nok
#'       # used_house_price_per_m2_nok
#'     ) %>%
#'     dplyr::collect() %>%
#'     as.data.table() %>%
#'     setorder(
#'       location_code,
#'       calyear
#'     )
#'
#'   # The variable returned must be a named list
#'   retval <- list(
#'     "income" = d_income,
#'     "price" = d_price
#'   )
#'   retval
#' }
#'
#' # **** functions **** ----
#'
#'
#'
#'


require(PBSadmb)
source("/Users/Jim/Dropbox/r_common/adfunctions.r")
setwd("/Users/Jim/_mymods/AMAK/examples/chub/")

mod1 <- readList("arc/mod1_R.rep")
mod2 <- readList("arc/mod2_R.rep")
mod3 <- readList("arc/mod3_R.rep")
length(mod3$Like_Comp)
rbind(mod2$Like_Comp,mod3$Like_Comp)
# show projections
plt_proj(mod1,fy=1970,ly=2020)
plt_proj(mod2)

# show fit to catch biomass
CatchFit(mod1)
CatchFit
p.catch.fit(mod1,f=1,ylab="Catch biomass (t)" ,ylim=c(0,1700000))
p.catch.fit(mod1,f=2,ylab="Catch biomass (t)" ,ylim=c(0,1700000))
p.catch.fit(mod1,f=3,ylab="Catch biomass (t)" ,ylim=c(0,1700000))

sel.age.mountain(mod2, f=1, xvec=NULL, yvec=NULL, zscale=3, fy=1977,ly=2014)
,nshades=50, xaxs="i", yaxs="i", xlab="", ylab="", las=1, new=TRUE, addbox=FALSE, cex.xax=1, cex.yax=1, main="", ...)
p.catch.fit(mod2,f=1,ylab="Catch biomass (t)" ,ylim=c(0,500000))
p.catch.fit(mod2,f=2,ylab="Catch biomass (t)" ,ylim=c(0,500000))

# example of writing multiple plots to pdf file:
pdf("agefits.pdf",width=9, height=7)
  AgeFits(mod1,f=1)
  AgeFits(mod2,f=1)
dev.off()

# another example of writing multiple plots to pdf file:
pdf("indices.pdf",width=9, height=7)
    Indices(mod1,"Model 1",fy=1970,ly=2015)
    Indices(mod2,"Model 2",fy=1970,ly=2015)
    Indices(mod3,"Model 3",fy=1970,ly=2015)
dev.off()

pdf("selectivity.pdf",width=9, height=7)
Mntns(mod1,"Model 1")
Mntns(mod2 ,"Model 2")
dev.off()

Mntns_srv(mod1,"Model 1")
detach()
# Stock recruitment curve
styr=1950
 p.stock.rec(mod1)
 p.stock.rec(mod2,main="Model 2")
# recruitment hist w/ errors
 vpa_r <- read.table("clipboard")
 rec_age=0
 p.rec.hist(mod1,ylab="Age 0 recruitment",fy=1950,ly=2014,main="model 1")
 p.rec.hist(mod2,ylab="Age 0 recruitment",fy=1950,ly=2014,main="model 2")
  base=mod1$Stock_Rec[26:64,4]
length(base)
  wchina=mod2$Stock_Rec[20:65,4]
  vpa_r=(t(vpa_r))
  plot(base,vpa_r,xlab="Base",ylab="VPA",pch=19)
  plot(mod1$Stock_Rec[20:65,4],mod2$Stock_Rec[20:65,4],ylab="Base",xlab="Including Chinese catches",pch=19)
  lines(supsmu(wchina,base))
  ?supsmu

# Fishing mortality
 p.full.f(mod1)
 p.full.f(mod2)

# sample sizes
 p.eff.n(mod1,typ="F")
 p.eff.n(mod2,typ="F",main="Model 2")

# spawning biomass and last year's estimates
 p.biom.pol(mod1,main="Model 1")
 p.biom.pol(mod2,main="Model 2",fy=1950,ly=2014)
 p.biom.pol(mod3,main="Model 3")
 lines(mod1a$TotBiom[,1],mod1a$TotBiom[,2],lty=3,lw=3)

# Survey fit
 p.sur.stk(mod1,S=1)
detach()
# Rec
 p.biom.stk(mod1,typ="R")

# Numbers at age
 p.bub.age(mod1c,siz=3000)

# show spawning biomass relative to population with no fishing
spwn_ratio(mod1)


#  James Rekow

createMeanDissDF  = function(MVec = NULL, N = 20, numReplicates = 2){

  #  ARGS:
  #
  #  RETURNS:

  source("abdListCreator.r")
  source("DOCProcedure.r")

  if(is.null(MVec)){
    MVec = seq(from = 40, to = 200, by = 40)
  } #  end if

  MVec = c(MVec, MVec)
  numM = length(MVec) / 2

  univVec = c(rep(1, numM), rep(0, numM))

  inputDF = data.frame(M = MVec, univ = univVec)

  testReplicate = function(inputRow){

    M = inputRow[1]
    univ = inputRow[2]

    abdList = abdListCreator(M = M, N = N, univ = univ)

    ##  testing

    createSampledMeanDiss = function(zz = NULL){

      keepIx = sample(N, 20)

      speciesSelector = function(abdVec) abdVec[keepIx]

      speciesSubsetAbdList = lapply(abdList, speciesSelector)

      speciesSubsetDoc = DOCProcedure(abdList = speciesSubsetAbdList)

      speciesSubsetMeanDiss = mean(speciesSubsetDoc$y)

      return(speciesSubsetMeanDiss)

    } #  end createSampledMeanDiss function

    sampledMeanDissVec = sapply(1:10, createSampledMeanDiss)
    sampledMeanDiss = mean(sampledMeanDissVec)

    return(sampledMeanDiss)

    ##

    doc = DOCProcedure(abdList = abdList)
    meanDiss = mean(doc$y)

    return(meanDiss)

  } #  end testReplicate function

  testDFReplicate = function(n){

    replicateIDVec = rep(n, 2 * numM)

    meanDiss = apply(inputDF, 1, testReplicate)

    outputDF = cbind(inputDF, replicateIDVec, meanDiss)

    return(outputDF)

  } #  end testDFReplicate function

  testResultsDFList = lapply(as.list(1:numReplicates), testDFReplicate)
  # testResultsDF = Reduce(rbind, testResultsDFList)
  testResultsDF = do.call(rbind, testResultsDFList)
  testResultsDF$univ = as.factor(testResultsDF$univ)

  return(testResultsDF)

} #  end  createMeanDissDF  function


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Preliminary data exploration plots
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
rm(list=ls()) # clears workspace
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
library(ggplot2)
library(plyr)
source('R/FracFeed-Functions.r')
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Run to update data files
# source('R/FracFeed-DataPrep-GoogleImport.r')
# Or load from saved file
load('Data/FracFeed_Data.Rdata') # load saved 'DB'
dat<-fdat
# Load the factor levels (to maintain orders)
load('Data/FracFeed_FactorLevels.Rdata')
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

alpha<-0.3 # alpha level for colours

##################
# Data exploration
##################

pdf('Output/Plots/FracFeed-DataSummaries.pdf',height=11,width=8)
	op<-par(mfrow=c(4,2),tcl=-0.3,mgp=c(2,0.4,0),cex=0.7,yaxs='i',cex.lab=1.3)

	# Count of surveys by name
	tab<-sort(table(dat$Name))
	barplot(tab,las=2,ylab='Surveys',log='y')
	legend('topleft',legend=paste('n = ',sum(tab)),bty='n')

	# Count of citations by name
	tab<-apply(table(dat$Name,dat$Citation),1,function(x){sum(x>0)})
	barplot(sort(tab),las=2,ylab='Citations')
	legend('topleft',legend=paste('n = ',sum(tab)),bty='n')

	# Count of Taxon groups
	taxCnt<-tab<-sort(table(dat$Taxon.group))
	barplot(tab,las=2,ylab='Frequency',log='y')

	# Count of Taxon groups by species
	tab<-table(dat$Consumer.identity,dat$Taxon.group)
	tab<-tab[,order(apply(tab,2,sum))]
	predCnt<-apply(tab,2,function(x){sum(x>0)})
	b<-barplot(tab,las=2,ylab='Frequency',ylim=c(0,1.1*max(taxCnt)))
	text(b,taxCnt+20,paste0('(',predCnt,')'),cex=0.7)
	legend('topleft',legend=paste0('(',sum(predCnt),' predator species)'),bty='n')

	# Count of ecosystems
	tab<-table(factor(dat$Ecosystem,levels=EcosystemLevels),useNA='ifany')
	barplot(tab,las=2,ylab='Frequency',log='y')

	# Count of SpaceTime.replicate types
	tab<-rev(table(factor(dat$SpaceTime.replicate, levels=rev(SpaceTimeLevels)),useNA='ifany'))
	barplot(tab,las=2,ylab='Frequency')

	# Count of Spatial averaging scales
	tab<-rev(table(factor(dat$Space.averaging, levels=rev(SpaceAvgLevels)),useNA='ifany'))
	barplot(tab,las=2,ylab='Frequency')

	# Count of Temporal averaging scales
	tab<-table(factor(dat$Time.averaging, levels=TimeAvgLevels),useNA='ifany')
	barplot(tab,las=2,ylab='Frequency')

	# Histogram of citation year
	cite.yrs<-as.numeric(substring(sapply(strsplit(dat$Citation, "_"), "[", 2),1,4))
	rng<-range(cite.yrs,na.rm=TRUE)
	yrs<-seq(rng[1]-1,rng[2]+2,1)+0.5
	h<-hist(cite.yrs,plot=FALSE,breaks=yrs)
	plot(h,axes=FALSE,xlab='Citation year',col=adjustcolor('grey',alpha),main='')
	axis(2);axis(1,at=h$mids[h$mids%%10==0],labels=h$mids[h$mids%%10==0])

	# Histogram of sampling year
	rng<-range(dat$Year,na.rm=TRUE)
	yrs<-seq(rng[1]-1,rng[2]+2,1)+0.5
	h<-hist(dat$Year,plot=FALSE,breaks=yrs)
	plot(h,axes=FALSE,xlab='Sample year',col=adjustcolor('grey',alpha),main='')
	axis(2);axis(1,at=h$mids[h$mids%%10==0],labels=h$mids[h$mids%%10==0])

	# Histogram of latitude
	h<-hist(dat$Latitude,breaks=seq(-90,90,5),plot=FALSE)
	plot(h,axes=FALSE,xlab='Latitude',col=adjustcolor('grey',alpha),main='')
	labs<-c('90S',abs(seq(-80,80,10)),'90N')
	axis(2);axis(1,at=seq(-90,90,10),labels=labs)

	# Histogram of sampling month - Should split by Northern/Southern hemisphere  - see below
	mnths<-seq(0.5,12.5,1)
	h<-hist(dat$Month,plot=FALSE,breaks=mnths)
	plot(h,axes=FALSE,xlab='Month',col=adjustcolor('grey',alpha),main='')
	axis(2);axis(1,at=h$mids,labels=h$mids)

	# Histogram of sample sizes per survey
	h<-hist(log10(dat$Total.stomachs.count),plot=FALSE,breaks=20)
	plot(h,axes=FALSE,xlab='Individuals sampled',col=adjustcolor('grey',alpha),main='')
	axis(2);axis(1,at=h$breaks,labels=10^(h$breaks))

	# Histogram of diet richness per survey
	bks<-seq(0,log(max(dat$Diet.richness.minimum,na.rm=TRUE)+1),0.5)
	h<-hist(log10(dat$Diet.richness.minimum),plot=FALSE,breaks=bks)
	plot(h,axes=FALSE,xlab='Diet richness',col=adjustcolor('grey',alpha),main='')
	ax1.at<-pretty(h$breaks)
	axis(2);axis(1,at=ax1.at,labels=ax1.at)

	# Histogram of Percent feeding
	h<-hist(dat$Percent.feeding,plot=FALSE,breaks=50)
	plot(h,axes=FALSE,xlab='Percent feeding',col=adjustcolor('grey',alpha),main='')
	axis(2);axis(1)

	# Compare given and calculated Percent Feeding
	op2<-par(pty='s',xaxs='i')
	plot(dat$Percent.feeding,
	     dat$Percent.feeding.given,
	     xlab='Calculated % feeding',
	     ylab='Given % feeding',
	     pch=21,bg=adjustcolor('grey',alpha))
	par(op2)

	par(yaxs='r')

  # Diet richness vs. Individuals surveys
	plot(dat$Diet.richness.minimum~dat$Total.stomachs.count,
	     log='x',
	     pch=21,
	     bg=adjustcolor('grey',alpha),
	     xlab='Individuals sampled',
	     ylab='Minimmum diet richness')

	# Percent feeding vs. Individuals surveyed
	plot(dat$Percent.feeding~dat$Total.stomachs.count,
	     log='x',
	     pch=21,
	     bg=adjustcolor('grey',alpha),
	     xlab='Individuals sampled',
	     ylab='Percent feeding')

	# Percent feeding vs. Diet richness
	plot(dat$Percent.feeding~dat$Diet.richness.min,
	     log='x',
	     pch=21,
	     bg=adjustcolor('grey',alpha),
	     xlab='Minimum diet richness',
	     ylab='Percent feeding')

	# Percent feeding vs. Latitude
 	plot(dat$Percent.feeding~dat$Latitude,
 	     pch=21,
 	     bg=adjustcolor('grey',alpha),
 	     xlab='Latitude',
 	     ylab='Percent feeding')

	# Percent feeding vs. Year
 	plot(dat$Percent.feeding~dat$Year,
 	     pch=21,
 	     bg=adjustcolor('grey',alpha),
 	     xlab='Year',
 	     ylab='Percent feeding')

	# Percent feeding vs. Hour
 	plot(dat$Percent.feeding~dat$Hour,
 	     pch=21,
 	     bg=adjustcolor('grey',alpha),
 	     xlab='Hour',
 	     ylab='Percent feeding',
 	     axes=FALSE);
 	axis(2);
 	axis(1,seq(0,24,2));
 	box(lwd=1)

	# Percent feeding vs. Month split by hemisphere
	datN<-subset(dat,Latitude>0)
	datS<-subset(dat,Latitude<0)
 	plot(datN$Percent.feeding~jitter(datN$Month),
 	     pch=21,
 	     bg=adjustcolor('grey',alpha),
 	     xlab='Month',
 	     ylab='Percent feeding',
 	     axes=FALSE,main="Northern");
 	axis(2);
 	axis(1,at=1:12);
 	box(lwd=1)
 	plot(datS$Percent.feeding~jitter(datS$Month),
 	     pch=21,
 	     bg=adjustcolor('grey',alpha),
 	     xlab='Month',
 	     ylab='Percent feeding',
 	     axes=FALSE,
 	     main="Southern");
 	axis(2);
 	axis(1,at=1:12);
 	box(lwd=1)

 	# Daylength vs. Latitude
 	plot(dat$Latitude,dat$DL,
 	     xlab='Latitude',
 	     ylab='Day length',
 	     pch=21,
 	     bg=adjustcolor('grey',alpha))

 	# Percent feeding vs. Daylength
 	plot(dat$DL,dat$Percent.feeding,
 	     xlab='Day length',
 	     ylab='Percent feeding',
 	     pch=21,
 	     bg=adjustcolor('grey',alpha))

 	# Daylength vs. Days since winter solstice
 	plot(dat$tWS,dat$DL,
 	     xlab='Days post winter solstice',
 	     ylab='Day length',
 	     pch=21,
 	     bg=adjustcolor('grey',alpha))

# Percent feeding vs. Days since winter solstice
 	plot(dat$tWS,dat$Percent.feeding,
 	     xlab='Days since winter solstice',
 	     ylab='Percent feeding',pch=21,
 	     bg=adjustcolor('grey',alpha))
   	fit <- mgcv::gam(Percent.feeding ~ s(tWS), data = dat)
   	newx1<-data.frame(tWS=seq(0,365,1))
   	predvals<-predict(fit,newdata=newx1,type = "response")
   	plot(fit,residuals=TRUE,seWithMean = TRUE,shade=TRUE,rug=FALSE,all.terms=TRUE,pch=21)

# Evaluate potential methodological biases over time
   	decades <- seq(1920,2020,10)
   	lab.decades <- decades[-length(decades)]
 	# By Feeding Data Type
  p1 <- ggplot(dat) +
 	  aes(x=cut(Year,
 	            breaks=decades,
 	            include.lowest=TRUE,
 	            right=FALSE,
 	            labels=lab.decades),
 	      fill=factor(Feeding.data.type)) +
 	  geom_bar(position = 'fill') +
 	  scale_y_continuous(limits = c(0,1), breaks = c(0,1)) +
 	  facet_grid(rows = vars(Taxon.group)) +
 	  labs(x = "", y = "Proportion", fill = "Observation type") +
    theme(strip.text.y = element_text(angle = 0))

 	# By Rate-limiting-step
  p2 <- ggplot(dat) +
    aes(x=cut(Year,
              breaks=decades,
              include.lowest=TRUE,
              right=FALSE,
              labels=lab.decades),
        fill=factor(Rate.limiting.step)) +
    geom_bar(position = 'fill') +
    scale_y_continuous(limits = c(0,1), breaks = c(0,1)) +
    facet_grid(rows = vars(Taxon.group)) +
    labs(x = "", y = "Proportion", fill = "Rate\nlimiting\nstep?") +
    theme(strip.text.y = element_text(angle = 0))

 	# By Survey type
  p3 <- ggplot(dat) +
    aes(x=cut(Year,
              breaks=decades,
              include.lowest=TRUE,
              right=FALSE,
              labels=lab.decades),
        fill=factor(SpaceTime.replicate)) +
    geom_bar(position = 'fill') +
    scale_y_continuous(limits = c(0,1), breaks = c(0,1)) +
    facet_grid(rows = vars(Taxon.group)) +
    labs(x = "", y = "Proportion", fill = "Survey type") +
    theme(strip.text.y = element_text(angle = 0))

  multiplot(p1, p2, p3, rows=3)

 	# Percent feeding vs. Time-averaging
	p1 <- ggplot(dat, aes(factor(Time.averaging, levels=TimeAvgLevels), Percent.feeding)) + geom_violin(scale = "width") + labs(x='')

	# Percent feeding vs. Spatial-averaging
	p2 <- ggplot(dat, aes(factor(Space.averaging,levels=SpaceAvgLevels), Percent.feeding)) + geom_violin(scale = "width") + labs(x='')

	# Percent feeding vs. Taxon group
	PercFeed.Taxon<-ddply(dat,.(Taxon.group),summarize,Mean=mean(Percent.feeding), SD=sd(Percent.feeding))
	PercFeed.Taxon<-PercFeed.Taxon[order(PercFeed.Taxon$Mean),]
	TaxonGroupLevels<-PercFeed.Taxon$Taxon.group
	p3 <- ggplot(dat, aes(factor(Taxon.group,levels=TaxonGroupLevels), Percent.feeding)) + geom_violin(scale = "width") + labs(x='')

	# Percent feeding vs. Ecosystem
	PercFeed.Ecosystem<-ddply(dat,.(Ecosystem),summarize,Mean=mean(Percent.feeding), SD=sd(Percent.feeding))
	PercFeed.Ecosystem<-PercFeed.Ecosystem[order(PercFeed.Ecosystem$Mean),]
	EcosystemLevels<-PercFeed.Ecosystem$Ecosystem
	p4 <- ggplot(dat, aes(factor(Ecosystem,levels=EcosystemLevels), Percent.feeding)) + geom_violin(scale = "width") + labs(x='')

	multiplot(p1, p2, p3, p4, rows=4)

	# Diet richness vs. Individuals surveys
	p1 <- ggplot(dat) + geom_point(aes(x=Total.stomachs.count,y=Diet.richness.minimum,color=Taxon.group),alpha=alpha) + theme_bw() + theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank()) + scale_x_log10()

	# Percent feeding vs. Individuals surveyed
	p2 <- ggplot(dat) + geom_point(aes(x=Total.stomachs.count,y=Percent.feeding,color=Taxon.group),alpha=alpha) + theme_bw() + theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank()) + scale_x_log10()

	# Percent feeding vs. Diet richness
	p3 <- ggplot(dat) + geom_point(aes(x=Diet.richness.minimum,y=Percent.feeding,color=Taxon.group),alpha=alpha) + theme_bw() + theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank()) + scale_x_log10()

	# Percent feeding vs. Latitude
	p4 <- ggplot(dat) + geom_point(aes(x=Latitude,y=Percent.feeding,color=Taxon.group),alpha=alpha) + theme_bw() + theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank())

	# Percent feeding vs. Year
 	p5 <- ggplot(dat) + geom_point(aes(x=Year,y=Percent.feeding,color=Taxon.group),alpha=alpha) + theme_bw() + theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank())

	# Percent feeding vs. Hour
	p6 <- ggplot(dat) + geom_point(aes(x=Hour,y=Percent.feeding,color=Taxon.group),alpha=alpha) + theme_bw() + theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank())

	# Percent feeding vs. Month split by hemisphere
	datN<-subset(dat,Latitude>0)
	datS<-subset(dat,Latitude<0)
	p7 <- ggplot(datN) + geom_point(aes(x=Month,y=Percent.feeding,color=Taxon.group),alpha=alpha) + theme_bw() + theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank())
	p8 <- ggplot(datS) + geom_point(aes(x=Month,y=Percent.feeding,color=Taxon.group),alpha=alpha) + theme_bw() + theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank())

	# Percent feedings vs. Daylength
	p9 <- ggplot(dat) + geom_point(aes(x=DL,y=Percent.feeding,color=Taxon.group),alpha=alpha) + theme_bw() + theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank())

	# Percent feeding vs. Days since winter solstice
	p10 <- ggplot(dat) + geom_point(aes(x=tWS,y=Percent.feeding,color=Taxon.group),alpha=alpha) + theme_bw() + theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank())

	multiplot(p1,p2,p3)
	multiplot(p4,p5,p6)
  multiplot(p7,p8,p9)
  multiplot(p10,p10,p10)

dev.off()
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


fn.poB = file.path(PROJECT_DIR, "generated_data", "CHI", "flow_percent_of_B_filtered.txt")
flow.poB = fread(fn.poB) %>%
  select(sample, matches("Gate")) %>%
  dplyr::rename(CD38high = Gate3,
                CD38high.CD10pos = Gate2,
                CD38high.CD10neg = Gate1,
                CD38pos = Gate4)

fn.info = file.path(PROJECT_DIR, "generated_data", "CHI", "flow_sample_info_filtered.txt")
flow.info = fread(fn.info)

# get originally gated flow data
flow.old = data.frame()
for (tp in c("day0", "pre7","day70")) {
  fn.old = file.path(PROJECT_DIR, "data", "CHI/flow/original_gates", sprintf("%s.log10.txt", tp))
  df.tmp = read.table(fn.old, sep="\t", header=T, row.names=1, stringsAsFactors=F)
  df.tmp = as.data.frame(t(df.tmp)) %>%
    dplyr::select(ID87) %>%
    tibble::rownames_to_column("subject") %>%
    mutate(subject=sub("X","",subject), time=tp)
  flow.old = rbind(flow.old, df.tmp)
}
flow.old = flow.old %>%
  mutate(sample = paste(subject, time, sep="_")) %>%
  dplyr::select(-time, -subject)

flow = inner_join(flow.poB, flow.info, by="sample") %>%
  dplyr::filter(time %in% c(0, -7, 70)) %>%
  mutate(subject = as.character(subject)) %>%
  inner_join(flow.old, by="sample")

pops = names(flow)[c(rev(2:5),11)]
pops.name = c(
  "CD20+CD38+ of total B cells",
  "CD20+CD38++ of total B cells",
  "CD20+CD38++CD10+ of total B cells\n(transitional-like)",
  "CD20+CD38++CD10- of total B cells\n(memory-like)",
  "CD20-CD38++CD27++ of total B cells\n(plasmablasts)"
)
pops.group = (1:3)[c(2,2,2,2,3)] %>% factor()

df.stab = data.frame(Population=factor(pops, levels=rev(pops)), group=pops.group, ISV=NA)
for (i in seq_along(pops)) {
  form = as.formula(sprintf("%s ~ subject", pops[i]))
  fit = aov(form, data=flow)
  ss = summary(fit)[[1]]["Sum Sq"][[1]]
  ssn = ss / sum(ss)
  df.stab$ISV[i] = ssn[1]
}

ggplot(df.stab, aes(Population, ISV, fill=group)) + geom_bar(stat="identity") +
  scale_x_discrete(labels=rev(pops.name), position="top") +
  xlab("") +
  ylab("ISV") +
  coord_flip() +
  theme_bw() +
  theme(legend.position="none", axis.ticks.y=element_blank())

fn.fig = file.path(PROJECT_DIR, "figure_generation", sprintf("CHI_flow_selected_gates_ISV"))
ggsave(paste0(fn.fig, ".png"), w=6,h=3)
ggsave(paste0(fn.fig, ".pdf"), w=6,h=3)


compare <- function(a, b)
{
  cat(paste(a, "is of type", class(a), "and", b, "is of type", class(b), "\n"))

  printer <- function(a, b, msg) cat(paste(a, msg, b, "\n"))

  op <- c(`<`, `<=`, `>`, `>=`, `==`, `!=`)
  msgs <- c(
    "is strictly less than",
    "is less than or equal to",
    "is strictly greater than",
    "is greater than or equal to",
    "is equal to",
    "is not equal to"
  )

  sapply(1:length(msgs), function(i) if(op[[i]](a, b)) printer(a, b, msgs[i]))

  invisible()
}


library(ggplot2)
library(VGAM)
library(monocle3)

# Args
args = commandArgs(trailingOnly=TRUE)
root_dir = args[1]
cluster_backend = args[2]

dir.create(root_dir)

# Add more filepaths here based on how many datasets we want to analyze
# TODO: Update this to read from files
filepaths = c(
    '/home/lexent/Downloads/cyclic_1.rds',
    '/home/lexent/Downloads/cyclic_5.rds',
    '/home/lexent/Downloads/cyclic_8.rds'
)

datasets = c(
    'dyntoy_cyclic_1',
    'dyntoy_cyclic_5',
    'dyntoy_cyclic_8'
)

results = data.frame()

for(i in 1:length(filepaths)){
    dataset = readRDS(filepaths[i])
    start_cell_ids = dataset$prior_information$start_id
    expression_matrix = dataset$counts
    cell_metadata = dataset$cell_ids
    gene_annotation = dataset$prior_information$features_id

    cell_m = matrix(unlist(cell_metadata), ncol = 1, byrow = TRUE)
    row.names(cell_m) = cell_m

    gene_m = matrix(unlist(gene_annotation), ncol = 1, byrow = TRUE)
    row.names(gene_m) = gene_m

    cds = new_cell_data_set(
        t(expression_matrix),
        cell_metadata = cell_m,
        gene_metadata = gene_m
    )
#     Preprocess
    cds <- preprocess_cds(cds,norm_method='log', pseudo_count=1)

#     Dimensionality reduction
    cds <- reduce_dimension(cds)

#     Cluster generation
    cds <- cluster_cells(cds, cluster_method=cluster_backend, verbose=TRUE, random_seed=0)

#     Learn trajectory
    cds <- learn_graph(cds)

#     Plot graph
    plot_cells(cds,
       color_cells_by = "cluster",
       label_groups_by_cluster=TRUE,
       label_leaves=FALSE,
       label_branch_points=FALSE
    )
    ggsave(paste(datasets[i], '.png', sep=""), path=root_dir)

#     Pseudotime computation
    cds = order_cells(cds, root_cells=start_cell_ids)
    plot_cells(cds,
       color_cells_by = "pseudotime",
       label_cell_groups=FALSE,
       label_leaves=FALSE,
       label_branch_points=FALSE,
       graph_label_size=1.5
    )
    ggsave(paste(datasets[i], '_pseudotime.png', sep=""), path=root_dir)

#     Metric computation (KT, SR etc.)
    monocle3_pseudotime = cds@principal_graph_aux[['UMAP']]$pseudotime
    gt_pseudotime = dataset$prior_information$timecourse_continuous
    gt_pseudotime[which(!is.finite(gt_pseudotime))] = 0
    monocle3_pseudotime[which(!is.finite(monocle3_pseudotime))] = 0

    gt_df = data.frame(gt_pseudotime, row.names=names(gt_pseudotime))
    m_df = data.frame(monocle3_pseudotime, row.names=names(monocle3_pseudotime))
    reorder_idx = match(rownames(m_df),rownames(gt_df))
    gt_df = data.frame(gt_df[reorder_idx,], row.names=names(monocle3_pseudotime))

    kt = cor.test(x=as.vector(t(gt_df)), y=as.vector(t(m_df)), method = 'kendall')
    sr = cor.test(x=as.vector(t(gt_df)), y=as.vector(t(m_df)), method = 'spearman')
    results[datasets[i], 'KT'] = kt$estimate
    results[datasets[i], 'SR'] = sr$estimate
}

print(results)

write.csv(results, paste(root_dir, 'results.csv', sep=""))


library(phyclust, quietly = TRUE)
library(parallel)

### Load data
data.path <- paste(.libPaths()[1], "/phyclust/data/pony524.phy", sep = "")
pony.524 <- read.phylip(data.path)
X <- pony.524$org
K0 <- 1
Ka <- 2

### Find MLEs
ret.K0 <- find.best(X, K0)
ret.Ka <- find.best(X, Ka)
LRT <- -2 * (ret.Ka$logL - ret.K0$logL)

### The user defined function
FUN <- function(jid){
  X.b <- bootstrap.seq.data(ret.K0)$org

  ret.K0 <- phyclust(X.b, K0)
  repeat{
    ret.Ka <- phyclust(X.b, Ka)
    if(ret.Ka$logL > ret.K0$logL){
      break
    }
  }

  LRT.b <- -2 * (ret.Ka$logL - ret.K0$logL)
  LRT.b
}

### Task pull and summary
ret <- mclapply(1:100, FUN)
LRT.B <- unlist(ret)
cat("K0: ", K0, "\n",
    "Ka: ", Ka, "\n",
    "logL K0: ", ret.K0$logL, "\n",
    "logL Ka: ", ret.Ka$logL, "\n",
    "LRT: ", LRT, "\n",
    "p-value: ", mean(LRT > LRT.B), "\n", sep = "")


#!/usr/bin/env Rscript
args = commandArgs(trailingOnly=TRUE)
if (length(args)==0) {
  stop("At least one argument must be supplied (input file).n", call.=FALSE)
}
outputfile<-"Alleles_largedist"
largedist1a<- read.table (args[1], header = TRUE)
attach (largedist1a)
largedist2a <- as.dist(largedist1a)  #this gives a triangular matrix dist 2 is triangular matrix
largehca <- hclust(largedist2a, "average") #UPGMA

pdf (file =paste(outputfile,"_tree.pdf", sep=""), width =10, height = 5, pointsize =6)
plot(largehca, cex=0.8)
dev.off()


library(tidyverse)

# read in data
canada <- read.csv("canadiancitycouncil.csv")

# calculate councilors per 100,000 population
canada$pc.council <- canada$council/(canada$pop16/100000)

annot <- read.table(text=
  "city|number|just|text
  33.5|2.7|0|Current number
of councilors - 44.
  41.5|2.6|1|Proposed number
of councilors - 25.
  16.5|5.4|0|Richmond Hill is the median city with
4.03 councilors per 100,000 residents.",
  sep="|", header=TRUE, stringsAsFactors=FALSE)
annot$text <- gsub("
", "\n", annot$text)

# plot
c <- ggplot(data=canada,
  aes(x=reorder(city, -pc.council), y=pc.council, width=0.9, fill=highlight))+
  geom_bar(stat="identity")+
  scale_fill_manual(values = c("yes"="#E69F00", "no"="#999999" ), guide = FALSE )+
  scale_y_continuous(breaks=seq(0, 12, by=2))+
  # read in annotations
  geom_label(data=annot, aes(x=city, y=number, label=text, hjust=just),
    family="Open Sans Condensed Light", lineheight=0.95,
    size=3, label.size=0, color="#2b2b2b", inherit.aes = FALSE)+
  # Theming
  labs(
    title="Doug Ford's proposal will result in fewest city councilors per capita among the largest Canadian cities",
    subtitle="City councilors per 100,000 residents, 40 largest Canadian cities, 2016",
    caption="Author: Chris Goodman (@cbgoodman), Data: Statistics Canada & Author's calculations.",
    y=NULL,
    x=NULL) +
  theme_minimal(base_family="Open Sans Condensed Light") +
  # light, dotted major y-grid lines only
  theme(panel.grid=element_line())+
  theme(panel.grid.major.y=element_line(color="#2b2b2b", linetype="dotted", size=0.15))+
  theme(panel.grid.major.x=element_blank())+
  theme(panel.grid.minor.x=element_blank())+
  theme(panel.grid.minor.y=element_blank())+
  # light x-axis line only
  theme(axis.line=element_line())+
  theme(axis.line.y=element_blank())+
  theme(axis.line.x=element_blank())+
  # tick styling
  theme(axis.ticks=element_line())+
  theme(axis.ticks.x=element_blank())+
  theme(axis.ticks.y=element_blank())+
  theme(axis.ticks.length=unit(5, "pt"))+
  # x-axis labels
  theme(axis.text.x=element_text(size=10, angle=90, hjust=0.95,vjust=0.2))+
  # breathing room for the plot
  theme(plot.margin=unit(rep(0.5, 4), "cm"))+
  # move the y-axis tick labels over a bit
  #theme(axis.text.y=element_text(margin=margin(r=-5)))+
  # make the plot title bold and modify the bottom margin a bit
  theme(plot.title=element_text(family="Open Sans Condensed Bold", margin=margin(b=15)))+
  # make the subtitle italic
  theme(plot.subtitle=element_text(family="Open Sans Condensed Light Italic"))+
  theme(plot.caption=element_text(size=8, hjust=0, margin=margin(t=15)))

ggsave(plot=c, "canadiancouncilors.png", width=10, height=6, units="in", dpi="retina")


source('~/project/main.r')
library('highcharter')

raw_tmp <-arrange(filter(row_refine,車種=='C03'))

raw_tmp <- select(raw_tmp,當事者行動狀態意義,死,受傷)
raw_tmp <- raw_tmp %>% drop_na(當事者行動狀態意義)
raw_tmp$count <- 1
raw_tmp[is.na(raw_tmp)] <- 0
raw_tmp_summary <- (raw_tmp %>% group_by(當事者行動狀態意義) %>%
  summarise_all(sum)
)

raw_tmp_summary$死比率 <- raw_tmp_summary$死 / sum(raw_tmp_summary$count) * 100
raw_tmp_summary$受傷比率 <- raw_tmp_summary$受傷 / sum(raw_tmp_summary$count) * 100
raw_tmp_summary$意外比率 <- raw_tmp_summary$count / sum(raw_tmp_summary$count) * 100

# highchart() %>%
#   hc_chart(type ="column", options3d = list(enabled = TRUE, beta = 15, alpha = 15)) %>%
#   hc_xAxis(categories = raw_tmp_summary$當事者行動狀態意義) %>%
#   hc_add_series(data = raw_tmp_summary$死比率, name = "死/總意外比率") %>%
#   hc_add_series(data = raw_tmp_summary$受傷比率, name = "受傷/總意外比率") %>%
#   hc_add_series(data = raw_tmp_summary$意外比率, name = "意外/總意外比率")

raw_tmp_summary %>% hchart(
  "pie", hcaes(x = 當事者行動狀態意義, y = count),
  name = "Fruit consumption"
)

raw_tmp <-arrange(filter(row_refine,當事者行動狀態=='9'))

raw_tmp <- select(raw_tmp,事故類型及型態意義,死,受傷)
raw_tmp <- raw_tmp %>% drop_na(事故類型及型態意義)
raw_tmp$count <- 1
raw_tmp[is.na(raw_tmp)] <- 0
raw_tmp_summary <- (raw_tmp %>% group_by(事故類型及型態意義) %>%
  summarise_all(sum)
)

raw_tmp_summary %>% hchart(
  "pie", hcaes(x = 事故類型及型態意義, y = count),
  name = "Fruit consumption"
)


cat(sapply(strsplit(readLines(tail(commandArgs(), n=1)), " | ", fixed=TRUE), function(s) {
  c <- sapply(strsplit(s[1], " ")[[1]], as.integer)
  for (i in 2:length(s)) {
    d <- sapply(strsplit(s[i], " ")[[1]], as.integer)
    for (j in 1:length(d)) {
      if (d[j] > c[j]) {
        c[j] <- d[j]
      }
    }
  }
  paste(c, collapse=" ")
}), sep="\n")


plot.width = {img_width}
plot.height = {img_height}
plot.range = {date_range}
plot.typeids = c(29668,34133,34132,40519)
plot.locationid = {locationid}
plot.title = '{plot_title}'
plot.path = '{plot_path}'

date.min <- Sys.Date() - plot.range
plot.typeids.str <- paste(plot.typeids, collapse=',')
## Event List ##
event.query <- paste0(
    'SELECT datetime, eventName ',
    'FROM event_list ',
    'WHERE eventGroup in (\'patch\') ',
    'AND datetime > \'', date.min, '\' '
)
event <- sqlQuery(emd, event.query)
event$datetime <- as.POSIXlt(event$datetime, tz='GMT')
do_lines <- TRUE
if(nrow(event)==0){{do_lines <- FALSE}}

ec.query <- paste0(
    'SELECT price_date AS `date`, price_time AS `hour`, locationid, typeid, ',
    'SUM(IF(buy_sell=1, price_best, NULL)) AS `SellOrder`, ',
    'SUM(IF(buy_sell=0, price_best, NULL)) AS `BuyOrder` ',
    'FROM snapshot_evecentral ',
    'WHERE locationid=', plot.locationid, ' ',
    'AND typeid IN (', plot.typeids.str, ') ',
    'AND price_date > \'', date.min, '\' ',
    'GROUP BY price_date, price_time, typeid'
)
ec <- sqlQuery(emd, ec.query)
odbcClose(emd)
ec$date <- as.Date(ec$date)
ec$typeid <- as.factor(ec$typeid)
ec <- subset(ec, SellOrder > 0)
ec$datetime <- paste(ec$date, ec$hour, sep=' ')
ec$datetime <- as.POSIXlt(ec$datetime, tz='GMT')

## CREST Lookups ##
CREST_BASE = 'https://crest-tq.eveonline.com/'
solarsystem.addr <- paste0(CREST_BASE, 'solarsystems/', plot.locationid, '/')
solarsystem.json <- fromJSON(readLines(solarsystem.addr))
solarsystem.name <- solarsystem.json$name

ec$locationName <- solarsystem.name

type_list <- unique(ec$typeid)
ec$typeName <- NA
for(type.index in 1:length(type_list)){{
    type.name <- ''
    type.id <- type_list[type.index]
    type.addr <- paste0(CREST_BASE, 'inventory/types/', type.id, '/')
    type.json <- fromJSON(readLines(type.addr))
    type.name <- type.json$name
    ec$typeName[ec$typeid==type.id] <- type.name
}}

## Plot Theme ##
theme_dark <- function( ... ) {{
  theme(
    text = element_text(color="gray90"),
    title = element_text(size=rel(2),hjust=0.05,vjust=3.5),
    axis.title.x = element_text(size=rel(1),hjust=0.5, vjust=0),
    axis.title.y = element_text(size=rel(1),hjust=0.5, vjust=1.5),
    plot.margin = unit(c(2,1,1,1), "cm"),
    plot.background=element_rect(fill="gray8",color="gray8"),
    panel.background=element_rect(fill="gray10",color="gray10"),
    panel.grid.major = element_line(colour="gray17"),
    panel.grid.minor = element_line(colour="gray12"),
    axis.line = element_line(color = "gray50"),
    plot.title = element_text(color="gray80"),
    axis.title = element_text(color="gray70"),
    axis.text = element_text(color="gray50",size=rel(1.1)),
    legend.key = element_rect(fill="gray8",color="gray8"),
    legend.background = element_rect(fill="gray8"),
    legend.title = element_text(size=rel(0.6)),
    legend.text = element_text(size=rel(1.1)),
    strip.background = element_rect(fill="gray1"),
    strip.text = element_text(size=rel(1.2))
  ) + theme(...)
}}

ec <- subset(ec, SellOrder > 0)
plot.data <- ec
plot.data$SellOrder[plot.data$typeid==34132] <- 3.5 * plot.data$SellOrder[plot.data$typeid==34132]
plot.data$BuyOrder[ plot.data$typeid==34132] <- 3.5 * plot.data$BuyOrder[ plot.data$typeid==34132]
plot.data$SellOrder[plot.data$typeid==40519] <- 35/8* plot.data$SellOrder[plot.data$typeid==40519]
plot.data$BuyOrder[ plot.data$typeid==40519] <- 35/8* plot.data$BuyOrder[ plot.data$typeid==40519]

price.max_scale <- max(plot.data$SellOrder, na.rm=TRUE)
price.min_scale <- min(plot.data$BuyOrder, na.rm=TRUE)

## Build Plot ##
alpha_group <- c(1.0,0.3,0.3,0.8)
plot <- ggplot(
    plot.data,
    aes(
        x=datetime,
        ymin=BuyOrder,
        ymax=SellOrder,
        fill=typeName,
        alpha=typeName)
)
plot <- plot + geom_ribbon()
plot <- plot + theme_dark()
plot <- plot + scale_alpha_manual(values=alpha_group)
plot <- plot + scale_y_continuous(
    limit=c(price.min_scale, NA),
    labels=function(x)sprintf('%.1fB', x/1e9),
    position='right'
)
if(do_lines){{
    plot <- plot + geom_vline(
        xintercept=as.numeric(event$datetime),
        linetype=2,
        color='white'
    )
    plot <- plot + geom_text(
        aes(
            x=datetime,
            y=Inf,
            label=eventName),
        color='white',
        angle=-90,
        vjust=1.2,
        hjust=0,
        data=event,
        inherit.aes=FALSE
    )
}}
plot <- plot + labs(
    title=plot.title,
    color='PriceKey',
    x='date',
    y='price'
)

## Print Plot To File ##
png(
    plot.path,
    width=plot.width,
    height=plot.height
)
print(plot)
dev.off()


N <- 100

insSort <- function(x){
    return(8*x^2)
}

merSort<- function(x){
    return(log(x) * 64 * x)
}

mer <- c()
ins <- c()

for(i in 1:N){
    mer <- c(mer, merSort(i))
    ins <- c(ins, insSort(i))
}

merSortBetter <- mer < ins

insSortBetter <- ins < mer

equals <- mer == ins

summary(merSortBetter)
summary(insSortBetter)

head(merSortBetter, n=50)


suppressPackageStartupMessages({
    source("../../../.Rprofile", chdir = TRUE)
    library(ggplot2)
    library(Seurat)
    library(DoubletFinder)
})

inputdata.10x <- Read10X_h5("pbmc_granulocyte_sorted_10k_filtered_feature_bc_matrix.h5")
meta.data <- read.csv("wnn_meta_data.csv", row.names = 1)

rna.counts <- inputdata.10x$`Gene Expression`[, rownames(meta.data)]
rna.so <- CreateSeuratObject(counts = rna.counts, assay = "RNA", meta.data = meta.data)

rna.so <- NormalizeData(rna.so)

rna.so <- FindVariableFeatures(rna.so, selection.method = "vst", nfeatures = 2000)

rna.so <- ScaleData(rna.so)

rna.so <- RunPCA(rna.so, npcs = 30, verbose=FALSE)

rna.so <- RunUMAP(rna.so, dims = 1:30)

sweep.res.list <- paramSweep_v3(rna.so, PCs = 1:30, sct = FALSE)

sweep.stats <- summarizeSweep(sweep.res.list, GT = FALSE)

bcmvn <- find.pK(sweep.stats)

options(repr.plot.width=12, repr.plot.height=6)
ggplot(data=bcmvn, mapping=aes(x=pK, y=BCmetric, group=1)) + geom_point() + geom_line()

annotations <- rna.so@meta.data$celltype
homotypic.prop <- modelHomotypic(annotations)
nExp_poi <- round(0.075*nrow(rna.so@meta.data))
# nExp_poi.adj <- round(nExp_poi*(1-homotypic.prop))

rna.so <- doubletFinder_v3(rna.so, PCs = 1:30, pN = 0.25, pK = 0.005, nExp = nExp_poi, reuse.pANN = FALSE, sct = FALSE)

classification_key <- paste0("DF.classifications_0.25_0.005_", nExp_poi)
write.csv(data.frame(
    doubletfinder = rna.so@meta.data[, classification_key],
    row.names = rownames(rna.so@meta.data)
), "doubletfinder_inference.csv", quote = FALSE)


########################################################
#####       Author: Diego Valle Jones
#####       Website: www.diegovalle.net
#####       Date Created: Tue May 25 09:58:24 2010
########################################################
#Pretty plots of marijuana and opium eradication, cultivation and
#cocaine prices

drugPlot <- function(df, filename, ylab, title) {
  print(ggplot(df, aes(years, area, group = type,
                    color = type)) +
      geom_line() +
      geom_rect(xmin = 2006, xmax = 2009,
              ymin=0, ymax=Inf, alpha = .02, fill = "red",
                color= "#efefef") +
      annotate("text", x = 2007.5, y = 28000, label = "Drug War") +
      ylab(ylab) + xlab("") +
      opts(title = title) +
      scale_y_continuous(formatter = "comma", limits = c(0, max(df$area, na.rm = TRUE))))
  filename <- paste("drugs/output/", filename)
  dev.print(png, filename, width=640, height=480)
}

#http://www.state.gov/p/inl/rls/nrcrpt/2010/vol1/137197.htm
#Eradication (ha)
mj <- c(14135, 18663, 23316, 30162, 30857, 30852, 36585, 30775, 28699)
opium <- c(11471, 13189, 11410, 16890, 21609, 15926, 20034, 19158, 19115)
drugs <- data.frame(area = c(mj, opium),
                    years = rep(2009:2001, 2),
                    type = rep(c("marijuana", "poppy"), each = 9))
drugPlot(drugs, "cannabis-poppy-eradication.png", "Eradication (ha)",
         "The amount of cannabis and opium poppy\neradicated has decreased")

#Harvestable / Net Cultivation (ha)
mj <- c(12000, 8900, NA, 8600, 5600, 5800, 7500, 7900, 4100)
poppy <- c(15000, 6900, NA, 5100, 3300, 3500, 4800, 2700, 4400)
drugs <- data.frame(area = c(mj, poppy),
                    years = rep(2009:2001, 2),
                    type = rep(c("marijuana", "poppy"), each = 9))
drugPlot(drugs, "cannabis-poppy-cultivation.png",
         "Net Cultivation (ha)",
         "The amount of cannabis and opium poppy\ncultivated has increased")

########################################################
#Cocaine Prices
########################################################
#WORLD DRUG REPORT 2009
#http://www.unodc.org/documents/wdr/WDR_2009/WDR2009_eng_web.pdf page 220
#Prices adjusted for purity and inflation
cok.prc <- c(421,343,263,251,232,275,217,208,189,193,224,227,158,166,147,140,134,162,216)
p <- qplot(1990:2008, cok.prc, geom="line") +
    geom_rect(xmin = 2006, xmax = 2009,
            ymin=0, ymax=Inf, alpha = .02, fill = "red") +
    annotate("text", x = 2007.5, y = 370, label = "Drug War") +
    opts(title = "There has been an increase in the price of\ncocaine adjusted for purity and inflation\nsince the start of the drug war") +
    ylab("Street price - US$/gram") + xlab("year") +
    ylim(c(0, max(cok.prc)))
print(p)
dev.print(png, "drugs/output/coke-price.png", width=640, height=480)


# 4. faza: Napredna analiza podatkov
setwd("/Users/blazpovh/Documents/R_projektna_naloga/APPR-2021-22-Blaz-Povh/")
Tabela_porabe1 <- read.csv("~/Documents/R_projektna_naloga/APPR-2021-22-Blaz-Povh/podatki/zdruzeni_podatki/Tabela_porabe.csv", sep="")

dnevna_poraba <-rowSums(Tabela_porabe1[ ,3:98],is.na(Tabela_porabe1) == FALSE)
length(dnevna_poraba)
porabniki  <-  labels(table(Tabela_porabe1$porabnik))[[1]]

povpr_poraba=c()
for (i in 1:length(porabniki)){
  print(i)
  poraba=dnevna_poraba[Tabela_porabe1$porabnik==porabniki[i]]
  povpr_poraba[i]=mean(poraba)
}
frekvenca <- c(1:51)
data_povpr_poraba <- data.frame(povpr_poraba,frekvenca)

jpeg("slike/prikaz_skupne_povprecne_porabe_za_razlicne_porabnike.jpg")
chol <- data_povpr_poraba
qplot(chol$povpr_poraba,
      geom = "histogram",
      binwidth= 40,
      main = "Povprečna poraba el. energije za različne porabnike",
      xlab = "Povprečna poraba",
      ylab = "Frekvenca",
      ylim = c(0,10))
dev.off()
jpeg("slike/prikaz_skupne_povprecne_porabe_za_razlicne_meritve.jpg")
Tabela_delovnih_dni <- filter(Tabela_porabe1, Prosti_dan == "FALSE")
meritev3 <- colMeans(Tabela_delovnih_dni[ , 3:98 ],is.na(Tabela_porabe1)== FALSE)
p3 <-plot(meritev3, type = "o",pch = 20, xlab="čas",ylab = "povprečna poraba",main = "Graf povprečne poraba el. energije za različne tipe dni",xaxt='n')
meritev1 <- colMeans(Tabela_porabe1[ , 3:98 ],is.na(Tabela_porabe1)== FALSE)
p1 <-points(meritev1, type = "o",pch = 20, xlab="čas",ylab = "povprečna poraba",main = "Graf povprečne poraba el. energije za razl. meritve",xaxt='n',col="blue")
Tabela_prostih_dni <- filter(Tabela_porabe1, Prosti_dan == "TRUE")
meritev2 <- colMeans(Tabela_prostih_dni[ , 3:98 ],is.na(Tabela_porabe1)== FALSE)
p2 <-points(meritev2, type = "o",pch = 20, xlab="čas",ylab = "povprečna poraba",main = "Graf povprečne poraba el. energije za proste dni",xaxt='n',col="red")
Tabela_delovnih_dni <- filter(Tabela_porabe1, Prosti_dan == "FALSE")
meritev3 <- colMeans(Tabela_delovnih_dni[ , 3:98 ],is.na(Tabela_porabe1)== FALSE)
p3 <-points(meritev3, type = "o",pch = 20, xlab="čas",ylab = "povprečna poraba",main = "Graf povprečne poraba el. energije za delavne dni",xaxt='n',col="green")
xlabels=c("3h","6h","9h","12h","15h","18h","21h","24h")
axis(side=1, at=c(12,24,36,48,60,72,84,96),labels=xlabels)
legend(title = "Legenda", legend = c("vsi dnevi","prosti dnevi","delovni dnevi"),"topright",col = c("blue","red","green"),lty = 1)
dev.off()

jpeg("slike/prikaz_skupne_povprecne_porabe_za_proste_dni.jpg")
Tabela_prostih_dni <- filter(Tabela_porabe1, Prosti_dan == "TRUE")
meritev2 <- colMeans(Tabela_prostih_dni[ , 3:98 ],is.na(Tabela_porabe1)== FALSE)
p2 <-plot(meritev2, type = "o",pch = 20, xlab="čas",ylab = "povprečna poraba",main = "Graf povprečne poraba el. energije za proste dni",xaxt='n')
xlabels=c("3h","6h","9h","12h","15h","18h","21h","24h")
axis(side=1, at=c(12,24,36,48,60,72,84,96),labels=xlabels)
dev.off()

jpeg("slike/prikaz_skupne_povprecne_porabe_za_delovne_dni.jpg")
Tabela_delovnih_dni <- filter(Tabela_porabe1, Prosti_dan == "FALSE")
meritev3 <- colMeans(Tabela_delovnih_dni[ , 3:98 ],is.na(Tabela_porabe1)== FALSE)
p3 <-plot(meritev3, type = "o",pch = 20, xlab="čas",ylab = "povprečna poraba",main = "Graf povprečne poraba el. energije za delavne dni",xaxt='n')
xlabels=c("3h","6h","9h","12h","15h","18h","21h","24h")
axis(side=1, at=c(12,24,36,48,60,72,84,96),labels=xlabels)
dev.off()

jpeg("slike/prikaz_skupne_povprecne_porabe_za_razlicne_dneve.jpg")
par(mar=c(5,6,4,1)+.0001)
plot(c(0,97),c(0.5,4),main="Povprečna poraba za dneve v tednu",type = "n",pch=20, xlab = "čas", ylab = "povprečna poraba",xaxt='n')
povpr_poraba_ponedeljek <- colMeans(filter(Tabela_porabe1, Ime_dneva =="Monday")[ ,3:98])
graf_ponedeljek <- points(povpr_poraba_ponedeljek,type = "o",pch=20,xaxt='n',col="black")
povpr_poraba_torek <- colMeans(filter(Tabela_porabe1, Ime_dneva =="Tuesday")[ ,3:98])
graf_torek <- points(povpr_poraba_torek, type = "o",pch=20,xaxt='n',col="red")
povpr_poraba_sreda <- colMeans(filter(Tabela_porabe1, Ime_dneva =="Wednesday")[ ,3:98])
graf_sreda <- points(povpr_poraba_sreda, type = "o",pch=20,xaxt='n',col="blue")
povpr_poraba_cetrtek <- colMeans(filter(Tabela_porabe1, Ime_dneva =="Thursday")[ ,3:98])
graf_cetrtek <- points(povpr_poraba_cetrtek, type = "o",pch=20,xaxt='n',col="green")
povpr_poraba_petek <- colMeans(filter(Tabela_porabe1, Ime_dneva =="Friday")[ ,3:98])
graf_petek <- points(povpr_poraba_petek, type = "o",pch=20,xaxt='n',col="orange")
povpr_poraba_sobota <- colMeans(filter(Tabela_porabe1, Ime_dneva =="Saturday")[ ,3:98])
graf_sobota <- points(povpr_poraba_sobota, type = "o",pch=20,xaxt='n',col="yellow")
povpr_poraba_nedelja <- colMeans(filter(Tabela_porabe1, Ime_dneva =="Sunday")[ ,3:98])
graf_nedelja <- points(povpr_poraba_nedelja, type = "o",pch=20,xaxt='n',col="purple")
xlabels=c("3h","6h","9h","12h","15h","18h","21h","24h")
axis(side=1, at=c(12,24,36,48,60,72,84,96),labels=xlabels)
legend(title = "Legenda", legend = c("ponedeljek","torek","sreda","cetrtek","petek","sobota","nedelja"),"topright",col = c("black","red","blue","green","orange","yellow","purple"),lty=1)
dev.off()

# ***********************************************
# od tu naprej imam analizo za vremenske podatke
# **********************************************
data_vreme2_tidy <- read.table("podatki/zdruzeni_podatki/data_vreme2_tidy.txt",sep=" ")
datumi <- (data_vreme2_tidy$datum)
padavine_po_dnevih <- data.frame(rowSums(data_vreme2_tidy[ ,4:51], is.na(data_vreme2_tidy) == FALSE))
colnames(padavine_po_dnevih) <- c('Kolicina padavin za dan')
rownames(padavine_po_dnevih) <-c(datumi)
write.table(padavine_po_dnevih,"podatki/zdruzeni_podatki/padavine_po_dnevih.txt",sep=" ")

temperature_po_dnevih <- data.frame(rowMeans(data_vreme2_tidy[ ,52:99], is.na(data_vreme2_tidy) == FALSE))
colnames(temperature_po_dnevih) <- c('Skupna temperatura za dan')
rownames(temperature_po_dnevih) <-c(datumi)
write.table(temperature_po_dnevih,"podatki/zdruzeni_podatki/temperature_po_dnevih.txt",sep=" ")

padavine_po_urah <- data.frame(colSums(data_vreme2_tidy[ ,4:51]))
colnames(padavine_po_urah) <- c('Povprecna kol padavina za to uro')
write.table(padavine_po_urah,"podatki/zdruzeni_podatki/padavine_po_urah.txt",sep=" ")

temperature_po_urah <- data.frame(colMeans(data_vreme2_tidy[ ,52:99], is.na(data_vreme2_tidy) == FALSE))
colnames(temperature_po_urah) <- c('Povprecna temperatura za vsako casovno obdobje')
write.table(temperature_po_urah,"podatki/zdruzeni_podatki/temperature_po_urah.txt",sep=" ")

# *************************************************
# Korelacije
# *************************************************
povpr_poraba_za_vsak_dan <-rowMeans(Tabela_porabe1[ ,3:98])
povpr_poraba_matrika <- t(matrix(povpr_poraba_za_vsak_dan,198,51))
povpr_poraba_za_vsak_dan1 <- as.vector(colSums(povpr_poraba_matrika))
povpr_poraba_za_vsak_dan1<-povpr_poraba_za_vsak_dan1[-198]
povprecna_T_za_vsak_dan <- temperature_po_dnevih$`Skupna temperatura za dan`
skupne_padavine_za_vsak_dan <- padavine_po_dnevih$`Kolicina padavin za dan`
r12=cor(povpr_poraba_za_vsak_dan1,povprecna_T_za_vsak_dan[1:197]) #brisem zato ker za porabo na koncu 0
r13=cor(povpr_poraba_za_vsak_dan1,skupne_padavine_za_vsak_dan[1:197])

# ***************************************************
# Napovedni model s časovnimi vrstami
# ***************************************************
povpr_poraba_za_vsak_dan_ts <- ts(povpr_poraba_za_vsak_dan1, frequency = 365, start = c(2021,1))
arima_model <- auto.arima(povpr_poraba_za_vsak_dan_ts)
summary(arima_model)
holt_model <- holt(povpr_poraba_za_vsak_dan_ts, h=1)
summary(holt_model)
se_model <- ses(povpr_poraba_za_vsak_dan_ts, h = 1)
summary(se_model)
naive_mod <- naive(povpr_poraba_za_vsak_dan_ts, h = 1)
summary(naive_mod, "NA"= 0)

jpeg("slike/prikaz_natancnosti_razlicnih_napovednih_modelov.jpg")
mar.default <- c(5,2,4,2) + 0.1
par(mar = mar.default + c(0, 4, 0, 0),family="serif") #axis(side, at=, labels=, pos=, lty=, col=, las=, tck=, ...)
title="Povprečna poraba in njene  napovedi"
plot(c(2021,2021.6), c(0,170),yaxt='n',xaxt='n',main=title, type = "n", pch=19,cex.lab=1.2, cex.axis=1.3, cex.main=1.5,xlab = "Čas",ylab = "Povprečna poraba")  # setting up coord. system
xlabels = c(2021,2021.1, 2021.2, 2021.3, 2021.4, 2021.5, 2021.6)
ylabels = c(1:10)*17
axis(side=1,at=xlabels)
axis(side=2,at=ylabels)
lines(arima_model$fitted, type = "l", col = "blue",lwd=1,cex = 1,pch=16)
lines(holt_model$fitted, type = "l", col = "green",lwd=1,cex = 1,pch=16)
lines(se_model$fitted, type = "l", col = "red",lwd=1,cex = 1,pch=16)
lines(naive_mod$fitted, type = "l", col = "purple",lwd=1,cex = 1,pch=16)
lines(povpr_poraba_za_vsak_dan_ts, type = "l", col = "orange",lwd=2,cex = 1,pch=16)
legend("top", legend=(c("Dejanska poraba","Arima model", "Holt model", "Se model", "Naive mod")), pch=c(16,16),cex=c(1.2,1.2),col=c("orange","blue", "green", "red", "purple"),y.intersp=0.8)
dev.off()
# ***************************************************
# Grupiranje rezultatov
# ***************************************************
povpr_poraba_za_vsak_dan <-rowMeans(Tabela_porabe1[ ,3:98])
povpr_poraba_matrika <- t(matrix(povpr_poraba_za_vsak_dan,198,51))
set.seed(123)

# *************************************************************
# Ugotavljanje optimalnega števila skupin s silhuetnim diagramom
# *************************************************************
obrisi = function(podatki, hc = TRUE, od = 2, do = NULL) {
  n = nrow(podatki)
  if (is.null(do)) {
    do = n - 1
  }

  razdalje = dist(podatki)

  k.obrisi = tibble()
  for (k in od:do) {
    if (hc) {
      o.k = hclust(razdalje) %>%
        cutree(k) %>%
        silhouette(razdalje)
    } else {
      set.seed(42) # zato, da so rezultati ponovljivi
      o.k = kmeans(podatki, k)$cluster %>%
        silhouette(razdalje)
    }
    k.obrisi = k.obrisi %>% bind_rows(
      tibble(
        k = rep(k, n),
        obrisi = o.k[, "sil_width"]
      )
    )
  }
  k.obrisi$k = as.ordered(k.obrisi$k)

  k.obrisi
}

obrisi.povprecje = function(k.obrisi) {
  k.obrisi.povprecje = k.obrisi %>%
    group_by(k) %>%
    summarize(obrisi = mean(obrisi))
}

obrisi.k = function(k.obrisi) {
  obrisi.povprecje(k.obrisi) %>%
    filter(obrisi == max(obrisi)) %>%
    summarize(k = min(k)) %>%
    unlist() %>%
    as.character() %>%
    as.integer()
}

r.hc = povpr_poraba_matrika[c(1:9,11:43,45:51),] %>% obrisi(hc = TRUE, od=2, do=20)
r.km = povpr_poraba_matrika[c(1:9,11:43,45:51),]  %>% obrisi(hc = FALSE,od=2, do=20)

diagram.obrisi = function(k.obrisi) {
  ggplot() +
    geom_boxplot(
      data = k.obrisi,
      mapping = aes(x = k, y = obrisi)
    ) +
    geom_point(
      data = obrisi.povprecje(k.obrisi),
      mapping = aes(x = k, y = obrisi),
      color = "red"
    ) +
    geom_line(
      data = obrisi.povprecje(k.obrisi),
      mapping = aes(x = as.integer(k), y = obrisi),
      color = "red"
    ) +
    geom_point(
      data = obrisi.povprecje(k.obrisi) %>%
        filter(obrisi == max(obrisi)) %>%
        filter(k == min(k)),
      mapping = aes(x = k, y = obrisi),
      color = "blue"
    ) +
    xlab("število skupin (k)") +
    ylab("obrisi (povprečje obrisov)") +
    ggtitle(paste("Maksimalno povprečje obrisov pri k =", obrisi.k(k.obrisi))) +
    theme_classic()
}
jpeg("slike/hirarhicni_model.jpg")
diagram.obrisi(r.hc)
dev.off()

jpeg("slike/model_k_tih_voditeljev.jpg")
diagram.obrisi(r.km)
dev.off()
# ***************************************************
# Generiranje skupin
# ***************************************************
klas <- kmeans(povpr_poraba_matrika,2)
klasifikacija <- klas$cluster
povpr_poraba_matrika1 <- cbind(povpr_poraba_matrika, klasifikacija)

M=max(max(povpr_poraba_matrika1[,1:198]))
m=min(min(povpr_poraba_matrika1[,1:198]))

Tabela_razred1 <- povpr_poraba_matrika1[povpr_poraba_matrika1[,199] == "1",1:198]
Tabela_razred2 <- povpr_poraba_matrika1[povpr_poraba_matrika1[,199] == "2",1:198]

jpeg("slike/prikaz_povprecne_porabe_za_razlicne_razrede.jpg")
mar.default <- c(5,2,4,2) + 0.1
par(mar = mar.default + c(0, 4, 0, 0),family="serif") #axis(side, at=, labels=, pos=, lty=, col=, las=, tck=, ...)
title="Povprečna poraba za različne razrede porabnikov"
plot(c(0,199), c(0,100),yaxt='n',xaxt='n',main=title, type = "n", pch=19,cex.lab=1.2, cex.axis=1.3, cex.main=1.5,xlab = "Dnevi",ylab = "Povprečna poraba")  # setting up coord. system
xlabels=c(1:19)*10
axis(side=1,at=xlabels,labels=xlabels)
axis(side=2,at=c(0:6)*20,labels=as.factor(c(0:6)*20))
lines(Tabela_razred1, type = "l", col = "black",lwd=2,cex = 1,pch=16)
lines(colSums(Tabela_razred2), type = "l", col = "red",lwd=2,cex = 1,pch=16)
legend("top", legend=(c("Sk1","Sk2")), pch=c(16,16),cex=c(1,1),col=c("black","red"),y.intersp=1.5,horiz=T)
dev.off()


#nens landings pre may 15

p = bio.snowcrab::load.environment()

a = logbook.db('logbook')

a = a[which(a$cfa=='cfanorth'),]

b = aggregate(landings~yr,data=a,FUN=sum)

y=2005:2015

x=data.frame(yr=NA,tot.l=NA,ear.l=NA)
for(i in 1:length(y)){
	r = a[which(a$yr==y[i]),]
	dd = paste(y[i],'05','16',sep="-")
	r = r[which(r$date.fished<dd),]
	g=0
	if(nrow(r)>0) {g = aggregate(landings~yr,data=r,FUN=sum)[2]}
	x[i,] = c(y[i],b[which(b$yr==y[i]),'landings'],g)
}

table.view(x)


nox<-3; noy<-3;
paper<-F        # graphics on paper=file (TRUE) or on screen (FALSE)

run.ID<-'retro-N'         # file id used for paper output
cleanup()

first.year.on.plot<-1975
last.year.on.plot<-2012

doGrid<-T
#incl.sp<-c("Cod")                      # species to be included. Name(s) or "all"
incl.sp<-"all"

first.pch<-1    # first pch symbol
first.color<-1   # first color

palette("default")                # good for clolorfull plots
#palette(gray(seq(0,.9,len=6)))  # gray scale for papers, use len =500 to get black only

if (F) {    # sometimes the dir and labels are defined outside this script !

  dirs<-c("baltic-2012-keyRun-WGSAM2012","baltic-2012-keyRun-updated")
  labels<-c("Key run 2012","Updated")

  dirs<-c("bal-1-area-run-01-final","baltic-2012-keyRun-updated","bal-4-areas-run-01-final","baltic-2012-keyRun-4-areas")
  dirs<-c("bal-1-area-final - afterMeeting","baltic-2012-keyRun-updated","bal-4-areas-run-01-final","baltic-2012-keyRun-4-areas")
  labels<-c("WKmultbal","Key run 2012 updated","4 areas 2011","4 areas 2012")

  dirs<-c("baltic-2012-keyRun-updated","baltic-2012-keyRun-4-areas")
  labels<-c("Key run 2012 updated","4 areas 2012")

  dirs<-c("NS_63-10-Sep-2014","NS_74-13-Oct-2014")
  labels<-c("Old","New")

}

dirs<-c("Baltic-2012-keyRun-results","Baltic-2019-keyRun")
labels<-c("2012 key run","2019 key run")

for (dir in dirs) {
  if ( file.access(file.path(root,dir,"sms.dat"), mode = 0)!=0)  stop(paste('Directory',dir,'does not exist'))
}

Init.function() # get SMS.contol object  including sp.names

for (dir in dirs) {
   a<-Read.summary.data(dir=file.path(root,dir),read.init.function=F)
   a<-subset(a,(Year>=first.year.on.plot & Year<=last.year.on.plot  & Age<=8),
             select=c(Species, Year,Quarter,Age,C.obs))
   M2<-data.frame(scen=labels[which(dirs==dir)],vari='C.obs',a)
   names(M2)<-c("scenario","Variable","Species","Year","Quarter","Age","Value")
 if (dir==dirs[1]) all<-rbind(M2) else all<-rbind(all,M2)
}
#all<-droplevels(subset(all,Species=='Sprat'))
values<-tapply(all$Value,list(all$Year,all$scenario,all$Species,all$Variable,all$Age),sum)
values<-values/1000
y<-as.numeric(dimnames(values)[[1]])

if (paper) dev<-"wmf" else dev<-"screen"
if (incl.sp=="all") sp.plot<-sp.names else sp.plot<-incl.sp

len.dir<-length(dirs)

 plotvar<-function(sp=sp,vari='M2',ylab='') {
   if (sp %in% dimnames(values)[[3]]) {
    v<-values[,,sp,vari,]
    #print(v)
    maxval<-max(v,na.rm=T)
    if (maxval>0) {
      if ((gi %% (nox*noy))==0  | gi==0) {
        newplot(dev,nox,noy,filename=paste("com_",run.ID,'_',sp,sep=''),Portrait=F);

         par(mar=c(0,0,0,0))
        # make legends
        if (paper) lwds<-2
        else  lwds<-2
        plot(10,10,axes=FALSE,xlab=' ',ylab=' ',xlim=c(0,1),ylim=c(0,1))
        legend("center",legend=labels,col=first.color:(first.color+len.dir-1),
              pch=first.pch:(first.pch+len.dir-1),cex=2,title=sp)
        gi<<-gi+1

        par(mar=c(3,3,3,1)) # c(bottom, left, top, right)
      }

      gi<<-gi+1

      ages<-dimnames(v)[[3]][1:min(nox*noy-1,dim(v)[[3]])]
      for (ag in ages) {
        maxval<-max(v[,,ag],na.rm=T)
        minval<-min(0,v[,,ag],na.rm=T)
        if (maxval>0) {
          plot(y,v[,labels[1],ag],main=paste("age",ag),xlab="",ylab=ylab,type='b',lwd=lwds,ylim=c(minval,maxval),
                    col=first.color,pch=first.pch)
           if (doGrid) grid()
          for (i in (2:len.dir)) {
            if (paper) lwds<-1
            else  lwds<-2;
            lines(y,v[,labels[i],ag],col=first.color+i-1,pch=first.pch+i-1,type='b',lwd=lwds)
           }
        }
       }
     }
   }
  }

 for (sp in (sp.plot)) {
  gi<-0
  plotvar(sp=sp,vari="C.obs",ylab="C")
}

if (paper) cleanup();


## 17022020 CKR
#Figure 2E
library(vegan)
library(ggsci)
library(tidyr)
library(reshape2)
library(dplyr)
library(ggpubr)
library(stringr)
library(matrixStats)

#Canada
Caz_Canada=read.table("../Data/Suppl4_CA.txt",sep="\t",head=T,row.names=1)
Caz_Canada=select(Caz_Canada,contains("Number"))%>%
  mutate(label=rownames(Caz_Canada))
colnames(Caz_Canada)[1]="Number"
#Canada PTR
CanadaPTR=read.table("../Data/Suppl5_CA.txt",sep="\t",head=T,row.names=1)#read in PTR
CanadaPTR=CanadaPTR[1:(nrow(CanadaPTR)-1),] #remove last row
CanadaPTR[is.na(CanadaPTR)]=0 #change NA to 0
CanadaPTR=CanadaPTR[rowSums(CanadaPTR)!=0,]
#filter for common species
CanadaPTR=CanadaPTR[rowSums(CanadaPTR==0)<(ncol(CanadaPTR)/2),] #less than 50% of subjects do not have PTR for the species
CanadaPTR[CanadaPTR<1]=1 #set PTR < 1 to 1 for non-removed species
CanadaPTR=summarise_all(CanadaPTR,median)
CanadaPTR=melt(CanadaPTR)
Canada=merge(CanadaPTR,Caz_Canada,by.x="variable",by.y="label")

#plot
ggplot(Canada, aes(x=Number,y=value)) +
  geom_point()  +
  geom_smooth(method = "lm")+
  theme_classic()+border()
cor.test(Canada$value,Canada$Number,method="spearman")

#Singapore
Caz_Singapore=read.table("../Data/Suppl4_SG_Final.txt",sep="\t",head=T,check.names=F,row.names=1)
Caz_Singapore=select(Caz_Singapore,contains("Number"))%>%
  mutate(label=rownames(Caz_Singapore))
colnames(Caz_Singapore)[1]="Number"

SingPTR=read.table("../Data/Suppl5_SG_Final.txt",sep="\t",head=T,row.names=1,check.names=F) #read in PTR
SingPTR=SingPTR[1:(nrow(SingPTR)-1),] #remove last row
SingPTR[is.na(SingPTR)]=0 #change NA to 0
SingPTR=SingPTR[rowSums(SingPTR)!=0,] #remove row with no abundances

#less than 50% of subjects do not have PTR for the species
SingPTR=SingPTR[(rowSums(SingPTR!=0)>(ncol(SingPTR)/2)),]
SingPTR[SingPTR<1]=1
SingPTR=summarise_all(SingPTR,median)
SingPTR=melt(SingPTR)
Singapore=merge(SingPTR,Caz_Singapore,by.x="variable",by.y="label")

#plot
ggplot(Singapore, aes(x=Number,y=value)) +
  geom_point()  +
  geom_smooth(method = "lm")+
  theme_classic()+border()
cor.test(Singapore$value,Singapore$Number,method="spearman")


#impoting dataset
dataset = read.csv('50_Startups.csv')


#!/usr/bin/Rscript
pdf("optimise_cost_progress_scatter_plot.pdf")
candidates <- read.table("optimise_cost.tsv",header = TRUE)
plot(candidates$generation,candidates$fitness,col=rgb(0,100,0,50,maxColorValue=255),pch=16)
dev.off()