################################################################
  # name:advanceRetreateGraph
  # this is in my old  files at
  # ~/Dropbox/data/drought/HutchinsonIndex/versions/AdvancRetreatGraph
  # small multiples graph
  source('~/tools/delphe-project/tools/connect2postgres.r')
  ch <- connect2postgres('130.56.102.41','delphe','ivan_hanigan')
  source('~/tools/delphe-project/tools/readOGR2.r')
  require('rgdal')
  source('~/tools/delphe-project/tools/fixGeom.r')
  pwd <-  readline('session password = ')

  #################################################################
  # N:\NCEPH_IT\Data Management\projects\9.999 Ivan's PhD\Papers\Suicide and Drought in NSW\data\drought\load_drought_data.r
  # author:
  # ihanigan
  # date:
  # 2010-08-17
  # description:
  # a project of great importance
  #################################################################

  # changelog
  Sys.Date()
  # 2010-08-17  make the small multiples plot again but for a longer time period, had to change the extract_pgis arguments to work on nceph machine

  #source('i:/my dropbox/tools/transformations.r')
  #library(RODBC)
  #ch=odbcConnect('delphe')
  #source('i:/my dropbox/tools/extract_pgis.r')
  library(maptools)

  qc <- dbGetQuery(ch,"select t2.geoid,SD_code,SD_name,year,month,
    cast(year || '-' || month || '-' || 1 as date) as indexdate,
    avg(t1.sum) as avsum,avg(t1.count) as avcount,
    avg(t1.rain) as avrain,
    case when avg(t1.count) >= 5  then avg(t1.count) else 0 end as threshold
  from bom_grids.rain_NSW_1890_2008_4 as t1 join (
          select abs_sd.nswsd91.gid as geoid,abs_sd.nswsd91.SD_code,abs_sd.nswsd91.SD_name,bom_grids.grid_NSW.*
          from abs_sd.nswsd91, bom_grids.grid_NSW
          where st_intersects(abs_sd.nswsd91.the_geom,bom_grids.grid_NSW.the_geom)
          order by SD_code,bom_grids.grid_NSW.gid
  ) as t2
  on t1.gid=t2.gid
  where year>=1970
  group by t2.geoid,SD_code,SD_name,year,month;")

  head(qc)

  ## sdlist=names(table(qc$sd_name))
  ## sdlist

  ## par(mfrow=c(2,6),mar=c(4,3,3,1))

  ## for(sdi in sdlist){
  ## #sdi=sdlist[1]

  ## with(qc,
  ## plot(indexdate[sd_name==sdi],avcount[sd_name==sdi],type='l',col='red',main=sdi)
  ## )

  ## with(qc,
  ## points(indexdate[sd_name==sdi],threshold[sd_name==sdi])
  ## )
  ## }

  ## qc=sqlQuery(ch,'select t2.geoid,SD_code,SD_name,year,month,avg(t1.sum) as avsum,avg(t1.count) as avcount,avg(t1.rain) as avrain,
  ## case when avg(t1.count) >= 5  then avg(t1.count) else 0 end as threshold
  ## from bom_grids.rain_NSW_1890_2008_4 as t1 join (
  ##         select abs_sd.nswsd91.gid as geoid,abs_sd.nswsd91.SD_code,abs_sd.nswsd91.SD_name,bom_grids.grid_NSW.*
  ##         from abs_sd.nswsd91, bom_grids.grid_NSW
  ##         where st_intersects(abs_sd.nswsd91.the_geom,bom_grids.grid_NSW.the_geom)
  ##         order by SD_code,bom_grids.grid_NSW.gid
  ## ) as t2
  ## on t1.gid=t2.gid
  ## where year>=1970
  ## group by t2.geoid,SD_code,SD_name,year,month;')

  ## # send to local
  ## #local=odbcConnect('ilocal')
  ## #sqlQuery(local,"SET search_path =ivan_hanigan, pg_catalog")
  ## #sqlSave(local,qc,tablename='suicidedroughtnsw19702007_drought')

  ## # make some qc maps
  ## #extract_pgis(psql='select gid, admin_name, st_simplify(the_geom,0.01) as the_geom FROM spatial.admin00_aus_states where admin_name = \'New South Wales\'','nsw.shp',
  ##   #host='130.56.102.30',user='ivan_hanigan',db='delphe',pgpath='C:\\Program Files\\PostgreSQL\\8.3\\bin\\pgsql2shp')

  ## #d=readShapePoly('nsw.shp')
  ## plot(d)
  ## axis(2)
  ## axis(1)
  ## box()

  ## #extract_pgis(psql='select * FROM bom_grids.grid_nsw','grid_nsw.shp')
  ## #grd=readShapePoly('grid_nsw.shp')
  ## plot(grd,add=T)

  ## # check fields
  ## #sqlQuery(ch,'select * FROM bom_grids.grid_nsw limit 1')
  ## #sqlQuery(ch,'select * FROM bom_grids.rain_NSW_1890_2008_4 limit 1')

  ## # get drought data on grid
  ## extract_pgis(psql='select t2.gid,year,month,t1.count,t1.rain,case when t1.count >= 5  then 1 else 0 end as threshold, t2.the_geom from bom_grids.rain_NSW_1890_2008_4 as t1 join bom_grids.grid_NSW as t2 on t1.gid=t2.gid where year=1973 and month = 1 and t1.count >= 5;','197301.shp')

  ## #grd=readShapePoly('197301.shp')
  ## plot(grd,add=T,col=grd@data$THRESHOLD)

  ## # good.  want to reproduce http://www.dpi.nsw.gov.au/agriculture/emergency/drought/planning/climate/advance-retreat
  ## # get the data to local
  ## cat("\"C:\\PostgreSQL\\8.4\\bin\\pg_dump.exe\" -h 130.56.102.30 -U ivan_hanigan -i -t bom_grids.grid_NSW | \"C:\\PostgreSQL\\8.4\\bin\\psql\" -h localhost postgis")

  ## #bom_grids.rain_NSW_1890_2008_4

tassla06 <-
  readOGR2(hostip='115.146.94.209',user='gislibrary',db='pgisdb',
           layer='tassla06')
plot(tassla06)
  #d=readShapePoly('nsw.shp')
  d <- readOGR2('130.56.102.41','ivan_hanigan','delphe','abs_sd.nswsd01', p = pwd)
  plot(d)

  plot_drought=function(year,month){
  extract_pgis(psql=paste('select t2.gid,year,month,t1.count,t1.rain,case when t1.count >= 4  then 1 else 0 end as threshold, t2.the_geom from bom_grids.rain_NSW_1890_2008_4 as t1 join bom_grids.grid_NSW as t2 on t1.gid=t2.gid where year=',year,' and month = ',month,' and t1.count >= 5;',sep=''),'drt.shp',host='130.56.102.30',user='ivan_hanigan',db='delphe',pgpath='C:\\Program Files\\PostgreSQL\\8.3\\bin\\pgsql2shp')
  plot(d)

  if(length(dir(pattern='drt.shp'))>0){
          grd=readShapePoly('drt.shp')
          plot(grd,add=T,col=grd@data$THRESHOLD)
          file.remove('drt.shp')
          file.remove('drt.shx')
          file.remove('drt.dbf')
          file.remove('drt.prj')
          }
  }

  # newnode THE graph
  windows(height=20,width=6)
  Sys.setenv(R_GSCMD="C:\\gs\\gs8.56\\bin\\gswin32c.exe")

  bitmap('droughtAdvRet_19002008.jpg',type='jpeg',res=400,height=20,width=5)
  par(mfrow=c(110,13),mar=c(0,0,0,0))
  plot(0:3,0:3,axes=F,ylab='',xlab='',type='n')

  for(mm in c('j','f','m','a', 'm','j','j','a','s','o','n','d')){
  plot(0:3,0:3,axes=F,ylab='',xlab='',type='n')
  text(1.5,1.5,mm)
  }

  for(j in 1900:2008){
  print(j)
           plot(0:3,0:3,axes=F,ylab='',xlab='',type='n')
           text(1.5,1.5,j) #substr(j,3,4))

           for(i in 1:12){
           plot_drought(j,i)
           }

  }

  # this is the first one 1972-2008 savePlot('droughtAdvRet.jpg',type=c('jpg'))
  #savePlot('droughtAdvRet_19002008.tiff',type=c('tiff'))
  dev.off()


# This block by itself launches a blank page
library(shiny)
library(leaflet)
library(dplyr)
library(ggplot2)

# ==== Server ====
shinyServer(func = function(input, output, session) {

  # ==== Median Income Histogram ====
  output$median_household_income <- renderPlot(mhhi_hist)
  output$median_household_income.county <- renderPlot(mhhi_hist.county)

  # ==== Median Income of 25 Most Populous Cities ====
  output$mhhi_biggest_cities <- renderPlot(top_25_bar)

  # Median Income vs. Housing Prices
  output$top_25_scatter <- renderPlot(top_25_scatter)
  output$top_25_bar.inc_vs_home <- renderPlot(top_25_bar.inc_vs_home)
  output$top_25_bar.sf_vs_home <- renderPlot(top_25_bar.sf_vs_home)

  # ==== Median Income Map ====
  output$mhhi_map <- renderLeaflet(mhhi_map)

  # Change Dataset
  observe({
    dataset <- input$map_dataset

    if (input$map_dataset == "ACS 5-Year Estimates") {
      updateSelectInput(session, "map_year",
                        choices = ACS_5YR_RANGE)
    } else {
      updateSelectInput(session, "map_year",
                        choices = ACS_1YR_RANGE)
    }
  })

  # Change Year
  observe({
    # browser()
    # debug(session_map$show_year)

    session_map <- IncomeMap(data = ACS_5YR_FINANCE_COUNTY,
                             map = leafletProxy("mhhi_map",
                                                data=COUNTIES_GEO,
                                                session))

    if (input$map_dataset == "ACS 5-Year Estimates") {
      # Swap pointers
      session_map$data = ACS_5YR_FINANCE_COUNTY
      session_map$dataset = '5yr'

      # Make sure map years are valid
      if (input$map_year %in% ACS_5YR_RANGE) {
        # Load map layer
        # cat("Input Year:", as.td_yr(input$map_year))
        session_map$show_year(as.td_yr(input$map_year))
      }
    } else {
      # Swap pointers
      session_map$data = ACS_1YR_FINANCE_COUNTY
      session_map$dataset = '1yr'

      # Make sure map years are valid
      if (input$map_year %in% ACS_1YR_RANGE) {
        # Load map layer
        cat("Input Year:", as.td_yr(input$map_year))
        session_map$show_year(as.td_yr(input$map_year))
      }
    }
  })

  # ==== Median Income Table ====
  mhhi_table.cols_subset = c("City", "Population",
                             "Median Household Income")

  output$mhhi_table <- renderDataTable({
    if (input$mhhi_table == "Counties (ACS 1-Year Estimates)") {
      data <- ACS_1YR_FINANCE_COUNTY$county_data[
        c("geo_display_label",
          "mhhi_15", "mhhi_moe_15",
          "mhhi_13", "mhhi_moe_13",
          "mhhi_11", "mhhi_moe_11",
          "mhhi_09", "mhhi_moe_09",
          "mhhi_07", "mhhi_moe_07",
          "mhhi_05", "mhhi_moe_05")] %>%
        filter(!is.na(geo_display_label))

      names(data) = c("County", "2015", "MoE", "2013", "MoE",
                      "2011", "MoE", "2009", "MoE",
                      "2007", "MoE", "2005", "MoE")

    } else if (input$mhhi_table == "Counties (ACS 5-Year Estimates)") {
      data <- ACS_5YR_FINANCE_COUNTY$county_data[
        c("geo_display_label", "mhhi_15", "mhhi_moe_15", "mhhi_10", "mhhi_moe_10")] %>%
        filter(!is.na(geo_display_label))
      names(data) = c("County", "2015", "MoE", "2010", "MoE")
    } else {
      data <- med_hh_income[mhhi_table.cols_subset]
    }

    data
  })
})


library(jsonlite)
library(oro.nifti)
library(fslr)
library(foreach)
library(doParallel)
library(logging)

source('utils.r')

# File and folder names
results_folder_name <- format(Sys.time(),format='RES_survival_stats_low-medium_%Y%m%d_%H%M')
results_file_name <- list('p_values_original', 'p_values_corrected', 'q_values')
log_file_name <- 'group_comparison.log'
dir.create(results_folder_name)

# Setting up logging
logReset()
basicConfig(level='DEBUG')
addHandler(writeToFile, file=paste(results_folder_name, log_file_name, sep='/'), level='INFO')
removeHandler('writeToConsol')

# Host-specific parameters
host <- Sys.info()["nodename"]
if (host == 'SINTEF-0ZQHTDG'){
    library(fdrtool) # Bit available in R 3.4
    n_cores <- 4
} else if (host == 'medtech-beast') {
    n_cores <- 30
} else {
    logwarn('The computer named %s is not known. Number of cores is set to 1.', host)
    n_cores <- 1
}
registerDoParallel(cores=n_cores)

loginfo('Reading data')
pids_per_voxel <- fromJSON('pids_per_voxel.json')
#load('test_data.RData')
survival_group_per_patient <- unlist( fromJSON('survival_group_per_patient.json'), use.names=FALSE)

template_img_file <- 'total_tumor.nii.gz'
template_img <- readNIfTI(template_img_file)
img_dim <- template_img@dim_[2:4]

n_total <- count_patients_per_group(survival_group_per_patient)
n_permutations <- 500
min_marginal <- 0

loginfo('Creating permutations')
loginfo('Number of permutations: %i', n_permutations)
set.seed(7)
permuted_indices <- rperm(n_permutations, length(survival_group_per_patient))

loginfo('Performing permutation tests')
batches_per_core <- 4
batch_size <- ((length(pids_per_voxel)/(batches_per_core*n_cores))%/%1000+1)*1000 # Rounded up to nearest 1000, leaving the last batch smaller than the rest.
batch_lims <- seq(0,length(pids_per_voxel)-1, by=batch_size)
t1 <- system.time({
    p_values_array <-
        foreach( lim = batch_lims, .combine = '+') %dopar% {
            lim1 <- lim+1
            lim2 <- min( lim+batch_size, length(pids_per_voxel) )
            batch <- c(lim1:lim2)
            t2 <- system.time({
                temp_array <- array(0, dim=c(2,img_dim))
                for (i in batch) {
                    pids <- pids_per_voxel[[i]]+1 # Add 1 to convert from pythonic, zero-based indexing
                    if (length(pids)>=min_marginal) {
                        res_original <- stat_test(survival_group_per_patient[pids], n_total)
                        p_value_original <- res_original$p
                        p_values <- rep(0, n_permutations)
                        for (j in 1:n_permutations) {
                            survival_groups_permuted <- survival_group_per_patient[permuted_indices[,j]]
                            #groups <- survival_groups_permuted[pids] #evt. unlist(pid,use.names=FALSE)?
                            res <- stat_test(survival_groups_permuted[pids], n_total)
                            p_values[j] <- res$p
                        }
                        p_value_corrected <- sum(p_values<p_value_original)/n_permutations
                        if( res_original$direction == 'increasing' ){
                            dir_sign <- 1
                        } else {
                            dir_sign <- -1
                        }

                        index_str <- names(pids_per_voxel[i])
                        index_str_list <- strsplit(index_str,'_')
                        index <- strtoi(unlist(index_str_list))+1 # Add 1 to convert from pythonic, zero-based indexing
                        temp_array[1, img_dim[1]+1-index[1], index[2], index[3]] <- p_value_original*dir_sign #p_values_corrected[[index_str]]
                        temp_array[2, img_dim[1]+1-index[1], index[2], index[3]] <- p_value_corrected*dir_sign #p_values_corrected[[index_str]]
                    }
                }
            })
            #cat(paste('Finished processing voxels', lim1, 'to', lim2, ' out of ', length(pids_per_voxel), ' in ', round(t2[3]), ' seconds.\n'), file='log.txt', append=TRUE)
            loginfo('Finished processing voxels %i to %i out of %i in %i seconds', lim1, lim2, length(pids_per_voxel), round(t2[3]))
            temp_array
        }
})
loginfo('Total processing time: %i seconds.', round(t1[3]))

results_array <- array(0, dim=c(3,img_dim))
results_array[1:2,,,] <- p_values_array
n_results <- 2
if (host == 'SINTEF-0ZQHTDG'){
    loginfo('Computing q values')
    p_values <- p_values_array[2,,,]
    p_values_sign <- sign(p_values)
    p_values <- abs(p_values)
    p_values_vector <- p_values[p_values>0]
    fdr <- fdrtool(p_values_vector, statistic="pvalue")
    q_values_array <- array(0, img_dim)
    q_values_array[p_values>0] <- fdr$qval
    results_array[3,,,] <- q_values_array*p_values_sign
    n_results <- 3
}

loginfo('Writing results to file')
for (i in 1:n_results){
    results_img <- niftiarr(template_img, results_array[i,,,])
    writeNIfTI(results_img, filename=paste(results_folder_name, results_file_name[[i]], sep='/'))
}

loginfo('Finished.')


library(lubridate)
library(modelr)
library(broom)
library(tidyverse)
library(visdat)
library(mlr3verse)

source("usa/code/utils/read-data-usa.r")

forecast_googleMob<-function(){
  # read data
    # google
      google_data <- read_google_mobility()
      google_data$code[which(is.na(google_data$code))]<- "US"

    # new foursquare data
      new_foursquare= read_csv("usa/code/utils/mobility-reg/visitdata-grouped.csv")
      new_foursquare$categoryname=as.factor(new_foursquare$categoryname)

  # c("Airport" ,  "Arts & Entertainment"        "Banks"
  # [5] "Beach"                       "Big Box Stores"              "Bus"                         "Colleges & Universities"
  # [9] "Convenience Store"           "Discount Stores"             "Drug Store"                  "Events"
  # [13] "Fast Food Restaurants"       "Fitness Center"              "Food"                        "Gas Stations"
  # [17] "Government"                  "Grocery"                     "Gun Shops"                   "Hardware Stores"
  # [21] "Hotel"                       "Light Rail Stations"         "Medical"                     "Metro Stations"
  # [25] "Nightlife Spots"             "Office"                      "Outdoors & Recreation"       "Professional & Other Places"
  # [29] "Residences"                  "School"                      "Shops & Services"            "Skiing"
  # [33] "Spiritual Center"            "Sports"                      "Travel & Transport"

  sfsq <- new_foursquare %>%
          filter(categoryname!="Skiing",demo=="All") %>%
          select(c(-demo,-county,-p50Duration)) # revisit p50

  google_cleaned <- google_data %>%
          select(date,state=sub_region_1,retail.recreation,grocery.pharmacy,parks,transitstations,workplace,residential) %>%
          filter(state!="")

  mobility_data <- left_join(sfsq,google_cleaned, by = c("state" = "state", "date" = "date"))

  #mobility_data <- mobility_data %>% #  filter(!(state %in% c("Alaska", "District of Columbia", "Hawaii")))
  mobility_data <- mobility_data %>%
          pivot_wider(names_from =categoryname , values_from = c(avgDuration,visits))
  mobility_data$state <- as.factor(mobility_data$state)
  names(mobility_data)<-make.names(names(mobility_data),unique = TRUE)

  # check fit on last week
  last_google=ymd((mobility_data %>% filter(!is.na(retail.recreation)) %>%summarise(last(date)))[[1,1]])
  train_stop=last_google-6

  # foursquare broken then
  mobility_data=mobility_data %>% filter(date!=ymd("2020-04-19"))

  # need to rmove date for mlr
  mobility_data=mobility_data %>% arrange(date)
  mobility_data$id=c(1:nrow(mobility_data))

  train_end_id=(mobility_data %>% filter(date==train_stop) %>% summarise(last(id)))[[1,1]]
  google_end_id=(mobility_data %>% filter(date==last_google) %>% summarise(last(id)))[[1,1]]
  dates=mobility_data$date
  mobility_data=mobility_data %>% select(c(-date,-categoryid))

  # revisit imputaiton
  mobility_data=mobility_data %>% fill(names(mobility_data),.direction = 'updown')

  ## todo remove
  names(google_cleaned)

  task = TaskRegr$new(id = "retail.recreation", backend = as.data.frame(mobility_data %>%
          select(c(-"grocery.pharmacy",-"parks",-"transitstations",-"workplace",-"residential"))), target = "retail.recreation")
  learner=lrn("regr.ranger")
  train_set = c(1:train_end_id)
  test_set = c((train_end_id+1):google_end_id)
  learner$train(task, row_ids = train_set)
  prediction = learner$predict(task, row_ids = test_set)
  abs(prediction$truth-prediction$response)
  df_lastweek=data.frame(id=prediction$row_ids,retail.recreation=(abs(prediction$truth-prediction$response)) )
  train_set = c(1:google_end_id)
  test_set = setdiff(seq_len(task$nrow), train_set)
  learner$train(task, row_ids = train_set)
  prediction = learner$predict(task, row_ids = test_set)
  mobility_data[test_set,"retail.recreation"]=prediction$response

  c("retail.recreation","grocery.pharmacy","parks","transitstations","workplace","residential")

  task = TaskRegr$new(id = "grocery.pharmacy", backend = as.data.frame(mobility_data %>%
                                                                          select(c(-"retail.recreation",-"parks",-"transitstations",-"workplace",-"residential"))),
                      target ="grocery.pharmacy")
  learner=lrn("regr.ranger")
  train_set = c(1:train_end_id)
  test_set = c((train_end_id+1):google_end_id)
  learner$train(task, row_ids = train_set)
  prediction = learner$predict(task, row_ids = test_set)
  abs(prediction$truth-prediction$response)
  df_lastweek=cbind(df_lastweek,data.frame(grocery.pharmacy=(abs(prediction$truth-prediction$response)) ))
  train_set = c(1:google_end_id)
  test_set = setdiff(seq_len(task$nrow), train_set)
  learner$train(task, row_ids = train_set)
  prediction = learner$predict(task, row_ids = test_set)
  mobility_data[test_set,"grocery.pharmacy"]=prediction$response

  c("retail.recreation","grocery.pharmacy","parks","transitstations","workplace","residential")

  task = TaskRegr$new(id = "parks", backend = as.data.frame(mobility_data %>%
                                                              select(c(-"retail.recreation",-"grocery.pharmacy",-"transitstations",-"workplace",-"residential"))),
                      target ="parks")
  learner=lrn("regr.ranger")
  train_set = c(1:train_end_id)
  test_set = c((train_end_id+1):google_end_id)
  learner$train(task, row_ids = train_set)
  prediction = learner$predict(task, row_ids = test_set)
  abs(prediction$truth-prediction$response)
  df_lastweek=cbind(df_lastweek,data.frame(parks=(abs(prediction$truth-prediction$response)) ))
  train_set = c(1:google_end_id)
  test_set = setdiff(seq_len(task$nrow), train_set)
  learner$train(task, row_ids = train_set)
  prediction = learner$predict(task, row_ids = test_set)
  mobility_data[test_set,"parks"]=prediction$response

  task = TaskRegr$new(id = "transitstations", backend = as.data.frame(mobility_data %>%
                                                                        select(c(-"retail.recreation",-"grocery.pharmacy",-"parks",-"workplace",-"residential"))),
                      target ="transitstations")
  learner=lrn("regr.ranger")
  train_set = c(1:train_end_id)
  test_set = c((train_end_id+1):google_end_id)
  learner$train(task, row_ids = train_set)
  prediction = learner$predict(task, row_ids = test_set)
  abs(prediction$truth-prediction$response)
  df_lastweek=cbind(df_lastweek,data.frame(transitstations=(abs(prediction$truth-prediction$response)) ))
  train_set = c(1:google_end_id)
  test_set = setdiff(seq_len(task$nrow), train_set)
  learner$train(task, row_ids = train_set)
  prediction = learner$predict(task, row_ids = test_set)

  mobility_data[test_set,"transitstations"]=prediction$response

  c("retail.recreation","grocery.pharmacy","parks","transitstations","workplace","residential")

  task = TaskRegr$new(id = "workplace", backend = as.data.frame(mobility_data %>%
                                                                  select(c(-"retail.recreation",-"grocery.pharmacy",-"parks",-"transitstations",-"residential"))),
                      target ="workplace")
  learner=lrn("regr.ranger")
  train_set = c(1:train_end_id)
  test_set = c((train_end_id+1):google_end_id)
  learner$train(task, row_ids = train_set)
  prediction = learner$predict(task, row_ids = test_set)
  abs(prediction$truth-prediction$response)
  df_lastweek=cbind(df_lastweek,data.frame(workplace=(abs(prediction$truth-prediction$response)) ))
  train_set = c(1:google_end_id)
  test_set = setdiff(seq_len(task$nrow), train_set)
  learner$train(task, row_ids = train_set)
  prediction = learner$predict(task, row_ids = test_set)
  mobility_data[test_set,"workplace"]=prediction$response

  task = TaskRegr$new(id = "residential", backend = as.data.frame(mobility_data %>%
                                                                  select(c(-"retail.recreation",-"grocery.pharmacy",-"parks",-"transitstations",-"workplace"))),
                      target ="residential")
  learner=lrn("regr.ranger")
  train_set = c(1:train_end_id)
  test_set = c((train_end_id+1):google_end_id)
  learner$train(task, row_ids = train_set)
  prediction = learner$predict(task, row_ids = test_set)
  abs(prediction$truth-prediction$response)
  df_lastweek=cbind(df_lastweek,data.frame(residential=(abs(prediction$truth-prediction$response)) ))
  train_set = c(1:google_end_id)
  test_set = setdiff(seq_len(task$nrow), train_set)
  learner$train(task, row_ids = train_set)
  prediction = learner$predict(task, row_ids = test_set)
  mobility_data[test_set,"residential"]=prediction$response

  mobility_data$date=dates

  # error analysis
  c("retail.recreation","grocery.pharmacy","parks","transitstations","workplace","residential")
  df_raw_error=copy(df_lastweek)
  print("Error last week")
  print(df_raw_error %>% summarise(retail.recreation=mean(retail.recreation),
                            grocery.pharmacy=mean(grocery.pharmacy),
                            parks=mean(parks),transitstations=mean(transitstations),
                            workplace=mean(workplace),residential=mean(residential)
                            ))
  df_lastweek=df_lastweek %>% pivot_longer(  c("retail.recreation","grocery.pharmacy","parks","transitstations","workplace","residential")
,names_to = "cat",values_to = "error")

  return(mobility_data)
}

f<-forecast_googleMob()
#colnames(df_lastweek) <- paste("err", colnames(df_lastweek), sep = "_")

google_forecast <- f %>% select(state,retail.recreation,grocery.pharmacy,parks,transitstations,workplace,residential,date)
write.csv(google_forecast, "usa/data/google-mobility-forecast.csv", row.names = FALSE)


library(Seurat)
llibrary(data.table)
library(dplyr)
library('org.Hs.eg.db')
library(limma)

seurat_recipet = function(expr){
expr_obj = CreateSeuratObject(expr)
#expr_obj = NormalizeData(expr_obj, normalization.method = "LogNormalize", scale.factor = 10000)
#expr_obj = ScaleData(expr_obj)
#expr_obj = FindVariableFeatures(expr_obj, selection.method = "vst", nfeatures = 2000)
#expr_obj = RunPCA(expr_obj, features = VariableFeatures(object = expr_obj), npcs = 100)
expr_obj
}

fn_expr = 'MO_round2.csv'
fn_meta = 'MO_meta_round2.csv'
fn_hpca = 'hpca_round2.csv'
fn_umap = 'umap_round2.csv'
fn_cluster = 'seurat_cluster_round2.csv'
fn_topgene = 'seurat_topgene_round2.csv'
fn_marker = 'seurat_markers_round2.csv'

write_csv = function(vec, fn){write.table(vec, file = fn, append = FALSE, quote = FALSE, sep = ",",
                eol = "\n", na = "NA", dec = ".", row.names = TRUE,
                col.names = TRUE, qmethod = c("escape", "double"),
                fileEncoding = "")}

folder_ = paste0('./')
exprs=read.csv(paste0(folder_, fn_expr), row.names=1, header=T , check.names = F)
exprs=t(exprs)

meta=read.csv(paste0(folder_, fn_meta), row.names=1, header=T, check.names = F)
abrain = seurat_recipet(exprs)

npc = 50

df_harmony = read.csv(fn_hpca, row.names = 1)

abrain[["harmony"]] <- CreateDimReducObject(embeddings = as.matrix(df_harmony),
                                 key = "harmony_", assay = DefaultAssay(abrain))

abrain1=FindNeighbors(object = abrain, dims = 1:npc, k.param = 15, reduction = "harmony")
abrain1=FindClusters(object = abrain1, resolution = .1, graph.name = 'RNA_snn')
write_csv(abrain1@meta.data$seurat_clusters, fn_cluster)

abrain1=RunUMAP(object = abrain1, min.dist = .3, graph = 'RNA_snn',  n.epochs = 200)
write_csv(Embeddings(object = abrain1, reduction = "umap"), fn_umap)

abrain.markers=FindAllMarkers(object = abrain1, min.pct= 0.3, return.thresh = 1.)
topgene=abrain.markers %>% group_by(cluster) %>% top_n(n = 10, wt = avg_logFC)
write_csv(topgene,fn_topgene)
write_csv(as.data.frame(abrain.markers), fn_marker)


  figure.mcmc = function( vname="", type="density", res=NULL, fn=NULL, aulabels=c("N-ENS","S-ENS","4X") , save.plot=TRUE, ...) {

    y = res$mcmc
    sb= res$p$fishery_model$standata

    ntacs = sb$nProj
    yrs0 = res$p$assessment_years
    yrs = c( yrs0, (max(yrs0)+c(1:sb$M) ) )
    yrs.last = max(yrs0) + 0.5
    ndata = length(yrs0)
    hdat = 1:ndata

    if (vname =="r.ts") {
      # catch this first as the layout is different
        br = 75

        plot.new()
        layout( matrix(c(1:(sb$N*3)), ncol=3, nrow=sb$N ))
        par(mar = c(1., 1., 0.65, 0.75))

        for (i in 1:3) {
        for (yr in 1:sb$N) {
          dta = y$r[yr,i]
          qs = apply( dta, 2, quantile, probs=c(0.025, 0.5, 0.975) )
          qs = signif( qs, 3 )
          pdat = as.vector( dta)
          xrange = range( pdat, na.rm=T )
          postdat = hist( pdat, breaks=br, plot=FALSE )
          yrange = range( 0, postdat$density, na.rm=T ) * 1.02
          hist( pdat, freq=FALSE, breaks=br, xlim=xrange, ylim=yrange, main="", xlab="", ylab="Density", col="lightgray", border="gray")
          YR = rownames(sb$IOA) [yr]
          legend( "topright", bty="n", legend=paste( aulabels[i], YR, "r", " = ", qs[2,i], " {", qs[1,i], ", ",  qs[3,i], "}  ", sep="" ), cex=0.9 )
        }}

     if(save.plot) savePlot( filename=fn, type="png" )
      return( fn)

    }

    plot.new()
    layout( matrix(c(1,2,3), 3, 1 ))
    par(mar = c(4.4, 4.4, 0.65, 0.75))

    prr = NULL
    prr$class ="none"  # no priors by default

    if ( type=="density" ) {  # default

      if ( vname=="K" ) {
        qs = apply( y$K, 2, quantile, probs=c(0.025, 0.5, 0.975) )
        qs = signif( qs, 3 )
        for (i in 1:3) {
          pdat = as.vector(y$K[,i])
           prr=NULL
           prr$class="lognormal"

          # E(X) = exp(mu + 1/2 sigma^2)
          # med(X) = exp(mu)
          # Var(X) = exp(2*mu + sigma^2)*(exp(sigma^2) - 1)
          # CV = sqrt( Var(X) ) / E(X) = sqrt(exp(sigma^2) - 1) ~ sigma; sigma < 1/2
          # SD(X) = sqrt( exp(2*mu + sigma^2)*(exp(sigma^2) - 1) )
          #  or   = CV * E(X)

           prr$meanlog= sb$Kmu[i]
           prr$sdlog = sqrt(sb$Ksd[i])
          plot.freq.distribution.prior.posterior( prior=prr, posterior=pdat, ... )

          legend( "topright", bty="n", legend=paste( aulabels[i], "\n", vname, " = ", qs[2,i], " {", qs[1,i], ", ",  qs[3,i], "}  ", sep="" ))
      }
    }

      if ( vname=="r" ) {
        qs = apply( y$r, 2, quantile, probs=c(0.025, 0.5, 0.975) )
        qs = signif( qs, 3 )
        for (i in 1:3) {    prr=NULL
          prr=NULL
          prr$class='normal'
          prr$mean=sb$rmu[i]
          prr$sd=sqrt(sb$rsd[i])
          pdat = as.vector(y$r[,i])
          plot.freq.distribution.prior.posterior( prior=prr, posterior=pdat, ...  )
          legend( "topright", bty="n", legend=paste( aulabels[i], "\n", vname, " = ", qs[2,i], " {", qs[1,i], ", ",  qs[3,i], "}  ", sep="" ) )
      }}

      if ( vname=="q" ) {
        qs = apply( y$q, 2, quantile, probs=c(0.025, 0.5, 0.975) )
        qs = signif( qs, 3 )
        for (i in 1:3) {
          pdat = as.vector(y$q[,i])
          prr=NULL
          prr$class="normal"
          prr$mean=sb$qmu[i]
          prr$sd=sb$qsd[i]
          plot.freq.distribution.prior.posterior( prior=prr, posterior=pdat, ...  )
          legend( "topright", bty="n", legend=paste( aulabels[i], "\n", vname, " = ", qs[2,i], " {", qs[1,i], ", ",  qs[3,i], "}  ", sep="" )
      )}}

      if ( vname=="qs" ) {
        QQ = apply( y$q, 2, quantile, probs=c(0.025, 0.5, 0.975) )
        QQ = signif( QQ, 3 )
        for (i in 1:3) {
          pdat = as.vector(y$qs[,i])
          # prr=NULL
          # prr$class="normal"
          # prr$mean=sb$q0x[i]
          # prr$sd=sb$q0x[i]*sb$cv
          plot.freq.distribution.prior.posterior( prior=prr, posterior=pdat, ...  )
          legend( "topright", bty="n", legend=paste( aulabels[i], "\n", vname, " = ", QQ[2,i], " {", QQ[1,i], ", ",  QQ[3,i], "}  ", sep="" )
      )}}

      if ( vname=="BMSY" ) {
        qs = apply( y$BMSY, 2, quantile, probs=c(0.025, 0.5, 0.975) )
        qs = signif( qs, 3 )
        for (i in 1:3) {
          pdat = as.vector(y$BMSY[,i])
          prr=NULL
          prr$class="none"
          plot.freq.distribution.prior.posterior( prior=prr, posterior=pdat, ...  )
          legend( "topright", bty="n",
            legend=paste( aulabels[i], " ", vname, " = ", qs[2,i], " {", qs[1,i], ", ",  qs[3,i], "}", sep="" )
      )}}

      if ( vname=="FMSY" ) {
        qs = apply( y$FMSY, 2, quantile, probs=c(0.025, 0.5, 0.975) )
        qs = signif( qs, 3 )
        for (i in 1:3) {
          pdat = as.vector(y$FMSY[,i])
          prr=NULL
          prr$class="none"
          plot.freq.distribution.prior.posterior( prior=prr, posterior=pdat, ...  )
          legend( "topright", bty="n",
            legend=paste( aulabels[i], " ", vname, " = ", qs[2,i], " {", qs[1,i], ", ",  qs[3,i], "}", sep="" )
      )}}

      if ( vname=="bosd" ) {
        qs = apply( y$bosd, 2, quantile, probs=c(0.025, 0.5, 0.975) )
        qs = signif( qs, 3 )
        for (i in 1:3) {
          pdat = as.vector(y$bosd[,i])
          prr=NULL
          prr$class='uniform'
          prr$max=3
          prr$min=0
          #prr$class="lognormal"
          #prr$meanlog=sb$bomup
          #prr$sdlog=sqrt(sb$bosdp)
          plot.freq.distribution.prior.posterior( prior=prr, posterior=pdat, ...  )
          legend( "topright", bty="n",
            legend=paste( aulabels[i], " ", vname, " = ", qs[2,i], " {", qs[1,i], ", ",  qs[3,i], "}", sep="" )
      )}}

      if ( vname=="bpsd" ) {
        qs = apply( y$bpsd, 2, quantile, probs=c(0.025, 0.5, 0.975) )
        qs = signif( qs, 3 )
        for (i in 1:3) {
          pdat = as.vector(y$bpsd[,i])
          prr=NULL
          prr$class='uniform'
          prr$max=3
          prr$min=0
          #prr$class="lognormal"
          #prr$meanlog=sb$bpmup
          #prr$sdlog=sqrt(sb$bpsdp)
          plot.freq.distribution.prior.posterior( prior=prr, posterior=pdat, ...  )
          legend( "topright", bty="n",
            legend=paste( aulabels[i], " ", vname, " = ", qs[2,i], " {", qs[1,i], ", ",  qs[3,i], "}", sep="" )
      )}}

    }

    # --------------

    if ( type=="timeseries" ) {

    plot.new()
    layout( matrix(c(1,2,3), 3, 1 ))
    par(mar = c(4.4, 4.4, 0.65, 0.75))

      if (vname=="biomass") {

        SI =  apply( y$q, 2, median, na.rm=T  )

        for (i in 1:3) {
          qIOA = sb$IOA[,i] / SI[i]
          IOA = sb$IOA[,i]
          meanval = apply( y$B[,,i], 2, mean, na.rm=T  )

          prs = seq( from=0.025, to=0.975, length.out=600)
          Bq =  apply( y$B[,,i], 2, quantile, probs=prs, na.rm=T  )

          yran = range(c(0, Bq, sb$IOA[,i] ), na.rm=T )*1.01
          plot( yrs, Bq[1,], type="n", ylim=yran, xlim=range(yrs0), xlab="", ylab=""  ) #change xlim to yrs0 to remove 3 yr projection
          cols = gray.colors( floor(length( prs)/2) )
          cols2 = c(cols[length(cols):1], cols )
          for ( j in 1:length(prs) ) {
            lines ( yrs, Bq[j,], lwd=4, col=cols2[j] )
          }
          # lines( yrs, B, lwd=3, col="darkgreen" )
          #abline (v=yrs.last , lwd=2, lty="dashed" ) #can comment out this line if not providing forward projection
          if (i==2) title( ylab="Fishable biomass (kt)" )
          if (i==3) title( xlab="Year" )
          points( yrs0, qIOA, pch=20, col="darkgreen" )
          lines ( yrs0, qIOA, lwd=3, col="darkgreen", lty="dashed" )
          lines ( yrs, meanval, lwd=2, col="blue", lty="dotted" )
          points( yrs0, IOA, pch=20, col="darkred" )
          lines( yrs0, IOA, lwd=3, lty="dotdash", col="red" )
          legend( "topright", bty="n", legend=aulabels[i])
        }
      }

      if (vname=="fishingmortality") {
        Fmsy = apply( y$FMSY, 2, mean, na.rm=T )
        for (i in 1:3) {
          prs = seq( from=0.025, to=0.975, length.out=600)
          Fi = apply( y$F[,1:sb$N,i], 2, quantile, probs=prs, na.rm=T )
          yran = range(c(0, max(c(Fi,Fmsy))), na.rm=T )*1.01
          yran = pmin( yran, 1.2 )
          plot( yrs0, Fi[1,], type="n", ylim=yran, xlab="", ylab="" )
          cols = gray.colors( floor(length( prs)/2) )
          cols2 = c(cols[length(cols):1], cols )
          if (i %in% c(1,2)){
          for ( j in 1:length(prs) ) {
            lines ( yrs0, Fi[j,], lwd=4, col=cols2[j] )
          }}
          if (i==3){
            for ( j in 1:length(prs) ) {
              lines ( yrs0-1, Fi[j,], lwd=4, col=cols2[j] )
          }}
          if (i==2) title( ylab="Fishing mortality" )
          if (i==3) title( xlab="Year" )
          legend( "topright", bty="n", legend=aulabels[i])
          abline (h=-log(1-0.2), lwd=2, lty="dashed" )
          abline (h=Fmsy[i], lwd=2, lty="solid", col="red" )
        }
      }

    }

    if (type=="hcr") {
      if (vname=="default") {

        B =  apply( y$B, c(2,3), mean, na.rm=T  )
        F =  apply( y$F, c(2,3), mean, na.rm=T  )
        K =  apply( y$K, c(2), mean, na.rm=T  )
        FMSY = apply( y$FMSY, c(2), mean, na.rm=T  )
        BMSY = apply( y$BMSY, c(2), mean, na.rm=T  )

        for (i in 1:3 ) {
          ylims = c(0, min( 1, max( FMSY[i] * 1.25, F[hdat,i] ) ) )
          plot( B[hdat,i], F[hdat,i],  type="b", xlim=c(0, K[i] * 1.1 ),
            ylim=ylims, col="darkorange", cex=0.8, lwd=2, xlab="", ylab="", pch=20 )

          # nn = as.matrix( cbind( Bx=as.vector( y$B[,ndata,i] ), Fx = as.vector( y$F[,ndata,i] ) ))
          # ellipse.2d(nn[,1], nn[,2], pv=0.05, sc=30)

          if (i==3) title( xlab="Fishable biomass (kt)" )
          if (i==2) title( ylab="Fishing mortality" )

          F30 = -log(1-0.3)
          F10 = -log(1-0.1)

          Fref =  0.22
          Bmsy = K[i] * 0.5
          Bref = K[i] * 0.2
          BK = K[i]
          BK25 = K[i] * .25
          Fhistorical = mean( F[hdat,i], na.rm=T )
          Bhistorical = mean( B[hdat,i], na.rm=T )
          yl = 0.05

          polygon(x=c(Bmsy,Bmsy*2,Bmsy*2, Bmsy),y=c(-0.08,-0.1,FMSY[i],FMSY[i]),col='lightgreen',border=NA)
          polygon(x=c(Bmsy/2,Bmsy,Bmsy, Bmsy/2),y=c(-0.08,-0.1,FMSY[i],FMSY[i]),col='lightgoldenrod',border=NA)
          polygon(x=c(0,Bmsy/2,Bmsy/2, 0),y=c(-0.08,-0.1,FMSY[i],FMSY[i]),col='darksalmon',border=NA)

#might need adjustment below to offset F vs B. Need to plot F against PREfishery biomass
          lines( B[hdat,i], F[hdat,i],  type="b", xlim=c(0, K[i] * 1.1 ),
            ylim=ylims, col='blue', cex=0.8, lwd=2, xlab="", ylab="", pch=20 )

          abline (h=Fref, lty="solid", col="gray", lwd=2 )

          abline (h=F10, lty="dotted", col="gray")
          # text( 0.05*K[i], F10, "10% HR", pos=1 )

          abline (h=F30, lty="dotted", col="gray")
          # text( 0.05*K[i], F30, "30% HR", pos=1 )

          abline (h=FMSY[i], lty="dashed", col="red" )

          # abline (h=Fhistorical, lty="dashed")
          # text( 0.05*K[i], Fhistorical, "Mean", pos=1, lwd=2 )

          # abline (v=Bref, lty="dotted")
          # text( Bref-0.2, 0.25, "Lower biomass reference point\n (LBRP = 0.2 * BMSY)" , srt=90, pos=3)

          abline (v=Bmsy, lty="dotted")

          abline (v=BK, lty="dotted")

          abline (v=BK25, lty="dotted")

          text( Bmsy-0.01*K[i], yl, "K/2" , srt=90, pos=3)
          text( BK-0.01*K[i], yl, "K" , srt=90, pos=3)
          text( BK25-0.01*K[i], yl, "K/4" , srt=90, pos=3)
          text( 0.05*K[i], Fref, "20% HR", pos=1 )
          text( 0.05*K[i], FMSY[i], "FMSY", pos=3, lwd=2, col="red" )
          if (i %in% c(1,2)){
            text( B[1:(ndata-1),i], F[1:(ndata-1),i],  labels=yrs0[-ndata], pos=3, cex= 0.8 )
            points( B[ndata,i], F[ndata,i],  pch=21, bg='darkorange', cex= 1.4 )
            text( B[ndata,i], F[ndata,i],  labels=yrs0[ndata], pos=3, cex= 1.4, font=2 )

            text( 0, ylims[2]*0.9,  labels=aulabels[i], pos=3, cex= 0.85 )
          }
          if (i==3){
          text( B[1:(ndata-1),i], F[1:(ndata-1),i],  labels=(yrs0[-ndata]-1), pos=3, cex= 0.8 )
          points( B[ndata,i], F[ndata,i],  pch=21, bg='darkorange', cex= 1.4 )
          text( B[ndata,i], F[ndata,i],  labels=yrs0[ndata]-1, pos=3, cex= 1.4, font=2 )

          text( 0, ylims[2]*0.9,  labels=aulabels[i], pos=3, cex= 0.85 )
          }
          # abline (v=Bhistorical, lty="dashed")
          # text( Bhistorical-0.01*K[i], yl, "Mean" , srt=90, pos=3,  lwd=2)
        }
      #Enable below to see the annual F estimates for inclusion in the document
          print("F for N-ENS" )
          print(F[hdat,1] )
          print("F for S-ENS" )
          print(F[hdat,2] )
        print("F for 4X" )
        print(F[hdat,3] )

      }

      if (vname=="default.unmodelled") {

        B =  sb$IOA
          F =  apply( y$F, c(2,3), mean, na.rm=T  )

          areas = c("cfa4x", "cfasouth", "cfanorth" )
          regions = c("4X", "S-ENS", "N-ENS")

          td = exploitationrates(p=p, areas=areas, labels=regions, CFA4X.exclude.year.assessment=FALSE )

          K =  apply( y$K, c(2), mean, na.rm=T  )
          FMSY = apply( y$FMSY, c(2), mean, na.rm=T  )
          BMSY = apply( y$BMSY, c(2), mean, na.rm=T  )

        for (i in 1:3 ) {
          ylims = c(0, FMSY[i] * 1.25)
          plot( B[hdat,i], F[hdat,i],  type="b", xlim=c(0, K[i] * 1.1 ),
            ylim=ylims, col="darkorange", cex=0.8, lwd=2, xlab="", ylab="", pch=20 )

          # nn = as.matrix( cbind( Bx=as.vector( y$B[,ndata,i] ), Fx = as.vector( y$F[,ndata,i] ) ))
          # ellipse.2d(nn[,1], nn[,2], pv=0.05, sc=30)

          if (i==3) title( xlab="Fishable biomass (kt)" )
          if (i==2) title( ylab="Fishing mortality" )

          F30 = -log(1-0.3)
          F10 = -log(1-0.1)

          Fref =  0.22
          Bmsy = BMSY[i]
          Bref = K[i] * 0.2
          BK = K[i]
          BK25 = K[i] * .25
          Fhistorical = mean( F[hdat,i], na.rm=T )
          Bhistorical = mean( B[hdat,i], na.rm=T )
          yl = 0.05

          abline (h=Fref, lty="solid", col="gray", lwd=2 )

          abline (h=F10, lty="dotted", col="gray")
          # text( 0.05*K[i], F10, "10% HR", pos=1 )

          abline (h=F30, lty="dotted", col="gray")
          # text( 0.05*K[i], F30, "30% HR", pos=1 )

          abline (h=FMSY[i], lty="dashed", col="red" )

          # abline (h=Fhistorical, lty="dashed")
          # text( 0.05*K[i], Fhistorical, "Mean", pos=1, lwd=2 )

          # abline (v=Bref, lty="dotted")
          # text( Bref-0.2, 0.25, "Lower biomass reference point\n (LBRP = 0.2 * BMSY)" , srt=90, pos=3)

          abline (v=Bmsy, lty="dotted")

          abline (v=BK, lty="dotted")

          abline (v=BK25, lty="dotted")

          text( 0.05*K[i], Fref, "20% HR", pos=1 )
          text( 0.05*K[i], FMSY[i], "FMSY", pos=3, lwd=2, col="red" )
          text( BK-0.01*K[i], yl, "K" , srt=90, pos=3)
          text( Bmsy-0.01*K[i], yl, "K/2" , srt=90, pos=3)
          text( BK25-0.01*K[i], yl, "K/4" , srt=90, pos=3)
          text( B[hdat,i], F[hdat,i],  labels=yrs0, pos=3, cex= 0.8 )

          text( 0, ylims[2]*0.9,  labels=aulabels[i], pos=3, cex= 0.85 )

          # abline (v=Bhistorical, lty="dashed")
          # text( Bhistorical-0.01*K[i], yl, "Mean" , srt=90, pos=3,  lwd=2)

        }
      }

      if (vname=="simple") {
        require(car)

          B =  apply( y$B, c(2,3), mean, na.rm=T  )
          F =  apply( y$F, c(2,3), mean, na.rm=T  )
          C =  apply( y$C, c(2,3), mean, na.rm=T  )
          K =  apply( y$K, c(2), mean, na.rm=T  )
#          for (i in 1:3) C[,i] = C[,i]  * K[i]
          FMSY = apply( y$FMSY, c(2), mean, na.rm=T  )
          BMSY = apply( y$BMSY, c(2), mean, na.rm=T  )

          aulabels = c("N-ENS", "S-ENS", "4X")

        for (i in 1:3 ) {
          ylims = max(C[,i] )* c(0, 1.1)
          plot( B[hdat,i], C[hdat,i],  type="l", xlim=c(0, K[i]*1.05  ),
            ylim=ylims, xlab="", ylab="",  lwd=2, col="darkorange" )

          abline(0,0.1, lty="dotted", lwd=2, col="gray" )
          abline(0,0.2, lwd=3, col="gray" )
          abline(0,0.3, lty="dotted", lwd=2, col="gray" )

          points( B[hdat,i], C[hdat,i], col="orange", cex=0.8, pch=20 )
          text( B[hdat,i], C[hdat,i],  labels=yrs0, pos=3, cex= 0.85 )

          text( 0, ylims[2]*0.9,  labels=aulabels[i], pos=3, cex= 0.85 )

          # nn = as.matrix( cbind( Bx=as.vector( y$B[,ndata,i] ), Fx = as.vector( y$F[,ndata,i] ) ))
          # ellipse.2d(nn[,1], nn[,2], pv=0.05, sc=30)

          if (i==3) title( xlab="Fishable biomass (kt)" )
          if (i==2) title( ylab="Catch (kt)" )

          Cmsy = ( exp( FMSY[i] ) - 1)
          Cref = ( exp( FMSY[i] * 0.2 ) - 1) * K[i]
          Bmsy = BMSY[i]
          Bref = K[i] * 0.2
          BK = K[i]
          BK25 = K[i] * .25
          Chistorical = mean( C[hdat,i], na.rm=T )
          Bhistorical = mean( B[hdat,i], na.rm=T )
          yl = 0.1 * max(C[hdat,i])

          # abline (h=Fref, lty="dotted")
          # text( 0.25, Fref, "Target\n (0.2 * FMSY) ", pos=1 )

          abline (0, Cmsy, lty="dotted", col="red")
          # text( 0.1*K[i], Cmsy, "FMSY", pos=1 )

          # abline (h=Chistorical, lty="dashed")
          # text( 0.1*K[i], Chistorical, "Mean", pos=3, lwd=2 )

          # abline (v=Bref, lty="dotted")
          # text( Bref-0.2, 0.25, "Lower biomass reference point\n (LBRP = 0.2 * BMSY)" , srt=90, pos=3)

          abline (v=BK, lty="dotted")
          text( BK-0.01*K[i], yl, "K" , srt=90, pos=3)

          abline (v=BK/2, lty="dotted")
          text( BK/2-0.01*K[i], yl, "K/2" , srt=90, pos=3)

          abline (v=BK25, lty="dotted")
          text( BK25-0.01*K[i], yl, "K/4" , srt=90, pos=3)

        }

      }
    }

    if (type=="diagnostic.catch") {

    }

    if (type=="diagnostic.phase") {

      B =  apply( y$B, c(2,), mean, na.rm=T  )
      K =  apply( y$K, c(2), mean, na.rm=T  )

      for (i in 1:3 ) {
        plot( B[1:ndata-1,i], B[2:ndata,i],  type="b", xlab="t", ylab="t+1",
          xlim=c(0, K[i] * 1.25 ), ylim=max(K[i] )* c(0, 1.25), lwd=2, col="darkorange" )

         # abline(0,0.1, lty="dotted", lwd=2, col="gray" )
         abline( coef=c(0,1) )
       #text( B[1:ndata-1,], B[2:ndata,],  labels=yrs4 , pos=4, cex=0.8 )
      }
    }

    if (type=="diagnostic.errors") {

      # observation vs process error
      graphics.off()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(5, 4, 0, 2))
      require(car)

      eP = y$bpsd
      eO = y$bosd
      for (i in 1:3 ) {
          plot( eP[,,i], eO[,,i],  type="p", pch=22 )
          if (i==2) title( ylab="Process error (SD)" )
          if (i==3) title( xlab="Observation error (SD)" )

      }

    }

    if (type=="diagnostic.production") {

      B =  apply( y$B, c(2,3), mean, na.rm=T  )
      P =  apply( y$P, c(2,3), mean, na.rm=T  )

      MSY = apply( y$MSY, c(2), mean, na.rm=T  )
      FMSY = apply( y$FMSY, c(2), mean, na.rm=T  )
      BMSY = apply( y$BMSY, c(2), mean, na.rm=T  )
      C =  apply( y$C, c(2,3), mean, na.rm=T  )
      K =  apply( y$K, c(2), mean, na.rm=T  )

      # production vs biomass
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(5, 4, 0, 2))
      for (i in 1:3) {
        plot( B[,i], P[,i], type="n", pch=20, ylim=c(0, max( c(P[,i], MSY[i]))*1.1), xlim=c(0,K[i]*1.05), xlab="Biomass; kt", ylab="Yield; kt"  )
        a = MSY[i] / (BMSY[i])^2
        curve( -a*(x-BMSY[i])^2 + MSY[i], from=0, to=K[i], add=TRUE, lwd=3, col="gray" )
        abline(v=BMSY[i], lty="dotted", lwd=3, col="gray")
        points( B[,i], P[,i], type="p", pch=20  )
        text( B[,i], P[,i], yrs0, pos=3, cex=0.8 )
        # abline(h=0)
      }

    }

    if (is.null(fn)) fn = paste(vname, "tmp", ".png", sep="" )
  if(save.plot) savePlot( filename=fn, type="png" )
    return( fn)

  }


##Need to combine Geojson into one file before putting into leaflet

library(shinythemes)
library(rgeos)
library(rgdal)
library(leaflet)
library(geojsonio)

load("map.rda")
load("zones.rda")

#input <- list(feetbuffer = 500, zones = "B-3")

ui <- bootstrapPage(theme = shinytheme("spacelab"),
                    title = "Cannabis Business Zoning",
                    tags$head(includeScript("google-analytics.js")),
                    tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
                    leafletOutput("map", width = "100%", height = "100%"),
                    absolutePanel(class = "panel panel-default",
                                  top = 10, right = 10, width = 330,
                                  includeMarkdown("docs/about.md"),
                                  numericInput("feetbuffer",
                                               label = h4("Feet From Facility"), 500),
                                  selectInput("zones", "Specific Zone", as.character(levels(zones@data$ZONING_DES))),
                                  actionButton("recalc", "Update"),
                                  br(),br(),
                                  a(img(src = "codeforanc.png"),
                                    href = "http://codeforanchorage.org/"),
                                  br(),br(),
                                  (a("Contact", href = "mailto:hans.thompson1@gmail.com"))
                                  )
                )

server <- function(input, output, session) {
  buffer <- eventReactive(input$recalc, {
      spTransform(map, CRS("+init=epsg:26934")) %>%
      gBuffer(width = input$feetbuffer / 3.28084) %>% #input$feetbuffer is actually in meters and is converted to feet in this line
      spTransform(CRS("+proj=longlat")) %>%
      as("SpatialPolygonsDataFrame")
  }, ignoreNULL = FALSE)
  filteredZones <- eventReactive(input$updateButton, {
  zones_filtered <- zones[as.character(zones@data$ZONING_DES) == input$zone,]
  zones_filtered <- as(zones_filtered, "SpatialPolygonsDataFrame")
  return(zones_filtered)
  })

  output$map <- renderLeaflet({
    #SpatialPolygons(list(buffers, zones), c("buffer", "zones"))
    leaflet() %>%
      addTiles(urlTemplate = "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png") %>%
      setView(-149.85, 61.15, zoom = 12) %>%
      addGeoJSON(geojson_json(buffer())) %>%
      addPolygons(data =   filteredZones(),
                  color="red")
  })

}

shinyApp(ui, server)