library(MASS)

cab <- 0.29
a <- 0.35
b <- 0.45
ca_a <- 0.72

ca_ac <- 0
ca_bc <- 0

# ca_a = (ca * a_ca)/a
# Sappiamo che:

a_ca <- 1
b_cb <- 1

# allora:

ca <- (ca_a*a)/a_ca

# Sappiamo anche che:
# cab = union(ca,cb) = ca + cb - intsersect(ca,cb)
# cab <- ca + cb - ca*cb
# cab <- ca + cb(1- ca)

cb <- (cab - ca)/(1-ca)

cb_b <- cb/b

print(fractions(cb_b))
print(fractions(cb))

cb_intersect_cac <- cb*(1-ca)

print(fractions(cb_intersect_cac))

cab_ca <- 1

# ca_cab <- (cab_ca*ca)/cab
ca_cab <- ca/cab

print(fractions(ca_cab))


# Plot errors spatially or output spatial error files

library(raster)
source("pixel-based/utils/RFTrain.r")
source("pixel-based/utils/load-sampling-data.r")
source("pixel-based/utils/covariate-names.r")
source("pixel-based/utils/crossvalidation.r")

Data.val = LoadValidationAndCovariates()
Data.val[is.na(Data.val)] = -9999
Val.sp = Data.val
Data.val = st_set_geometry(Data.val, NULL)
Data.val = TidyData(Data.val, drop.cols=NULL) # Drops around 1050
Val.sp = Val.sp[rownames(Data.val),]

Classes = GetCommonClassNames()
Truth = Data.val[,Classes]

# Points
RFSingle = RFTrain("../data/pixel-based/predictions/", "randomforest-onestep-allcovars-validation.csv", InflationAdjustment = 0)
RF3step = RFTrain3("../data/pixel-based/predictions/", "randomforest-threestep-median.csv", PredictType="quantiles")

# 1-step model

plot(Val.sp["shrub"])
PR.sp = st_set_geometry(RFSingle, Val.sp[["geometry"]])
plot(PR.sp["shrub"])

# Errors
RFSingleErr = RFSingle - Data.val[,Classes]
Err.sp = st_set_geometry(RFSingleErr, Val.sp[["geometry"]])
plot(Err.sp["shrub"])
AbsErr.sp = Err.sp
AbsErr.sp = abs(st_set_geometry(AbsErr.sp, NULL))
AbsErr.sp = st_set_geometry(AbsErr.sp, Err.sp[["geometry"]])
plot(AbsErr.sp["shrub"])
st_write(AbsErr.sp, "../output/2020-04-28-rf1-AE.gpkg")

EClusters = st_read("../data/pixel-based/biomes/ProbaV_UTM_LC100_biome_clusters_V3_global.gpkg")
MAE.sp = aggregate(AbsErr.sp, EClusters["bc_id"], mean)
plot(MAE.sp)
st_write(MAE.sp, "../output/2020-04-28-rf1-EC-MAE.gpkg")

# Raster
AbsErr.ras = SfToRaster(AbsErr.sp, 1, 1, fun=mean)
plot(AbsErr.ras)

writeRaster(AbsErr.ras[[-1]], "../output/rf1st-abserr-1deg-mean.tif", datatype="INT1U")

# 3-step model

RF3stepErr = RF3step - Data.val[,Classes]
Err.sp = st_set_geometry(RF3stepErr, Val.sp[["geometry"]])
plot(Err.sp["shrub"])
AbsErr.sp = Err.sp
AbsErr.sp = abs(st_set_geometry(AbsErr.sp, NULL))
AbsErr.sp = st_set_geometry(AbsErr.sp, Err.sp[["geometry"]])
plot(AbsErr.sp["shrub"])
st_write(AbsErr.sp, "../output/2020-10-12-rf3-AE.gpkg")

AbsErr.ras = SfToRaster(AbsErr.sp, 1, 1, fun=mean)
plot(AbsErr.ras)

writeRaster(AbsErr.ras[[-1]], "../output/rf3st-abserr-1deg-mean.tif", datatype="INT1U")

AbsErrOverall = apply(st_set_geometry(AbsErr.sp, NULL), 1, mean)
AbsErrOverall = st_set_geometry(data.frame(Overall = AbsErrOverall), AbsErr.sp$geometry)
st_write(AbsErrOverall, "../output/2020-10-12-rf3-AE-overall.gpkg")
AbsErrOverall.ras = SfToRaster(AbsErrOverall, 1, 1, fun=mean, layers="Overall")
writeRaster(AbsErrOverall.ras[[-1]], "../output/rf3st-abserr-1deg-mean-overall.tif", datatype="INT1U")


## Error analysis

setwd("~/Desktop/Code/laplace_approximation/Script")
.libPaths("~/Rlib/")
library(rstan)
library(dplyr)
library(tidyr)
library(scales)
library(boot)
library(directlabels)
library(latex2exp)
source("tools/errorTools.r")
source("tools/analysisTools.r")

################################################################
## Analysis of the disease map
modelName <- "disease_map"
fit_standard <- readRDS(file = file.path("deliv", modelName,
                        paste0(modelName, "Fit.Rsave")))

fit_benchmark <- readRDS(file = file.path("deliv", modelName,
                         paste0(modelName, "100long_Fit.Rsave")))

modelName <- "disease_map_ela"
fit_laplace <- readRDS(file = file.path("deliv", modelName,
                       paste0(modelName, "Fit.Rsave")))

pars <- c("alpha", "rho", "theta[1]", "theta[2]")

# it's worth examining the trace plots
traceplot(fit_standard, pars = pars)
traceplot(fit_laplace, pars = pars)

# Compare the Monte Carlo estimates
summary_standard <- summary(fit_standard, pars = pars)[[1]]
summary_benchmark <- summary(fit_benchmark, pars = pars)[[1]]
summary_laplace <- summary(fit_laplace, pars = pars)[[1]]

# plot Monte Carlo estimate with error
mcse_plot(summary_standard, summary_laplace, summary_benchmark, pars)

# Plot error
iter <- seq(from = 1, to = 500, by = 1)
nChains <- 4
samples_standard <- rstan::extract(fit_standard, pars, permuted = FALSE)  # [, 1, ]
samples_benchmark <- rstan::extract(fit_benchmark, pars, permuted = FALSE)
samples_laplace <- rstan::extract(fit_laplace, pars, permuted = FALSE)  # [, 1, ]

benchmark <- rep(NA, length(pars))
for (i in 1:length(pars)) benchmark[i] <-
  mean(samples_benchmark[, , i])

error_plot(samples_standard, samples_laplace, benchmark,
           pars = pars, one_chain = F, average_chain = T) +
  scale_y_continuous(trans = "log")

# Plot the error as a function of time.
# The time for each iteration is the mean warmup time,
# plus the estimated time to produce n samples,
# based on the mean total sampling time.
include_warmup <- F
time_standard <- iteration_time(fit_standard, iter, include_warmup)
time_laplace <- iteration_time(fit_laplace, iter, include_warmup)

error_plot(samples_standard, samples_laplace, benchmark,
           pars = pars, plot_time = T,
           time_standard = time_standard,
           time_laplace = time_laplace,
           one_chain = F, average_chain = T) +
  # scale_x_continuous(trans = "log") +
  scale_y_continuous(trans = "log")

#####################################################################
## Analysis for SKIM model

modelName <- "skim_logit"
fit_standard <- readRDS(file = file.path("deliv", modelName, "cluster",
                                         paste0(modelName, "Fit.Rsave")))
benchmarks <- 1:6
fit_benchmark <- list()
for (i in benchmarks) {
  fit_benchmark[[i]] <- readRDS(file = file.path("deliv", modelName,
                                paste0(modelName, "long_", benchmarks[i],
                                       "_Fit.Rsave")))
}
fit_benchmark <- sflist2stanfit(fit_benchmark)

modelName <- "skim_logit_ela"
fit_laplace <- readRDS(file = file.path("deliv", modelName, "cluster",
                                        paste0(modelName, "Fit.Rsave")))

pars <- c("caux", "lambda[81]", "lambda[86]", "tau", "xi")
# pars <- c("lambda[81]")
summary_standard <- summary(fit_standard, pars = pars)[[1]]
summary_benchmark <- summary(fit_benchmark, pars = pars)[[1]]
summary_laplace <- summary(fit_laplace, pars = pars)[[1]]

# plot Monte Carlo estimate with error
mcse_plot(summary_standard, summary_laplace, summary_benchmark, pars) +
  scale_y_continuous(trans = "log")

## Plot error
# TEST -- see if the plots are more interpretable with one chain
iter <- seq(from = 1, to = 2000, by = 1)
nChains <- 6  # 6
samples_standard <- rstan::extract(fit_standard, pars, permuted = FALSE)
samples_benchmark <- rstan::extract(fit_benchmark, pars, permuted = FALSE)
samples_laplace <- rstan::extract(fit_laplace, pars, permuted = FALSE)

log_parm <- T
benchmark <- rep(NA, length(pars))

if (!log_parm) {
  for (i in 1:length(pars)) benchmark[i] <- mean(samples_benchmark[, , i])
} else {
  for (i in 1:length(pars)) benchmark[i] <-
                                     mean(log(samples_benchmark[, , i]))
}

error_plot(samples_standard, samples_laplace, benchmark,
           pars = pars, one_chain = F, average_chain = T,
           log_parm = log_parm, f = c(mean)) +
  scale_y_log10(breaks = trans_breaks("log10", function(x) 10^x),
                labels = trans_format("log10", math_format(10^.x))) +
  scale_x_log10(breaks = trans_breaks("log10", function(x) 10^x),
                labels = trans_format("log10", math_format(10^.x))) +
  annotation_logticks(sides="lr")

# Plot for Neurips
# first create benchmark for plots
quantile_90 <- function(x) { quantile(x, probs = 0.9) }
benchmark <- c(mean(log(samples_benchmark[, , 1])),
               quantile_90(log(samples_benchmark[, , 2])),
               quantile_90(log(samples_benchmark[, , 3])),
               mean(log(samples_benchmark[, , 4])),
               mean(log(samples_benchmark[, , 5])))

include_warmup <- F
time_standard <- iteration_time(fit_standard, iter, include_warmup)
time_laplace <- iteration_time(fit_laplace, iter, include_warmup)
f <- c(mean, quantile_90, quantile_90, mean, mean)

parm_label <- c(TeX("$E( \\log \ c_{aux})$"),
                TeX("$Q_{90}( \\log \\lambda_{2516})$"),
                TeX("$Q_{90}( \\log \\lambda_{2586})$"),
                TeX("$E( \\log \\tau)$"),
                TeX("$E( \\log \\chi)$"))

error_plot(samples_standard, samples_laplace, benchmark,
           pars = pars, one_chain = F, average_chain = T,
           log_parm = T, f = f, plot_time = T,
           time_laplace = time_laplace,
           time_standard = time_standard,
           parm_label = parm_label) +
  theme(legend.position = "none", text = element_text(size = 25)) +
  scale_y_log10(breaks = trans_breaks("log10", function(x) 10^floor(x)),
                labels = trans_format("log10", math_format(10^.x))) +
  scale_x_log10(breaks = trans_breaks("log10", function(x) 10^floor(x)),
                labels = trans_format("log10", math_format(10^.x))) +
  annotation_logticks(sides="l")

# Check which covariates are softly selected (i.e. inspect 90th quantile)
pars <- c("lambda")
log_lambda <- log(rbind(rstan::extract(fit_benchmark, pars)$lambda))
select_lambda(log_lambda, quant = 0.9, n_select = 6)
# 86 160 179  81 120 151

log_lambda <- log(rbind(rstan::extract(fit_standard, pars)$lambda))
select_lambda(log_lambda, quant = 0.9, n_select = 6)
# 86 160 179  81 120 151

log_lambda <- log(rbind(rstan::extract(fit_laplace, pars)$lambda))
select_lambda(log_lambda, quant = 0.9, n_select = 6)
# 86 179 160  81 120  48

# Examine some of the high scoring lambdas.
pars <- c("lambda[86]", "lambda[160]", "lambda[179]", "lambda[81]")

# First compute the 90th quantile of log lambda
samples_benchmark <- rstan::extract(fit_laplace, pars)
quantile_90_log <- function(x) { quantile(log(x), probs = 0.9) }
benchmark <- lapply(samples_benchmark, quantile_90_log)
benchmark <- unlist(benchmark, use.names = F)

quantile_90 <- function(x) { quantile(x, probs = 0.9) }

samples_standard <- rstan::extract(fit_standard, pars, permuted = F)
samples_laplace <- rstan::extract(fit_laplace, pars, permuted = F)

parm_label <- c(TeX("$\\c_mathrm{aux}"),
                TeX("$\\rho$"),
                TeX("$\\theta_1$"),
                TeX("$\\theta_2$"))

error_plot(samples_standard, samples_laplace, benchmark,
           pars = pars, one_chain = F, average_chain = T,
           log_parm = log_parm, f = quantile_90) +
  scale_y_log10(breaks = trans_breaks("log10", function(x) 10^x),
                labels = trans_format("log10", math_format(10^.x))) +
  scale_x_log10(breaks = trans_breaks("log10", function(x) 10^x),
                labels = trans_format("log10", math_format(10^.x))) +
  annotation_logticks(sides="lr")

# Next, examine the probability that log lambda is greater than
# a certain threshold
threshold <- 2.5
prob_threshold_log <- function(x) { sum(log(x) > threshold) / length(x) }
benchmark <- lapply(samples_benchmark, prob_threshold_log)
benchmark <- unlist(benchmark, use.names = F)

prob_threshold <- function(x) { sum(x > threshold) / length(x) }

error_plot(samples_standard, samples_laplace, benchmark,
           pars = pars, one_chain = F, average_chain = T,
           log_parm = log_parm, f = prob_threshold) +
  scale_y_log10(breaks = trans_breaks("log10", function(x) 10^x),
                labels = trans_format("log10", math_format(10^.x))) +
  scale_x_log10(breaks = trans_breaks("log10", function(x) 10^x),
                labels = trans_format("log10", math_format(10^.x))) +
  annotation_logticks(sides="lr")

#####################################################################
## Analysis for horseshoe regression
modelName <- "bernoulli_logit_glm_rhs"

fit_standard <- list()
fit_standard[[1]] <- readRDS(file = file.path("deliv", modelName, "cluster",
                             paste0(modelName, "_1_to_4Fit.Rsave")))
fit_standard[[2]] <- readRDS(file = file.path("deliv", modelName, "cluster",
                             paste0(modelName, "_5_to_6Fit.Rsave")))
fit_standard <- sflist2stanfit(fit_standard)

modelName <- "bernoulli_logit_glm_ela"
fit_laplace <- readRDS(file = file.path("deliv", modelName, "cluster",
                       paste0(modelName, "Fit.Rsave")))

pars <- c("tau", "lambda[1816]", "lambda[2586]", "caux")
summary_standard <- summary(fit_standard, pars = pars)[[1]]
summary_laplace <- summary(fit_laplace, pars = pars)[[1]]

# for the benchmark, read in the summary file generated by cmdstan
# Need to skip first and last row
summary_benchmark_full <- read.table("deliv_cmdstan/summary.dat",
                                     skip = 6, nrows = 18108)
summary_benchmark <- summary_benchmark_full[pars, ]

# plot Monte Carlo estimate with error (not for f, since we will
# examine these after applying an inverse logit transformation)
mcse_plot(summary_standard, summary_laplace, summary_benchmark, pars)

# plot error as a function of iterations
iter <- seq(from = 1, to = 2000, by = 1)
nChains <- 6

# WARNING -- make sure the order of parameters are consistent between
# samples and saved benchmarks!!
# pars <- c("tau", "caux", "lambda[2586]", "lambda[1816]")
pars <- c("tau", "caux", "lambda[1816]", "lambda[2586]")
samples_standard <- rstan::extract(fit_standard, pars = pars, permuted = FALSE)
samples_laplace <- rstan::extract(fit_laplace, pars = pars, permuted = FALSE)

# for testing purposes
logs_laplace <- log(samples_laplace)
logs_standard <- log(samples_standard)

log_parm = T

# Let's first start by analyzing the first 4 parameters (as we
# will put these on the log scale).
pars <- pars[1:4]
if (!log_parm) {
  benchmark <- summary_benchmark[, 1]
} else {
  nChains_benchmark <- 8
  mean_log <- array(NA, c(nChains_benchmark, length(pars)))
  fileName <- "bernoulli_logit_glm_rhs.logmean"
  for (i in 1:nChains_benchmark) {
    table <- read.csv(file = paste0("deliv_cmdstan/",
                      fileName, ".", i, ".csv"))
    # TODO -- find a slicker way to do the next operation.
    # mean_log[i, ] <- c(table[[2]])
    elements <- c(table[[2]])
    for (k in 2:length(pars)) elements <- c(elements,
                                         table[[k + 1]])

    mean_log[i, ] <- elements
  }

  benchmark <- colMeans(mean_log)
}

error_plot(samples_standard, samples_laplace, benchmark,
           pars, one_chain = F, average_chain = T,
           log_parm = log_parm, f = c(mean)) +
  scale_y_log10(breaks = trans_breaks("log10", function(x) 10^x),
                labels = trans_format("log10", math_format(10^.x))) +
  scale_x_log10(breaks = trans_breaks("log10", function(x) 10^x),
                labels = trans_format("log10", math_format(10^.x)))

# (For Neurips paper), let's examine the error for expectation value
# of caux and tau, and 90th quantile of lambda[1816] and lambda[2586].
# do the same analysis with quantiles.
modelName <- "bernoulli_logit_glm_rhs"
file <- file.path("deliv_cmdstan", paste0(modelName, ".90quantile.csv"))
benchmark_quantile <- read.csv(file = file)
benchmark_quantile <- unname(benchmark_quantile[, 2])

# Recall pars = (tau, caux, lambda[1816], lambda[2586])
benchmark <- c(benchmark[1], benchmark[2], benchmark_quantile[2],
               benchmark_quantile[1])

# benchmark <- c(benchmark[1], benchmark_quantile[2],
#                benchmark_quantile[1], benchmark[4])

quantile_90 <- function(x) { quantile(x, probs = 0.9) }
f <- c(mean, mean, quantile_90, quantile_90)

include_warmup <- F
time_standard <- iteration_time(fit_standard, iter, include_warmup)
time_laplace <- iteration_time(fit_laplace, iter, include_warmup)

parm_label <- c(TeX("$E( \\log \ c_{aux})$"),
                TeX("$Q_{90}( \\log \\lambda_{1816})$"),
                TeX("$Q_{90}( \\log \\lambda_{2586})$"),
                TeX("$E( \\log \\tau)$"))

error_plot(samples_standard, samples_laplace, benchmark,
           pars, one_chain = F, average_chain = T,
           log_parm = T, f = f, plot_time = T,
           time_standard = time_standard,
           time_laplace = time_laplace) + #,
           # parm_label = parm_label) +
  theme(legend.position = "none", text = element_text(size = 25)) +
  scale_y_log10(breaks = trans_breaks("log10", function(x) 10^floor(x)),
                labels = trans_format("log10", math_format(10^.x))) +
  scale_x_log10(breaks = trans_breaks("log10", function(x) 10^x),
                labels = trans_format("log10", math_format(10^.x))) +
  xlab("time (s)") + ylab("squared error")

# Let's examine the probability for the first two patients
pars <- c("f[1]", "f[2]", "f[99]", "f[100]")
samples_standard <- rstan::extract(fit_standard, pars = pars, permuted = FALSE)
samples_standard <- inv.logit(samples_standard)
samples_laplace <- rstan::extract(fit_laplace, pars = pars, permuted = FALSE)
samples_laplace <- inv.logit(samples_laplace)

# read in expected value for probability
nChains_benchmark <- 8
mean_prob <- array(NA, c(length(pars), nChains_benchmark))
for (i in 1:nChains_benchmark) {
  chain_prob <- read.csv(paste0("deliv_cmdstan/", fileName, ".", i, ".csv"))
  mean_prob[, i] <- c(chain_prob$`f.1.`, chain_prob$`f.2.`,
                      chain_prob$`f.99.`, chain_prob$`f.100.`)
}
benchmark <- rowMeans(mean_prob)

benchmark
# 0.2024666 0.3154635 0.8985348 0.9599858

c(mean(samples_standard[, , 1]), mean(samples_standard[, , 2]),
  mean(samples_standard[, , 3]), mean(samples_standard[, , 4]))
# 0.2077414 0.3144079 0.8952827 0.9577220

c(mean(samples_laplace[, , 1]), mean(samples_laplace[, , 2]),
  mean(samples_laplace[, , 3]), mean(samples_laplace[, , 4]))
# 0.2588491 0.2721569 0.8141369 0.8930643

error_plot(samples_standard, samples_laplace, benchmark,
           pars = pars, one_chain = F, average_chain = T,
           log_parm = F, f = mean) +
  scale_y_continuous(trans = "log")

##
# Let's take a closer look at the lambdas
pars <- c("lambda[2586]", "lambda[1816]", "lambda[4960]",
          "lambda[4238]", "lambda[4843]", "lambda[3381]",
          "lambda[4647]")

# Read in benchmark for probability of exceeding threshold
# (the prob is computed for each chain, it suffices to
# average out the quantities).
modelName <- "bernoulli_logit_glm_rhs"
file <- file.path("deliv_cmdstan", paste0(modelName, ".prob"))

benchmark <- read.csv(file = paste0(file, "1.csv"))
benchmark <- as.numeric(unname(benchmark[, -1]))

# prob_threshold is defined above
samples_standard <- rstan::extract(fit_standard, pars = pars, permuted = FALSE)
samples_laplace <- rstan::extract(fit_laplace, pars = pars, permuted = FALSE)

prob_threshold_ <- function(x) { prob_threshold(x, threshold)}
error_plot(samples_standard, samples_laplace, benchmark,
           pars = pars, one_chain = F, average_chain = T,
           log_parm = log_parm, f = prob_threshold_) +
  scale_y_continuous(trans = "log")

# do the same analysis with quantiles.
file <- file.path("deliv_cmdstan", paste0(modelName, ".90quantile.csv"))
benchmark <- read.csv(file = file)
benchmark <- unname(benchmark[, 2])

error_plot(samples_standard, samples_laplace, benchmark,
           pars = pars, one_chain = F, average_chain = T,
           log_parm = log_parm, f = quantile_90) +
  scale_y_continuous(trans = "log")


x <- as.double(readline(prompt = "Enter x:"))
m <- as.double(readline(prompt = "Enter mean:"))
s <- as.double(readline(prompt = "Enter sigma:"))

# compute f(x)
first_part = 1 / (s * sqrt(2 * pi))
power_part = - (x - m) ^ 2 / 2 * s ^ 2

f_x = first_part * exp(power_part)

print('f(x) is')
print(f_x)


#' wbgt_stull
#'
#' Calculate wet bulb globe temperature index for outdoor environements
#' by using Stull formulation by using air temperature in degC ,relative humidity ,
#' globometric temperature in degC and air pressure in hPa.
#'
#
#' @param t numeric Air temperature in degC.
#' @param rh numeric Relative humidity in percentage.
#' @param tg numeric Solar Radiation Radiance in Watt/mq.
#' @param pair numeric Air Pressure in hPa. Default is 1010.
#' @return wbgt  in degC
#'
#'
#' @author Istituto per la Bioeconomia CNR Firenze Italy  Alfonso Crisci \email{alfonso.crisci@@ibe.cnr.it}
#'
#' @export
#'
#'
#'
#'

wbgt_stull=function(t,rh,tg,pair=1010) {
                                       ct$assign("t", as.array(t))
                                       ct$assign("rh", as.array(rh))
                                       ct$assign("tg", as.array(tg))
                                       ct$assign("press", as.array(pair))
                                       ct$eval("var res=[]; for(var i=0, len=t.length; i < len; i++){ res[i]=wbgt_full(t[i],rh[i],tg[i],press[0])};")
                                        res=ct$get("res")
                                       return(ifelse(res==9999,NA,res))
}


G13NAJ Example Program Results

 -- Charge Points --         --- Distribution ---
 Number     Position              Parameters
=================================================
   1           12            0.34            1.00
   2           32            2.57            1.00
   3           49            1.45            1.00
   4           52            -0.48           1.00
   5           70            1.20            1.00
   6           100           -0.23           1.00


# Plots probability density fucntion (PDFs)

setwd("/Users/danielpazmino")
library("ggplot2")

df <- read.csv("VIC_djf_ffdi_bc.csv", header = TRUE)

PDF = ggplot(df, aes(x=TMAX, colour=DATA)) + geom_density(size=3) +
scale_color_brewer(palette = "Set1") +
  xlab("TMAX (degC)") +
  ylab("Density") +
  ggtitle("")

PDF + theme_classic(base_size = 28, base_family = "Helvetica")

ggsave(filename = "VIC_TMAX_bc.eps", dpi = 600)

# To plot with color
#PDF = ggplot(df, aes(x=FFDI, colour=DATA)) + geom_density() +
#scale_color_brewer(palette = "Set1") +

# To plot in grey
# PDF = ggplot(df, aes(x=FFDI, colour=DATA)) + geom_density(size=3) +
#scale_color_grey() +


##############################
### Part 1: Basic R Review ###
##############################
# R is a high-level, interpreted programming language and environment for
# (primarily) statistical analysis. Read more about it here:
# https://www.r-project.org/about.html

######################################
# Getting today's workshop materials #
######################################

# 1) Download the materials from here:
#    https://github.com/kaars/R_Refresher_July_2018.git
#
# 2) Instructions on how to do this:
#   https://sites.northwestern.edu/summerworkshops/resources/downloading-from-github/

# Where am I?
getwd()

# Change my working directory to the location of the workshop materials
setwd(".")

# List the contents of the directory
dir()

###################
# R Basics Review #
###################

### Arithmetic Operations

# Addition
5 + 6

# Subtraction
100 - 1

# Multiplication
4 * 4

# Division
(6 - 5) / 4

# Exponentiation
2 ^ 100
# To change the number of significant figures...
signif(2 ^ 100, digits = 3)

# Modulo (returns the remainder)
21 %% 5

### Assigning variables

# The '<-' operator assigns a value to a variable
x <- 5 + 6
x

# '=' also works. However, the preference in the R community is to use the '<-'
# operator. More discussion about the difference can be found here:
# https://stackoverflow.com/questions/1741820/what-are-the-differences-between-and-in-r

y = 100 - 1
paste("y equals", y)  # paste converts arguments to character strings and concatenates them

z <- x + y
paste("z equals x + y, or", z)  # use print() with paste if called from inside a function

### Basic Data Types

## 1) Logical (Boolean values, TRUE and FALSE)
## 2) Integer (1, 2, 3)
## 3) Numeric (real numbers like 5.3)
## 4) Complex (z = 1 + 2i)
## 5) Character (text)

# Logical
logical_value <- TRUE
paste("logical_value", logical_value, "is of type", typeof(logical_value))

# Integer ('L' forces integer type)
integer_value <- 234L
paste("integer_value", integer_value, "is of type", typeof(integer_value))

# Numeric (double or real number)
numeric_value <- 234.77

# The function typeof() returns the data type for the R object
paste("numeric_value", numeric_value, "is of type", typeof(numeric_value))

# Complex
complex_value = 1 + 2i
paste("complex_value", complex_value, "is of type", typeof(complex_value))

# Character
# By putting quotes around the value, we are telling R that this is text.
character_value <- "234"
paste("character_value", character_value, "is of type", typeof(character_value))

### Data Structures in R

## From 'Advanced R' by Hadley Wickham
##
##      Homogeneous	    Heterogeneous
##  1d	Atomic vector	  List
##  2d	Matrix	        Data frame
##  nd	Array

## Atomic Vectors ##

# In R, a vector is a one-dimensional array.
# An atomic vector is a sequence of elements of the same data type (homogenous).
# Elements of a vector are called components.
# You assign elements to a vector using the combine function, c().

# Atomic vectors and lists (see below) are both a type of vector. They share the
# following properties:

# What type is it?
# typeof()

# How many elements are in it?
# length()

# Additional metadata (e.g., names)
# attributes()

# Vector Types #

# Logical
logical_vector <- c(TRUE, TRUE, FALSE)
logical_vector
typeof(logical_vector)

# Integer
# Add 'L' after the number to force integer type
integer_vector <- c(12L, 76L, 245L)
integer_vector
typeof(integer_vector)

# Double
double_vector <- c(12, 76.0, 245.34)
double_vector
typeof(double_vector)

# Character
character_vector <- c("twelve", "seventy six", "two hundred forty five")
character_vector

# What happens if you try to put different types of data in the same vector?
# R will force it the elements to the lowest type (see "Basic Data Types" above)
v <- c("R", "U", 4, "sure", "it's", TRUE, "?")
v
typeof(v)

# Accessing values of vectors #

12 %in% integer_vector                                     # TRUE
match(c("one", "twelve", "seventy six"), character_vector) # NA 1 2
which(logical_vector == TRUE)                              # 1 2
length(double_vector)                                      # 3

# Indexing Vectors #

# In R, indices start a 1, not 0 as in many other languages

# Vectors elements can be selected by position:
double_vector
double_vector[3]

integer_vector
integer_vector[2:3]

character_vector
character_vector[c(1,2,3)]

integer_vector
integer_vector[-2]

double_vector
double_vector[double_vector < 77]

#######################
# Complete Exercise 1 #
#######################

# Naming Vectors #

# Vectors can also be selected by name if the vector has name attributes. Examples of this
# are shown below.

# Before names are added...
num_guitars <- c(1, 4, 2, 15)
num_guitars

# After...
names(num_guitars) <- c("Bob", "Sue", "Max", "Emilia")
num_guitars

# You could also assign the names like so...
# guitar_names <- c("Bob", "Sue", "Max", "Emilia")
# names(num_guitars) <- guitar_names

# Notice that attributes() will now return the names
attributes(num_guitars)

# How many guitars does Emilia have? We can now access vector elements by name or
# position number.
num_guitars["Emilia"]
num_guitars[4]

# Adding Vectors #

# num_guitars is a vector describing the number of guitars owned by four people
num_guitars <- c(1, 4, 2, 15)
names(num_guitars) <- c("Bob", "Sue", "Max", "Emilia")

# How many guitars do they own collectively?
total_guitars <- sum(num_guitars)
paste("Total number of guitars:", total_guitars)

# Bob, Sue, Max, and Emilia went to a guitar auction. Some bought and some sold guitars.
bought_and_sold <- c(-1,-2, 8, 0)

# How many does each person own now?
new_num_guitars <- num_guitars + bought_and_sold
new_num_guitars

# Notice that both vectors don't have to be named; R will perform the operation
# element-wise and transfer the names to the new vector, 'new_num_guitars'. But
# what if both vectors have names and they aren't the same?"

# Add different names to the second vector
names(bought_and_sold) <- c("Joe", "Frank", "Lisa", "John")

# Which set of names get transferred to the new vector?
new_num_guitars <- num_guitars + bought_and_sold
new_num_guitars

# How about if we switch the order on the right side?
new_num_guitars <- bought_and_sold + num_guitars
new_num_guitars

# The set of names associated with the left-most vector in the addition operation
# is the one chosen. Be aware of this if you are performing operations on named R
# objects!

## Lists ##

# Like atomic vectors, lists, which are also a type of vector, are 1-dimensional.
# However, they let you store many types of R objects in one structure. These
# objects don't have to be related at all, but often are.

my_list <- list(0:4, "x", c(5.6, 9.8), c(TRUE, FALSE, TRUE))
my_list

# A common use for lists is to provide a single container for different data types
# returned by a single R function.

# 1) Vector of 5 numbers
v <- 1:5

# 2) A 3 x 2 matrix of numbers from 1 to 6
m <- matrix(1:6, ncol = 2)

# 3) First 5 rows of the built-in data set 'iris'
iris_head <- iris[1:5,]

# Create a list of these three data structures and give the components names
some_list <- list(vec = v,
                  mat = m,
                  df  = iris_head)
some_list

# Print the vector component of some_list
# All three of these do the same thing
some_list$vec      # by name
some_list[["vec"]] # using a text value for the name
some_list[[1]]     # by index

# Print the second element of 'vec'
some_list[["vec"]][2]

# Add an element to a list
some_list$another_component <- c("a", "b", "c")
some_list

## Matrices

# A matrix is a 2-dimensional vector (i.e., it has rows and columns) that contains
# elements of the same type. These can be numeric, character, or logical values.

# A matrix with 4 rows with the number 1 - 12 by row
matrix(1:12, byrow=TRUE, nrow=4)

# You can also create a matrix like this:
a <- c(1, 2, 3)
b <- c(4, 5, 6)
c <- c(7, 8, 9)
d <- c(10, 11, 12)

shapes <- matrix(c(a, b, c, d), nrow = 4)
shapes

# Create vectors that contains names for matrix rows and columns
color <- c("red", "green", "blue")
shape <- c("circle", "square", "rectangle", "triangle")

# These functions add names to rows and columns of a matrix
colnames(shapes) <- color
rownames(shapes) <- shape

# 'shapes' matrix with row and column names
shapes

# Find the total numbers of each shape in the matrix
total <- rowSums(shapes)  # use function colSums() to find column totals
total

# To add a new column, bind the new vector as a column to mat
tot_shapes <- cbind(shapes, total)

# Same matrix but with an added column of row totals
tot_shapes

# To add a row, use rbind
hexagon <- c(13, 14, 15, 42)
tot_shapes <- rbind(tot_shapes, hexagon)

# Now with an added row
tot_shapes

# Accessing matrices #

# Let's go back to the original 'shapes' matrix. Select just the circle row:
circles <- shapes[1,]
circles

# How many green squares and rectangles are there?
green_sq_rec <- shapes[2:3,2]
green_sq_rec

# Average number of shapes
mean(shapes)

# Subtract 2 from all elements
shapes - 2

#######################
# Complete Exercise 2 #
#######################

## Data Frames

# Like a matrix, a data frame has rows and columns. However, unlike a matrix, a
# data frame can contain multiple data types. Columns contain variables and rows
# contain observations. The structure of a data frame is similar to that of an
# Excel spreadsheet.

# Create vectors containing data about four people's guitar collections
owner <- c("Bob", "Sue", "Max", "Emilia")
count <- c(0, 2, 10, 15)
value <- c(0, 605.50, 5140.10, 9243.44)
professional <- c(FALSE, FALSE, TRUE, TRUE)

# Create a data frame from the vectors
guitars_df <- data.frame(owner, count, value, professional)
guitars_df

# Returns only the 'professional' variable
guitars_df$professional

# Returns the entire row for every professional player
# Use ! to return all non-professiona players
guitars_df[professional,]

## Factors

# A factor is a vector that can contain only predefined, categorical data.
#
# Factors have two attributes:
# 1) the class "factor", which makes their behavior different than that of integer vectors
# 2) "levels", which defines the allowed set of values
#
# Factors can be composed of either unordered categories or ordered levels (ordinal).

# light_switch, a non-ordered categorical variable of type 'character'
light_switch <- c("on", "off", "on", "off", "on", "off")
light_switch
table(light_switch) # Build a table of counts of factor levels

# Change 'light_switch' to a factor. Notice that the "Levels" are printed after the contents.
factor_ls <- factor(light_switch)
factor_ls

# 'size', an ordinal variable. The factor levels have an order in this case.
size <- c("Small", "Large", "Medium", "Medium", "Large", "Large", "Small")
factor_size <- factor(size, ordered = TRUE, levels = c("Small", "Medium", "Large"))
factor_size

# Give a summary of the counts of each category
summary(factor_size)

# Choose a size to compare (the first component of the vector)
first_size <- factor_size[1]
first_size

# Choose another size (the fourth component of the vector)
second_size <- factor_size[4]
second_size

# Is the first size larger than the second size?
paste("Is the first size larger than the second size?", first_size > second_size)

## Dates

# Print today's date
Sys.Date()

# Default format is YYYY-MM-DD
more_dates <- as.Date(c("2016-03-19", "2017-12-13", "2018-07-04"))
more_dates

# Convert strings in 'MM/dd/yyyy' format to date objects
char_dates <- c("01/05/1965", "08/16/1975")
dates <- as.Date(char_dates, "%m/%d/%Y")
dates

# I would recommend the 'lubridate' package for working with dates in R (a cheat sheet can be
# found here: https://www.rstudio.com/resources/cheatsheets/.

### Special Values in R ###

## Missing Data (NA)

  # In R, missing data in represented as NA
  v <- c(1, 2, 3, NA, 5, 6, NA, NA)

  # The is.na() function will return TRUE or FALSE for each element
  is.na(v)

  # Which elements are NA?
  which(is.na(v))

  # How many NA's are there?
  sum(is.na(v))

## Inf

  # If a function computes a number that is too large, R will return 'Inf' or '-Inf'
  3 ^ 1000
  -2 ^ 5000

  # It's the same if you divide by 0
  1 / 0

## NaN

  # If R cannot make sense out of the result of a computation, it will return 'NaN'
  # (not a number)
  0 / 0

## NULL
  # Null is used to represent an undefined value
  # It is NOT the same as NA, Inf, -Inf, or NaN

#######################
# Complete Exercise 3 #
#######################


#Copyright (c) 2015 Brunston Poon (@brupoon) - MIT License
#install.packages("doBy")
#install.packages("ggplot2")
library(doBy)
library(ggplot2)
#data
nyt = read.csv(path) #change for different computer

#view information
summary(nyt)
head(nyt)

ageGroupings <- c(-Inf,0,18,24,34,44,54,64,Inf)
nyt$age <- cut(nyt$Age, breaks = ageGroupings)

#Let's create one vector which can store all of our summaries.
vsum <-c()

siteRange <- function(x){c(length(x), min(x), mean(x), max(x))}
#Creates a function siteRange returning a vector of x with above attr.

#brackets
vsum$byAge <- summaryBy(Age~age, data = nyt, FUN=siteRange)
#groupwise summary stats

#only signed in users have ages and genders
#impressions / click-thru rate for each age category
vsum$byAge_imp_ctr<- summaryBy(Gender+Signed_In+Impressions+Clicks~age, data = nyt)

#plotting
hst_imp_age <- ggplot(nyt, aes(x=Impressions, fill=age)) +
    geom_histogram(binwidth=1)
box_imp_age <- ggplot(nyt, aes(x=age, y=Impressions, fill=age)) +
    geom_boxplot()


tic.clearlog()
tic("total")
tic("data generation")
X <- matrix(rnorm(50000*1000), 50000, 1000)
b <- sample(1:1000, 1000)
y <- runif(1) + X %*% b + rnorm(50000)
toc(log = TRUE, quiet = TRUE)
tic("model fitting")
model <- lm(y ~ X)
toc(log = TRUE, quiet = TRUE)
toc(log = TRUE, quiet = TRUE)


AddResidualsSinglePreference <- function(dt) {
  # This function adds to the summary of the data the residuals from the
  # regression performed on various variables of interest.
  # It returns the summary of the data including these residuals.

  dt_tmp <- c()

  # Single preference average gender difference residualised
  for (pref in unique(dt$preference)) {
    # using the Gender Equality Index
    dt_tmpGEI <- Residualise(dt[preference == pref],
                             var1 = "GenderIndex",
                             var2 = "gender")
    new_nameGEI <- paste0("residualsgenderGEI_", pref)
    dt_tmpGEI[, ((new_nameGEI)) := residualsgender]
    dt_tmpGEI <- rev(dt_tmpGEI)[, 1]

    # using the logGDP
    dt_tmpGDP <- Residualise(dt[preference == pref],
                             var1 = "logAvgGDPpc",
                             var2 = "gender")

    new_nameGDP <- paste0("residualsgenderGDP_", pref)
    dt_tmpGDP[, ((new_nameGDP)) := residualsgender]
    dt_tmpGDP <- rev(dt_tmpGDP)[, 1]

    # LogGDP residualised using the Gender Equality Index
    dt_logGDP_GEI <- Residualise(dt[preference == pref],
                                 var1 = "GenderIndex",
                                 var2 = "logAvgGDPpc")
    new_nameGEI <- paste0("residualslogAvgGDPpc_", pref)
    dt_logGDP_GEI[, ((new_nameGEI)) := residualslogAvgGDPpc]
    dt_logGDP_GEI <- rev(dt_logGDP_GEI)[, 1]

    # Gender Equality Index residualised using logGDP
    dt_GEI_logGDP <- Residualise(dt[preference == pref],
                                 var1 = "logAvgGDPpc",
                                 var2 = "GenderIndex")
    new_nameGDP <- paste0("residualsGenderIndex_", pref)
    dt_GEI_logGDP[, ((new_nameGDP)) := residualsGenderIndex]
    dt_GEI_logGDP <- rev(dt_GEI_logGDP)[, 1]

    dt_tmp <- cbind(dt_tmp, dt_tmpGEI, dt_tmpGDP, dt_logGDP_GEI, dt_GEI_logGDP)

    rm(dt_logGDP_GEI)
    rm(dt_GEI_logGDP)
  }

  dt_tmp$country <- unique(dt$country)

  dt <- merge(dt, dt_tmp, by = "country")

  return(dt)
}


#' @export
#' @title concave.hull
#' @description Find the outline (boundary) of a set of points in 2D space.
#' @param \code{xy}  Points data in x,y format
#' @param \code{k} Number of nearest neighbours to consider, defaults to 5
#' @param \code{ub} Upper bound in spatial distance to consider, defaults to 1/8 max range
#' @param \code{plot} defaults to TRUE
#' @param \code{random.start} defaults to FALSE otherwise the min values are used.
#' @family documented
#' @author Jae Choi, \email{<jae.choi>@dfo-mpo.gc.ca}
#' @export
  concave.hull = function( xy, k=5, ub=NULL, plot=FALSE, random.start=FALSE ) {

    if (k < 3) return (NULL)
    p = as.matrix( xy )
    dimnames(p) =NULL
    p = p[ ! duplicated( p) , ]
    if (is.null(ub)) {
      dx = diff(range(xy[,1]))
      dy = diff(range(xy[,2]))
      dd = max( dx, dy )
      ub = dd / 8
    }

    nsets = nrow (p)
    if ( nsets < 3 ) return ( NULL )
    if ( nsets == 3) return( p )

    # initiate list with the first few points
    convex.hull <- spatstat::convexhull.xy( p )

    p0i = which.min( convex.hull$bdry[[1]]$y )
    if (random.start) {
      p0i = floor(runif(1) * length(convex.hull$bdry[[1]]$y) ) + 1
    }
    p.start = as.matrix( cbind( convex.hull$bdry[[1]]$x[ p0i ], convex.hull$bdry[[1]]$y[ p0i ] ) )
    hull = p0 = p.start
    to.remove = which( p0[,1] == p[,1] & p0[,2] == p[,2] )
    if (length( to.remove) > 0 ) p = p[ - to.remove ,]

    finished = F
    while ( ! finished ) {
      if (nrow(hull)==3) p = rbind( p.start, p)  # return p.start after a few steps
      p.new=NULL
      p.new = bio.utilities::nearest.sorted.angles( p, hull, k, eps=pi/10, ub=ub ) # eps determines the acute angle solutions to ignore
      if (is.null(p.new) ) {
        kadd = k
        while (is.null(p.new) ) {
          kadd = kadd + 1
          p.new = bio.utilities::nearest.sorted.angles( p, hull, k=kadd, eps=pi/10, ub=ub )
          if ((kadd-k) > 10) stop()
        }
      }
      if (p.new[,1] == p.start[,1] & p.new[,2] == p.start[,2]) finished = T
      p0 = p.new
      hull = rbind( hull, p0 )
      to.remove = which( p0[,1] == p[,1] & p0[,2] == p[,2] )
      if (length( to.remove) > 0 ) p = p[ - to.remove ,]
#      lines(hull[,1], hull[,2])
    }

    sa = signif(splancs::areapl(hull),3)
    densit = signif( nsets/splancs::areapl(hull),3)

    print( paste("Surface area:", sa))
    print( paste("Mean density:", densit))
    print( paste("Neighbourhood radius:", ub))
    print( "Check the plot and modify ub to alter the complexity of the outline." )

    if (plot) {
      plot( xy, pch=20, col="gray",
        sub = paste("Criteria:", k, "neighbours and", ub, "km radius", "\n No. sets =", nsets, "; SA = ", sa, "km^2 \n Density = ", densit, "stations / km^2" ),
        ylab="", xlab="" )
      lines(hull, lwd=2)
    }

    return (hull)
  }


# Figure 4: Mean Variance by Session

rm(list=ls())

library(ggplot2)

# setwd("~/Dropbox/machine_parliament/PA_replication/")
wd <- getwd() # Run this from the replication folder, with data in a subdirectory (or setwd())
data.dir <- paste0(wd, "/data/")

df<- read.csv(paste0(data.dir, "SAG_speaker_prob_estimates_allmembers_j27.csv"))

# Aggregate by index (session):
ag <- aggregate(df[,c('estprob','estprobvar')], by=list(df$index), FUN=mean)
names(ag) <- c('index', 'estprob','estprobvar')

# Session index --
dd <- read.csv(paste0(data.dir,'acc_j27_allmembers.csv'), stringsAsFactors=F)
yrs4 <- read.csv(paste0(data.dir,'years_session_index.csv'), stringsAsFactors=F)
dd$yrmth <- yrs4$yearmth

dd2 <- dd[seq(5,75, 5),] # subset for labeling the plot

a <- aggregate(df, by=list(df$index), FUN=mean)
ag2 <- ag[seq(5,75, 5),]
ag2$yrmth <- dd2$yrmth

p <- ggplot(ag, aes(x=index, y=estprobvar))
p + geom_line() + theme_bw()+ ylab('Mean variance of MP estimates' ) + xlab("Session of Parliament") +
  scale_x_continuous(breaks=ag2$index, labels=ag2$yrmth)+ theme(axis.text.x = element_text(angle = 90, hjust = 1))# , angle = 90)

ggsave('plot_var_sess.pdf',  width=10, height=6)

p <- ggplot(ag, aes(x=year, y=estprobvar))
p + geom_line() + theme_bw()+ ylab('Mean variance of Speakers estimates' ) #+scale_x_continuous(breaks=dd2$index, labels=dd2$yrmth)+


library(reshape2)
source("xtable.r")

df <- data.frame(row = LETTERS[1:3], a = 1:3, b = 4:6, c = 7:9)
xtable(df, "melt-raw.tex")

dfm <- melt(df, id = "row")
names(dfm)[2] <- "column"
xtable(dfm, "melt-output.tex")


library(dplyr)

d <- "R-Meeting-Sponsors-France.tsv" %>%
  readr::read_tsv(col_types = "iccccccccccii")

nrow(d) # 201 (v0.2)

# 10 conferences, 8--46 sponsors (except 2020, 1 sponsor for now)
group_by(d, year, event) %>%
  tally

# 1--4 organisers
group_by(d, year, event) %>%
  filter(organiser == 1) %>%
  tally

# top sponsors by occurrence
group_by(d, sponsor, sponsor_sector) %>%
  tally(sort = TRUE) %>%
  filter(n >= 4) # %>% knitr::kable()

# sponsor sectors
group_by(d, sponsor_role) %>%
  tally(sort = TRUE)

# sponsor types
group_by(d, sponsor_type) %>%
  tally(sort = TRUE) %>%
  filter(n >= 10)

# sponsor domains
t <- na.omit(d$sponsor_domain) %>%
  strsplit(",") %>%
  unlist %>%
  as_tibble %>% # exported by `dplyr`, column named `value`
  group_by(value) %>%
  tally(sort = TRUE)

nrow(t) # 20 different domains
filter(t, n > 5)

# have a nice day


 ZGELSD Example Program Results

 Least squares solution
 ( 3.9747,-1.8377) (-0.9186, 0.8253) (-0.3105, 0.1477) ( 1.0050, 0.8626)
 (-0.2256,-1.9425)

 Tolerance used to estimate the rank of A
      1.00E-02
 Estimated rank of A
      3

 Singular values of A
      2.9979     1.9983     1.0044     0.0064


pdf_file<-"pdf/tablecharts_ballonplot.pdf"
cairo_pdf(bg="grey98",pdf_file,width=9,height=9)

par(omi=c(0.75,0.25,0.5,0.25),mai=c(0.25,0.55,0.25,0),family="Lato Light",cex=1.15)
library(gplots)

# Import data and prepare chart

data(Titanic)
myData<-as.data.frame(Titanic) # convert to 1 entry per row format
attach(myData)
myColours<-Titanic
myColours[,,,"Yes"]<-"LightSkyBlue"
myColours[,,,"No"]<-"plum1"
myColours<-as.character(as.data.frame(myColours)$Freq)

# Create chart

balloonplot(x=list(Age,Sex),main="",
            y=list(Class=Class,
            Survived=gdata::reorder.factor(Survived,new.order=c(2,1))),
            z=Freq,dotsize=18,
            zlab="Number of Passengers",
            sort=T,
            dotcol=myColours,
            show.zeros=T,
            show.margins=T)

# Titling

mtext("Titanic - Passenger and Crew Statistics",3,line=0,adj=0,cex=2,family="Lato Black",outer=T)
mtext("Balloon Plot for Age, Sex by Class, Survived",3,line=-2,adj=0,cex=1.25,font=3,outer=T)
mtext("Source: R library gplots",1,line=1,adj=1.0,cex=1.25,font=3,outer=T)
mtext("Area is proportional to Number of Passengers",1,line=1,adj=0,cex=1.25,font=3,outer=T)
dev.off()


\name{PAFit_oneshot}
\alias{PAFit_oneshot}
%- Also NEED an '\alias' for EACH other topic documented here.
\title{
 Estimating the nonparametric preferential attachment function from one single snapshot.
}
\description{
  This function estimates the attachment function \eqn{A_k} from one snapshot.
}
\usage{

PAFit_oneshot(net_object,
              M    = 10,
              S    = 5,
              loop = 5,
              G    = 1000)
}
%- maybe also 'usage' for other objects documented here.
\arguments{
 \item{net_object}{
    an object of class \code{PAFit_net} that contains the network. Any time-step information, if available, will be ignored.
  }
   \item{M}{
  Integer. Number of simulated networks in each iteration. Default is \code{10}.
  }
  \item{S}{
  Integer. Number of iterations inside each loop. Default is \code{5}.
  }
  \item{loop}{
  Integer. Number of loops of the whole process. Default is \code{5}.
  }
    \item{G}{
  Integer. Number of bins for the PA function. Default is \code{1000}.
  }
}

\value{
   Outputs a \code{PAFit_result} object.
}

\author{
  Thong Pham \email{thongphamthe@gmail.com}
}
\references{
1. Pham, T., Sheridan, P. & Shimodaira, H. (2021). Non-parametric estimation of the preferential attachment function from one network snapshot. Journal of Complex Networks 9(5): cnab024. (\doi{10.1093/comnet/cnab024}).

%  2. Pham, T., Sheridan, P. & Shimodaira, H. (2016). Joint Estimation of Preferential Attachment and Node Fitness in Growing Complex Networks. Scientific Reports 6, Article number: 32558. doi:10.1038/srep32558   (\url{http://www.nature.com/articles/srep32558}).

% 3. Pham, T., Sheridan, P. & Shimodaira, H. (2020). PAFit: An R Package for the Non-Parametric Estimation of Preferential Attachment and Node Fitness in Temporal Complex Networks. Journal of Statistical Software 92 (3), doi:10.18637/jss.v092.i03. (\url{http://dx.doi.org/10.18637/jss.v092.i03})
}
%\seealso{
%  See \code{\link{get_statistics}} for how to create summerized statistics needed in this function.

%  See \code{\link{Jeong}}, \code{\link{Newman}} and \code{\link{only_A_estimate}} for functions to estimate the attachment function in isolation.

%    See \code{\link{only_F_estimate}} for a function to estimate node fitnesses in isolation.
%}

\examples{
\dontrun{
  library("PAFit")
  net_1    <- generate_BA(N = 10000, alpha = 1) # true attachment exponent = 1.0
  result_1 <- PAFit_oneshot(net_1)
  print(result_1)

  net_2    <- generate_BA(N = 10000, alpha = 0.5) # true attachment exponent = 0.5
  result_2 <- PAFit_oneshot(net_2)
  print(result_2)
  }
}

\concept{preferential attachment}
\concept{attachment function}


# Clase 2022-03-29

# Funciones
rm(list = ls())

f.suma <- function(x = 0, y = 0) x + y
formals(f.suma)
body(f.suma)

# Modificar los argumentos
argum.original <- formals(f.suma) # almacenamos los argumentos originales
formals(f.suma) <- alist(x = , y = , z = ) # nolint
f.suma

# Modificar el cuerpo
cuerpo.original <- body(f.suma) # almacenamos el cuerpo original
body(f.suma) <- expression({
    suma1 <- x + y
    suma2 <- x + z
    return(list(suma1 = suma1, suma2 = suma2))
})
f.suma(1, 2, 3)

# reestablecemos argumentos y cuerpo originales
formals(f.suma) <- argum.original
body(f.suma) <- cuerpo.original
f.suma

environment(f.suma)

x <- 1
f <- function(x) {
    y <- 1
    x <- x + y
    return(x)
}
f(x)

x # cambia su valor solo dentro de la función

y # este objeto solo existe dentro de la función

class(var)
typeof(var)

formals(var)
body(var)
environment(var)
class(sum)
typeof(sum)

formals(sum)
body(sum)
environment(sum)
sum

class(`[`)
typeof(`[`)

lista <- list(x = 1:10, y = 10:13)
lapply(lista, function(v) v^2)

formals(paste)
paste("uno", "dos", "tres", sep = "+")

# Hay que tener en cuenta que cuando se usa el argumento ... en una función, el resto
# de argumentos que le siguen se deben pasar siempre por nombre y no por posición.

grafico <- function(x, ...) {
    z <- (x - mean(x)) / sd(x)
    plot(x, z, ...)
}
grafico(1:10, main = "Gráfico 1")

grafico(1:10, main = "Gráfico 2", type = "l", col = 4)

x <- 1
f <- function(y) {
    z <- x + y
    z
}

environment(f)
ls()
f1 <- function(a, b) a + b
f2 <- function(a, b) {
    f1 <- function(a, b) a - b
    f1(a, b)
}
f1(1, 1)

f2(1, 1)

y <- 10
f <- function(x) {
    y <- 2
    y^2 + g(x)
}
g <- function(x) x * y

f(3)

#
# --- ESTRUCTURAS DE CONTROL -----------------------------------------------------
#

# if
x <- 5
if (x >= 5) cat("Aprobado") else cat("Suspenso")

calif <- if (x >= 5) print("Aprobado") else print("Suspenso")

calif

saludo <- function(franja = NA, nombre) {
    if (is.na(franja)) {
        paste("Hola", nombre)
    } else if (franja == 1) {
        paste("Buenos días", nombre)
    } else if (franja == 2) {
        paste("Buenas tardes", nombre)
    } else if (franja == 3) {
        paste("Buenas noches", nombre)
    } else {
        warning("Franja puede ser 1 (mañana), 2 (tarde) ó 3 (noche)")
        paste("Hola", nombre)
    }
}

saludo(nombre = "Lola")
saludo(franja = 1, nombre = "Lola")
saludo(franja = 4, nombre = "Lola")

x <- 5
if (x > 4 | n > 1) "se comprueban las dos"

if (x > 4 || n > 1) "se comprueba sólo la primera"

raiz <- function(x) {
    if (!is.vector(x) || !is.numeric(x) || any(x < 0)) {
        stop("Argumento no válido")
    }
    sqrt(x)
}

# ifelse
# Observa que la condición x==0 se evalúa para cada elemento del vector x[i],
milog <- function(x) ifelse(x == 0, NA, log(x))
milog(c(1, 0, 2))
milog(c(1, 0, NA))

milog <- function(x) if (x == 0) NA else log(x)
milog(c(1, 0, 2))
Sys.setenv("_R_CHECK_LENGTH_1_CONDITION_" = "true")

# switch
opciones <- function(x) {
    if (x == "a") {
        "opción 1"
    } else if (x == "b") {
        "opción 2"
    } else if (x == "c") {
        "opción 3"
    } else {
        stop("Valor de x no válido")
    }
}

opciones("a")
# se compacta a

opciones <- function(x) {
    switch(x,
        a = "opción 1",
        b = "opción 2",
        c = "opción 3",
        stop("Valor de x no válido")
    )
}
opciones <- function(x) {
    switch(x,
        "uno",
        "dos",
        "tres",
        "cuatro"
    )
}

opciones(2)
opciones(1.4)
opciones(5)
opciones("a")

opciones <- function(x) {
    resultado <- c("uno", "dos", "tres", "cuatro")
    resultado[x]
}
opciones(2)
opciones(1.4)
opciones(5)
opciones("a")

# Traducir a switch
saludo <- function(franja = NA, nombre) {
    if (is.na(franja)) {
        paste("Hola", nombre)
    } else if (franja == 1) {
        paste("Buenos días", nombre)
    } else if (franja == 2) {
        paste("Buenas tardes", nombre)
    } else if (franja == 3) {
        paste("Buenas noches", nombre)
    } else {
        warning("Franja puede ser 1 (mañana), 2 (tarde) ó 3 (noche)")
        paste("Hola", nombre)
    }
}

saludo <- function(franja = NA, nombre) {
    switch(as.character(franja),
        "NA" = paste("Hola", nombre),
        "1"  = paste("Buenos días", nombre),
        "2"  = paste("Buenas tardes", nombre),
        "3"  = paste("Buenas noches", nombre),
        {
            warning("Franja puede ser 1 (mañana), 2 (tarde) ó 3 (noche)")
            paste("Hola", nombre)
        }
    )
}

saludo(1, "Lucas")
saludo(2, "Lucas")
saludo(3, "Lucas")
saludo(4, "Lucas")
saludo(111, "Lucas")
saludo("42", "Lucas")
saludo(c(NA, 1), "Lucas")
saludo(, "Lucas")


# MIT License
# Copyright (c) 2020 Abhinav Prakash, Vijay Panchang, Yu Ding, and Lewis Ntaimo

# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:

# The above copyright notice and this permission notice shall be included in all
# copies or substantial portions of the Software.

# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.

source("function.r")
inputfile = "assunpink.csv"
outputfile = "Results/assunpink_constrained_MCMC_"
outputplot = "Assunpink Creek"
data_col = 3
year_col = 1
ReferenceYear = 2018
ReturnPeriod = 100
burn_in = 500
CSVFile = read.csv(file = inputfile, header = T)
Data = CSVFile[,data_col]
Year = CSVFile[,year_col]
time_index = time.index(Year,ReferenceYear)
parameters = draw.MCMC.samples(Data,time_index,InitialValues = c(50,1,20,0.8),LocationInterceptPrior = c(0,200),LocationSlopePrior = c(-5,5),ScalePrior = c(0,50),ShapePrior = c(-1,1),ProposalWidth = c(1,.1,1,0.05),n_samples=10000)
parameters = parameters[-c(1:burn_in),]
mu_post = parameters[,1]
muslope_post = parameters[,2]
scale_post = parameters[,3]
shape_post = parameters[,4]
ret_post=rep(-1,length(mu_post))
for (i in 1:length(mu_post)){
  ret_post[i] = calc.nstat.ret.event(mu_post[i],muslope_post[i],scale_post[i],shape_post[i],n = ReturnPeriod,baseyear = ReferenceYear, analysisyear = ReferenceYear, epsilon = 1)
}

bw = c(1.5,0.02,0.5,0.050,25)

### Expected and MAP Values of the parameters and the return event
d_mu = density(mu_post, bw = bw[1])
d_muslope = density(muslope_post, bw = bw[2])
d_scale = density(scale_post, bw= bw[3])
d_shape = density(shape_post, bw = bw[4])
d_retEvent = density(ret_post, bw = bw[5])

mu_exp = mean(mu_post)
mu_map = d_mu$x[which.max(d_mu$y)]
muslope_exp = mean(muslope_post)
muslope_map = d_muslope$x[which.max(d_muslope$y)]
scale_exp = mean(scale_post)
scale_map = d_scale$x[which.max(d_scale$y)]
shape_exp =mean(shape_post)
shape_map = d_shape$x[which.max(d_shape$y)]
retEvent_exp = mean(ret_post)
retEvent_map = d_retEvent$x[which.max(d_retEvent$y)]
NLLH_exp = likelihood.val(Data,time_index,mu_exp,muslope_exp,scale_exp,shape_exp)
NLLH_map = likelihood.val(Data,time_index,mu_map,muslope_map,scale_map,shape_map)
cat("Expected Values of the Parameters:",'\n')
cat("Location Intercept:", mu_exp, '\n')
cat("Location Slope:", muslope_exp, '\n')
cat("Scale:",scale_exp, '\n')
cat("Shape:", shape_exp, '\n')
cat("100 year Return Event:", retEvent_exp, '\n')
cat("NLLH:", NLLH_exp, '\n')
cat('\n',"MAP values of the Parameters:",'\n')
cat("Location Intercept:", mu_map, '\n')
cat("Location Slope:", muslope_map, '\n')
cat("Scale:",scale_map, '\n')
cat("Shape:", shape_map, '\n')
cat("100 year Return Event:", retEvent_map, '\n')
cat("NLLH:", NLLH_map, '\n')


# Replication code for Figure 1: Classification Accuracy (y-axis)
# for Different Levels of Separation (x-axis)
# at different levels of noise.

rm(list=ls())
library(ggplot2)

wd <- getwd() # Run this from the replication folder, with data in a subdirectory (or setwd())
data.dir <- paste0(wd, "/data/")
df <- read.csv(paste0(data.dir, "acc_sims.csv"))

df <- df[,c("separation", "mn_sag",'noisefrac')]
df$sep <- .5-df$separation

# fix noise / limit labels for clarity:
d.3 <- df[df$noisefrac==0.5,]
d.3 <- d.3[,c("separation", "mn_sag")]
d.3$sep <- .5-d.3$separation
dlab <- d.3[c(11,13,15,17,19),]
df <- df[df$separation>.39,]

df.sel <- df[is.element(df$noisefrac, c(.05, .1, .25, .5)),]
pdf("separation_v_acc.pdf",  width=8, height=6)
p <- ggplot(df.sel, aes(x=separation, y=mn_sag, linetype=factor(noisefrac)))
p + geom_line() + theme_bw() +  scale_x_continuous(breaks=dlab$separation, labels=dlab$sep )+
  xlab("Separation") + ylab("Mean Classification Accuracy, 10-fold X-Validation")+labs(linetype = "Fraction Noise")
dev.off()


bubble_sort <- function(a){
  for(i in 1:(length(a)-1)){
    for (j in 1:(length(a)-1)) {
      if(a[j] > a[j+1]){
        t = a[j]
        a[j] = a[j+1]
        a[j+1] = t
      }
    }
  }
  print(a)
}
startTime <- Sys.time()
bubble_sort(c(-2,45,0,11,-9))
endTime <- Sys.time()
timeTaken <- endTime - startTime
cat("Time required : ", as.numeric(timeTaken), "\n")


# R script to set up PreservationSimulation/shelf data
# RBLandau 20141214

# REQUIRES:
# - sInputFilename
# - sOutputFilemane
# - sTitle

# I N P U T
dat <- data.frame(read.table(sInputFilename, header=TRUE))
# Use dataset with only the interesting columns: docsize, lifem, copies, lost
# because we don't want to aggregate anything else.
datn = data.frame(dat$docsize,dat$lifem,dat$copies,dat$lost)
sink()
cat("Input data from ",sInputFilename,"\n")
cat("Output analysis into ",sOutputFilename,"\n\n")
cat(sTitle,"\n")
cat("\n")

# F U N C T I O N S

trimean <-  function(vect)  { foo = fivenum(vect); ans <- 0.5*foo[3] + 0.25*foo[2] + 0.25*foo[4]; ans }
midmean <-  function(vect)  { ans <- mean(vect,trim=0.25); ans }

WhateverSampleSadisticsYouWant <- function(docsize,lifem,copies,shelfsize,vect)
{
    cat("=== ","docsize",docsize,"lifem",lifem,"copies",copies,"shelfsize",shelfsize,"N",length(vect),"\n")
    stem(vect)
    cat("docsize",docsize,"lifem",lifem,"copies",copies,"shelfsize",shelfsize,"N",length(vect),"\n")
    cat("median","\t\t",median(vect),"\n")
    cat("trimean","\t",trimean(vect),"\n")
    cat("midmean","\t",midmean(vect),"\n")
    stat_mean <- mean(vect)
    cat("mean","\t\t",stat_mean,"\n")
    cat("stddev","\t\t",sd(vect),"\n")
    cat("IQR","\t\t",IQR(vect),"\n")
    cat("mad","\t\t",mad(vect),"\n")
    stat_SEM <- (sd(vect)/sqrt(length(vect)))
    cat("SEM","\t\t",stat_SEM,"\n")
    stat_MeanOverSEM <- stat_mean / stat_SEM
    stat_LogMeanOverSEM <- log10(stat_mean / stat_SEM)
    cat("MeanOverSEM","\t",stat_MeanOverSEM,"\n")
    cat("LogMeanOverSEM","\t",stat_LogMeanOverSEM,"\n")
    cat("\n")
}

# T A B L E S
# Summary table with medians.
#summ <- data.frame(cbind(0,0,1,2,3,4,5,8,10,14,16,20))
summ <- data.frame(rbind(numeric(13)))
colnames(summ) <- c("docsize","lifem","shelfsize","c1","c2","c3","c4","c5","c8","c10","c14","c16","c20")
datn = data.frame(dat$docsize,dat$lifem,dat$shelfsize,dat$copies,dat$lost)

for (ss in levels(factor(datn$dat.shelfsize)))
{
    for (ds in levels(factor(datn$dat.docsize)))
    {
        tmp <- data.frame(datn[datn$dat.docsize==ds & datn$dat.shelfsize==ss,]);
        for (lfm in levels(factor(tmp$dat.lifem)))
        {
            tmp2 <- tmp[tmp$dat.lifem==lfm & tmp$dat.shelfsize==ss,]
            tmp3 = aggregate(tmp2, by=list(tmp2$dat.copies), FUN=median)
            newrow <- c(ds,lfm,ss,tmp3$dat.lost)
            if (length(newrow) < length(colnames(summ)))
            {
                filler <- rep(0,length(colnames(summ)) - length(newrow))
                #print(c(length(filler),"=>",filler))
                #print(c(length(newrow),"=>",newrow))
                newrow <- c(newrow,filler)
            }
            #print(newrow)
            summ <- rbind(summ,as.numeric(newrow))
        }
    }
}
summ <- summ[-1,]
rownames(summ) <- NULL

if(FALSE)
{
# Summary table with trimeans.
#sumt <- data.frame(cbind(0,0,1,2,3,4,5,8,10,14,16,20))
sumt <- data.frame(rbind(numeric(13)))
colnames(sumt) <- c("docsize","lifem","shelfsize","c1","c2","c3","c4","c5","c8","c10","c14","c16","c20")
datn = data.frame(dat$docsize,dat$lifem,dat$shelfsize,dat$copies,dat$lost)

for (ss in levels(factor(datn$dat.shelfsize)))
{
    for (ds in levels(factor(datn$dat.docsize))){
        tmp <- data.frame(datn[datn$dat.docsize==ds & datn$dat.shelfsize==ss,]);
        for (lfm in levels(factor(tmp$dat.lifem))) {
            tmp2 <- tmp[tmp$dat.lifem==lfm & tmp$dat.shelfsize==ss,]
            tmp3 = aggregate(tmp2, by=list(tmp2$dat.copies), FUN=trimean)
            newrow <- c(ds,lfm,ss,tmp3$dat.lost)
            if (length(newrow) < length(colnames(sumt)))
            {
                filler <- rep(0,length(colnames(sumt)) - length(newrow))
                newrow <- c(newrow,filler)
            }
            #print(newrow)
            sumt <- rbind(sumt,as.numeric(newrow))
        }
    }
}
sumt <- sumt[-1,]
rownames(sumt) <- NULL
}

# O U T P U T
# Leave tracks for the console user.
#cat("Input data from ",sInputFilename,"\n")
#cat("Output analysis into ",sOutputFilename,"\n\n")
#cat(sTitle,"\n")
#cat("\n")
#cat("\n")

# Send output to a file so we can read it later.
sink(sOutputFilename)
cat(sTitle,"\n")
cat("Input data from ",sInputFilename,"\n")
cat("Output analysis into ",sOutputFilename,"\n\n")

# Show results.
cat("Question 0 Summary losses (medians)\n")
print(summ)
cat("\n")
if(FALSE){
cat("Question 0 Summary losses (trimeans)\n")
print(sumt)
}
cat("\n")

# Let's look at the distributions of the samples.
# The order of nesting here makes some comparisons easier than others.
for (ds in levels(factor(datn$dat.docsize)))
{
    tmp1 <- data.frame(datn[datn$dat.docsize==ds,]);
    for (lfm in levels(factor(tmp1$dat.lifem)))
    {
        tmp2 <- tmp1[tmp1$dat.lifem==lfm,]
        for (cp in levels(factor(tmp2$dat.copies)))
        {
            tmp3 <- tmp2[tmp2$dat.copies==cp,]
            for (ss in levels(factor(tmp3$dat.shelfsize)))
            {
                tmp4 <- tmp3[tmp3$dat.shelfsize==ss,]
                WhateverSampleSadisticsYouWant(ds,lfm,cp,ss,tmp4$dat.lost)
            }
        }
    }
}

sink()

#END


getwd()
setwd("C:/Users/samee/Documents/CS584/code_javaSE/project")
dist = read.csv("purchase_all_cc_size_distribution.csv",h=F)
hist(dist)
str(dist)
barplot(table(dist$V1))

h = hist(dist$V1)
h$density = h$counts/sum(h$counts)*100
plot(h,freq=FALSE, ylim=c(0,100),ylab='%' , xlab='Number of nodes in Connected Components',main="Purchase CC's",col="grey")

library(ggplot2)
ggplot(dist, aes(x=factor(V1)) ,stat='count') +
  geom_histogram(fill="lightgreen", color="grey50", stat="count", aes( y=..count../sum(..count..)))+ylab('%')+xlab('number of cc')
savehistory("plotting_CC_dist_purchase.r")


# ------------------------------------------------------------------------------
# Produces a graph for number of times a paper is cited by the decade of
# publication.
# ------------------------------------------------------------------------------

# Load CSV into a data frame

df <- read.csv('citations_by_year.csv')

# Convert the year of publication into a factor called 'Decade'

df['Decade'] <- trunc(df$Year_Published/10)*10
df['Decade'] <- factor(df$Decade)

# Summarise the data frame

summary(df)

# Produce a Box plot

boxplot( Times_Cited ~ Decade, data=df)


motifs <- c('alberto', 'elisa', 'david', 'bertrand', 'julien')

counts <- c('alberto', 'alberto', 'alberto', 'alberto',
             'elisa',
             'david', 'david', 'david',
             'bertrand', 'bertrand', 'bertrand','bertrand',
             'julien', 'julien')

idx <- order(table(counts)[motifs], decreasing=TRUE)

motifs <- motifs[idx]

match(motifs, idx)

#############"

set.seed(3)
x <- sample(100,1000, replace=TRUE)
idx <- order(table(x), decreasing=TRUE)
xx <- match(x, idx)
n <- table(xx)
n
all(n == cummin(n))


#Dataset - Chocolate bar ratings
#Features in dataset:Company_Maker, Bar_Name, REF, Review_Date, Cocoa_Percentage, Company_Location, Rating, Bean_Type, Bean_Origin
#Loading libraries

library(ggplot2) # for data visualization
library(treemapify) # for treemap
library(tidyverse) # for dplyr functionality
library(corrplot) # for correlation plot
library(wordcloud) # for plotting word cloud
library(tm) # for data prep of word cloud

#Reading dataset
chocolate <- read.csv("C:/Users/pratik/Documents/notes/SEMESTER 8/R_lab/09_chocolate_bar_ratings.csv", na.strings=c(""," "," ","NA"), stringsAsFactors = FALSE, encoding = 'UTF-8')
head(chocolate)

#Rename columns for better understanding
names(chocolate)[1:9] <- c("Company_Maker", "Bar_Name","REF", "Review_Date", "Cocoa_Percentage", "Company_Location", "Rating", "Bean_Type", "Bean_Origin")

#check structure of data
str(chocolate)

# plot missing value percentage distribution
missing.values <- chocolate %>%
  tidyr::gather(key = "key", value = "val") %>%
  mutate(isna = is.na(val)) %>%
  group_by(key) %>%
  mutate(total = n()) %>%
  group_by(key, total, isna) %>%
  summarise(num.isna = n()) %>%
  mutate(pct = num.isna / total * 100)

levels <-
  (missing.values  %>% arrange(desc(pct)))$key

percentage.plot <- missing.values %>%
  ggplot() +
  geom_bar(aes(x = reorder(key, desc(pct)),
               y = pct, fill=isna),
           stat = 'identity', alpha=0.8) +
  scale_x_discrete(limits = levels) +
  scale_fill_manual(name = "Status",
                    values = c('darkgreen', 'red'), labels = c("Present", "Missing")) +
  coord_flip() +
  labs(title = "Percentage of missing values", x =
         'Variable', y = "% of missing values")
percentage.plot

#50% of Bean_Type in NA, we exclude this column for now
chocolate = select (chocolate,-c(Bean_Type))

chocolate = chocolate %>% group_by(Company_Maker) %>% fill(Bean_Origin)

#now filter NA rows
chocolate = chocolate[complete.cases(chocolate), ]

#percentage field is a string field we will convert it to numeric value
chocolate$Cocoa_Percentage <- as.numeric(sub("%", "", chocolate$Cocoa_Percentage))
head(chocolate)

#What is the correlation between given features?
chocolate_cor <- data.frame(chocolate$REF, chocolate$Review_Date, chocolate$Cocoa_Percentage, chocolate$Rating)
names(chocolate_cor)[1:4] <- c('REF', 'Review Date', 'Cocoa %', 'Rating')

chocolate_cor <- round(cor(chocolate_cor), 4)

corrplot(chocolate_cor, method = 'circle', type = 'upper', tl.srt = 45)

#REF shows high correlation with Review date that is because of the fact that REF is just a reference number that
#increases as more and more reviews are added day by day.
#next REF and Rating have high correlation

#Top 10 companies
companies = chocolate %>% group_by(Company_Maker) %>%
  summarize(count=n(), .groups = 'drop') %>% arrange(desc(count)) %>% top_n(20)

ggplot(companies, aes(x = reorder(Company_Maker, -count), y = count))+
  geom_bar(stat = 'identity', width = 0.7, fill = "#009999", alpha=0.5) +
  labs(x = "Company", y = "Count", title = "Top 10 companies") +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))

#treemap for Bar_Name and Bean_Origin
treemap_data = chocolate %>% group_by(Bar_Name, Bean_Origin) %>% summarise(count=n()) %>% arrange(desc(Bar_Name,count))
treemap_data = treemap_data[complete.cases(treemap_data), ]
top_5_origin = chocolate %>% group_by(Bar_Name) %>% summarise(count=n()) %>% arrange(desc(count)) %>% top_n(5)
treemap_data = treemap_data[treemap_data$Bean_Origin %in% pull(top_5_origin,Bar_Name), ]
treemap_data = treemap_data %>% group_by(Bean_Origin) %>% arrange(desc(count)) %>% top_n(5)
ggplot(treemap_data, aes(area = count, fill=count,label = Bar_Name,
                subgroup = Bean_Origin)) +
  geom_treemap() +
  geom_treemap_subgroup_border(colour = "white", size = 5) +
  geom_treemap_subgroup_text(place = "centre", grow = T, alpha = 0.5, colour =
                               "black", fontface = "italic", min.size = 0) +
  geom_treemap_text(colour = "white", place = "topleft", reflow = T)

# cocoa percentage by origin
cocoa_percent = chocolate %>% group_by(Bean_Origin) %>%
  mutate(Stat=mean(Cocoa_Percentage)) %>% arrange(desc(Stat)) %>% select(c('Bean_Origin', 'Stat'))
top_5_origin = chocolate %>% group_by(Bean_Origin) %>% summarise(count=n()) %>% arrange(desc(count)) %>% top_n(10)
cocoa_percent = cocoa_percent[cocoa_percent$Bean_Origin %in% pull(top_5_origin,Bean_Origin), ]
cocoa_percent = cocoa_percent %>% group_by(Bean_Origin) %>% summarise(count=n()) %>% arrange(desc(count)) %>% top_n(10)
ggplot(chocolate[chocolate$Bean_Origin %in% cocoa_percent$Bean_Origin,],aes(x = Bean_Origin, y = Cocoa_Percentage)) +
  geom_boxplot(aes(fill=Bean_Origin)) +
  coord_flip() +
  labs(x='Bean Origin',y='Cocoa percentage', title = "Cocoa percantage for Bean Origin")

#Checking which coutries have more chocolate companies and taking the top 10 in the form of barplot
select_country = chocolate %>% group_by(Company_Location) %>%
  summarize(count=n(), .groups = 'drop') %>% arrange(desc(count)) %>% top_n(20)

ggplot(select_country, aes(x=reorder(Company_Location, count), y = count) ) +
  geom_segment(size=2,aes(x=reorder(Company_Location, count) ,xend=reorder(Company_Location, count), y=0, yend=count), color="grey") +
  geom_point(size=4, color="#009E73") +
  coord_flip() +
  theme(
    panel.grid.minor.y = element_blank(),
    panel.grid.major.y = element_blank(),
    legend.position="none"
  ) +
  xlab("") +
  ylab("Top 10 countries with most chocolate companies")

#Checking which coutries have more chocolate companies and taking the top 10 in the form of word cloud
word_choc <- gsub(" ", "",chocolate$Company_Maker)
corpus = Corpus(VectorSource(word_choc))

wordcloud(corpus, max.words = 60, random.order = TRUE,
          scale = c(1.5,0.5), rot.per = 0.3, colors = brewer.pal(5, "Set1"))

#Where does the cocoa bean come from?
select_bean <- chocolate %>% group_by(Bean_Origin) %>% summarize(count = n(), .groups = 'drop') %>% arrange(desc(count)) %>% top_n(10)
select_bean

#With a boxplot we're going to see the relation between country and their ratings
country = as.character(select_country$Company_Location)
score_select_country = chocolate %>% filter(Company_Location %in% country) %>%
  select(Company_Location, Rating) %>% arrange(Company_Location)

p1 = ggplot(score_select_country,aes(x = reorder(Company_Location, Rating, median), y = Rating)) +
  geom_boxplot(aes(fill = Company_Location)) +
  coord_flip() +
  labs(x='Country',y='Rating')

#As we did with countries we're going to see a boxplot with these countries and relate it with the Ratings means
select_bean <- as.character(select_bean$Bean_Origin)
bean_score <- chocolate %>% filter(Bean_Origin %in% select_bean) %>% select(Bean_Origin, Rating) %>% arrange(Bean_Origin)
p2 = ggplot(bean_score, aes(x = reorder(Bean_Origin, Rating, mean), y = Rating)) +
  geom_boxplot(aes(fill = Bean_Origin)) +
  coord_flip() +
  labs(x = "Bean Origin", y = "Ratings") +
  theme(axis.text.x=element_text(angle = 45, vjust = 0.6))

multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
  library(grid)

  # Make a list from the ... arguments and plotlist
  plots <- c(list(...), plotlist)

  numPlots = length(plots)

  # If layout is NULL, then use 'cols' to determine layout
  if (is.null(layout)) {
    # Make the panel
    # ncol: Number of columns of plots
    # nrow: Number of rows needed, calculated from # of cols
    layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
                     ncol = cols, nrow = ceiling(numPlots/cols))
  }

  if (numPlots==1) {
    print(plots[[1]])

  } else {
    # Set up the page
    grid.newpage()
    pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))

    # Make each plot, in the correct location
    for (i in 1:numPlots) {
      # Get the i,j matrix positions of the regions that contain this subplot
      matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))

      print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
                                      layout.pos.col = matchidx$col))
    }
  }
}
multiplot(p1,p2,cols=2)

# There are 74 chocolate bar without Bean Origin
# ERROR
#Top 10 countries where the cocoa bean come from
select_bean <- chocolate %>% group_by(Bean_Origin) %>% summarize(count = n(), .groups = 'drop') %>% arrange(desc(count)) %>% top_n(10)
select_bean <- na.omit(select_bean)
ggplot(select_bean, aes(x = reorder(Bean_Origin, -count), y = count))+
  geom_bar(stat = 'identity',width = 0.8, col='black',fill = "#c693ff") +
  labs(x = "Country", y = "Count", title = "Top 10 countries where the cocoa bean come from")+
  theme(axis.text.x=element_text(angle = 45, vjust = 0.6))

#We can also verify how these ratings are distributed
ratings_sum <- chocolate %>% group_by(Rating) %>% summarize(count=n(), .groups = 'drop') %>% arrange(desc(count))
p1 = ggplot(data=ratings_sum, aes(x=Rating, y=count, group=1)) +
    geom_line(colour='#f7ca89', size=2)+
    geom_point(colour='#ff8c00', size=2)+
    geom_text(colour='#4d4d4d',
    label=ratings_sum$count,
    nudge_x = 0.15, nudge_y = 0.25,
    check_overlap = T) +
    labs(x='',y = "Count")

# We can se that there are only 2 Chocolate bars with the highest grade and 4 with the lowest
#chocolate[chocolate$Rating == 5.00,]
#chocolate[chocolate$Rating == 1.00,]
p2 = ggplot(chocolate, aes(x=Rating))+
  geom_histogram(aes(y=..density..), color="black", fill="white", bins = 18)+
  geom_density(alpha=0.5, fill="#00b8ff")+
  labs(x="Ratings", y="Density")
multiplot(p1, p2)

#Comparison of Means
#Now we're going to take the top 5 coutries that produces more chocolate and compare their rating distribuition.
usa_rating <- chocolate %>% group_by(Company_Location) %>% filter("U.S.A." %in% Company_Location) %>% select(Rating)
france_rating <- chocolate %>% group_by(Company_Location) %>% filter("France" %in% Company_Location) %>% select(Rating)
canada_rating <- chocolate %>% group_by(Company_Location) %>% filter("Canada" %in% Company_Location) %>% select(Rating)
uk_rating <- chocolate %>% group_by(Company_Location) %>% filter("U.K." %in% Company_Location) %>% select(Rating)
italy_rating <- chocolate %>% group_by(Company_Location) %>% filter("Italy" %in% Company_Location) %>% select(Rating)

top_five <- rbind(usa_rating, uk_rating, france_rating, canada_rating, italy_rating)
top_five <- as.data.frame(top_five)
top_five[,1] <- as.factor(top_five[,1])

#a density plot of ratings for each location
ggplot(top_five, aes(x = Rating)) +
  geom_density(aes(group = Company_Location, fill = Company_Location), alpha = 0.6)+
  labs(x = "Ratings", y = "Density", fill = "Company Location")

#facet of a density plot of ratings for each location
ggplot(top_five, aes(x = Rating)) +
  geom_density(aes(group = Company_Location, fill = Company_Location), alpha = 0.6)+
  labs(x = "Ratings", y = "Density", fill = "Company Location")+
  facet_wrap(~Company_Location)


# Compute a set of variables from the raw data.
Trials = read.csv(paste("YOURDIR/YOURFILENAME"));
saveFileName="YOURFILENAME";
cohValues = unique(Trials$coherence);
cohValues = sort(cohValues,decreasing=FALSE)
# Now count number of trials for each condition
# Should be much easier than this but I am struggling :)

dNameRows = c("cor", "err");
dNameCols = cohValues;
quantileNames = c(seq(from=0.1,to=0.9,by=0.1),0.975)

quantileNames = c(seq(from=0.1,to=0.9,by=0.1))

counts = matrix(data=NA, nrow=2,ncol=length(cohValues), dimnames=list(dNameRows, dNameCols));
accuracy = c(cohValues);
quantiles = array(data=NA, dim = c(length(quantileNames),2,length(cohValues)), dimnames=list(quantileNames, dNameRows, dNameCols))

pb = array(data=NA, dim = c(10,2,length(cohValues)), dimnames=list(1:10, dNameRows, dNameCols))

plot(y=NULL,x=NULL,ylim=c(0.3, 1.0),xlim=c(0,1),ylab="",xlab="")

whichQ = seq(1,10,2)

cnt = 1;
print("Writing down different coherence values")
# Here we had 7 levels of coherence
for(cid in c(4,10,20,31,40,60,90)){
  # print(cid)
  iX = Trials$coherence==cid;
  # print(sum(Trials$correct[iX]==1))
  temp = sum(Trials$correct[iX]==1);
  counts[1,cnt] = temp;

  temp = sum(Trials$correct[iX]==0);
  counts[2,cnt] = temp;

  accuracy[cnt] = counts[1,cnt]/(counts[1,cnt] + counts[2,cnt]);

  ixCorrect = Trials$correct==1 & Trials$coherence==cid;
  ixWrong = Trials$correct==0 & Trials$coherence==cid;

  quantiles[1:length(quantileNames),1,cnt] = quantile(Trials$rt[ixCorrect],quantileNames);
  quantiles[1:length(quantileNames),2,cnt] = quantile(Trials$rt[ixWrong],quantileNames);

  pb[1:10,1,cnt] = counts[1,cnt]/10; # Divide by 10 because you have quantiles :)!
  pb[1:10,2,cnt] = counts[2,cnt]/10;

  points(rep(accuracy[cnt],1,length(whichQ)), quantiles[whichQ,1,cnt],col="green3", pch=4)
  points(1-rep(accuracy[cnt],1,length(whichQ)), quantiles[whichQ,2,cnt],col="red3",pch=4)
  cnt = cnt + 1;

  # Get percentiles for the correct and incorrect values for each value of coherence

  }
names(accuracy)<-cohValues

p = accuracy;
q = quantiles;
n = counts;
x = subset(Trials,select=c("coherence","correct","rt"));

dat = list(p=p,n=n,q=q,pb=pb,x=x);
save(file=saveFileName,dat);

# Now create the pb


library(ggplot2)
tashu <- read.csv('tashu.csv', header = TRUE)

top_rent <- data.frame(table(tashu $ RENT_STATION))
top_return <- data.frame(table(tashu $ RETURN_STATION))

merged <- merge(top_rent, top_return, by = 'Var1')
merged

top_station <- data.frame(station = c(merged $ Var1), count = c(merged $ Freq.x + merged $ Freq.y))
top_station <- top_station[order(top_station $ count, decreasing = T),]
top_station[1:10,]

top_station $ station <- as.factor(top_station $ station)
top_station $ count <- as.factor(top_station $ count)
ggplot(top_station[1:10,], aes(station, count, variable)) + geom_bar(stat = 'identity') + scale_colour_manual(values=c(colours(), 10))


# Goal: obtain plot of CFP vs RFP for mixed infected pSeg population
library(Hmisc)
library(Cairo)

dna  = read.table('dapi.csv',header=T,sep=',',stringsAsFactors=F)
cfp  = read.table('cfp.csv',header=T,sep=',',stringsAsFactors=F)
rfp  = read.table('rfp.csv',header=T,sep=',',stringsAsFactors=F)

# Quick QC of cell cycle

hist(log2(dna$sum_nucleus),100     )
maxDNA = 20
minDNA = 19.75

keep   = log2(dna$sum_nucleus) < maxDNA &
         log2(dna$sum_nucleus) > minDNA

dna  = log2(dna[keep,'sum_nucleus'])
cfp  = log2(cfp[keep,'sum_nucleus'])
rfp  = log2(rfp[keep,'sum_nucleus'])

# Correct using DNA
# RFP first
plot( NA, NA, xlim=c(19.75,20),
      ylim=c(13.5,22))

rk = kmeans( rfp, 2 )
for( m in 1:2 ){
  indices = rk$cluster == m
  points( dna[indices],rfp[indices],
          pch=16,
          col=rgb(c(0,1)[m],0,c(1,0)[m],.5))
  fit = lm(rfp[indices]~dna[indices])
  abline(fit, col='black', lwd=3)

  legend(c('topleft','bottomleft')[m],
         paste(round(rcorr(rfp[indices],dna[indices],type='pearson')$r[2],2)),
         text.col=rgb(c(0,1)[m],0,c(1,0)[m]),bty='n')

  rfp[indices] = median(rfp[indices])+fit$residuals
}

# CFP next
plot( NA, NA, xlim=c(19.75,20),
      ylim=c(16.8,20.5))

ck = kmeans( cfp, 2 )
for( m in 1:2 ){
  indices = ck$cluster == m
  points( dna[indices],cfp[indices],
          pch=16,
          col=rgb(c(0,1)[m],0,c(1,0)[m],.5))
  fit = lm(cfp[indices]~dna[indices])
  abline(fit, col='black', lwd=3)

  legend(c('topleft','bottomleft')[m],
         paste(round(rcorr(cfp[indices],dna[indices],type='pearson')$r[2],2)),
         text.col=rgb(c(0,1)[m],0,c(1,0)[m]),bty='n')

  cfp[indices] = median(cfp[indices])+fit$residuals
}

#######

#

ak = kmeans(cbind(cfp,rfp),4,iter.max=100,nstart=10)

CairoSVG( 'mixed.svg', width=4,height=4)

plot(NA,NA, xlim=c(min(cfp),max(cfp)),
     ylim=c(min(rfp),max(rfp)),
     xlab='CFP',ylab='RFP')

corrs  = c()
cols   = c()
counts = c()
for( m in 1:4 ){
  indices = ak$cluster == m
  col = rgb(c(0,1,0,0)[m],c(0,0,.5,0)[m],c(1,0,1,0)[m],.25)
  points( cfp[indices],rfp[indices],
          pch=16,
          col=col)
  cols = c(cols,col)
  corrs = c(corrs,
            round(rcorr(cfp[indices],rfp[indices],'pearson')$r[2],2))
  counts = c(counts,sum(indices))
}

legend( 'bottomright',
        paste(round(counts/sum(counts)*100),'%',sep=''),
        text.col=cols,bty='n')

dev.off()


###################################
# Prepare the working environment #
###################################

Sys.setlocale(category = "LC_ALL", locale = "English")
working_dir = 'D:/Google/MIT/DataScience/Project/Power'
setwd(working_dir)
#install.packages(c("VIM","mice"))
getwd()
rm(list=ls())

###################################
# Load the data from the txt file #
###################################

# load data from the txt file function
load_data <- function(filename){
  Data <- read.csv(file=filename,header=TRUE,sep=";")
  return(Data)
}

# load data in mydata data.frame
raw_data <- load_data("./code/household_power_consumption.txt")
# print('Original Summary Data')
# print(summary(mydata))
raw_data$version <- 0
mydata <- raw_data

####################################
# Assign Proper type to the values #
####################################

# Deal with data to make them the proper data format
format_data <-function(mydata){
  mydata$DateFull <- paste(mydata$Date,mydata$Time)
  mydata$DateFull <- as.POSIXct(mydata$DateFull,"%d/%m/%Y %H:%M:%S",tz=Sys.timezone())
  mydata$Date <- as.Date(mydata$Date,"%d/%m/%Y")
  mydata$DateTimeS <- as.POSIXct(mydata$Time,"%H:%M:%S",tz=Sys.timezone())
  mydata$Global_active_power <- as.numeric(as.character(mydata$Global_active_power))
  mydata$Global_reactive_power <- as.numeric(as.character(mydata$Global_reactive_power))
  mydata$Global_intensity <- as.numeric(as.character(mydata$Global_intensity))
  mydata$Voltage <- as.numeric(as.character(mydata$Voltage))
  mydata$Sub_metering_1 <- as.numeric(as.character(mydata$Sub_metering_1))
  mydata$Sub_metering_2 <- as.numeric(as.character(mydata$Sub_metering_2))
  mydata$Sub_metering_3 <- as.numeric(as.character(mydata$Sub_metering_3))
  return(mydata)
}

mydata = format_data(mydata)
mydata$version <- 1

#====================================================================================#

##########################
# Deal with missing Data #
##########################

#########################################
# I. Analysze Missing Data Distribution #
#########################################

###################
# a. Summary Data #
###################
print('Summary Data')
print(summary(mydata))

####################################
# b. Find Missing Rate and Counts #
####################################

# Find the missing rate of the data
pMiss <- function(x) {sum(is.na(x))/length(x)*100}
print('Missing data rate for each column')
print(apply(mydata,2,pMiss))

# Analysis with mice
library(mice)
print(md.pattern(mydata))

#################################
# c. Visualize the missing data #
#################################

library('VIM')

# show missing data matrix
png('./img/Data-Missing-Matrix.png')
matrixplot(mydata)
dev.off()

# Data-Missing-Meter-3 check the missing values graph in sub-metering
png('./img/Data-Missing-Time-Meter-3.png')
par(mfrow=c(3,2))
marginplot(mydata[c("DateFull","Sub_metering_3")],col=c("darkgray","red","blue"))
#dev.off()

#png('./img/Data-Missing-Time-Voltage.png')
marginplot(mydata[c("DateFull","Voltage")],col=c("darkgray","red","blue"))
#dev.off()

#png('./img/Data-Missing-Time-Meter-2.png')
marginplot(mydata[c("DateFull","Sub_metering_2")],col=c("darkgray","red","blue"))
#dev.off()

#png('./img/Data-Missing-Time-Intensity.png')
marginplot(mydata[c("DateFull","Global_intensity")],col=c("darkgray","red","blue"))
#dev.off()

#png('./img/Data-Missing-Time-Global_Active.png')
marginplot(mydata[c("DateFull","Global_active_power")],col=c("darkgray","red","blue"))
#dev.off()

#png('./img/Data-Missing-Time-Global_ReActive.png')
marginplot(mydata[c("DateFull","Global_reactive_power")],col=c("darkgray","red","blue"))
dev.off()

#png('./img/Data-Missing-Time-Meter-3.png')
marginplot(mydata[c("DateFull","Sub_metering_3")],col=c("darkgray","red","blue"))
#dev.off()

dev.off()
################################################
# d. Analysis the distribution of Missing data #
################################################

# The missing data can be analyszed from 2 aspects
# 1. The time is random or meaning something
# 2. The data before and after it, cause it? (High Intensity or ?)

missing_data_time =  subset(mydata,is.na(mydata$DateFull))
missing_data_other = subset(mydata,is.na(mydata$Global_active_power))

#########
# Notes #
#########
# 1. The missing of the data is because some unknown of the equipment or network, and most happen in 2007 and 2008, mainly in 3 parts.
# 2. After analysze the data near the missing data, we found that the high voltage is not the reason why the data is missing.
# 3. we infer that it may caused because the outrage nearby
# 4. So we decide to drop the data null

############################
# e. Drop the missing rows #
############################

clean_data <- na.omit(mydata)
clean_data$version <- 2

###################################
# f. add other data to the column #
###################################

clean_data$Sub_metering_other <- (clean_data$Global_active_power*1000/60)-clean_data$Sub_metering_1-clean_data$Sub_metering_2-clean_data$Sub_metering_3
print('Summary for sub meter other')
print(summary(clean_data$Sub_metering_other))

# replace the sub meter other < 0 with 0
clean_data$Sub_metering_other[clean_data$Sub_metering_other < 0 ] <- 0

clean_data$version <- 3
#===========================================================================#

####################
# Explore the data #
####################

# a. summary the data
print('Summary for clean data')
print(summary(clean_data))

png('./img/Data-Range-Global_Activate_Power.png')
par(mfrow=c(4,2))
plot(clean_data$DateFull,clean_data$Global_active_power,main='Global Active Power')
# dev.off()

# png('./img/Data-Range-Global_ReActivate_Power.png')
plot(clean_data$DateFull,clean_data$Global_reactive_power,main='Global ReActive Power')
# dev.off()

#png('./img/Data-Range-Voltage.png')
plot(clean_data$DateFull,clean_data$Voltage,main='Voltage')
#dev.off()

#png('./img/Data-Range-Global_Intensity.png')
plot(clean_data$DateFull,clean_data$Global_intensity,main='Global Intensity')
#dev.off()

#png('./img/Data-Range-Sub_Metering_1.png')
plot(clean_data$DateFull,clean_data$Sub_metering_1,main='Sub Metering 1')
#dev.off()

#png('./img/Data-Range-Sub_Metering_2.png')
plot(clean_data$DateFull,clean_data$Sub_metering_2,main='Sub Metering 2')
#dev.off()

#png('./img/Data-Range-Sub_Metering_3.png')
plot(clean_data$DateFull,clean_data$Sub_metering_3,main='Sub Metering 3')
#dev.off()

#png('./img/Data-Range-Sub_Metering_other.png')
plot(clean_data$DateFull,clean_data$Sub_metering_other,main='Sub Metering Other')
dev.off()

# b. Data Preprocessing
# seperate the year,month,day,hour,minute into different column
clean_data$Year = format(clean_data$DateFull,format="%Y")
clean_data$Month = format(clean_data$DateFull,format="%m")
clean_data$Day = format(clean_data$DateFull,format="%d")
clean_data$Hour = format(clean_data$DateFull,format="%H")
clean_data$Minute = format(clean_data$DateFull,format="%M")
clean_data$DayOfYear = format(clean_data$DateFull,format="%j")

# Total Power
clean_data$Global_Power <- sqrt(clean_data$Global_active_power^2+clean_data$Global_reactive_power^2)
clean_data$Phase <- clean_data$Global_active_power/clean_data$Global_Power

png('./img/Data-Explore-Phase-VS-Voltage.png')
par(mfrow=c(3,1))
plot(clean_data$Phase,clean_data$Voltage)
#dev.off()

#png('./img/Data-Explore-Phase-VS-Intensity.png')
plot(clean_data$Phase,clean_data$Global_intensity)
#dev.off()

# png('./img/Data-Explore-Global_Power-vs-Date.png')
# plot(clean_data$DateFull,clean_data$Global_Power)
# dev.off()

#png('./img/Data-Explore-Voltage-vs-Intensity.png')
plot(clean_data$Voltage,clean_data$Global_intensity)
dev.off()

png('./img/Data-Explore-Pie-Chart-Meters.png')
slice <- c(sum(clean_data$Sub_metering_1),sum(clean_data$Sub_metering_2),sum(clean_data$Sub_metering_3),sum(clean_data$Sub_metering_other))
lbls <- c('Sub_Meter_1','Sub_Meter_2','Sub_Meter_3','Sub_Meter_Other')
piepercent<- round(100*slice/sum(slice), 1)
pie(slice,labels = piepercent,main="Pie Chart of the Power Comsuption",col=rainbow(length(slice)))
legend("topright", c("Meter1","Meter2","Meter3","Meter_other"), cex = 0.8,fill = rainbow(length(slice)))
dev.off()


Nicholas Ieng Kit Ho, 2016. All rights reserved. Cannot be copied, re-used, or edited

#METHOD 1 - Tree-based Classifier: Recursive Partitioning

library(rpart)
url <- "http://archive.ics.uci.edu/ml/machine-learning-databases/mushroom/agaricus-lepiota.data"
# read data
mushrooms <- read.table(file=url, header=F, sep=",")
set.seed(120)
# split data into train and test
ind = sample(2,nrow(mushrooms), replace=T, prob=c(0.7,0.3))
train.mushrooms = mushrooms[ind==1,]
test.mushrooms = mushrooms[ind==2,]
# set control parameter
myc <- rpart.control(minsplit=3,cp=1e-8)
# fit the model
tree <- rpart(V1~., data=train.mushrooms, method="class")
cpt <- tree$cptable[which.min(tree$cptable[,"xerror"]),"CP"]
# prune tree
ptree <- prune(tree, cp=cpt)
# determine the estimated future misclassification rate
pred.ptree <- predict(ptree, newdata=test.mushrooms[,-1], type='class')
tab <- table(as.vector(test.mushrooms$V1),as.vector(pred.ptree))
fmr.rpart <- sum(tab[row(tab)!=col(tab)])/sum(tab)
fmr.rpart

set.seed(121)

#METHOD 2 - Classification Tree

require(tree)
train.dat <- train.mushrooms
train.dat$V1 <- as.factor(train.dat$V1)
tree2 <- tree(V1~., data = train.dat)
test.dat <- test.mushrooms
test.dat$V1 <- as.factor(test.dat$V1)
pred.tree2 <- predict(tree2, newdata=test.dat[,-1], type ='class')
tab2<-table(as.vector(test.dat$V1),as.vector(pred.tree2))
fmr.tree <- sum(tab2[row(tab2) != col(tab2)]) / sum(tab2)
fmr.tree

set.seed(122)

# METHOD 1 - Ensemble: Bagging

library(adabag)
mushrooms.bagging <- bagging(V1~.,data=train.mushrooms,mfinal=100)
mushrooms.predbagging <- predict.bagging(mushrooms.bagging, newdata=test.mushrooms[,-1])
mushrooms.predbagging <- as.factor(mushrooms.predbagging$class)
mushrooms.predbagging <- as.factor(mushrooms.predbagging)
# estimate future misclassfication rate
tab.bag<-table(as.vector(test.mushrooms$V1),as.vector(mushrooms.predbagging))
fmr.bag <- sum(tab.bag[row(tab.bag) != col(tab.bag)]) / sum(tab.bag)
fmr.bag

set.seed(123)
library(adabag)
library(rpart)

# METHOD 2 - Ensemble: Boosting (AdaBoost)
mushrooms.boosting <- boosting(V1~.,data=train.mushrooms)
mushrooms.predboosting <- predict.boosting(mushrooms.boosting, newdata=test.mushrooms[,-1])
mushrooms.predboosting <- mushrooms.predboosting$class
mushrooms.predboosting <- as.factor(mushrooms.predboosting)
# estimate future misclassification rate
tab.boosting <-table(as.vector(test.mushrooms$V1),as.vector(mushrooms.predboosting))
fmr.boosting <- sum(tab.boosting[row(tab.boosting) != col(tab.boosting)]) / sum(tab.boosting)
fmr.boosting


titanic <- read.csv("dataset/titanic.csv")
View(head(titanic))

head(titanic_data,10)
tail(titanic_data,10)
names(titanic_data)

str(titanic_data)
summary(titanic)

sin_valor <- function(x){
  sum = 0
  for(i in 1:ncol(x))
  {
    cat("En la columna",colnames(x[i]),"total de valores NA:",colSums(is.na(x[i])),"\n")
  }
  print()
}
sin_valor(titanic)

en_blanco <- function(x){
  sum = 0
  for(i in 1:ncol(x))
  {
    cat("En la columna",colnames(x[i]),"total de valores en blanco:",colSums(x[i]==""),"\n")
  }
}
en_blanco(titanic)

library(ggplot2)
library(scales)
ggplot(data = titanic, aes(x = Survived, y = Fare, fill = factor(Pclass))) +
  geom_boxplot() +
  geom_hline(aes(yintercept = 80),
             colour = "red", linetype = "dashed", lwd = 2) +
  scale_y_continuous(labels = dollar_format()) +
  theme_bw()

titanic$Survived[c(62, 830)] <- "C"

barplot(table(titanic$Pclass), main="Pasajeros de Titanic por Cl
ase", names= c("Primera", "Segunda", "Tercera"))

table(titanic$Sex)
barplot(table(titanic$Sex), main="Pasajeros del Titanic por Gen
ero", names= c("Mujer", "Hombre"))

counts = table(titanic$Survived, titanic$Sex)
barplot(counts, col=c("green","yellow"), legend = c("Murieron", "Sobr
evivieron"), main = "Sobreviviencia de Pasajeros por Genero")

counts1 = table(titanic$Survived, titanic$Pclass)
barplot(counts1, col=c("green","yellow"), legend = c("Murieron","Sobr
evivieron"), main = "Sobreviviencia de Pasajeros por Clase", names= c("
Primera", "Segunda", "Tercera"))