# Snow crab --- Areal unit modelling of habitat  -- no reliance upon stmv fields

# -------------------------------------------------
# Part 1 -- construct basic parameter list defining the main characteristics of the study
# require(aegis)

  year.assessment = 2021

  p = bio.snowcrab::snowcrab_parameters(
    project_class="carstm",
    yrs=2000:year.assessment,
    areal_units_type="lattice",
    selection = list(type = "number")
 )

# ------------------------------------------------
# Part 2 -- spatiotemporal statistical model

  if ( spataiotemporal_model ) {

    if (0) {
      # polygon structure:: create if not yet made
      # adjust based upon RAM requirements and ncores

      p$areal_units_constraint_nmin = 3
      p$areal_units_constraint_ntarget = 10

      for (au in c("cfanorth", "cfasouth", "cfa4x", "cfaall" )) plot(polygon_managementareas( species="snowcrab", au))
      xydata = snowcrab.db( p=p, DS="areal_units_input", redo=TRUE )

      sppoly = areal_units( p=p, redo=TRUE )  # create constrained polygons with neighbourhood as an attribute
      MS = NULL
    }

    sppoly = areal_units( p=p )  # to reload
    plot( sppoly[, "au_sa_km2"]  )

    # -------------------------------------------------
    M = snowcrab.db( p=p, DS="carstm_inputs", redo=TRUE )  # will redo if not found
    M = NULL; gc()

    fit = carstm_model(
      p=p,
      data='snowcrab.db( p=p, DS="carstm_inputs" )'
      num.threads="4:2",
    ) # 151 configs and long optim .. 19 hrs
    # fit = carstm_model( p=p, DS="carstm_modelled_fit")

      # extract results
      if (0) {
        # very large files .. slow
        fit = carstm_model( p=p, DS="carstm_modelled_fit" )  # extract currently saved model fit
        plot(fit)
        plot(fit, plot.prior=TRUE, plot.hyperparameters=TRUE, plot.fixed.effects=FALSE )
      }

    res = carstm_model( p=p, DS="carstm_modelled_summary"  ) # to load currently saved results
    res$summary$dic$dic
    res$summary$dic$p.eff
    res$dyear

    plot_crs = p$aegis_proj4string_planar_km
    coastline=aegis.coastline::coastline_db( DS="eastcoast_gadm", project_to=plot_crs )
    isobaths=aegis.bathymetry::isobath_db( depths=c(50, 100, 200, 400 ), project_to=plot_crs )
    managementlines = aegis.polygons::area_lines.db( DS="cfa.regions", returntype="sf", project_to=plot_crs )

    time_match = list( year=as.character(2020)  )
    carstm_map(  res=res,
        vn="predictions",
        time_match=time_match,
        coastline=coastline,
        managementlines=managementlines,
        isobaths=isobaths,
        main=paste("Predicted abundance", paste0(time_match, collapse="-") )
    )

    # map all :
    vn = "predictions"

    outputdir = file.path( p$modeldir, p$carstm_model_label, "predicted.numerical.densitites" )
    if ( !file.exists(outputdir)) dir.create( outputdir, recursive=TRUE, showWarnings=FALSE )

    brks = pretty(  quantile(res[[vn]], probs=c(0,0.975))  )

    for (y in res$year ){

        time_match = list( year=as.character(y)  )
        fn_root = paste("Predicted_abundance", paste0(time_match, collapse="-"), sep="_")
        fn = file.path( outputdir, paste(fn_root, "png", sep=".") )

          carstm_map(  res=res, vn=vn, time_match=time_match,
            breaks =brks,
            coastline=coastline,
            isobaths=isobaths,
            managementlines=managementlines,
            main=paste("Predicted numerial abundance", paste0(time_match, collapse="-") ),
            outfilename=fn
          )

    }

    snowcrab.db(p=p, DS="carstm_output_compute" )

    RES = snowcrab.db(p=p, DS="carstm_output_timeseries" )

    bio = snowcrab.db(p=p, DS="carstm_output_spacetime_biomass" )
    num = snowcrab.db(p=p, DS="carstm_output_spacetime_number" )

    outputdir = file.path( p$modeldir, p$carstm_model_label, "aggregated_biomass_timeseries" )

    if ( !file.exists(outputdir)) dir.create( outputdir, recursive=TRUE, showWarnings=FALSE )

    png( filename=file.path( outputdir, "cfa_all.png"), width=3072, height=2304, pointsize=12, res=300 )
      plot( cfaall ~ yrs, data=RES, lty="solid", lwd=4, pch=20, col="slateblue", type="b", ylab="Biomass index (kt)", xlab="")
      lines( cfaall_lb ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
      lines( cfaall_ub ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
    dev.off()

    png( filename=file.path( outputdir, "cfa_south.png"), width=3072, height=2304, pointsize=12, res=300 )
      plot( cfasouth ~ yrs, data=RES, lty="solid", lwd=4, pch=20, col="slateblue", type="b", ylab="Biomass index (kt)", xlab="")
      lines( cfasouth_lb ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
      lines( cfasouth_ub ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
    dev.off()

    png( filename=file.path( outputdir, "cfa_north.png"), width=3072, height=2304, pointsize=12, res=300 )
      plot( cfanorth ~ yrs, data=RES, lty="solid", lwd=4, pch=20, col="slateblue", type="b", ylab="Biomass index (kt)", xlab="")
      lines( cfanorth_lb ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
      lines( cfanorth_ub ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
    dev.off()

    png( filename=file.path( outputdir, "cfa_4x.png"), width=3072, height=2304, pointsize=12, res=300 )
      plot( cfa4x ~ yrs, data=RES, lty="solid", lwd=4, pch=20, col="slateblue", type="b", ylab="Biomass index (kt)", xlab="")
      lines( cfa4x_lb ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
      lines( cfa4x_ub ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
    dev.off()

    # map it ..mean density

    sppoly = areal_units( p=p )  # to reload

    plot_crs = p$aegis_proj4string_planar_km
    coastline=aegis.coastline::coastline_db( DS="eastcoast_gadm", project_to=plot_crs )
    isobaths=aegis.bathymetry::isobath_db( depths=c(50, 100, 200, 400, 800), project_to=plot_crs  )
    managementlines = aegis.polygons::area_lines.db( DS="cfa.regions", returntype="sf", project_to=plot_crs )

    vn = paste("biomass", "predicted", sep=".")

    outputdir = file.path( p$modeldir, p$carstm_model_label, "predicted.biomass.densitites" )

    if ( !file.exists(outputdir)) dir.create( outputdir, recursive=TRUE, showWarnings=FALSE )

    brks = pretty(  quantile( bio[], probs=c(0,0.975) )* 10^6 )

    for (i in 1:length(p$yrs) ){
      y = as.character( p$yrs[i] )
      sppoly[,vn] = bio[,y] * 10^6
      fn = file.path( outputdir , paste( "biomass", y, "png", sep=".") )

        carstm_map(  sppoly=sppoly, vn=vn,
          breaks=brks,
          coastline=coastline,
          isobaths=isobaths,
          managementlines=managementlines,
          main=paste("Predicted biomass density", y ),
          outfilename=fn
        )
    }

    plot( fit, plot.prior=TRUE, plot.hyperparameters=TRUE, plot.fixed.effects=FALSE )
    plot( fit$marginals.hyperpar$"Phi for space", type="l")  # posterior distribution of phi nonspatial dominates
    plot( fit$marginals.hyperpar$"Precision for space", type="l")
    plot( fit$marginals.hyperpar$"Precision for setno", type="l")

    (res$summary)

Time used:
    Pre = 13.7, Running = 11277, Post = 6.19, Total = 11297
Random effects:
  Name	  Model
    dyri AR1 model
   yr AR1 model
   inla.group(t, method = "quantile", n = 11) RW2 model
   inla.group(z, method = "quantile", n = 11) RW2 model
   inla.group(substrate.grainsize, method = "quantile", n = 11) RW2 model
   inla.group(pca1, method = "quantile", n = 11) RW2 model
   inla.group(pca2, method = "quantile", n = 11) RW2 model
   space BYM2 model
   space_time BYM2 model

Model hyperparameters:
                                                                             mean    sd 0.025quant 0.5quant 0.975quant
Precision for dyri                                                         52.326 0.080     52.163   52.328     52.476
Rho for dyri                                                                0.765 0.000      0.764    0.765      0.765
Precision for yr                                                           55.148 0.102     54.956   55.145     55.355
Rho for yr                                                                  0.761 0.000      0.761    0.761      0.762
Precision for inla.group(t, method = "quantile", n = 11)                   52.842 0.264     52.402   52.833     53.290
Precision for inla.group(z, method = "quantile", n = 11)                   54.802 0.209     54.489   54.771     55.260
Precision for inla.group(substrate.grainsize, method = "quantile", n = 11) 53.714 0.159     53.488   53.689     54.061
Precision for inla.group(pca1, method = "quantile", n = 11)                54.755 0.140     54.556   54.732     55.068
Precision for inla.group(pca2, method = "quantile", n = 11)                54.875 0.227     54.529   54.850     55.319
Precision for space                                                    54.589 0.049     54.488   54.588     54.700
Phi for space                                                           0.049 0.000      0.049    0.049      0.049
Precision for space_time                                                         56.525 0.036     56.452   56.525     56.595
Phi for space_time                                                                0.050 0.000      0.049    0.050      0.050
GroupRho for space_time                                                           0.773 0.000      0.773    0.773      0.773
                                                                             mode
Precision for dyri                                                         52.338
Rho for dyri                                                                0.765
Precision for yr                                                           55.134
Rho for yr                                                                  0.762
Precision for inla.group(t, method = "quantile", n = 11)                   52.521
Precision for inla.group(z, method = "quantile", n = 11)                   54.601
Precision for inla.group(substrate.grainsize, method = "quantile", n = 11) 53.527
Precision for inla.group(pca1, method = "quantile", n = 11)                54.601
Precision for inla.group(pca2, method = "quantile", n = 11)                54.602
Precision for space                                                    54.590
Phi for space                                                           0.049
Precision for space_time                                                         56.527
Phi for space_time                                                                0.049
GroupRho for space_time                                                           0.773

Expected number of effective parameters(stdev): 480.66(15.72)
Number of equivalent replicates : 15.10

Deviance Information Criterion (DIC) ...............: 51941.31
Deviance Information Criterion (DIC, saturated) ....: 94121.92
Effective number of parameters .....................: -680.14

Watanabe-Akaike information criterion (WAIC) ...: 57902.25
Effective number of parameters .................: 3659.12

Marginal log-Likelihood:  -29248.16
Posterior marginals for the linear predictor and
 the fitted values are computed

  }

  ##########

  if (fishery_model) {

      p$fishery_model = fishery_model( DS = "logistic_parameters", p=p, tag=p$areal_units_type )
      p$fishery_model$stancode = stan_initialize( stan_code=fishery_model( p=p, DS="stan_surplus_production" ) )

      str( p$fishery_model)

      p$fishery_model$stancode$compile()

      # res = fishery_model( p=p, DS="samples", tag=p$areal_units_type )  # to get samples

      if (0) {

        fit = fishery_model( p=p,   DS="fit", tag=p$areal_units_type )  # to get samples

        print( fit, max_rows=30 )
        # fit$summary("K", "r", "q")

        fit$cmdstan_diagnose()
        fit$cmdstan_summary()

          # (penalized) maximum likelihood estimate (MLE)
        fit_mle =  p$fishery_model$stancode$optimize(data =p$fishery_model$standata, seed = 123)
        fit_mle$summary( c("K", "r", "q") )

        u = stan_extract( as_draws_df(fit_mle$draws() ) )

        mcmc_hist(fit$draws("K")) +
          vline_at(fit_mle$mle(), size = 1.5)

        # Variational Bayes
        fit_vb = p$fishery_model$stancode$variational( data =p$fishery_model$standata, seed = 123, output_samples = 4000)
        fit_vb$summary(c("K", "r", "q"))

        u = stan_extract( as_draws_df(fit_vb$draws() ) )

        bayesplot_grid(
          mcmc_hist(fit$draws("K"), binwidth = 0.025),
          mcmc_hist(fit_vb$draws("K"), binwidth = 0.025),
          titles = c("Posterior distribution from MCMC", "Approximate posterior from VB")
        )

        color_scheme_set("gray")
        mcmc_dens(fit$draws("K"), facet_args = list(nrow = 3, labeller = ggplot2::label_parsed ) ) + facet_text(size = 14 )
        # mcmc_hist( fit$draws("K"))

        res = fishery_model(
          DS="logistic_model",
          p=p,
          tag=p$areal_units_type,
          fit = fit_vb
          # from here down are params for cmdstanr::sample()
        )

      }

      fit = p$fishery_model$stancode$sample(
        data=p$fishery_model$standata,
        iter_warmup = 4000,
        iter_sampling = 2000,
        seed = 123,
        chains = 3,
        parallel_chains = 3,  # The maximum number of MCMC chains to run in parallel.
        max_treedepth = 18,
        adapt_delta = 0.99,
        refresh = 500
      )

      # save fit and get draws
      res = fishery_model(
        DS="logistic_model",
        p=p,
        tag=p$areal_units_type,
        fit = fit
        # from here down are params for cmdstanr::sample()
      )

      color_scheme_set("gray")
      mcmc_dens(res$mcmc, regex_pars="K",  facet_args = list(nrow = 3, labeller = ggplot2::label_parsed ) ) + facet_text(size = 14 )
      # mcmc_hist( fit$draws("K"))

      # frequency density of key parameters
      fishery_model( DS="plot", vname="K", res=res )
      fishery_model( DS="plot", vname="r", res=res )
      fishery_model( DS="plot", vname="q", res=res, xrange=c(0.5, 3))
      fishery_model( DS="plot", vname="FMSY", res=res  )
      # fishery_model( DS="plot", vname="bosd", res=res  )
      # fishery_model( DS="plot", vname="bpsd", res=res  )

      # timeseries
      fishery_model( DS="plot", type="timeseries", vname="biomass", res=res  )
      fishery_model( DS="plot", type="timeseries", vname="fishingmortality", res=res)

      # Summary table of mean values for inclusion in document
      biomass.summary.table()

      # Harvest control rules
      fishery_model( DS="plot", type="hcr", vname="default", res=res  )
      fishery_model( DS="plot", type="hcr", vname="simple", res=res  )

      # diagnostics
      # fishery_model( DS="plot", type="diagnostic.errors", res=res )
      # fishery_model( DS="plot", type="diagnostic.phase", res=res  )

      NN = res$p$fishery_model$standata$N

      # K
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(res$mcmc$K[,i] ), main="")
      ( qs = apply(  res$mcmc$K[,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )

      # R
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(res$mcmc$r[,i] ), main="")
      ( qs = apply(  res$mcmc$r[,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )

      # q
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(res$mcmc$q[,i] ), main="")
      ( qs = apply(  res$mcmc$q[,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )

      # FMSY
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(res$mcmc$FMSY[,i] ), main="")
      ( qs = apply(  res$mcmc$FMSY[,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )

      # densities of biomass estimates for the year.assessment
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(res$mcmc$B[,NN,i] ), main="")
      ( qs = apply(  res$mcmc$B[,NN,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )

      # densities of biomass estimates for the previous year
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density( res$mcmc$B[,NN-1,i] ), main="")
      ( qs = apply(  res$mcmc$B[,NN-1,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )

      # densities of F in assessment year
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(  res$mcmc$F[,NN,i] ), xlim=c(0.01, 0.6), main="")
      ( qs = apply(  res$mcmc$F[,NN,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )
      ( qs = apply(  res$mcmc$F[,NN,], 2, mean ) )

      # densities of F in previous year
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(  res$mcmc$F[,NN-1,i] ), xlim=c(0.01, 0.6), main="")
      ( qs = apply(  res$mcmc$F[,NN-1,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )
      ( qs = apply(  res$mcmc$F[,NN-1,], 2, mean ) )

      # F for table ---
      summary( res$mcmc$F, median)
  }

# end


context("Bounds")

test_that("rescale_mid returns correct results", {
  x <- c(-1, 0, 1)

  expect_equal(rescale_mid(x), c(0, 0.5, 1))
  expect_equal(rescale_mid(x, mid = -1), c(0.5, 0.75, 1))
  expect_equal(rescale_mid(x, mid = 1), c(0, 0.25, 0.5))

  expect_equal(rescale_mid(x, mid = 1, to = c(0, 10)), c(0, 2.5, 5))
  expect_equal(rescale_mid(x, mid = 1, to = c(8, 10)), c(8, 8.5, 9))

  expect_equal(rescale_mid(c(1, NA, 1)), c(0.5, NA, 0.5))
})

test_that("rescale_max returns correct results", {
  expect_equal(rescale_max(0), NaN)
  expect_equal(rescale_max(1), 1)
  expect_equal(rescale_max(.3), 1)
  expect_equal(rescale_max(c(4, 5)), c(0.8, 1.0))
  expect_equal(rescale_max(c(-3, 0, -1, 2)), c(-1.5, 0, -0.5, 1))
  expect_equal(rescale_max(c(-3, 0, -1, 2)), c(-1.5, 0, -0.5, 1))
})

test_that("rescale functions handle NAs consistently", {
  expect_equal(rescale(c(2, NA, 0, -2)), c(1, NA, 0.5, 0))
  expect_equal(rescale(c(-2, NA, -2)), c(.5, NA, .5))

  expect_equal(rescale_mid(c(NA, 1, 2)), c(NA, 0.75, 1))
  expect_equal(rescale_mid(c(2, NA, 0, -2), mid = .5), c(0.8, NA, 0.4, 0))
  expect_equal(rescale_mid(c(-2, NA, -2)), c(.5, NA, .5))

  expect_equal(rescale_max(c(1, NA)), c(1, NA))
  expect_equal(rescale_max(c(2, NA, 0, -2)), c(1, NA, 0, -1))
  expect_equal(rescale_max(c(-2, NA, -2)), c(1, NA, 1))
})

test_that("zero range inputs return mid range", {
  expect_that(rescale(0), equals(0.5))
  expect_that(rescale(c(0, 0)), equals(c(0.5, 0.5)))
})

test_that("scaling is possible with dates and times", {
  dates <- as.Date(c("2010-01-01", "2010-01-03", "2010-01-05", "2010-01-07"))
  expect_equal(rescale(dates, from = c(dates[1], dates[4])), seq(0, 1, 1 / 3))
  expect_equal(rescale_mid(dates, mid = dates[3])[3], 0.5)

  dates <- as.POSIXct(c(
    "2010-01-01 01:40:40",
    "2010-01-01 03:40:40",
    "2010-01-01 05:40:40",
    "2010-01-01 07:40:40"
  ))
  expect_equal(rescale(dates, from = c(dates[1], dates[4])), seq(0, 1, 1 / 3))
  expect_equal(rescale_mid(dates, mid = dates[3])[3], 0.5)
})

test_that("scaling is possible with integer64 data", {
  skip_if_not_installed("bit64")
  x <- bit64::as.integer64(2^60) + c(0:3)
  expect_equal(
    rescale_mid(x, mid = bit64::as.integer64(2^60) + 1),
    c(0.25, 0.5, 0.75, 1)
  )
})

test_that("scaling is possible with NULL values", {
  expect_null(rescale(NULL))
  expect_null(rescale_mid(NULL))
})

test_that("scaling is possible with logical values", {
  expect_equal(rescale(c(FALSE, TRUE)), c(0, 1))
  expect_equal(rescale_mid(c(FALSE, TRUE), mid = 0.5), c(0, 1))
})

test_that("expand_range respects mul and add values", {
  expect_equal(expand_range(c(1,1), mul = 0, add = 0.6), c(0.4, 1.6))
  expect_equal(expand_range(c(1,1), mul = 1, add = 0.6), c(-0.6, 2.6))
  expect_equal(expand_range(c(1,9), mul = 0, add = 2), c(-1, 11))
})

test_that("out of bounds functions return correct values", {
  x <- c(-Inf, -1, 0.5, 1, 2, NA, Inf)

  expect_equal(oob_censor(x), c(-Inf, NA, 0.5, 1, NA, NA, Inf))
  expect_equal(oob_censor_any(x), c(NA, NA, 0.5, 1, NA, NA, NA))
  expect_equal(oob_censor(x), censor(x))

  expect_equal(oob_squish(x), c(-Inf, 0, 0.5, 1, 1, NA, Inf))
  expect_equal(oob_squish_any(x), c(0, 0, 0.5, 1, 1, NA, 1))
  expect_equal(oob_squish_infinite(x), c(0, -1, 0.5, 1, 2, NA, 1))
  expect_equal(oob_squish(x), squish(x))

  expect_equal(oob_discard(x), c(0.5, 1, NA))
  expect_equal(oob_discard(x), discard(x))

  expect_equal(oob_keep(x), x)
})


files_dirs = dir(path = ".", full.names = FALSE, recursive = FALSE, all.files = FALSE, no.. = FALSE)
home_dir = getwd()

abb_ban = files_dirs[1]
asc_lon = files_dirs[2]
abb_ban_path = paste(home_dir, "/", files_dirs[1], "/", "grd", sep = "")
asc_lon_path = paste(home_dir, "/", files_dirs[2], "/", "grd", sep = "")
abb_ban_tiff_path

test <- function(r_dir) {
  r <- raster(r_dir)
  r[r != 1] <- NA
  setwd()
  writeRaster(r, gsub(".grd", ".tif", r_dir), format="GTiff")
  setwd(r_dir)
}

# First pdw to raster dir
# loop through the files in the dir for the convertion
# in the convertion, set the output dir to tif folder
# test("~/my_rasters")

r_dir = abb_ban_path
r = raster(r_dir)


#' 2D contours of a 3D surface
#'
#' ggplot2 can not draw true 3D surfaces, but you can use `geom_contour()`,
#' `geom_contour_filled()`, and [geom_tile()] to visualise 3D surfaces in 2D. To
#' specify a valid surface, the data must contain `x`, `y`, and `z` coordinates,
#' and each unique combination of `x` and `y` can appear at most once.
#' Contouring requires that the points can be rearranged so that the `z` values
#' form a matrix, with rows corresponding to unique `x` values, and columns
#' corresponding to unique `y` values. Missing entries are allowed, but contouring
#' will only be done on cells of the grid with all four `z` values present. If
#' your data is irregular, you can interpolate to a grid before visualising
#' using the [interp::interp()] function from the `interp` package
#' (or one of the interpolating functions from the `akima` package.)
#'
#' @eval rd_aesthetics("geom", "contour")
#' @eval rd_aesthetics("geom", "contour_filled")
#' @inheritParams layer
#' @inheritParams geom_point
#' @inheritParams geom_path
#' @param bins Number of contour bins. Overridden by `binwidth`.
#' @param binwidth The width of the contour bins. Overridden by `breaks`.
#' @param breaks Numeric vector to set the contour breaks. Overrides `binwidth`
#'   and `bins`. By default, this is a vector of length ten with [pretty()]
#'   breaks.
#' @seealso [geom_density_2d()]: 2d density contours
#' @export
#' @examples
#' # Basic plot
#' v <- ggplot(faithfuld, aes(waiting, eruptions, z = density))
#' v + geom_contour()
#'
#' # Or compute from raw data
#' ggplot(faithful, aes(waiting, eruptions)) +
#'   geom_density_2d()
#'
#' \donttest{
#' # use geom_contour_filled() for filled contours
#' v + geom_contour_filled()
#'
#' # Setting bins creates evenly spaced contours in the range of the data
#' v + geom_contour(bins = 3)
#' v + geom_contour(bins = 5)
#'
#' # Setting binwidth does the same thing, parameterised by the distance
#' # between contours
#' v + geom_contour(binwidth = 0.01)
#' v + geom_contour(binwidth = 0.001)
#'
#' # Other parameters
#' v + geom_contour(aes(colour = after_stat(level)))
#' v + geom_contour(colour = "red")
#' v + geom_raster(aes(fill = density)) +
#'   geom_contour(colour = "white")
#'
#' # Irregular data
#' if (requireNamespace("interp")) {
#'   # Use a dataset from the interp package
#'   data(franke, package = "interp")
#'   origdata <- as.data.frame(interp::franke.data(1, 1, franke))
#'   grid <- with(origdata, interp::interp(x, y, z))
#'   griddf <- subset(data.frame(x = rep(grid$x, nrow(grid$z)),
#'                               y = rep(grid$y, each = ncol(grid$z)),
#'                               z = as.numeric(grid$z)),
#'                    !is.na(z))
#'   ggplot(griddf, aes(x, y, z = z)) +
#'     geom_contour_filled() +
#'     geom_point(data = origdata)
#' } else
#'   message("Irregular data requires the 'interp' package")
#' }
geom_contour <- function(mapping = NULL, data = NULL,
                         stat = "contour", position = "identity",
                         ...,
                         bins = NULL,
                         binwidth = NULL,
                         breaks = NULL,
                         lineend = "butt",
                         linejoin = "round",
                         linemitre = 10,
                         na.rm = FALSE,
                         show.legend = NA,
                         inherit.aes = TRUE) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomContour,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      bins = bins,
      binwidth = binwidth,
      breaks = breaks,
      lineend = lineend,
      linejoin = linejoin,
      linemitre = linemitre,
      na.rm = na.rm,
      ...
    )
  )
}

#' @rdname geom_contour
#' @export
geom_contour_filled <- function(mapping = NULL, data = NULL,
                                stat = "contour_filled", position = "identity",
                                ...,
                                bins = NULL,
                                binwidth = NULL,
                                breaks = NULL,
                                na.rm = FALSE,
                                show.legend = NA,
                                inherit.aes = TRUE) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomContourFilled,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      bins = bins,
      binwidth = binwidth,
      breaks = breaks,
      na.rm = na.rm,
      ...
    )
  )
}

#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
#' @include geom-path.r
GeomContour <- ggproto("GeomContour", GeomPath,
  default_aes = aes(
    weight = 1,
    colour = "#3366FF",
    size = 0.5,
    linetype = 1,
    alpha = NA
  )
)

#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
#' @include geom-polygon.r
GeomContourFilled <- ggproto("GeomContourFilled", GeomPolygon)


\name{hc_polygon-HilbertCurve-method}
\alias{hc_polygon,HilbertCurve-method}
\title{
Add polygons to Hilbert curve
}
\description{
Add polygons to Hilbert curve
}
\usage{
\S4method{hc_polygon}{HilbertCurve}(object, ir = NULL, x1 = NULL, x2 = NULL,
    gp = gpar(), end_type = c("expanding", "average", "shrinking"))
}
\arguments{

  \item{object}{a \code{\link{HilbertCurve-class}} object.}
  \item{ir}{an \code{\link[IRanges:IRanges-constructor]{IRanges}} object which specifies the input intervals.}
  \item{x1}{if start positions are not integers, they can be set by \code{x1}.}
  \item{x2}{if end positions are not integers, they can be set by \code{x2}.}
  \item{gp}{graphic parameters. It should be specified by \code{\link[grid]{gpar}}.}
  \item{end_type}{since two ends of a continuous interval do not necessarily completely overlap with  the Hilbert curve segments, this argument controls how to determine the ends of the interval which will be presented on the curve.  \code{average}: if the end covers more than half of the segment, the whole segment is included and if the end covers less than half of the segment, the segment is removed; \code{expanding}: segments are included as long as they are overlapped; \code{shrinking}: segments are removed if they are not completely covered.}

}
\details{
Drawing polygons are quite visually similar as drawing rectangles.
The major differences are: 1) for rectangles, colors for the ends of the interval can change if they are not completely
covered by the Hilbert curve segments, and 2) polygons can have borders.

Normally polygons are used to mark areas in the Hilbert curve.
}
\value{
No value is returned.
}
\author{
Zuguang Gu <z.gu@dkfz.de>
}
\examples{
require(IRanges)
ir = IRanges(10, 40)

hc = HilbertCurve(0, 100, level = 4, reference = TRUE)
hc_segments(hc, ir)
hc_text(hc, x1 = 10:40, labels = 10:40)
hc_polygon(hc, ir, gp = gpar(fill = "#FF000080", col = 1))
}


# For use with baseballdatawrangling2.r

murray <- bavg %>%
  filter(batterid=='murre001') %>%
  select(H,AB,RDate) %>%
  arrange(RDate) %>%
  mutate(Total_H=cumsum(H), Total_AB=cumsum(AB)) %>%
  mutate(AVG = round((Total_H / Total_AB),3)) %>%
  mutate(player='Eddie Murray')


#!/usr/bin/Rscript

require(scales)
require(ggplot2)
require(grid)
require(png)
require(gridExtra)
require(reshape2)

args <- commandArgs(TRUE)
onCMDLine <- !is.na(args[1])

if ( onCMDLine ) {
  file <- args[1]
  sample_id <- args[2]
  gene <- args[3]
}

cnv = read.csv(file,sep="\t",header=T,check.names=FALSE)

affected_samples = c(sample_id)

std_columns = c("#chr","start","end")

affected <- melt(subset(cnv, select=names(cnv) %in% c(std_columns,affected_samples)),id=std_columns)

melted_all <- melt(cnv,id=std_columns)
plot.title = sprintf("%s", gene)
file.out = sprintf("%s.pdf", sample_id)

q <- ggplot(melted_all,aes(x=start/1000,y=exp(value))) + geom_line(aes(group = variable),color="lightgrey")
q <- q + geom_line(data=affected,aes(x=start/1000,y=exp(value),group = variable),color="blue")
q <- q + geom_point(data=affected,aes(x=start/1000,y=exp(value),group = variable),color="black") + theme_bw()
q <- q + scale_y_continuous("Estimated Copy Number", limits=c(0,4)) + scale_x_continuous("Position (kb)")
q <- q + ggtitle(plot.title)

pdf(file.out)
print(q)
dev.off()


source('constants.r')
source('backtest_lib.r')
source('data_cleaning.r')
source('strategy_hmm.r')
#source('strategy_ipr.R')
source('new metrics file.R')
#install.packages("tseries")
library(XLConnect)
#library(knitr)
#install.packages("regpro")
library("regpro")
library(MASS)
#install.packages("forecast")
library("forecast")

# notes 2015-11-20

#1. ETL (cleaning, organizing section), factor in for missing data, outliers, etc.
# -> think of the opportunistic time intervals to trade (don't decide arbritarily, decide based on
# intelligence)
# -> separate the strategy from the market module in the flow chart
# -> market sends back fills and acknowledgements (assume we don't need this)
# -> strategy will act only upon "fill" (may not need to do this) and "timer"
# -> market reacts to order,replace,cancel and market data
# -> change active and passive to fill and timer
# -> highlight strategy with more detail

#knitr::spin

init_cash = 100000
#global_variables: position matrices, trade matrices, ourdata, order book

#order format: msgtype, symbol, price, quantity, side, ordtype, orderID, time
#execution message format: orderID, Execstatus, symbol, quantity, avg price, side, time
#Execstatus can be the following: filled, replaced, cancelled, replacereject?, cancelreject

#order book format: orderID, time, symbol, price, quantity, side, ordtype
#trade matrix format: time, symbol, side, quantity, price, open/close, pnl
#position matrix: time, asset, #of shares, book value, market value,
global_tables = new.env()

global_tables[[Con_GlobalVarName_LOB]]<- data.frame(matrix(0, 0, length(orderbook_spec)))
colnames(global_tables[[Con_GlobalVarName_LOB]]) <- orderbook_spec

#the position book is a list of data frames
init_pos <- data.frame(matrix(0, 1, length(positionbook_spec)))
colnames(init_pos) <- positionbook_spec
init_pos[,Con_FieldName_Sym] = Con_Sym_Cash
init_pos[,c(Con_FieldName_Qty, Con_FieldName_BookVal, Con_FieldName_MktVal)] = init_cash

global_tables[[Con_GlobalVarName_PositionBook]] <- list(init_pos)
names(global_tables[[Con_GlobalVarName_PositionBook]])[1] = 0

global_tables[[Con_GlobalVarName_TradesBook]] <- data.frame(matrix(0, 0, length(tradesbook_spec)))
colnames(global_tables[[Con_GlobalVarName_TradesBook]]) <- tradesbook_spec

global_tables[[Con_GlobalVarName_ListDates]] <- list(vector())

import_data(global_tables, c('BNS', 'BMO', 'AC'))

#strategy_impliedpricerisk(c("CPD", "SU", "ABX"), global_tables, 780, 780, 780)
#system.time({test_results <- test_HMMM(global_tables, c('BMO'), 30, 3)})

test_results <- test_HMMM(global_tables, c('BMO'), 30, 3)

#result<-sum(comparison[!is.na(comparison)]) / (nrow(comparison) * ncol(comparison))
 temp_ind_2 <- !is.na(global_tables$tradesbook[["PnL"]])
 pnl_pertrade <- global_tables$tradesbook[["PnL"]][temp_ind_2]
 eod_vals <- data.matrix(test_results[["eod_results"]][["eod_value"]])
 mu <- data.matrix(test_results[["mu"]])
 A <- data.matrix(test_results[["A"]])
 cov_matrix <- data.matrix(test_results[["cov_matrix"]])
 accuracy <- data.matrix(test_results[["accuracy"]])
# plot(eod_vals)

output <- output(global_tables$tradesbook, global_tables$positionbook, global_tables$SPX_ask)


library(shiny)
library(plotly)

renderInputs <- function(prefix) {
  wellPanel(
    fluidRow(
        column(3,
        sliderInput(paste0(prefix, "_", "ngen"), "Number of generations:", min = 10, max = 100, value = 100,step = 20),
        sliderInput(paste0(prefix, "_", "nloci"), "Number of loci:", min = 50, max = 200, value = 50, step = 25),
        sliderInput(paste0(prefix, "_", "nrep"), "Number of repetitions:", min = 1, max = 100, value = 50, step = 10)
        ),
        column(3,
        sliderInput(paste0(prefix, "_", "nploidy"), "Number of ploidy:", min = 2, max = 6, value = 2, step = 2),
        sliderInput(paste0(prefix, "_", "ninit0"), "Number of wildtype individuals:", min = 10, max = 100, value = 50, step = 10),
        sliderInput(paste0(prefix, "_", "ninit1"), "Number of rescuetype individuals:", min = 1, max = 100, value = 5)
        ),
        column(3,
        sliderInput(paste0(prefix, "_", "k"), "Carrying capacity of the population:", min = 10, max = 150, value = 100, step = 20),
        sliderInput(paste0(prefix, "_", "r"), "Intrinsic growthrate of the population:", min = 0.0, max = 0.5, value = 0.1, step = 0.05),
        sliderInput(paste0(prefix, "_", "distlocal"), "Distance of locally adapted locus from major locus:", min = 1, max = 10, value = 1)
        ),
        column(3,
        sliderInput(paste0(prefix, "_", "scmajor"), "Major locus additive fitness:", min = 0.0, max = 0.5, value = 0.05, step = 0.05),
        sliderInput(paste0(prefix, "_", "sclocal"), "Locally adapted locus additive fitness:", min = -0.1, max = 0.0, value = -0.1, step = 0.01),
        sliderInput(paste0(prefix, "_", "rec"), "Recombination rate:", min = 0.0, max = 0.5, value = 0.5, step = 0.05)
        )
    ),
    p(actionButton(paste0(prefix, "_", "recalc"),
      "Run simulation", icon("random")
    ))
  )
}

# Define UI for application that plots random distributions
fluidPage(theme="simplex.min.css",
  tags$style(type="text/css",
    "label {font-size: 12px;}",
    ".recalculating {opacity: 1.0;}"
  ),

  # Application title
  tags$h2("Evolutinar rescue due to introgressive hybridization"),
  p("Simulations implemented in c++"),
  hr(),

  fluidRow(
    column(6,
    renderInputs("a")
    ),
    column(3,
    plotOutput("a_PopulationPlot")
    ),
    column(3,
    plotOutput("a_IntrogressionPlot")
    )
  ),
  fluidRow(
    textOutput("fixation_output")
  ),
  fluidRow(
      plotlyOutput("a_lociPlot")
  )
)


p <- ifelse(train$Sex == "female", 1,0)

train
View(train)
##verificar com calma a Pclass
test$Pclass = as.factor(test$Pclass)

new_train <- train
new2_train <- new_train
new2_train

test$Age <- ifelse(is.na(test$Age),sample(0:80,1),test$Age)

new2_train$Embarekd <- ifelse(is.na(new2_train$Embarked),"S",new2_train$Embarked)

new2_train$Embarked <- ifelse(is.na(new2_train$Embarked),"S",new2_train$Embarked)

View(new2_train)

new2_train$Age <- ifelse(is.na(new2_train$Age),sample(0:80,1),new2_train$Age)
new2_train$Sex <- as.numeric(new2_train$Sex)
new2_train$Survived <- as.numeric(new2_train$Survived)
new2_train$Embarked

new3_train <- new2_train

is.na(new3_train$Embarked)

new2_train <- train

View(new2_train)

summary(new_train)
sd(new_train$age~Pclass)
summary(new2_train)
new_train <- train

hist(new_train$Age)
boxplot(new_train$Age)
lm(new_train$Age~new_train$Survived)

?numeric
as.numeric(3.2)
clear()


library(jsonlite)
library(ggplot2)
library(zoo)
library(readr)

library(colorspace)
library(gridExtra)

library(plotly)
library(htmlwidgets)

library(sf)

library(lubridate)
library(plyr)

library(dplyr)

library(tidyr)
library(lubridate)

library(reshape2)
library(readr)

# get last_date_
load('data/latest/last_date_.Rda')

#https://www.hzjz.hr/aktualnosti/covid-19-izvjesce-hzjz-a/
vacc_data <- read.csv(file = 'data/vaccination/cro_vaccination_per_county_2021_12_26.csv')
vacc_date <- "26.12.2021."

first_dose_reordered <- as.numeric(vacc_data[1, 2:22])
fully_vacc_reordered <- as.numeric(vacc_data[2, 2:22])

first_dose_reordered
fully_vacc_reordered

hr <- st_read(dsn = "data/Official_Croatia_Boundaries/CROATIA_HR_Županije_ADMIN1.shp")

vacc_data

hr <- hr[order(hr$ZUP_IME),]
hr$Zupanija <- hr$ZUP_IME

hr$ZUP_IME

hr <-cbind(hr, first_dose_reordered, fully_vacc_reordered)

hr_map <- ggplot(hr, aes(text = paste("Županija: ", Zupanija, "
", "Prva doza: ", first_dose_reordered, "%
",
                                      "Završeno cijepljenje: ", fully_vacc_reordered, "%
",
                                      sep=""))) +
  ggtitle(paste("COVID 19 u Hrvatskoj: Procijepljenost po županijama (", vacc_date, ")", sep="")) +
  geom_sf(aes_string(fill = 'fully_vacc_reordered')) +
  scale_fill_distiller(palette = "RdYlGn", direction=1, limits = c(0, 100), oob = scales::squish, name='Postotak\nprocijepljenosti') +
  geom_sf_text(aes(label=paste(round(fully_vacc_reordered, digits= 0), "%", sep="")), fontface="bold", size=5, color="black") +
  theme(legend.position = "bottom") +
  theme_void() +
  labs(caption = paste('Postotak procijepljenosti po županijama (s obje doze) u odnosu na ukupno stanovništvo županije.\n\nGenerirano: ', format(Sys.time() + as.difftime(1, units="hours"), '%d.%m.%Y. %H:%M:%S h'), ', izvor podataka: hzjz.hr, autor: Petar Palašek', sep='')) +
  theme(plot.caption = element_text(hjust = 0))

hr_map

ggsave(paste('img/', last_date_, '_vaccination.png', sep = ''), plot = hr_map, dpi=300, width=309.80, height=215.90, units="mm")

hr_map_p <- ggplotly(hr_map, tooltip = c("text"))

hr_map_p

print(last_date_)

saveWidget(hr_map_p, file = "html/index_vaccination.html", title = paste("COVID 19 u Hrvatskoj: Postotak procijepljenosti po županijama (", vacc_date, ")", sep=""))


#install_keras(tensorflow="1.4.1-gpu")

library(keras)
use_backend("tensorflow")
#use_backend("theano")

#mnist <- dataset_mnist()
mnist <- dataset_fashion_mnist()

x_train <- mnist$train$x
y_train <- mnist$train$y
x_test <- mnist$test$x
y_test <- mnist$test$y

# reshape
x_train <- array_reshape(x_train, c(nrow(x_train), 784))
x_test <- array_reshape(x_test, c(nrow(x_test), 784))
# rescale
x_train <- x_train / 255
x_test <- x_test / 255

y_train <- to_categorical(y_train, 10)
y_test <- to_categorical(y_test, 10)

model <- keras_model_sequential()
model %>%
  layer_dense(units = 256, activation = 'relu', input_shape = c(784)) %>%
  layer_dropout(rate = 0.4) %>%
  layer_dense(units = 128, activation = 'relu') %>%
  layer_dropout(rate = 0.3) %>%
  layer_dense(units = 10, activation = 'softmax')

summary(model)

model %>% compile(
  loss = 'categorical_crossentropy',
  optimizer = optimizer_rmsprop(),
  #optimizer = optimizer_sgd(momentum=0.9, lr=0.001),
  metrics = c('accuracy')
)

set.seed(1234)
history <- model %>% fit(
  x_train, y_train,
  epochs = 20, batch_size = 500,
  validation_split = 0.5
)

plot(history)

mmodel <- model %>% multi_gpu_model(gpus = NULL)

mmodel %>% compile(
  loss = 'categorical_crossentropy',
  optimizer = optimizer_rmsprop(),
  metrics = c('accuracy')
)

history <- mmodel %>% fit(
  x_train, y_train,
  epochs = 50, batch_size = 5000,
  validation_split = 0.2
)

plot(history)

model %>% evaluate(x_test, y_test)

model %>% predict_classes(x_test)

rm(mnist)

rm(list=ls())

cifar10 <-dataset_cifar10()
b <- dataset_cifar100()

c <- dataset_fashion_mnist()

str(c)

str(cifar10)


################################################################################
context("Test wrapper function (calcEF)")
################################################################################

 #calcEF==================================================================

#Main
test_that("calcEF EF Baseline works for Main Engines",
          {
            #create Benchmark
            testEFBaseline<-data.table::data.table(
              engineType=c("SSD","MSD","ST","GT","LNG"),
              location=c("OutsideECA","ECA","GreatLakes","ECA","OutsideECA"),
              tier=c("Tier 2","Tier 3","Tier 0","Tier 0","Tier 0")
            )

            testEFBaseline[,hc:=calcEF_HC(engineType = engineType,
                                           main_aux_boiler = "main")
                          ]

            testEFBaseline[,co2:=calcEF_CO2(engineType = engineType,
                                            location = location,
                                            main_aux_boiler = "main")
                          ]

            testEFBaseline[,co:=calcEF_CO(engineType = engineType,
                                          main_aux_boiler = "main")
                          ]

            testEFBaseline[,nox:=calcEF_NOx(engineType = engineType,
                                           location = location,
                                           tier = tier,
                                           main_aux_boiler = "main")
                          ]

            testEFBaseline[,so2:=calcEF_SO2(engineType = engineType,
                                            location = location,
                                            ECAfuelSulfurPercentage = 0.1,
                                            GlobalfuelSulfurPercentage = 0.5,
                                            main_aux_boiler = "main")
                          ]

            testEFBaseline[,pm2.5:=calcEF_PM(engineType = engineType,
                                             location = location,
                                             ECAfuelSulfurPercentage = 0.1,
                                             GlobalfuelSulfurPercentage = 0.5,
                                             pmSize = "pm2.5",
                                             main_aux_boiler = "main"),
                           ]

            testEFBaseline[,pm10:=calcEF_PM(engineType = engineType,
                                             location = location,
                                             ECAfuelSulfurPercentage = 0.1,
                                             GlobalfuelSulfurPercentage = 0.5,
                                             pmSize="pm10",
                                             main_aux_boiler = "main")
                          ]

             #Run Calculation
             calcEF_out<-data.table(
                                      calcEF(engineType = testEFBaseline$engineType,
                                                              location = testEFBaseline$location,
                                                              tier = testEFBaseline$tier,
                                                              pollutants = "ALL",
                                                              loadBasedBSFC = "N",
                                                              output="EF",
                                                              main_aux_boiler = "main")
                                    )

             #Compare output against benchmark
             expect_equal(calcEF_out$hc,
                          testEFBaseline$hc
                         )

             expect_equal(calcEF_out$co2,
                          testEFBaseline$co2
                          )

             expect_equal(calcEF_out$co,
                          testEFBaseline$co
                         )

             expect_equal(calcEF_out$nox,
                         testEFBaseline$nox
                        )

             expect_equal(calcEF_out$pm2.5,
                          testEFBaseline$pm2.5
                         )

             expect_equal(calcEF_out$so2,
                          testEFBaseline$so2
                         )

             expect_equal(calcEF_out$pm10,
                          testEFBaseline$pm10
                         )

          }
         )

test_that("calcEF EF Load Based works for Main Engines",
          {
            #create Benchmark
            testEFLoad<-data.table::data.table(
              engineType=c("SSD","MSD","ST","GT","LNG"),
              location=c("OutsideECA","GreatLakes","ECA","GreatLakes","ECA"),
              tier=c("Tier 1","Tier 3","Tier 0","Tier 0","Tier 0"),
              loadFactor=c(0.284596685,0.521665062,0.766855145,0.078203076,0.708915957249701)
              )

            testEFLoad[,hc:=calcEF_HC(engineType = engineType,
                                       main_aux_boiler = "main")
                      ]

            testEFLoad[,co2:=calcEF_CO2(engineType = engineType,
                                         location = location,
                                         loadFactor = loadFactor,
                                         main_aux_boiler = "main")
                      ]

            testEFLoad[,co:=calcEF_CO(engineType = engineType,
                                       main_aux_boiler = "main")
                      ]

            testEFLoad[,nox:=calcEF_NOx(engineType = engineType,
                                        location = location,
                                        tier = tier,
                                        main_aux_boiler = "main")
                      ]

            testEFLoad[,pm2.5:=calcEF_PM(engineType = engineType,
                                          location = location,
                                          loadFactor = loadFactor,
                                          ECAfuelSulfurPercentage = 0.1,
                                          GlobalfuelSulfurPercentage = 0.5,
                                          pmSize = "pm2.5",
                                          main_aux_boiler = "main")
                      ]

            testEFLoad[,so2:=calcEF_SO2(engineType = engineType,
                                         location = location,
                                         loadFactor = loadFactor,
                                         ECAfuelSulfurPercentage = 0.1,
                                         GlobalfuelSulfurPercentage = 0.5,
                                         main_aux_boiler = "main")
                      ]

            testEFLoad[,pm10:=calcEF_PM(engineType = engineType,
                                         location = location,
                                         loadFactor = loadFactor,
                                         ECAfuelSulfurPercentage = 0.1,
                                         GlobalfuelSulfurPercentage = 0.5,
                                         pmSize = "pm10",
                                         main_aux_boiler = "main")
                      ]

            #Run Calculation
            EF_LLAF_out<-calcEF(engineType = testEFLoad$engineType,
                                      location = testEFLoad$location,
                                      tier = testEFLoad$tier,
                                      loadFactor = testEFLoad$loadFactor,
                                      loadBasedBSFC = "Y",
                                      pollutants = "ALL",
                                      output="EF",
                                      main_aux_boiler = "main")

            #Compare output against benchmark
            expect_equal(EF_LLAF_out$hc,
                         testEFLoad$hc
                         )

            expect_equal(EF_LLAF_out$co2,
                         testEFLoad$co2
                        )

            expect_equal(EF_LLAF_out$co,
                         testEFLoad$co
                        )

            expect_equal(EF_LLAF_out$nox,
                         testEFLoad$nox
                        )

            expect_equal(EF_LLAF_out$pm2.5,
                         testEFLoad$pm2.5
                        )

            expect_equal(EF_LLAF_out$pm10,
                         testEFLoad$pm10
                        )

            expect_equal(EF_LLAF_out$so2,
                         testEFLoad$so2
                        )

            }
           )

test_that("calcEF EF Load range works for Main Engines",
          {
            testEFLoad<-data.table::data.table(
              engineType=c("SSD","MSD","ST","GT","LNG"),
              location=c("OutsideECA","GreatLakes","ECA","GreatLakes","ECA"),
              tier=c("Tier 1","Tier 3","Tier 0","Tier 0","Tier 0"),
              loadFactor=c(0.078203076,0.284596685,0.521665062,0.708915957249701,0.766855145),
              loadRange = "0.0,0.5"
            )

            testEFLoad[,hc:=calcEF_HC(engineType = engineType,
                                       main_aux_boiler = "main")
            ]

            testEFLoad[,#loadFactor>=0.5,
                       co2:=calcEF_CO2(engineType = engineType,
                                         location = location,
                                         main_aux_boiler = "main")
            ]

            testEFLoad[loadFactor<0.5,
                       co2:=calcEF_CO2(engineType = engineType,
                                        location = location,
                                        loadFactor = loadFactor,
                                        main_aux_boiler = "main")
            ]

            testEFLoad[,co:=calcEF_CO(engineType = engineType,
                                       main_aux_boiler = "main")
            ]

            testEFLoad[,nox:=calcEF_NOx(engineType = engineType,
                                         location = location,
                                         tier = tier,
                                         main_aux_boiler = "main")
            ]

            testEFLoad[loadFactor>=0.5
                       ,pm2.5:=calcEF_PM(engineType = engineType,
                                          location = location,
                                          ECAfuelSulfurPercentage = 0.1,
                                          GlobalfuelSulfurPercentage = 0.5,
                                          pmSize = "pm2.5",
                                          main_aux_boiler = "main")
            ]

            testEFLoad[loadFactor<0.5
                       ,pm2.5:=calcEF_PM(engineType = engineType,
                                          location = location,
                                          loadFactor = loadFactor,
                                          ECAfuelSulfurPercentage = 0.1,
                                          GlobalfuelSulfurPercentage = 0.5,
                                          pmSize = "pm2.5",
                                          main_aux_boiler = "main")
            ]

            testEFLoad[loadFactor >= 0.5,
                       so2:=calcEF_SO2(engineType = engineType,
                                         location = location,
                                         ECAfuelSulfurPercentage = 0.1,
                                         GlobalfuelSulfurPercentage = 0.5,
                                         main_aux_boiler = "main")
            ]

            testEFLoad[loadFactor < 0.5
                       ,so2:=calcEF_SO2(engineType = engineType,
                                         location = location,
                                         loadFactor = loadFactor,
                                         ECAfuelSulfurPercentage = 0.1,
                                         GlobalfuelSulfurPercentage = 0.5,
                                         main_aux_boiler = "main")
            ]

            testEFLoad[loadFactor >=0.5
                       ,pm10:=calcEF_PM(engineType = engineType,
                                         location = location,
                                         ECAfuelSulfurPercentage = 0.1,
                                         GlobalfuelSulfurPercentage = 0.5,
                                         pmSize = "pm10",
                                         main_aux_boiler = "main")
            ]

            testEFLoad[loadFactor <0.5,
                       pm10:=calcEF_PM(engineType = engineType,
                                         location = location,
                                         loadFactor = loadFactor,
                                         ECAfuelSulfurPercentage = 0.1,
                                         GlobalfuelSulfurPercentage = 0.5,
                                         pmSize = "pm10",
                                         main_aux_boiler = "main")
            ]

            #Run Calculation
            EF_LLAF_out<-calcEF(engineType = testEFLoad$engineType,
                                      location = testEFLoad$location,
                                      tier = testEFLoad$tier,
                                      loadFactor = testEFLoad$loadFactor,
                                      pollutants = "ALL",
                                      loadBasedBSFC = testEFLoad$loadRange[1],
                                      output="EF",
                                      main_aux_boiler = "main")

            #Compare output against benchmark
            expect_equal(EF_LLAF_out$hc,
                         testEFLoad$hc
            )

            expect_equal(EF_LLAF_out$co2,
                         testEFLoad$co2
            )

            expect_equal(EF_LLAF_out$co,
                         testEFLoad$co
            )

            expect_equal(EF_LLAF_out$nox,
                         testEFLoad$nox
            )

            expect_equal(EF_LLAF_out$pm2.5,
                         testEFLoad$pm2.5
            )

            expect_equal(EF_LLAF_out$pm10,
                         testEFLoad$pm10
            )

            expect_equal(EF_LLAF_out$so2,
                         testEFLoad$so2
            )
          }
        )

test_that("calcEF EF Load LLAF works",
          {
            #create Benchmark
            testEFLoadLLAF<-data.table::data.table(
              engineType=c("SSD", "MSD", "ST", "GT", "LNG"),
              location=c("OutsideECA", "GreatLakes", "ECA", "GreatLakes", "ECA"),
              tier=c("Tier 1","Tier 3","Tier 0","Tier 0","Tier 0"),
              loadFactor=c(0.284596685, 0.521665062, 0.766855145, 0.078203076, 0.708915957249701)
            )

            #The previous tests check the accuracy of the EF and LLAF components,
            #so we just need to make sure they get multiplied at the end for this test
            testEFs<-calcEF(engineType = testEFLoadLLAF$engineType,
                                 location = testEFLoadLLAF$location,
                                 tier = testEFLoadLLAF$tier,
                                 loadFactor = testEFLoadLLAF$loadFactor,
                                 pollutants = "ALL",
                                 output="EF",
                                 main_aux_boiler = "main")

            testLLAFs<-calcLLAF(engineType = testEFLoadLLAF$engineType,
                                location = testEFLoadLLAF$location,
                                loadFactor = testEFLoadLLAF$loadFactor,
                                pollutants = "ALL")

            #Run Calculation
            EF_LLAF_out<-calcEF(engineType = testEFLoadLLAF$engineType,
                                     location = testEFLoadLLAF$location,
                                     tier = testEFLoadLLAF$tier,
                                     loadFactor = testEFLoadLLAF$loadFactor,
                                     pollutants = "ALL",
                                     output="EF_LLAF",
                                     main_aux_boiler = "main")

            #Compare output against benchmark
            expect_equal(EF_LLAF_out$hc,
                         testEFs$hc*testLLAFs$hc,
                         tolerance=1e-07
            )

            expect_equal(EF_LLAF_out$co2,
                         testEFs$co2*testLLAFs$co2,
                         tolerance=1e-07
            )

            expect_equal(EF_LLAF_out$nox,
                         testEFs$nox*testLLAFs$nox,
                         tolerance=1e-07
            )

            expect_equal(EF_LLAF_out$so2,
                         testEFs$so2*testLLAFs$so2,
                         tolerance=1e-07
            )

            expect_equal(EF_LLAF_out$pm2.5,
                         testEFs$pm2.5*testLLAFs$pm2.5,
                         tolerance=1e-07
            )

            expect_equal(EF_LLAF_out$pm10,
                         testEFs$pm10*testLLAFs$pm10,
                         tolerance=1e-07
            )

          }
)

test_that("calcEF EF Load LLAF works with input LLAF table",
          {
            #create Benchmark
            testEFLoadLLAF<-data.table::data.table(
              engineType=c("SSD", "MSD", "ST", "GT", "LNG"),
              location=c("OutsideECA", "GreatLakes", "ECA", "GreatLakes", "ECA"),
              tier=c("Tier 1","Tier 3","Tier 0","Tier 0","Tier 0"),
              loadFactor=c(0.284596685, 0.521665062, 0.766855145, 0.078203076, 0.708915957249701)
            )

            #create LLAF table
            tbl<-data.table(load=c(1:100))

            tbl[,co:=load*2]
            tbl[,pm2.5:=load*2]
            tbl[,nox:=load*2]

            #create a temporary file!!!
            tmpName<-tempfile()

            fwrite(tbl, file = tmpName)

            #The previous tests check the accuracy of the EF and LLAF components,
            #so we just need to make sure they get multiplied at the end for this test
            testEFs<-calcEF(engineType = testEFLoadLLAF$engineType,
                                 location = testEFLoadLLAF$location,
                                 tier = testEFLoadLLAF$tier,
                                 loadFactor = testEFLoadLLAF$loadFactor,
                                 pollutants = c("co","pm2.5","nox"),
                                 output="EF",
                                 main_aux_boiler = "main")

            testLLAFs<-calcLLAF(engineType = testEFLoadLLAF$engineType,
                                loadFactor = testEFLoadLLAF$loadFactor,
                                pollutants = c("co","pm2.5","nox"),
                                inputTableLocation = tmpName)

            #Run Calculation
            EF_LLAF_out<-calcEF(engineType = testEFLoadLLAF$engineType,
                                     location = testEFLoadLLAF$location,
                                     tier = testEFLoadLLAF$tier,
                                     loadFactor = testEFLoadLLAF$loadFactor,
                                     pollutants = c("co","pm2.5","nox"),
                                     output="EF_LLAF",
                                     main_aux_boiler = "main",
                                     inputTableLocation = tmpName)

            file.remove(tmpName)

            #Compare output against benchmark

            expect_equal(EF_LLAF_out$nox,
                         testEFs$nox*testLLAFs$nox,
                         tolerance=1e-07
            )

            expect_equal(EF_LLAF_out$co,
                         testEFs$co*testLLAFs$co,
                         tolerance=1e-07
            )

            expect_equal(EF_LLAF_out$pm2.5,
                         testEFs$pm2.5*testLLAFs$pm2.5,
                         tolerance=1e-07
            )

          }
)

#Aux
test_that("calcEF EF Baseline works for Aux Engines",
          {
            #create Benchmark
            testEFAux<-data.table::data.table(
              engineType=c("SSD","MSD","ST","GT","LNG"),
              location=c("OutsideECA","ECA","GreatLakes","ECA","OutsideECA"),
              tier=c("Tier 2","Tier 3","Tier 0","Tier 0","Tier 0")
            )

            testEFAux[,hc:=calcEF_HC(engineType = engineType,
                                           main_aux_boiler = "aux")
            ]

            testEFAux[,co2:=calcEF_CO2(engineType = engineType,
                                             location = location,
                                             main_aux_boiler = "aux")
            ]

            testEFAux[,co:=calcEF_CO(engineType = engineType,
                                           main_aux_boiler = "aux")
            ]

            testEFAux[,nox:=calcEF_NOx(engineType = engineType,
                                             location = location,
                                             tier = tier,
                                             main_aux_boiler = "aux")
            ]

            testEFAux[,so2:=calcEF_SO2(engineType = engineType,
                                             location = location,
                                             ECAfuelSulfurPercentage = 0.1,
                                             GlobalfuelSulfurPercentage = 0.5,
                                             main_aux_boiler = "aux")
            ]

            testEFAux[,pm2.5:=calcEF_PM(engineType = engineType,
                                              location = location,
                                              ECAfuelSulfurPercentage = 0.1,
                                              GlobalfuelSulfurPercentage = 0.5,
                                              pmSize = "pm2.5",
                                              main_aux_boiler = "aux"),
            ]

            testEFAux[,pm10:=calcEF_PM(engineType = engineType,
                                             location = location,
                                             ECAfuelSulfurPercentage = 0.1,
                                             GlobalfuelSulfurPercentage = 0.5,
                                             pmSize="pm10",
                                             main_aux_boiler = "aux")
            ]

            #Run Calculation
            calcEF_out<-data.table(
              calcEF(engineType = testEFAux$engineType,
                           location = testEFAux$location,
                           tier = testEFAux$tier,
                           pollutants = "ALL",
                           loadBasedBSFC = "N",
                           output="EF",
                           main_aux_boiler = "aux")
            )

            #Compare output against benchmark
            expect_equal(calcEF_out$hc,
                         testEFAux$hc
            )

            expect_equal(calcEF_out$co2,
                         testEFAux$co2
            )

            expect_equal(calcEF_out$co,
                         testEFAux$co
            )

            expect_equal(calcEF_out$nox,
                         testEFAux$nox
            )

            expect_equal(calcEF_out$pm2.5,
                         testEFAux$pm2.5
            )

            expect_equal(calcEF_out$so2,
                         testEFAux$so2
            )

            expect_equal(calcEF_out$pm10,
                         testEFAux$pm10
            )

          }
)

#Boiler
test_that("calcEF EF Baseline works for Aux Engines",
          {
            #create Benchmark
            testEFBoiler<-data.table::data.table(
              engineType=c("SSD","MSD","ST","GT","LNG"),
              location=c("OutsideECA","ECA","GreatLakes","ECA","OutsideECA"),
              tier=c("Tier 2","Tier 3","Tier 0","Tier 0","Tier 0")
            )

            testEFBoiler[,hc:=calcEF_HC(engineType = engineType,
                                      main_aux_boiler = "boiler")
            ]

            testEFBoiler[,co2:=calcEF_CO2(engineType = engineType,
                                        location = location,
                                        main_aux_boiler = "boiler")
            ]

            testEFBoiler[,co:=calcEF_CO(engineType = engineType,
                                      main_aux_boiler = "boiler")
            ]

            testEFBoiler[,nox:=calcEF_NOx(engineType = engineType,
                                        location = location,
                                        tier = tier,
                                        main_aux_boiler = "boiler")
            ]

            testEFBoiler[,so2:=calcEF_SO2(engineType = engineType,
                                        location = location,
                                        ECAfuelSulfurPercentage = 0.1,
                                        GlobalfuelSulfurPercentage = 0.5,
                                        main_aux_boiler = "boiler")
            ]

            testEFBoiler[,pm2.5:=calcEF_PM(engineType = engineType,
                                         location = location,
                                         ECAfuelSulfurPercentage = 0.1,
                                         GlobalfuelSulfurPercentage = 0.5,
                                         pmSize = "pm2.5",
                                         main_aux_boiler = "boiler"),
            ]

            testEFBoiler[,pm10:=calcEF_PM(engineType = engineType,
                                        location = location,
                                        ECAfuelSulfurPercentage = 0.1,
                                        GlobalfuelSulfurPercentage = 0.5,
                                        pmSize="pm10",
                                        main_aux_boiler = "boiler")
            ]

            #Run Calculation
            calcEF_out<-data.table(
              calcEF(engineType = testEFBoiler$engineType,
                           location = testEFBoiler$location,
                           tier = testEFBoiler$tier,
                           pollutants = "ALL",
                           loadBasedBSFC = "N",
                           output="EF",
                           main_aux_boiler = "boiler")
            )

            #Compare output against benchmark
            expect_equal(calcEF_out$hc,
                         testEFBoiler$hc
            )

            expect_equal(calcEF_out$co2,
                         testEFBoiler$co2
            )

            expect_equal(calcEF_out$co,
                         testEFBoiler$co
            )

            expect_equal(calcEF_out$nox,
                         testEFBoiler$nox
            )

            expect_equal(calcEF_out$pm2.5,
                         testEFBoiler$pm2.5
            )

            expect_equal(calcEF_out$so2,
                         testEFBoiler$so2
            )

            expect_equal(calcEF_out$pm10,
                         testEFBoiler$pm10
            )

          }
)


system("cat sandbox/small_run.r")

source('mapping/epimap.r')
source('sandbox/limit_data.r')

opt = Rmap_options(
    stage = "full",
    region_id = 1,
    first_day_modelled = "2020-08-26",
    last_day_modelled = "2020-12-08",
    spatialkernel = "none",
    temporalkernel = "matern12",
    globalkernel = "none",
    localkernel = "local",
    days_ignored=NULL,
    days_per_step = 7,
    num_steps_forecasted = 3,
    iterations=3000,
    fixed_gp_time_length_scale = -1,
    fixed_gp_space_length_scale = -1,
    clean_directory='fits/clean-1215',
    results_directory='fits/test-weekly-northeast-newrt-local'
)

env = Rmap_setup(opt)
#limit_data_multi(env,list(
  #list(area='Oxford',distance=.6),
  #list(area='Birmingham',distance=.6)
#  list(area='Westminster',distance=.8)
#))
#limit_data_by_distance(env,'Oxford',0.6)
# timing:
# Oxford .8 -> 64 areas, ~ 10 hours
# Oxford .6 -> 26 areas, 2.8 hours
# Oxford .4 -> 8 areas, ~ .5 hours (removed local effects)
# Oxford .3 Birmingham .3 -> 21 areas, ~2.3 hours
# Oxford .5 Birmingham .5 -> 43 areas, ~ hours
# Oxford .6 Birmingham .6 -> 58 areas, ~ 9.2 hours

print(env$N)
print(env$areas[env$modelled_region[,1]==1])

Rmap_run(env)
Rmap_postprocess(env)

# Rmap_merge(env,c(1,2,3))


# Data Wrangling in R
# Social Security Disability Case Study

# Load the tidyverse
library(tidyverse)
library(lubridate)
library(stringr)

# Read in the coal dataset
ssa <- read_csv("http://594442.youcanlearnit.net/ssadisability.csv")

# Take a look at how this was imported
glimpse(ssa)


library(ggplot2)
theme_set(theme_bw(18))
setwd("~/cogsci/projects/stanford/projects/sinking_marbles/sinking-marbles/experiments/14_sinking-marbles-wonky/results/")
source("rscripts/helpers.r")

load("data/r.RData")
r = read.table("data/sinking_marbles.csv", sep=",", header=T)
r$trial = r$slide_number_in_experiment - 2
nrow(r)
head(r)
r = r[,c("workerid", "rt", "effect", "cause","language","gender.1","age","gender","other_gender","quantifier", "object_level", "response", "object","num_objects","trial","enjoyment","asses","comments","strangedescription")]

## add priors to data.frame
# load prior dataset
expectations = read.table("~/cogsci/projects/stanford/projects/sinking_marbles/sinking-marbles/experiments/12_sinking-marbles-prior15/results/data/expectations.txt", quote="",sep="\t",header=T)
row.names(expectations) = paste(expectations$effect, expectations$object)
head(expectations)
nrow(expectations)

r$PriorExpectation = expectations[paste(r$effect, r$object),]$expectation
r$Half = as.factor(ifelse(r$trial < 16, 1, 2))
r$Quarter = as.factor(ifelse(r$trial < 8, 1, ifelse(r$trial < 16, 2, ifelse(r$trial < 24, 3, 4))))
summary(r)
r$Item = as.factor(paste(r$object,r$effect))
table(r$Item)

save(r, file="data/r.RData")

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

ggplot(aes(x=gender.1), data=r) +
  geom_histogram()

ggplot(aes(x=rt), data=r) +
  geom_histogram() +
  scale_x_continuous(limits=c(0,20000))

ggplot(aes(x=age), data=r) +
  geom_histogram()

ggplot(aes(x=enjoyment), data=r) +
  geom_histogram()

ggplot(aes(x=asses), data=r) +
  geom_histogram()

ggplot(aes(x=quantifier), data=r) +
  geom_histogram()

head(r$comments)
unique(r$comments)


GuessANumber <- function( low, high ) {
  print( sprintf("Guess a number between %d and %d until you get it right", low, high ) );
  X <- low:high;
  number <- sample( X, 1 );
  repeat {
    input <- as.numeric(readline());
    if (input > number) {
      print("Too high, try again"); }
    else if (input < number) {
      print("Too low, try again");}
    else {
      print("Correct!");
      break; }
  }
}


cm <- unit(1, "cm")
cm2 <- unit(2, "cm")
cm5 <- unit(5, "cm")

null <- unit(1, "null")


suppressMessages(library(fmlref))

m = 3
n = 2
x = refmat(m, n)
x$fill_linspace(1, m*n)
xr = x$to_robj()

y = refmat(m, n)
y$fill_eye()
yr = y$to_robj()

source("internals/common.r")
source("internals/linalg.r")


#'@title Build a univariate time series of raw data from a specified table and column
#'
#'@description Build a univariate time series object from a specified table a column
#'
#'@usage
#'
#'@param connectionDetails  An R object of type\cr\code{connectionDetails} created using the
#'                                     function \code{createConnectionDetails} in the
#'                                     \code{DatabaseConnector} package.
#'@param dbSchema A fully qualified CDM or Results schema name.
#'@param tableName A  valid table name.
#'@param dateColumnName A valid date column in the specified table.
#'@param startDate A string date in the "YYYY-MM-DD" format
#'@param endDate A string date in the "YYYY-MM-DD" format
#'@param dataColumnName The column in the specified table to count.
#'@param frequency A string indicating the number of observations per unit of time in the time series.
#'                 Acceptable values are "day","week","month","quarter", and "year".
#'
#'@return A univariate time series object
#'
#'@export

getRawTs <- function(
	connectionDetails,
	dbSchema,
	tableName,
	dateColumnName,
	startDate,
	endDate,
	dataColumnName,
	frequency)
{

	query <- "
		select @date_column_name as start_date, sum(@data_column_name) as raw_value
		  from @db_schema.@table_name
		 where @date_column_name >= '@start_date' and @date_column_name <= '@end_date'
		 group by @date_column_name
		 order by @date_column_name;"

	query <- SqlRender::render(
		sql              = query,
		date_column_name = dateColumnName,
		data_column_name = dataColumnName,
		db_schema        = dbSchema,
		table_name       = tableName,
		start_date       = startDate,
		end_date         = endDate)

	query <- SqlRender::translate(query, targetDialect = connectionDetails$dbms)

	conn <- DatabaseConnector::connect(connectionDetails)

	resultSetData <- DatabaseConnector::querySql(conn,query)

    if (nrow(resultSetData) == 0) stop ("Cannot create time series from an empty data frame")

	freqString <- tolower(frequency)

	# Find the correct starting point for the first element in the time series
	# to form the c(startYear,startPos) vector given to the "start" argument of the time series

	startYear <- as.integer(strftime(resultSetData$START_DATE[1], format = "%Y"))

    if (freqString == "day") {
		freqNum  <- 365
		startPos <- as.integer(strftime(resultSetData$START_DATE[1], format = "%j"))
	} else if (freqString ==  "week") {
		freqNum  <- 52
		startPos <- as.integer(strftime(resultSetData$START_DATE[1], format = "%W"))
	} else if (freqString ==  "month") {
		freqNum  <- 12
		startPos <- as.integer(strftime(resultSetData$START_DATE[1], format = "%m"))
	} else if (freqString ==  "quarter") {
		freqNum  <- 4
		startPos <- ceiling(as.integer(strftime(resultSetData$START_DATE[1], format = "%m"))/12)
	} else if (freqString ==  "year") {
		freqNum  <- 1
		startPos <- 1
	} else {
		stop("Invalid frequency string: Acceptable values are \"day\", \"week\", \"month\", \"quarter\", and \"year\"")
	}

    # Create a vector of dense dates to capture all dates between the start and end of the time series
    lastRow <- nrow(resultSetData)

    denseDates <- seq.Date(
	                from = as.Date(resultSetData$START_DATE[1],"%Y-%m-%d"),
	                to   = as.Date(resultSetData$START_DATE[lastRow],"%Y-%m-%d"),
	                by   = freqString
	             )

    # Find gaps, if any, in data (e.g., dates that have no data, give that date a 0 value)
    denseDatesDf <- data.frame(START_DATE=denseDates, SUM_VALUE=rep(0,length(denseDates)))

    joinResults <- dplyr::left_join(denseDatesDf,resultSetData,by=c("START_DATE" = "START_DATE"))

    joinResults$RAW_VALUE[which(is.na(joinResults$RAW_VALUE))] <- 0

    # Now that we no longer have sparse dates, keep only necessary columns and build the time series
    joinResults <- joinResults[,c("START_DATE","RAW_VALUE")]

    resultSetDataTs <- ts(
	  data      = joinResults$RAW_VALUE,
	  start     = c(startYear,startPos),
	  frequency = freqNum
    )

	on.exit(DatabaseConnector::disconnect(conn))

    return (resultSetDataTs)

}