> ## Demo from RO implementors
> library(R0)
Loading required package: MASS
>
> # Generating an epidemic with given parameters
> mGT <- generation.time("gamma", c(3,1.5))
> mEpid <- sim.epid(epid.nb=1, GT=mGT, epid.length=30, family="poisson", R0=1.67, peak.value=500)
> mEpid <- mEpid[,1]
> # Running estimations
> est <- estimate.R(epid=mEpid, GT=mGT, methods=c("EG","ML","TD"))
Waiting for profiling to be done...
Warning messages:
1: In est.R0.TD(epid = c(1, 1, 1, 1, 1, 3, 1, 2, 1, 6, 2, 6, 4, 12,  :
  Simulations may take several minutes.
2: In est.R0.TD(epid = c(1, 1, 1, 1, 1, 3, 1, 2, 1, 6, 2, 6, 4, 12,  :
  Using initial incidence as initial number of cases.
>
> # Model estimates and goodness of fit can be plotted
> plot(est)
> plotfit(est)
# Sensitivity analysis for the EG estimation; influence of begin/end dates
s.a <- sensitivity.analysis(res=est$estimates$EG, begin=1:15, end=16:30, sa.type="time")
# This sensitivity analysis can be plotted
plot(s.a)

# Set up the R environment with the necessary packages
install.packages(c("dplyr", "R0", "magrittr", "RCurl"))

# RUN PATTERN DEVELOPED BY C. MOREFIELD and ABSTRACTED by J. Mallery
# Load libraries
library(R0)
library(RCurl)
library(data.table)

fetch_JHU_Data <- function() {
	csv <- getURL("https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_19-covid-Confirmed.csv")
	data <- read.csv(text = csv, check.names = F)
	names(data)[1] <- "ProvinceState"
	names(data)[2] <- "CountryRegion"
	numberColumns <- length(names(data))
	data.table(data) }

prepare_dates <- function (date_vector)	{as_date(mdy(date_vector))}

fetch_JHU_Dates <- function() {
	rawdat = RCurl::getURL("https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_19-covid-Confirmed.csv")
	curdata = read.csv(text=rawdat, stringsAsFactors=FALSE, check.names=FALSE)
	date_vector <- names(curdata)[-c(1:4)]
	prepare_dates(date_vector )
	}

trimLeading <- function(x, value=0) {
	w <- which.max(cummax(x != value))
	x[seq.int(w, length(x))] }

extract_country_data <- function (name, data) {
	cdata <- data[CountryRegion == name]
	cdata}

extract_ProvinceState_data <- function (name, data) {data[ProvinceState == name] }

diff_data <- function (cdata) {
	cdata <- append(cdata[1], diff(cdata))
	cdata <- trimLeading(cdata, value = 0)
	cdata}

prepare_data <- function (cdata) {
	cdata <- cdata[,5:numberColumns]
	names(cdata) <- NULL
	cdata <- unlist(c(cdata))
	cdata <- diff_data(cdata)
	cdata}

# Fetch the data
my_data <- fetch_JHU_Data()
numberColumns <- length(names(my_data))
my_dates <- fetch_JHU_Dates()

# SERIAL TIME INTERVAL
GT.cov2 <- generation.time("gamma", c(4.75, 3.96))
# GT.cov2 <- generation.time("gamma", c(5.8,.95)) # from DOI 10.7326/M20-0504

# EUROPE
data.France <- extract_ProvinceState_data("France", my_data)
diff.France <- prepare_data(data.France)
R.France <- My_Estimate_R(my_dates,diff.France)
R.France

epid.count <- prepare_data(extract_country_data("Germany", my_data))
R.Germany <- estimate.R(epid.count, GT = GT.cov2, methods = c("EG"))
R.Germany

epid.count <- prepare_data(extract_country_data("Germany", my_data))
R.Germany <- estimate.R(epid.count, GT = GT.cov2, methods = c("EG"))
R.Germany

epid.count <- prepare_data(extract_country_data("Italy", my_data))
R.Italy <- estimate.R(epid.count, GT = GT.cov2, methods = c("EG"))
R.Italy

epid.count <- prepare_data(extract_country_data("Spain", my_data))
R.Spain <- estimate.R(epid.count, GT = GT.cov2, methods = c("EG"))
R.Spain

epid.count <- prepare_data(extract_ProvinceState_data("United Kingdom", my_data))
R.UK <- estimate.R(epid.count, GT = GT.cov2, methods = c("EG"))
R.UK

# MIDDLE EAST
epid.count <- prepare_data(extract_country_data("Iran", my_data))
R.Iran<- estimate.R(epid.count, GT = GT.cov2, methods = c("EG"))
R.Iran

# ASIA
epid.count <- prepare_data(extract_country_data("Korea, South", my_data))
R.SouthKorea <- estimate.R(epid.count, GT = GT.cov2, methods = c("EG"))
R.SouthKorea

epid.count <- prepare_data(extract_country_data("Singapore", my_data))
R.Singapore <- estimate.R(epid.count, GT = GT.cov2, methods = c("EG"))
R.Singapore

# US States and Regions

epid.count <- prepare_data(extract_ProvinceState_data("Illinois", my_data))
R.Illinois <- estimate.R(epid.count, GT = GT.cov2, methods = c("EG"))
R.Illinois

epid.count <- prepare_data(extract_ProvinceState_data("New York", my_data))
R.NewYork <- estimate.R(epid.count, GT = GT.cov2, methods = c("EG"))
R.NewYork

epid.count <- prepare_data(extract_ProvinceState_data("Massachusetts", my_data))
R.Massachusetts <- estimate.R(epid.count, GT = GT.cov2, methods = c("EG"))
R.Massachusetts

epid.count <- prepare_data(extract_ProvinceState_data("California", my_data))
R.California <- estimate.R(epid.count, GT = GT.cov2, methods = c("EG"))
R.California

epid.count <- prepare_data(extract_ProvinceState_data("New Hampshire", my_data))
R.NewHampshire <- estimate.R(epid.count, GT = GT.cov2, methods = c("EG"))
R.NewHampshire

epid.count <- c(267, 99, 76, 126, 4, 71, 261, 172, 0, 362, 148)
R.Washington <- estimate.R(epid.count, GT = GT.cov2, methods = c("EG"))
R.Washington

data.US <- c(2, 2, 5, 5, 5, 5, 5, 7, 8, 8, 11, 11, 11, 11, 11, 11, 11, 11, 12, 12, 13, 13, 13, 13, 13, 13, 13, 13, 15, 15, 15, 51, 51, 57, 58, 60, 68, 74, 98, 118, 149, 217, 262, 402, 518, 583, 959, 1281, 1663, 2179, 2727, 3499, 4632, 6421, 7783, 13677, 19100, 25489, 38757)

epid.count <- diff_data(data.US)
R.US <- estimate.R(epid.count, GT = GT.cov2, methods = c("EG"))
R.US

Data.Grafton.NH <- c(1,2,2,2,2,2,3,3,3,3,3,3,3,3,5,7,7,9,12,13)
epid.count <- diff_data(Data.Grafton.NH)
R.Grafton.NH <- estimate.R(epid.count, GT = GT.cov2, methods = c("EG"))
R.Grafton.NH

# Vince Carey R Code to Estimate time dependent reproduction numbers
# with the attached code you should be able to do
# %vjcair> Rscript pure.R | tail -1
# Waiting for profiling to be done...
# 4.920046
suppressMessages({
suppressPackageStartupMessages({
ii = rownames(installed.packages())
if (!("BiocManager" %in% ii)) install.packages("BiocManager")
library(BiocManager)
if (!("R0" %in% ii)) BiocManager::install("R0")
library(R0)
if (!("lubridate" %in% ii)) BiocManager::install("lubridate")
library(lubridate)
})
})

#	c("1/22/20", "1/23/20", "1/24/20", "1/25/20", "1/26/20", "1/27/20", "1/28/20", "1/29/20", "1/30/20", "1/31/20", "2/1/20", "2/2/20", "2/3/20", "2/4/20", "2/5/20", "2/6/20", "2/7/20", "2/8/20", "2/9/20", "2/10/20", "2/11/20", "2/12/20", "2/13/20", "2/14/20", "2/15/20", "2/16/20", "2/17/20", "2/18/20", "2/19/20", "2/20/20", "2/21/20", "2/22/20", "2/23/20", "2/24/20", "2/25/20", "2/26/20", "2/27/20", "2/28/20", "2/29/20", "3/1/20", "3/2/20", "3/3/20", "3/4/20", "3/5/20", "3/6/20", "3/7/20", "3/8/20", "3/9/20", "3/10/20", "3/11/20", "3/12/20", "3/13/20", "3/14/20", "3/15/20", "3/16/20", "3/17/20", "3/18/20", "3/19/20", "3/20/20", "3/21/20")
datevec <- as_date(mdy(
	c( "1/24/20", "1/25/20", "1/26/20", "1/27/20", "1/28/20", "1/29/20", "1/30/20", "1/31/20", "2/1/20", "2/2/20", "2/3/20", "2/4/20", "2/5/20", "2/6/20", "2/7/20", "2/8/20", "2/9/20", "2/10/20", "2/11/20", "2/12/20", "2/13/20", "2/14/20", "2/15/20", "2/16/20", "2/17/20", "2/18/20", "2/19/20", "2/20/20", "2/21/20", "2/22/20", "2/23/20", "2/24/20", "2/25/20", "2/26/20", "2/27/20", "2/28/20", "2/29/20", "3/1/20", "3/2/20", "3/3/20", "3/4/20", "3/5/20", "3/6/20", "3/7/20", "3/8/20", "3/9/20", "3/10/20", "3/11/20", "3/12/20", "3/13/20", "3/14/20", "3/15/20", "3/16/20", "3/17/20", "3/18/20", "3/19/20", "3/20/20", "3/21/20", "3/22/20")
	))
cumevents <- data.US
names(cumevents) = datevec
plot(cumevents~as_date(ymd(names(cumevents))), main="US as of 3/22/2020 from JHU. World-o-Meters")
epid.count <- (diff(cumevents))
est1 = estimate.R(epid.count, GT = GT.cov2 , t = as_date(ymd(names(epid.count))),
  begin=1L, end=as.integer(length(epid.count)), methods=c("EG"))
cat(est1$estimates$EG$R, "\n")

library(dplyr)
library(magrittr)
library(RCurl)
library(R0)

fetch_JHU_Data = function (as.data.frame = FALSE)
{
    csv <- getURL("https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_19-covid-Confirmed.csv")
    data <- read.csv(text = csv, check.names = F)
    names(data)[1] <- "ProvinceState"
    names(data)[2] <- "CountryRegion"
    numberColumns <- length(names(data))
    if (!as.data.frame)
        return(data.table(data))
    data
}
get_series = function (province = "", country, dataset = try(fetch_JHU_Data(as.data.frame = TRUE)))
{
    if (inherits(dataset, "try-error"))
        stop("could not get data from fetch_JHU_Data()")
    stopifnot(all(c("ProvinceState", "CountryRegion") %in% colnames(dataset)))
    stopifnot(country %in% dataset$CountryRegion)
    ans = dataset %>% dplyr::filter(ProvinceState == province &
        CountryRegion == country)
    ans[, -c(1:4)]
}
plot_series = function (province = "", country, dataset = try(fetch_JHU_Data(as.data.frame = TRUE)),
    ...)
{
    if (inherits(dataset, "try-error"))
        stop("could not get data from fetch_JHU_Data()")
    ser = get_series(province = province, country = country,
        dataset = dataset)
    dates = lubridate::as_date(mdy(fix_slash_dates(names(dataset)[-c(1:4)])))
    plot(dates, ser, main = paste(province, country), ...)
}

as_vector = function(x) data.matrix(x)[1,,drop=TRUE]

my_plot <- function (title, cumulative_vector){}
	plot(cumulative_vector~as_date(ymd(names(cumulative_vector))), main= title)

# cvec = as_vector(get_series(country="Italy"))
# ivec = diff(cvec)
# tivec = trimLeading(ivec)
# estimate.R(tivec, GT=generation.time("gamma", c(3.5,4.8)), methods="EG")
# estimate.R(incidence_vector, GT = generation_time , t = as_date(myd(names(tivec))), begin=1L, end=as.integer(length(incidence_vector)), methods=c("EG"))}
# estimate.R(incidence_vector, GT=generation_time, methods="EG")
# 	estimate.R(incidence_vector, GT = generation_time , t = as_date(myd(names(tivec))), begin=1L, end=as.integer(length(incidence_vector)), methods=c("EG"))

# pass in the time vector and diff data
My_Estimate_R <- function (generation_time, incidence_vector) {
		estimate.R(incidence_vector, GT = generation_time , t = as_date(myd(names(incidence_vector))), begin=1L, end=as.integer(length(incidence_vector)), methods=c("EG"))
	}

# SCRIPTS FOR ESTIMATING VARIOUS REGIONS

GT.cov2 <- generation.time("gamma", c(4.75, 3.96))

data.France <- as_vector(get_series("France", "France"))
diff.France <- diff_data(data.France)
R.France <- My_Estimate_R (GT.cov2, diff.France)
R.France

data.Germany <- as_vector(get_series("", "Germany"))
diff.Germany <- diff_data(data.Germany)
R.Germany <- My_Estimate_R (GT.cov2, diff.Germany)
R.Germany

data.Italy <- as_vector(get_series("", "Italy"))
diff.Italy <- diff_data(data.Italy)
R.Italy <- My_Estimate_R (GT.cov2, diff.Italy)
R.Italy

data.Spain <- as_vector(get_series("", "Spain"))
diff.Spain <- diff_data(data.Spain)
R.Spain <- My_Estimate_R (GT.cov2, diff.Spain)
R.Spain

data.UK <- as_vector(get_series("United Kingdom",  "United Kingdom",))
diff.UK <- diff_data(data.UK)
R.UK <- My_Estimate_R (GT.cov2, diff.UK)
R.UK

# Middle East

data.Iran <- as_vector(get_series("", "Iran"))
diff.Iran <- diff_data(data.Iran)
R.Iran <- My_Estimate_R (GT.cov2, diff.Iran)
R.Iran

data.SouthKorea <- as_vector(get_series("", "Korea, South"))
diff.SouthKorea <- diff_data(data.SouthKorea)
R.SouthKorea <- My_Estimate_R (GT.cov2, diff.SouthKorea)
R.SouthKorea

data.Singapore <- as_vector(get_series("", "Singapore"))
diff.Singapore <- diff_data(data.Singapore)
R.Singapore <- My_Estimate_R (GT.cov2, diff.Singapore)
R.Singapore

# US States and Regions

data.NewYork <- as_vector(get_series("New York","US"))
diff.NewYork <- diff_data(data.NewYork)
R.NewYork <- My_Estimate_R (GT.cov2, diff.NewYork)
R.NewYork

data.Illinois <- as_vector(get_series("Illinois", "US"))
diff.Illinois <- diff_data(data.Illinois)
R.Illinois <- My_Estimate_R (GT.cov2, diff.Illinois)
R.Illinois

data.Massachusetts <- as_vector(get_series("Massachusetts", "US"))
diff.Massachusetts <- diff_data(data.Massachusetts)
R.Massachusetts <- My_Estimate_R (GT.cov2, diff.Massachusetts)
R.Massachusetts

data.California <- as_vector(get_series("California", "US"))
diff.California <- diff_data(data.California)
R.California <- My_Estimate_R (GT.cov2, diff.California)
R.California

data.NewHampshire <- as_vector(get_series("New Hampshire", "US"))
diff.NewHampshire <- diff_data(data.NewHampshire)
R.NewHampshire <- My_Estimate_R (GT.cov2, diff.NewHampshire)
R.NewHampshire


sd<-1
x<-rlnorm(10000,sd=sd,meanlog=2)
hist(x)
abline(v=median(x),col='blue')
abline(v=mean(x),col='red')

median(x)
mean(x)
exp((sd^2)/2)*median(x)


library(ggplot2)
library(data.table)
library(tseries)
library(forecast)
library(lmtest)
library(urca)

rm(list=ls())
gc()

# the following function selects the autoregressive order based on the 'SIC rule' as follows:
# (1) find the order, p (Schwarz Information Criterion);
# (2) test for serial correlation in residuals (Breusch-Godfrey test);
# (3) increase the order by 1, if we reject the null of no serial correlation;
# (4) repeat steps 2-3 until we fail to reject the null or if the autoregressive order, lag_opt, equals the predetermined maximum order, lag_max (set to 12).
ar_order <- function(x,max_lag=12,method="SIC",bg=TRUE){
  ic_func <- function(i){# optimal lag based on (A/S)IC
    fmla <- as.formula(paste("x~",paste0("x",c(1:i),collapse="+")))
    reg <- lm(fmla,data=d)
    if(method=="SIC"){
      log(crossprod(reg$resid))+log(nrow(d))*length(reg$coefficients)/nrow(d)
    }else{
      log(crossprod(reg$resid))+2*length(reg$coefficients)/nrow(d)
    }
  }
  bg_func <- function(i){# Breusch-Godfrey
    fmla <- as.formula(paste("x~",paste0("x",c(1:i),collapse="+")))
    as.numeric(bgtest(lm(fmla,data=d))[4])
  }
  d <- data.table(x=as.numeric(x))
  d <- d[,paste0("x",c(1:max_lag)) := shift(x,n=1:max_lag,fill=NA,type="lag")]
  d <- d[complete.cases(d)]
  ic_vec <- sapply(c(1:max_lag),ic_func)
  opt_lag <- which.min(ic_vec)
  if(bg){
    bg_vec1 <- sapply(c(opt_lag:1),bg_func)
    if(!is.na(which(bg_vec1 < .05)[1])){
      opt_lag <- opt_lag-which(bg_vec1 < .05)[1]+2
    }
    bg_vec2 <- sapply(c(opt_lag:max_lag),bg_func)
    if(!is.na(which(bg_vec2 < .05)[1])){
      if(which(bg_vec2 < .05)[1]==1){
        opt_lag <- opt_lag+sort(unlist(lapply(split(which(bg_vec2 < .05),cumsum(c(1,diff(which(bg_vec2 < .05)))!=1)),max),use.names=F))[1]
      }
    }
  }
  p <- ifelse(p<=max_lag,opt_lag,max_lag)
  return(p)
}

# load the function to test linearity against star-type alternatives
source("startest.r")

# load the price data
load("dataset.RData")

c.num <- ncol(prices_dt)-1

p <- 12
h <- 12

frac <- .8

n <- nrow(prices_dt)
R <- round(frac*n)
P <- n-R-h+1

c.names <- colnames(prices_dt)[-1]

select_ls <- list()

for(r in 1:P){

  select_dt <- data.table(c=c.names,i=as.numeric(NA),p=as.numeric(NA),d=as.numeric(NA),n=as.numeric(NA),t=as.numeric(NA),l=as.numeric(NA))

  for(k in 1:c.num){

    cmd <- c.names[k]

    y <- as.matrix(log(prices_dt[1:(R+r-1),..cmd]))

    ord <- ar_order(y,max_lag=p,method="SIC",bg=F)

    adf.l <- ur.df(y,type="drift",lags=ord)

    adf.ts <- adf.l@teststat["statistic","tau2"]
    adf.cv <- adf.l@cval["tau2","5pct"]

    select_dt[,2][k] <- ifelse(adf.ts < adf.cv,0,1)

    dy <- c(0,diff(y))
    ord <- ord-1

    dmat <- embed(dy,p+h+1)
    lmat <- embed(y,p+h+1)

    if(ord==0){
      test.sc <- startest(y=dmat[,1],x=rep(1,nrow(dmat)),x.n=rep(1,nrow(dmat)),tvar=dmat[,2],tvar.lag=0,contemp=F,ascending=T)
    }else{
      test.sc <- startest(y=dmat[,1],x=cbind(1,dmat[,2:(2+ord-1)]),x.n=cbind(1,dmat[,2:(2+ord-1)]),tvar=dmat[,2:(2+ord-1)],tvar.lag=0,contemp=F,ascending=T)
    }

    d <- as.numeric(substr(rownames(test.sc$star)[1],3,4))

    p_vec <- test.sc$star[1,c("p.3","p.2","p.1")]
    t_min <- p_vec[which.min(p_vec)]
    if(which.min(p_vec)==2){
      tf <- "e"
      select_dt[,7][k] <- 0
    }else{
      tf <- "l"
      select_dt[,7][k] <- 1
    }

    select_dt[,3][k] <- ord+1
    select_dt[,4][k] <- d
    select_dt[,5][k] <- ifelse(as.character(test.sc$star[[5]][1]) != "",1,0)
    select_dt[,6][k] <- ifelse(as.character(test.sc$tvar[[5]]) != "",1,0)

  }

  select_ls[[r]] <- select_dt

  print(r)

}

drop_ls <- lapply(select_ls,function(x)x[,-1])

drop_ar <- array(as.numeric(unlist(drop_ls)),dim=c(c.num,6,P))

average_mat <- round(apply(drop_ar,1:2,mean),2)
average_dt <- data.table(c.names,average_mat)
colnames(average_dt) <- colnames(select_dt)
average_dt <- average_dt[order(c)]

# select commodities that present evidence of nonlinearity in each
# and every expanding estimation window, wherein the autoregressive
# order is selected to minimize SIC subject to no serial correlation
sub_dt <- average_dt[n==1]
sub_dt <- sub_dt[order(c)]

cols <- sub_dt$c
cols <- cols[order(cols)]

subset_dt <- prices_dt[,..cols]
subset_dt$DATE <- prices_dt$DATE

save(subset_dt,sub_dt,file="subset.RData")


qsort <- function(v) {
  if ( length(v) > 1 )
  {
    pivot <- (min(v) + max(v))/2.0                            # Could also use pivot <- median(v)
    c(qsort(v[v < pivot]), v[v == pivot], qsort(v[v > pivot]))
  } else v
}

N <- 100
vs <- runif(N)
system.time(u <- qsort(vs))
print(u)


options(echo=FALSE)

args <- commandArgs(trailingOnly = TRUE)
if (length(args) < 1) {
    message("Specify a file name for input")
    quit(status=1)
}
filename <- args[1]

table <- read.csv(filename, header = FALSE, sep = "")

##########
#solveRow <- function(eachRow) {
#    return( diff(range(eachRow)) )
#}
#solution <- sum(apply(table, 1, solveRow))
#print(solution)
##########

##########
#solution <- 0
#for (rownum in 1:nrow(table)) {
#    eachRow <- table[rownum,]
#    rowSolution <- diff(range(eachRow))
#    solution <- solution + rowSolution
#}
#print(solution)
##########

part1SolveRow <- function(eachRow) {
    return( diff(range(eachRow)) )
}

applyOnRows <- function(someTable, someFunction) {
    result <- c()
    for (rowNum in 1:nrow(someTable)) {
        eachRow <- someTable[rowNum,]
        rowResult <- someFunction(eachRow)
        result <- c(result, rowResult)
    }
    return(result)
}

part2SolveRow <- function(eachRow) {
    answer <- 0
    n <- length(eachRow)

    for (i in 1:(n-1)) {
        for (j in (i+1):n) {
            inum <- eachRow[i]
            jnum <- eachRow[j]
            if (inum %% jnum == 0) {
                #print(sprintf("case1: inum=%d, jnum=%d\n", inum, jnum))
                return(inum / jnum)
            } else if (jnum %% inum == 0) {
                #print(sprintf("case2: inum=%d, jnum=%d\n", inum, jnum))
                return(jnum / inum)
            }
        }
    }
    return(answer)
}
#part1Solution <- sum(applyOnRows(table, part1SolveRow))
part1Solution <- sum(apply(table, 1, part1SolveRow))
cat(sprintf("Part1: %d\n", part1Solution))
part2Solution <- sum(apply(table, 1, part2SolveRow))
cat(sprintf("Part2: %d\n", part2Solution))
##########

##########
#for (i in 1:nrow(table)) {
#    rng <- range(table[i,])
#    min_i <- min(table[i,])
#    max_i <- max(table[i,])
#    #print(sprintf("%d, %d\n", min_i, max_i))
#    diff <- abs(min_i - max_i)
#    total <- total + diff
#    #print(diff)
#}
#message(total)
#print(length(table))
#print(min(table[,1]))
#print(max(table[,1]))


##### Chapter 3: Classification using Nearest Neighbors --------------------

## Example: Classifying Cancer Samples ----
## Step 2: Exploring and preparing the data ----

# import the CSV file
wbcd <- read.csv("wisc_bc_data.csv", stringsAsFactors = FALSE)

# examine the structure of the wbcd data frame
str(wbcd)

# drop the id feature
wbcd <- wbcd[-1]

# table of diagnosis
table(wbcd$diagnosis)

# recode diagnosis as a factor
wbcd$diagnosis <- factor(wbcd$diagnosis, levels = c("B", "M"),
                         labels = c("Benign", "Malignant"))

# table or proportions with more informative labels
round(prop.table(table(wbcd$diagnosis)) * 100, digits = 1)

# summarize three numeric features
summary(wbcd[c("radius_mean", "area_mean", "smoothness_mean")])

# create normalization function
normalize <- function(x) {
  return ((x - min(x)) / (max(x) - min(x)))
}

# test normalization function - result should be identical
normalize(c(1, 2, 3, 4, 5))
normalize(c(10, 20, 30, 40, 50))

# normalize the wbcd data
wbcd_n <- as.data.frame(lapply(wbcd[2:31], normalize))

# confirm that normalization worked
summary(wbcd_n$area_mean)

# create training and test data
wbcd_train <- wbcd_n[1:469, ]
wbcd_test <- wbcd_n[470:569, ]

# create labels for training and test data

wbcd_train_labels <- wbcd[1:469, 1]
wbcd_test_labels <- wbcd[470:569, 1]

## Step 3: Training a model on the data ----

# load the "class" library
library(class)

wbcd_test_pred <- knn(train = wbcd_train, test = wbcd_test,
                      cl = wbcd_train_labels, k=21)

## Step 4: Evaluating model performance ----

# load the "gmodels" library
library(gmodels)

# Create the cross tabulation of predicted vs. actual
CrossTable(x = wbcd_test_labels, y = wbcd_test_pred,
           prop.chisq=FALSE)

## Step 5: Improving model performance ----

# use the scale() function to z-score standardize a data frame
wbcd_z <- as.data.frame(scale(wbcd[-1]))

# confirm that the transformation was applied correctly
summary(wbcd_z$area_mean)

# create training and test datasets
wbcd_train <- wbcd_z[1:469, ]
wbcd_test <- wbcd_z[470:569, ]

# re-classify test cases
wbcd_test_pred <- knn(train = wbcd_train, test = wbcd_test,
                      cl = wbcd_train_labels, k=21)

# Create the cross tabulation of predicted vs. actual
CrossTable(x = wbcd_test_labels, y = wbcd_test_pred,
           prop.chisq=FALSE)

# try several different values of k
wbcd_train <- wbcd_n[1:469, ]
wbcd_test <- wbcd_n[470:569, ]

wbcd_test_pred <- knn(train = wbcd_train, test = wbcd_test, cl = wbcd_train_labels, k=1)
CrossTable(x = wbcd_test_labels, y = wbcd_test_pred, prop.chisq=FALSE)

wbcd_test_pred <- knn(train = wbcd_train, test = wbcd_test, cl = wbcd_train_labels, k=5)
CrossTable(x = wbcd_test_labels, y = wbcd_test_pred, prop.chisq=FALSE)

wbcd_test_pred <- knn(train = wbcd_train, test = wbcd_test, cl = wbcd_train_labels, k=11)
CrossTable(x = wbcd_test_labels, y = wbcd_test_pred, prop.chisq=FALSE)

wbcd_test_pred <- knn(train = wbcd_train, test = wbcd_test, cl = wbcd_train_labels, k=15)
CrossTable(x = wbcd_test_labels, y = wbcd_test_pred, prop.chisq=FALSE)

wbcd_test_pred <- knn(train = wbcd_train, test = wbcd_test, cl = wbcd_train_labels, k=21)
CrossTable(x = wbcd_test_labels, y = wbcd_test_pred, prop.chisq=FALSE)

wbcd_test_pred <- knn(train = wbcd_train, test = wbcd_test, cl = wbcd_train_labels, k=27)
CrossTable(x = wbcd_test_labels, y = wbcd_test_pred, prop.chisq=FALSE)


#' f_descent
#'
#' The descent algorithm using back tracking line search stepsize
#'
#' @param v_y   vector of y
#' @param v_x   vector of x
#' @param v_k0  vector of internal knots for covariates
#' @param v_m   vector of orders for covariates
#'
#' @param init initialization for $\beta$
#' @param alpha threshold $\alpha$, within $(0, 0.5)$.
#' @param bet   shrinkage rate $\bet$, within $(0, 1)$.
#' @param v_smooth  vector of smoothing parameters
#' @param maxit maximum number of iterations
#' @param eps   stopping critria threshhold
#' @param eta   stopping criteria for gradient size
#' @param trace indicator whether to plot trace
#'
#'
#' @return the estimated $\beta$
#'
f_descent <- function(v_y, v_x, v_k0, v_m, init = NULL,
                        alpha = 0.3, bet = 0.5, v_smooth = rep(1, 3),
                        maxit = 1e4, eps = 1e-3, eta = NULL, trace = NULL) {

#-------------------------------------------------------
##### set up #####
#-------------------------------------------------------
    function_call <- match.call()
    x_ord <- order(v_x)
    v_x <- v_x[x_ord]
    v_y <- v_y[x_ord]
    s_center <- mean(v_x)
    s_sd <- sd(v_x)
    v_x <- c(scale(v_x))
    iter <- 0L
    converge <- F
    s_n <- length(v_y)
    #Define dimensions
    k1 <- v_k0[2]; ktau <- v_k0[1]; m1 <- v_m[2]; mtau <- v_m[1]
    v_dim <- v_k0 + v_m
    #Require
    m_n1 <- f_n1(v_x, k1, m1)
    m_g1 <- f_g1(ktau, mtau)
    m_g2 <- f_g2(ktau, mtau)
    m_sigmatau <- f_sigmatau(v_dim[1])
    m_sigma <- f_sigma(v_dim[1], v_dim[2])
    m_s <- f_mats(v_dim[1], v_dim[2], v_smooth)

    #Precalculate h1
    m_h1 <- f_h1(m_n1, m_g1, m_g2, m_sigmatau)

    #Initialization
    if (is.null(init)) {
        init <- f_init(v_y, v_x, m_sigma, m_n1, v_k0, v_m, m_s)
    }
    til_beta <- init
    v_beta <- og_beta(til_beta, v_dim[1], v_dim[2])
    v_grad <- 0

    #Calculate H2 (most time consuming)
    v_taustar <- f_tausearch(v_y, m_n1, til_beta, m_sigma, ktau, mtau)
    m_ntaustar <- f_ntaustar(v_taustar, ktau, mtau)
    m_h2 <- f_h2(m_n1, m_ntaustar, m_g1, m_sigmatau)

    ##Loss
    s_loss <- f_criteria(v_beta, til_beta, v_taustar, v_y, m_sigma, m_h1, m_h2, m_s)

    ##trace
    ##trace
    if (!is.null(trace)) {
        v_taus <- trace
        con_quan <- list(x = v_x, y = v_y, center = s_center, sd = s_sd,
                    v_k0 = v_k0, v_m = v_m, m_sigma = m_sigma, n1 = m_n1,
                    til_beta = til_beta)
        sub <- paste("Iter:", iter, ", Error=", round(s_loss, 3))
        main <- paste("alpha=", alpha, "beta=", bet,
                "Smoothing:", v_smooth[1:2], "dim:", v_dim)
        cq_plot(trace, con_quan, sub = sub, main = main)
    }

    #Repeat
    while (maxit > iter) {
        iter <- iter + 1

        #Calculate gradient
        v_deriv <- f_lossderiv(til_beta, v_k0 + v_m, m_sigma, m_h1, m_h2) / s_n
        v_grad <- f_grad(v_beta, v_deriv, m_s)
        grad_size <-  sum(v_grad ^ 2)

        #backtracking line search
        t <- 1
        repeat{
            new_beta <- v_beta - t * v_grad
            new_tilbeta <- tilde_beta(new_beta, v_dim[2])
            new_loss <- f_criteria(new_beta, new_tilbeta, v_taustar, v_y, m_sigma, m_h1, m_h2, m_s)
            t <- bet * t
            if (new_loss <= (s_loss - alpha * t * grad_size) || t < 1e-4) {
                break
            }
        }

        #Update v_beta
        v_beta <- new_beta
        til_beta <- new_tilbeta

        #Update H2 (most time consuming)
#ptm <- proc.time()# Start the clock!
        v_taustar <- f_tausearch(v_y, m_n1, til_beta, m_sigma, ktau, mtau)
#print(proc.time() - ptm)# Stop the clock
        m_ntaustar <- f_ntaustar(v_taustar, ktau, mtau)
        m_h2 <- f_h2(m_n1, m_ntaustar, m_g1, m_sigmatau)

        ##trace
        if (!is.null(trace)) {
            con_quan$til_beta <- til_beta
            sub <- paste("Iter:", iter, ", Error=", round(new_loss, 3))
            cq_plot(trace, con_quan, sub = sub, main = main)
        }

        #Check stop criterion
        if (is.null(eta)) {
            converge <- (abs(new_loss - s_loss) <= eps * abs(s_loss))
        } else {
            converge <- (sqrt(grad_size) / norm_2(v_beta) <= eta)
        }

        s_loss <- new_loss
        #If gradient size criteria
        if (is.na(converge)) {
            converge <- F
            break
        }
        if (converge) break
    }

#-------------------------------------------------------
##### Output #####
#-------------------------------------------------------
    out <- list(
        beta = v_beta,
        til_beta = til_beta,
        gradient = v_grad,
        converge = converge,
        grad_size = sum(v_grad ^ 2),
        iter = iter,
        loss = s_loss,
        tau = v_taustar,
        x = v_x,
        y = v_y,
        center = s_center,
        sd = s_sd,
        v_k0 = v_k0,
        v_m = v_m,
        n1 = m_n1,
        m_sigma = m_sigma,
        mat_s = m_s,
        alpha = alpha,
        bet = bet,
        call = function_call)

    return(out)
}


#' Mean
#'
#' @description Compute arithmetic, geometric and harmonic mean
#'
#' @param x numeric vector
#'
#' @return Numeric vector
#' @export
#'
#' @examples
#'
#' x <- rnorm(100)
#'
#' num_mean(x)
#'

num_mean<- function(x){

  if(!is.numeric(x)){
    stop("x must be numeric.")
  }

  out <-
    dplyr::tibble(
      arithmetic =  mean(x, na.rm = TRUE),
      geometric  =  relper::geometric_mean(x),
      harmonic   =  relper::harmonic_mean(x)
    )

  return(out)

}


# ===
# R code used as basis for illustratig the CLT theorem and
# construction of the confidence interval.
# ===

# ---
# Load the libraries that we need. Indicate whether "shiny" is needed (probably not)
# ---

load_libraries <- function(withshiny = FALSE) {
   library(tidyverse)  # Load the whole tidyverse (ggplot2, dplyr, purrr etc..)
   library(statsr)     # Companion package for the Coursera "Statistics with R" specialization
   library(reshape2)   # Provides "reshape" to "melt" a data frame
   if (withshiny) {
      library(shiny)   # "An R package to build interactive web apps straight from R.", by RStudio.
   }
   library(testit)     # For "assert": https://www.rdocumentation.org/packages/testit/versions/0.11
                       # install.packages('testit')
}

# ---
# Load the "ames" dataset and return the "area" information
# ---

load_dataset_ames_area <- function() {
   data(ames)
   # We are interested in the area of transacted property, in feet²
   ames_area <- select(ames,area)
   # "ames_area" is a tibble of 1 column named "area"
   # to rename column "area" to just "x" (one could also use dplyr's rename function)
   # names(ames_area)[names(ames_area) == "area"] <- "x"
   str(ames_area)
   return (ames_area)
}

# ---
# Given a plot created by ggplot2, add vertical lines for certain statistics
# ---

add_stats_vlines_to_plot <- function(stats, plot, add_median = TRUE) {

   stddev            <- stats$stddev
   mean              <- stats$mean
   median            <- stats$median
   stddev_range_high <- stats$mean + stddev
   stddev_range_low  <- stats$mean - stddev

   color_mean    <- "red"
   color_stddev  <- "blue"
   color_median  <- "orange"

   # add a vertical line for "mean"

   x_where <- mean
   plot <- plot +
           geom_vline(xintercept=x_where, color=color_mean) +
           annotate(geom="text", x=x_where,  y=0, label="<>", color=color_mean)

   # add a vertical line for "median"

   if (add_median) {
      x_where <- median
      plot <- plot +
             geom_vline(xintercept=x_where, color=color_median) +
             annotate(geom="text", x=x_where,  y=0, label="∇", color=color_median)
   }

   # add a dashed vertical line for "1-stddev range, low value"

   x_where <- stddev_range_high
   plot <- plot +
           geom_vline(xintercept=x_where, color=color_stddev, linetype="dotdash") +
           annotate(geom="text", x=x_where, y=0, label="sd-", color=color_stddev)

   # add a dashed vertical line for "1-stddev range, high value"

   x_where <- stddev_range_low
   plot <- plot +
           geom_vline(xintercept=x_where, color=color_stddev, linetype="dotdash") +
           annotate(geom="text", x=x_where, y=0, label="sd+", color=color_stddev)

   return(plot)
}

# ---
# Create a ggplot2 histogram of "ames" "area" values. This may be
# over the whole population or just over a sample. Returns the plot.
# ---

plot_histogram_of_ames_area_data <- function(ames_area_data, binwidth, x_max, titlestr) {

   stats <- compute_ames_area_stats(ames_area_data)

   subtitlestr <-
      paste0(stats$num_obs, " observations",
             ", binwidth = " , binwidth,
             ", min = "      , stats$min,
             ", max = "      , stats$max,
             ", mean = "     , round(stats$mean,1),
             ", median = "   , stats$median,
             ", stddev = "   , round(stats$stddev,1))

   plot <-
      ggplot(ames_area_data) +
      coord_cartesian(xlim=c(0,x_max)) +
      geom_histogram(aes(x=area), binwidth=binwidth, color="grey") +
      labs(x="property area (feet²)", title=titlestr, subtitle=subtitlestr)

   stats_to_add <-
     setNames(as.list(c(stats$stddev,
                        stats$mean,
                        stats$median)),
              c("stddev", "mean", "median"))

   plot <- add_stats_vlines_to_plot(stats_to_add, plot)

   return(plot)
}

# ---
# Create a Probability Density Function for the "ames" "area" values. This may
# be over the whole population or just over a sample.
# "Adjust" gives the kernel width (measure of "smoothness")
# ---

create_pdf_for_ames_area_data <- function(ames_area_data, adjust) {
   density_obj = density(ames_area_data$area, adjust=adjust)
   # str(density_obj)
   pdf <- tibble(x=density_obj$x, y=density_obj$y)
   # str(pdf)
   return(pdf)
}

# ---
# Create a ggplot2 graph of a Probability Density Function for the "ames" "area"
# values. This may be over the whole population or just over a sample. Returns the plot
# ---

plot_pdf_of_ames_area_data <- function(ames_area_data, adjust, x_max, titlestr) {

   stats <- compute_ames_area_stats(ames_area_data)

   subtitlestr <-
      paste0(stats$num_obs, " observations",
             ", smoothing = ", adjust,
             ", min = "      , stats$min,
             ", max = "      , stats$max,
             ", mean = "     , round(stats$mean,1),
             ", median = "   , stats$median,
             ", stddev = "   , round(stats$stddev,1))

   pdf <- create_pdf_for_ames_area_data(ames_area_data,adjust)

   plot <-
      ggplot(pdf) +
      coord_cartesian(xlim=c(0,x_max)) +
      geom_line(aes(x=x,y=y)) +
      labs(x="property area (feet²)", y="dp/dx", title=titlestr, subtitle=subtitlestr)

   stats_to_add <-
     setNames(as.list(c(stats$stddev,
                        stats$mean,
                        stats$median)),
              c("stddev", "mean", "median"))

   plot <- add_stats_vlines_to_plot(stats_to_add, plot)

   return(plot)
}

# ---
# Create a single sample by selecting observations at random
# ---

create_single_sample_of_ames_area_observations <- function(ames_area, sample_size) {
   # Use dplyr:sample_n
   # Resulting "sample" is a tibble "sample_size x 1", listing observations
   sample <- sample_n(ames_area, size=sample_size, replace=FALSE)
   # str(sample)
   return(sample)
}

# ---
# Compute statistics of ames area data (either a sample or the whole set
# of observations)
# ---

compute_ames_area_stats <- function(ames_area_data) {

   # Use "summarise" from package "dplyr".
   # This creates a tibble of dimensions "1 x 8", with the columns having the
   # names given below.

   stats <-
      summarise(ames_area_data,
                mean   = mean(area),
                median = median(area),
                stddev = sd(area),
                iqr    = IQR(area),
                min    = min(area),
                max    = max(area),
                quart1 = quantile(area, 0.25), # first ¼-ile, 25th %-ile
                quart3 = quantile(area, 0.75)) # third ¼-ile, 75th %-ile

   stats <- add_column(stats, num_obs = nrow(ames_area_data))
   return(stats)

}

# ---
# Create multiple samples (and then their sample stats) from the ames dataset
# ---

create_multiple_ames_area_sample_stats <- function(ames_area, sample_size, sample_count) {
   # message("Creating ", sample_count, " samples of ", sample_size, " individuals, and their corresponding sample statistics")

   # Create empty list to store the "sample_count" sample statistics

   fillable_list  <- rep(list(NA), sample_count)

   # This can probably be done in vector fashion instead of a loop...

   for(i in 1:sample_count) {
      # "sample" is a tibble "sample_size x 1", listing observations
      sample <- create_single_sample_of_ames_area_observations(ames_area, sample_size)
      # "sample_stats" is a tibble "1 x 9", with columns "mean", "median", "stddev", ...
      sample_stats <- compute_ames_area_stats(sample)
      # str(sample_stats)
      fillable_list[[i]] <- sample_stats
   }

   # Not sure why the next instruction works but it does!
   # The result is a tibble with "sample_size x 9", with columns "mean", "median", "stddev", ...

   multiple_sample_stats <- do.call(rbind.data.frame, fillable_list)
   return(multiple_sample_stats)
}

# ---
# Compute the sampling stats (mean of sample means) from the collection of sample stats (sample means etc.)
# ---

compute_sampling_stats_for_mean <- function(multiple_sample_stats) {

   # Use "summarise" from package "dplyr".
   # This creates a tibble of dimensions "1 x 5", with the columns having the
   # names given below.

   stats <-
      summarise(multiple_sample_stats,
                mean   = mean(multiple_sample_stats$mean),
                median = median(multiple_sample_stats$mean),
                stddev = sd(multiple_sample_stats$mean),
                min    = min(multiple_sample_stats$mean),
                max    = max(multiple_sample_stats$mean))

   stats <- add_column(stats, sample_count = nrow(multiple_sample_stats))
   stats <- add_column(stats, sample_size  = mean(multiple_sample_stats$num_obs)) # constant over samples

   return(stats)
}

# ---
# Create a ggplot2 histogram of the "mean" sample statistics (over the samples). Returns the plot.
# ---

plot_histogram_of_ames_area_sample_stats_for_mean <- function(multiple_sample_stats, binwidth, mean_min, mean_max) {

   sampling_stats <- compute_sampling_stats_for_mean(multiple_sample_stats)

   titlestr <- "Histogram of mean of property area over samples of property transactions made in Ames, Iowa, 2006-2010"

   subtitlestr <-
      paste0(sampling_stats$sample_count, " samples of ",
             sampling_stats$sample_size, " observations ",
             ", binwidth = " , binwidth,
             ", min = "      , round(sampling_stats$min,1),
             ", max = "      , round(sampling_stats$max,1),
             ", mean = "     , round(sampling_stats$mean,1),
             ", stddev = "   , round(sampling_stats$stddev,2),
             "\nOverlaid: limit Gaussian postulated by CLT (scaled)")

   plot <-
      ggplot(multiple_sample_stats) +
      coord_cartesian(xlim=c(mean_min,mean_max)) +
      geom_histogram(aes(x=mean), binwidth=binwidth, color="grey") +
      labs(x="mean of property area over a single sample (feet²)", title=titlestr, subtitle=subtitlestr)

   stats_to_add <-
     setNames(as.list(c(sampling_stats$stddev,
                        sampling_stats$mean,
                        sampling_stats$median)),
              c("stddev", "mean", "median"))

   plot <- add_stats_vlines_to_plot(stats_to_add, plot, add_median = FALSE)

   return(plot)
}

# ---
# Overlay the Normal to which the histogram should converge according to the CLT
# ---

overlay_clt_normal <- function(plot, binwidth, mean_min, mean_max, population_mean, population_stddev, sample_size, sample_count) {
   num_points <- 200
   x <- seq(mean_min, mean_max, (mean_max-mean_min)/(num_points-1))
   stretch <- sample_count*binwidth # stretch the small Normal curve to the same dimension as the histogram
   y <- dnorm(x, mean=population_mean, sd=population_stddev/sqrt(sample_size))*stretch
   normal = tibble(x,y)
   plot <- plot + geom_line(data = normal, aes(x=x,y=y))
   return(plot)
}

# ---
# Compute a confidence interval then add its lower and upper limit to the "sample_stat", which is returned
# ---

add_confidence_interval <- function(sample_stats, confidence, verbose) {
   zscore             = -qnorm((1.0-confidence)/2)  # positive surface in tail of the Gaussian (one side)
   sample_size        = sample_stats$num_obs
   standard_error     = sample_stats$stddev / sqrt(sample_size)
   margin_of_error    = zscore*standard_error
   conf_interval_low  = sample_stats$mean - margin_of_error
   conf_interval_high = sample_stats$mean + margin_of_error
   if (verbose) {
      message("The confidence interval at "
              ,(confidence*100)
              ,"% is ["
              ,conf_interval_low
              ,","
              ,conf_interval_high
              ,"]")
   }
   res <- add_column(sample_stats
                     ,conf_interval_low  = conf_interval_low
                     ,conf_interval_high = conf_interval_high)
   return(res)
}

# ---
# Return TRUE if the population mean is indeed within the confidence interval
# ---

check_confidence_interval <- function(ames_area, population_mean, sample_size, confidence) {
   # create a single sample and compute its statistics
   # "sample_stats" is a tibble of 9x1 observations with variables "mean", "median, "stddev" etc..
   sample_stats <- create_multiple_ames_area_sample_stats(ames_area,
                      sample_size=sample_size,
                      sample_count=1)
   # extend the "sample_stats" tibble with information about the confidence interval
   sample_stats <- add_confidence_interval(sample_stats, confidence, verbose=FALSE)
   # str(sample_stats)
   # return TRUE if the population mean is indeed within the confidence interval
   return(sample_stats$conf_interval_low < population_mean && population_mean < sample_stats$conf_interval_high)
}


############################################################################
# Marek Opuszko
# Analytics of the COVID-19 (Corona) Spread
############################################################################

#
# In order to easily model the whole thing, the data is logarithmized so
# that we can then use a simple linear regression. Building on this,
# we can then make forecasts for the next few days
library(tidyr)
library(data.table)
library(ggplot2)
require(scales)
library(ggsci)
library(ggdark)

###################################################################################################
# 1. PREPROCESSING - DATA PREPARATION
###################################################################################################

# Define Working Directory
setwd("~/yourdirectoryhere")

subject = "Deaths" # or "Deaths" or "Recovered Cases"

# Load the Dataset
if (subject=="Cases") {
  data = read.csv("https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_confirmed_global.csv")
}else if(subject == "Deaths") {
  data = read.csv("https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_deaths_global.csv")
}else if(subject == "Recovered Cases") {
  data = read.csv("https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_recovered_global.csv")
}

# The dataset needs some adjustments. Clearing data types:
data$Province.State = as.character(data$Province.State)
data$Country.Region = as.character(data$Country.Region)

#We can remove lat and long since we are not using this geo information here
data$Lat <-  NULL
data$Long <- NULL
# check the data frame
str(data)

# We need to change the format of the data frame, from wide (columns) to long
# meaning we want a "date" and a "cases" variable instead of multiple columns for each date
# This is necesary to make use of the data for later functions and plotting

# using the melt function to transpose the data frame (needs prior transformation to data table format)
data_transformed <- melt(as.data.table(data), id=c("Province.State","Country.Region"), fun="Sum")
# change the variable names to something more "speaking"
names(data_transformed) <-  c("region","country","date","cases")
# remove the X invoked by R (no variable names beginning with a number allowed)
data_transformed$date <- gsub("X", "0", paste(data_transformed$date))
# transform character dates to actual date format
data_transformed$date <- as.Date(data_transformed$date, "%m.%d.%Y")
# This is optional, save the new formatted data frame
write.csv(data_transformed,paste0("covid_19_data_",subject,"_confirmed.csv"),row.names=FALSE)

###################################################################################################
# 2. ANALYTICS
# 2.1 World wide Trend
###################################################################################################

# Aggregate all cases by date -> overall sum over all countries for on date
data_subset <- aggregate(cases ~ date , data = data_transformed, sum)
# Aggregated Cases by Date and by Country
data_subset_countries <- aggregate(cases ~ country + date , data = data_transformed, sum)

# First Impressions - Plot
plot(data_subset$cases ~ data_subset$date)
# We see a string exponential development from mid of march ...
# logarithmize the cases to linearize expoential growth
plot(log(data_subset$cases) ~ data_subset$date)

# In order to make predictions we will simplify the model and use a simple linear
# regression model for the timespan the cases grow exponentially

lastDay <- max(data_subset$date)
# let's use the last two weeks ...
data_model <- data_subset[data_subset$date >= lastDay-21,]
# check plot ...
plot(log(data_model$cases) ~ data_model$date)

# To understand the regression, it's better to use Day Numbers
# so we can ask later on, what will today plus 7 days look like?
data_model$daynr = seq(1,length(data_model$cases))
# logarithmize the cases to apply linear regression
data_model$casesLog = log(data_model$cases)

# Check the plot ... looks "linear" ?
plot(data_model$casesLog ~ data_model$date)

# Run a simple linear regression
model <- lm(data_model$casesLog ~ data_model$daynr)
# extract Coefficients
a = as.numeric(model$coefficients[1])
b = as.numeric(model$coefficients[2])

###################################################################################################
# 2.2 Predictions ... the whole world
###################################################################################################
# Function to predict cases based on our simple model
predict <- function(day,a,b){
  cases = a + b*day
  return(cases)
}

# Since the model is based an logarithmic values <- reverse operation of the values
predict_cases <- function(day,a,b) {
  result = exp(predict(day,a,b))
  return(result)
}

today = length(data_model$daynr)

# Prediction of our model for today (31st of March as i'm writing this)
predict_cases(today,a,b)
# 800,000 vs 780,000 ... not bad ..

# Prediction of our model for tomorrow
predict_cases(today+1,a,b)
# Prediction of our model for one week into the future
predict_cases(today+7,a,b)
# 1,69 Million cases 7th of April :/

# Prediction of our model for two weeks into the future
predict_cases(today+14,a,b)

# Plot the model timespan
dateMin = min(data_model$date)
dateMax = max(data_model$date) + 7
ggplot(data_model, aes(x=date,y=cases)) +
  geom_line(aes(y=cases),size=1.1,alpha=0.7,color="white") +
  geom_point(aes(y=cases),alpha=0.5,color="grey") +
  scale_y_log10(labels = scales::comma) +
  geom_smooth(method = lm, fullrange=TRUE, color="red") +
  ggtitle(paste0("Worldwide COVID-19 ",subject," over Time")) + xlab("Date") +
  ylab("Number (log)")+
  xlim(dateMin, dateMax) +
  scale_color_nejm() +
  dark_theme_gray() +
  theme(axis.text.x = element_text(size = 15)) +
  theme(axis.text.y = element_text(size = 12)) +
  theme(plot.title = element_text(size=20,color="orange"))

# Plot the whole date span
ggplot(data_subset, aes(x=date,y=cases)) +
  geom_line(aes(y=cases),size=1.1,alpha=0.7,color="white") +
  geom_point(aes(y=cases),alpha=0.5,color="grey") +
  scale_y_log10(labels = scales::comma) +
  geom_smooth(method = loess, fullrange=TRUE, color="red") +
  ggtitle(paste0("Worldwide COVID-19 ",subject)) + xlab("Date") +
  ylab("Number (log)")+
  scale_color_nejm() +
  dark_theme_gray() +
  theme(axis.text.x = element_text(size = 15)) +
  theme(axis.text.y = element_text(size = 12)) +
  theme(plot.title = element_text(size=20,color="orange"))

###################################################################################################
# 2.3 Predictions ... Single Countries or Regions
###################################################################################################

###################################################################################################
# US
###################################################################################################
needle = c("US")

# Subset by Country list
data_subset_US = data_subset_countries[which(data_subset_countries$country %in% needle),]

# first impressions
plot(log(data_subset_US$cases) ~ data_subset_US$date)
# exponential growth since beginning of march
data_model_US <- data_subset_US[data_subset_US$date >= lastDay-14,]
plot(log(data_model_US$cases) ~ data_model_US$date)

# create Day Nr
data_model_US$daynr = seq(1,length(data_model_US$cases))
# logarithmize
data_model_US$casesLog = log(data_model_US$cases)

# Regression
model_US <- lm(data_model_US$casesLog ~ data_model_US$daynr)
# extract coefficients
a = as.numeric(model_US$coefficients[1])
b = as.numeric(model_US$coefficients[2])

today = length(data_model_US$daynr)

# Prediction of our model for today, tomorrow, etc (31st of March as i'm writing this)
predict_cases(today,a,b)
predict_cases(today+1,a,b)
predict_cases(today+7,a,b)
predict_cases(today+14,a,b)

# Plot the model timespan
dateMin = min(data_model_US$date)
dateMax = max(data_model_US$date) + 7
ggplot(data_model_US, aes(x=date,y=cases)) +
  geom_line(aes(y=cases),size=1.1,alpha=0.7,color="white") +
  geom_point(aes(y=cases),alpha=0.5,color="grey") +
  scale_y_log10(labels = scales::comma) +
  geom_smooth(method = lm, fullrange=TRUE, color="red") +
  ggtitle(paste0("US COVID-19 ",subject," over Time")) + xlab("Date") +
  ylab("Number (log)")+
  xlim(dateMin, dateMax) +
  scale_color_nejm() +
  dark_theme_gray() +
  theme(axis.text.x = element_text(size = 15)) +
  theme(axis.text.y = element_text(size = 12)) +
  theme(plot.title = element_text(size=20,color="orange"))

# Plot the whole date span
ggplot(data_subset_US, aes(x=date,y=cases)) +
  geom_line(aes(y=cases),size=1.1,alpha=0.7,color="white") +
  geom_point(aes(y=cases),alpha=0.5,color="grey") +
  scale_y_log10(labels = scales::comma) +
  geom_smooth(method = loess, fullrange=TRUE, se=FALSE, color="red") +
  ggtitle(paste0("US COVID-19 ",subject)) + xlab("Date") +
  ylab("Number (log)")+
  scale_color_nejm() +
  dark_theme_gray() +
  theme(axis.text.x = element_text(size = 15)) +
  theme(axis.text.y = element_text(size = 12)) +
  theme(plot.title = element_text(size=20,color="orange"))

##############################################################################################
# what About the daily increase/change?
# Lazy Approach: Calculate the daily cases based on the subtraction today and yesterday
# Works only for single cases, not if you have groups !!!
##############################################################################################
yesterday = c(data_subset_US$cases[1],data_subset_US$cases[1:length(data_subset_US$cases)-1])
data_subset_US$newInfects = data_subset_US$cases - yesterday

ggplot(data_subset_US, aes(x=date,y=newInfects,colour=country)) +
  geom_line(aes(y=newInfects),size=1.1,alpha=0.7) +
  geom_point(aes(y=newInfects),alpha=0.5) +
  geom_smooth(method = loess, aes(color=country),color="white") +
  ggtitle(paste0("Daily COVID-19 ",subject," in the US")) + xlab("Date") +
  ylab("Daily Increase")+
  xlim(dateMin, dateMax) +
  scale_color_nejm() +
  dark_theme_gray() +
  theme(axis.text.x = element_text(size = 15)) +
  theme(axis.text.y = element_text(size = 12)) +
  theme(plot.title = element_text(size=30,color="orange"))

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

###################################################################################################
# Top 6 Countries in Case Numbers
###################################################################################################
needle = c("China","US","Italy","Germany","Spain","Iran")

# Subset by Country list
data_subset_top6 = data_subset_countries[which(data_subset_countries$country %in% needle),]
# Plot - log scales
ggplot(data_subset_top6, aes(x=date,y=cases,color=country)) +
  geom_line(aes(y=cases),size=1.1,alpha=0.7) +
  geom_point(aes(y=cases),alpha=0.5) +
  scale_y_log10(labels = scales::comma) +
  ggtitle(paste0("COVID-19 ",subject," over Time")) + xlab("Date") +
  ylab("Number (log)")+
  scale_color_nejm() +
  dark_theme_gray() +
  theme(axis.text.x = element_text(size = 15)) +
  theme(axis.text.y = element_text(size = 12)) +
  theme(plot.title = element_text(size=20,color="orange"))
# Plot - normal scales
ggplot(data_subset_top6, aes(x=date,y=cases,color=country)) +
  geom_line(aes(y=cases),size=1.1,alpha=0.7) +
  geom_point(aes(y=cases),alpha=0.5) +
  ggtitle(paste0("COVID-19 ",subject," over Time")) + xlab("Date") +
  ylab("Number (log)")+
  scale_color_nejm() +
  dark_theme_gray() +
  theme(axis.text.x = element_text(size = 15)) +
  theme(axis.text.y = element_text(size = 12)) +
  theme(plot.title = element_text(size=20,color="orange"))

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


source('lib/libraries.r', encoding = 'UTF-8')

prileganje <- lm(data = brezposelni.Slovenija, Registrirane.brezposelne.osebe ~ Leto)
leta <- data.frame(Leto=seq(2017,2020,1))
napoved <- mutate(leta, Registrirane.brezposelne.osebe=predict(prileganje,leta))

#graf brezposelnih posameznikov

graf.napovedi <- ggplot(brezposelni.Slovenija, aes(x=Leto, y=Registrirane.brezposelne.osebe))+
  geom_point() + geom_smooth(method=lm, fullrange=TRUE, color='red') + geom_point(data=napoved, inherit.aes = TRUE)+
  labs(title='Registrirane brezposelne osebe v Sloveniji')
#plot(graf.napovedi)

#graf procentne brezposelnosti

brezposelnost <- left_join(prebivalstvo.slovenija, brezposelni.Slovenija, by=c('Leto'))
brezposelnost <- brezposelnost%>%filter(Registrirane.brezposelne.osebe != '')
brezposelnost <- transform(brezposelnost, Odstotek=(Registrirane.brezposelne.osebe/Prebivalstvo))
brezposelnost <- brezposelnost[c(-2,-3)]

prileganje1 <- lm(data=brezposelnost, Odstotek ~Leto)
leta1 <- data.frame(Leto=seq(2017,2020,1))
napoved.odstotka<-mutate(leta1, Odstotek=predict(prileganje1,leta1))

graf.napovedi.odstotkov <- ggplot(brezposelnost, aes(x=Leto, y=Odstotek)) + geom_point(data=napoved.odstotka, inherit.aes = TRUE) +
  geom_smooth(method=lm, fullrange=TRUE, color='green') + geom_point() + labs(title='Odstotek registrirane brezposelnosti v Sloveniji')
#plot(graf.napovedi.odstotkov)


library(MASS)
data("Boston")

# Make train and test dataset
set.seed(0)
which_train <- sample(
    x = c(TRUE, FALSE),
    size = nrow(Boston),
    replace = TRUE,
    prob = c(0.8, 0.2)
)
train <- Boston[which_train, ]
test <- Boston[!which_train, ]

# Training
lm_fit <- lm(medv~., data = train)
summary(lm_fit)

# Prediction
pred <- predict(lm_fit, test[, -14])
error <- mean((pred - test[, 14]) ** 2)
error


#!/usr/bin/Rscript

# Bhishan Poudel
# Jan 16, 2016

# set up a device driver to plot
#postscript(file='~/Copy/Programming/R/rprograms/plotting/legends/legend2.eps')

## Using 'ncol' :
x <- 0:64/64
matplot(x, outer(x, 1:7, function(x, k) sin(k * pi * x)),
        type = "o", col = 1:7, ylim = c(-1, 1.5), pch = "*")
op <- par(bg = "antiquewhite1")
legend(0, 1.5, paste("sin(", 1:7, "pi * x)"), col = 1:7, lty = 1:7,
       pch = "*", ncol = 4, cex = 0.8)
# legend(.8,1.2, paste("sin(", 1:7, "pi * x)"), col = 1:7, lty = 1:7,
#        pch = "*", cex = 0.8)
# legend(0, -.1, paste("sin(", 1:4, "pi * x)"), col = 1:4, lty = 1:4,
#        ncol = 2, cex = 0.8)
# legend(0, -.4, paste("sin(", 5:7, "pi * x)"), col = 4:6,  pch = 24,
#        ncol = 2, cex = 1.5, lwd = 2, pt.bg = "pink", pt.cex = 1:3)
par(op)

# turn off device driver
#dev.off()


suppressPackageStartupMessages(library(float))

### Diag taker
x = matrix(1:30, 10)
y = matrix(1:10, 10, 2)
z = matrix(1:5, 5, 3)

xs = fl(x)
ys = fl(y)
zs = fl(z)

test = dbl(diag(xs))
stopifnot(all.equal(test, diag(x)))

test = dbl(diag(ys))
stopifnot(all.equal(test, diag(y)))

test = dbl(diag(zs))
stopifnot(all.equal(test, diag(z)))

### Diag maker
tester = function(x, s)
{
  truth = diag(x)
  test = dbl(diag(s))
  stopifnot(all.equal(test, truth))

  truth = diag(x, 3, 2)
  test = dbl(diag(s, 3, 2))
  stopifnot(all.equal(test, truth))

  truth = diag(x, 5, 5)
  test = dbl(diag(s, 5, 5))
  stopifnot(all.equal(test, truth))
}

x = 1:4
s = fl(x)
tester(x, s)

x = c(3, 7)
s = fl(x)
tester(x, s)


#Reading the dataset
library(readr)

bank <-read.csv("bank.csv", stringsAsFactors = FALSE)
bank

View(bank)

#Cleaning and tidying up the dataset

library(tidyr)

library(dplyr)
class(bank)

dim(bank)
colnames(bank)
str(bank)
library(plyr)
hist(bank$balance)
boxplot(bank$balance)

class(bank$balance)

bank$balance<-as.character(bank$balance)
class(bank$balance)

library(tidyr)
bank1<-unite(data = bank, col= balance, loan)
bank1

#Understanding the structure of dataset
summary(bank)
bank$age<-as.numeric(bank$age)
bank$job<-as.character(bank$job)
bank$marital<-as.character(bank$marital)
bank$education<-as.character(bank$education)
bank$default<-as.character(bank$default)
bank$balance<-as.numeric(bank$balance)
bank$housing<-as.character(bank$loan)
bank$contact<- as.character(bank$contact)
bank$day<-as.numeric(bank$day)
bank$month<-as.character(bank$month)
bank$duration<-as.numeric(bank$duration)
bank$campaign<-as.numeric(bank$campaign)

#Hypothesis Test

t.test(bank$balance, bank$age)
t.test(bank$balance, mu = 5, alternative = 'greater')
cor(bank$balance, bank$age, method = 'spearman')
cor(bank$balance, bank$age, method = 'kendall')

#Tietjan-Moore Test

TietjenMoore <- function(dataSeries,k)
+ {
+     n = length(dataSeries)
+     ## Compute the absolute residuals.
+     r = abs(dataSeries - mean(dataSeries))
+     ## Sort data according to size of residual.
+     df = data.frame(dataSeries,r)
+     dfs = df[order(df$r),]
+     ## Create a subset of the data without the largest k values.
+     klarge = c((n-k+1):n)
+     subdataSeries = dfs$dataSeries[-klarge]
+     ## Compute the sums of squares.
+     ksub = (subdataSeries - mean(subdataSeries))**2
+     all = (df$dataSeries - mean(df$dataSeries))**2
+     ## Compute the test statistic.
+     sum(ksub)/sum(all)
+ }

FindOutliersTietjenMooreTest <- function(dataSeries,k,alpha=0.05){
+     ek <- TietjenMoore(dataSeries,k)
+     ## Compute critical value based on simulation.
+     test = c(1:10000)
+     for (i in 1:10000){
+         dataSeriesdataSeries = rnorm(length(dataSeries))
+         test[i] = TietjenMoore(dataSeriesdataSeries,k)}
+     Talpha=quantile(test,alpha)
+     list(T=ek,Talpha=Talpha)
+ }
#Demonstration of test

x <- c(-1.40, -0.44, -0.30, -0.24, -0.22, -0.13, -0.05, 0.06, 0.10, 0.18,
+        0.20, 0.39, 0.48, 0.63, 1.01)
FindOutliersTietjenMooreTest(x, 2)

FindOutliersTietjenMooreTest(bank$balance, 2)

#Parsimonious Model

install.packages('devtools')
install.packages('MoEClust')
library(MoEClust)

View(bank)
age <- bank[,1]
age

balance<-bank[,6]
balance

m1    <- MoE_clust(balance, G=0:2, verbose=FALSE)
m2    <- MoE_clust(balance, G=2, verbose=FALSE)
m3    <- MoE_clust(balance, G=1:2,  verbose=FALSE)
comp

plot(comp$optimal, what="gpairs", jitter=FALSE)
(mod <- as.Mclust(comp$optimal))

plot(mod, what="classification")
plot(mod, what="uncertainty")

#Probability Plots

p1 <- ggplot(data = bank, aes(bank$balance)) + stat_function(fun = dnorm, n = 101, args = list(mean = 0, sd = 1)) + ylab("") + scale_y_continuous(breaks = NULL)
p2 <- ggplot(data = bank, aes(bank$balance)) +stat_function(fun = pnorm, n = 101, args = list(mean = 0, sd = 1)) + ylab("") + scale_y_continuous(breaks = NULL)
p4 <- ggplot(data = bank, aes(bank$balance)) +
+ stat_function(fun = rnorm, n = 101, args = list(mean = 0, sd = 1)) + ylab("") +scale_y_continuous(breaks = NULL)

#Shapiro Wik Test
shapiro.test(bank$balance[1:10])

shapiro.test(bank$balance[1:4000])


R.version  #r version running
search()        # Shows the loaded packages
getOption("defaultPackages")
library()       # Shows the installed packages
#install.packages("ggplot2")
#install.packages("tidyr")
library(ggplot2)
library("tidyr")
#install.packages(c("tidyr", "devtools")) #tidyr for data handling
getwd()  #name of the working directory
dir()  # show files in the working directory
#to change working directory
#getting and setting the working directory
setwd("C:\\Users\\lenovo\\Desktop\\Rdatamining")
getwd()
#Kmeans clustering
data(iris)
#to get structure of data
str(iris)
iris2 <- iris
iris2$Species <- NULL #not to use species field
str(iris2)
km <- kmeans(iris2, 3)
km
?kmeans
km$size  #size of each cluster
km$centers
km$cluster
km$iter  #number of iterations used
iris2$cluster <- factor(km$cluster) #adding cluster label with each point
iris2
km$withinss  #each cluster Sum of square error

#visulaizing clusters
I=iris2[c(1,2,5)]
I  #data to plot
centers <- data.frame(cluster=factor(1:3), km$centers)
centers
ggplot(data=I, aes(x=Sepal.Length, y=Sepal.Width, color=cluster, shape=cluster)) +
  geom_point(alpha=.3)+
  geom_point(data=centers, aes(x=Sepal.Length, y=Sepal.Width), size=3, stroke=2)

#plotting mean of each variable within each cluster
centers=km$centers
t(centers)
centers <- as.data.frame(t(centers))
names(centers) <- paste("Cluster", 1:3)
centers
centers$Symbol <- row.names(centers)
centers$Symbol

centers <- gather(centers, "Cluster", "Mean", -Symbol)
centers$Color = centers$Mean > 0
ggplot(centers, aes(x=Symbol, y=Mean, fill=Color)) +
  geom_bar(stat='identity', position = "identity", width=.75) +
  facet_grid(Cluster ~ ., scales='free_y')
#comparing clusters with actual class species
table(iris$Species, km$cluster)

#other parameters setting
km1 <- kmeans(iris2, 2,5) #adding number of iteration
table(iris$Species, km1$cluster)
#may create confusion matrix


# ......................................................................................
# ..............................Cvičení 2 - Pravděpodobnost.............................
# ..................Adéla Vrtková, Michal Béreš, Martina Litschmannová .................
# ......................................................................................

# Nezobrazuje-li se vám text korektně, nastavte File \ Reopen with Encoding... na UTF-8
# Pro zobrazení obsahu skriptu použijte CTRL+SHIFT+O
# Pro spouštění příkazů v jednotlivých řádcích použijte CTRL+ENTER

# V tomto cvičení projdeme úvod do pravděpodobnosti. Předpokládáme znalosti z přednášky,
# především pojmy: **definice pravděpodobnosti, podmíněná pravděpodobnost, věta o úplné
# pravděpodobnosti, Bayesova věta**.
#
#  Pomocné funkce ####
#
# * Úplná pravděpodobnost ####
# $P(A)=\sum_{i=1}^{n}P(B_i)P(A|B_i)$

# spočítání pravděpodobnosti P(A) - věta o úplné pravděpodobnosti
uplna_pravdepodobnost = function(P_B, P_AB)
{   # uvažujeme P_B jako vektor hodnot P(B_i) a P_BA jako vektor hodnot P(A|B_i)
    P_A = 0
    for (i in 1:length(P_B))
    {
        P_A = P_A + P_B[i]*P_AB[i]
    }
    return(P_A)
}

# * Bayesova věta ####
# $P(B_k|A)=\frac{P(B_k)P(A|B_k)}{\sum_{i=1}^{n}P(B_i)P(A|B_i)}$

# spočítání podmíněné pravděpodobnosti P(B_k|A) - Bayesova věta
bayes = function(P_B, P_AB, k)
{   # uvažujeme P_B jako vektor hodnot P(B_i), P_BA jako vektor hodnot P(A|B_i)
    P_A = uplna_pravdepodobnost(P_B, P_AB)
    P_BkA = P_B[k]*P_AB[k]/P_A
    return(P_BkA)
}

# **Přidáme funkce z munulého cvičení pro počítání kombinatorických výběrů, jsou v
# skriptu kombinatorika.R**

source('kombinatorika.R')

#  Příklady ####
# * Příklad 1. ####
# Určete pravděpodobnost, že při hodu 20stěnnou spravedlivou (férovou) kostkou padne
# číslo větší než 14.

omega = 1:20
A = c(15,16,17,18,19,20)
# pravděpodobnost jako podíl příznivých ku všem
length(A)/length(omega)

# * Příklad 2. ####
# Určete pravděpodobnost, že při hodu 20stěnnou kostkou padne číslo větší než 14,
# víte-li, že sudá čísla padají 2x častěji než lichá.

p_liche = 1/(20+10)
p_sude = 2*p_liche
pravd = c(p_liche, p_sude, p_liche, p_sude, p_liche, p_sude, p_liche, p_sude,
          p_liche, p_sude, p_liche, p_sude, p_liche, p_sude, p_liche, p_sude,
          p_liche, p_sude, p_liche, p_sude)
pravd
#pravdepodobnost je
sum(pravd[15:20])

# * Příklad 3. ####
# Určete pravděpodobnost, že ve sportce uhodnete 4 čísla. (Ve sportce se losuje 6 čísel
# ze 49.)

(kombinace(6,4)*kombinace(43,2))/kombinace(49,6)

# * Příklad 4. ####
# Z abecedního seznamu studentů zapsaných na dané cvičení vybere učitel prvních 12 a
# nabídne jim sázku: „Pokud se každý z Vás narodil v jiném znamení zvěrokruhu, dám
# každému z Vás 100 Kč. Pokud jsou však mezi Vámi alespoň dva studenti, kteří se
# narodili ve stejném znamení, dá mi každý z Vás 100 Kč.“ Vyplatí se studentům sázku
# přijmout? S jakou pravděpodobností studenti vyhrají?

permutace(12)/variace_opak(12,12)

# * Příklad 5. ####
# Spočtěte pravděpodobnost toho, že z bodu 1 do bodu 2 bude protékat elektrický proud,
# je-li část el. obvodu včetně pravděpodobnosti poruch jednotlivých součástek vyznačen
# na následujícím obrázku. (Poruchy jednotlivých součástek jsou na sobě nezávislé.)
# Obrázek viz sbírka úloh.

# rozdělíme na bloky I=(A,B) a II=(C,D,E)
PI = 1 - (1 - 0.1)*(1 - 0.3)
PI
PII = 0.2*0.3*0.2
PII
# výsledek
(1 - PI)*(1-PII)

# * Příklad 6. ####
# Ohrada má obdélníkový tvar, východní a západní stěna mají délku 40 m, jižní a severní
# pak 100 m. V této ohradě běhá kůň. Jaká je pravděpodobnost, že je k jižní stěně blíž
# než ke zbývajícím třem?

# geometrická pravděpodobnost
ohrada = 40*100
#blize k jihu
blize_J = 20*60 + 20*20
#pravdepodobnosti
blize_J/ohrada

# * Příklad 7. ####
# U pacienta je podezření na jednu ze čtyř vzájemně se vylučujících nemocí - N1, N2, N3,
# N4 s pravděpodobností výskytu P(N1)=0,1; P(N2)=0,2; P(N3)=0,4; P(N4)=0,3. Laboratorní
# zkouška A je pozitivní v případě první nemoci v 50 % případů, u druhé nemoci v 75 %
# případů, u třetí nemoci v 15 % případů a u čtvrté v 20 % případů. Jaká je
# pravděpodobnost, že výsledek laboratorní zkoušky bude pozitivní?

# věta o úplné pravděpodobnosti
P_N = c(0.1,0.2,0.4,0.3) # P(N1), P(N2), ...
P_PN = c(0.5,0.75,0.15,0.2) # P(P|N1), P(P|N2), ...
P_P = uplna_pravdepodobnost(P_B = P_N, P_AB = P_PN) # P(P)
P_P

# * Příklad 8. ####
# Telegrafické znaky se skládají ze signálů „tečka“, „čárka“. Je statisticky zjištěno,
# že se zkomolí 25 % sdělení „tečka“ a 20 % signálů „čárka“. Dále je známo, že signály
# se používají v poměru 3:2. Určete pravděpodobnost, že byl přijat správně signál,
# jestliže byl přijat signál „tečka“.

# Bayesova věta
P_O = c(0.6, 0.4)   #    P(O.),    P(O-)
P_PO = c(0.75, 0.2) # P(P.|O.), P(P.|O-)
bayes(P_B = P_O, P_AB = P_PO, k = 1) # k = 1 protože správně = O.

# * Příklad 9. ####
# V jednom městě jezdí 85 % zelených taxíků a 15 % modrých. Svědek dopravní nehody
# vypověděl, že nehodu zavinil řidič modrého taxíku, který pak ujel. Testy provedené za
# obdobných světelných podmínek ukázaly, že svědek dobře identifikuje barvu taxíku v 80
# % případů a ve 20 % případů se mýlí.
#  - Jaká je pravděpodobnost, že viník nehody skutečně řídil modrý taxík?
#  - Následně byl nalezen další nezávislý svědek, který rovněž tvrdí, že taxík byl
# modrý. Jaká je nyní pravděpodobnost, že viník nehody skutečně řídil modrý taxík?
#  - Ovlivní pravděpodobnost, že viník nehody skutečně řídil modrý taxík to, zda dva
# výše
# zmínění svědci vypovídali postupně nebo najednou?

# a) opět Bayesova věta
P_B = c(0.85, 0.15)  #    P(Z),    P(M)
P_SB = c(0.20, 0.80) # P(SM|Z), P(SM|M)
bayes(P_B = P_B, P_AB = P_SB, k = 2) # modrý je druhý

# b) první možnost - druhý průchod Bayesem
P_M = bayes(P_B = P_B, P_AB = P_SB, k = 2)
P_B = c(1 - P_M, P_M)  #     P(Z),     P(M)
P_SB = c(0.20, 0.80)   # P(S2M|Z), P(S2M|M)
bayes(P_B = P_B, P_AB = P_SB, k = 2)

# c) nebo odpověděli najednou
P_B = c(0.85, 0.15)      #         P(Z),         P(M)
P_SB = c(0.20^2, 0.80^2) # P(S1M&S2M|Z), P(S1M&S2M|M)
bayes(P_B = P_B, P_AB = P_SB, k = 2)

# * Příklad 10. ####
# Potřebujeme zjistit odpověď na určitou citlivou otázku. Jak odhadnout, kolik procent
# dotazovaných na otázku odpoví ANO a přitom všem respondentům zaručit naprostou
# anonymitu? Jedním z řešení je tzv. dvojitě anonymní anketa:
# Necháme respondenty hodit korunou a dvojkorunou a ti, kterým padl na koruně líc
# napíšou na lísteček odpověď (ANO/NE) na citlivou otázku. Ostatní respondenti napíší,
# zda jim padl na dvojkoruně líc (ANO/NE). Jakým způsobem určíme podíl studentů, kteří
# na citlivou otázku odpověděli ANO?
# Předpokládejme, že respondenti byli dotazování, zda podváděli u zkoušky. Z anketních
# lístků se zjistilo, že „ANO“ odpovědělo 120 respondentů a „NE“ odpovědělo 200
# respondentů. Kolik procent studentů podvádělo u zkoušky?

# věta o úplné pravděpodobnosti
# P(A) = P(K_lic)*P(A|K_lic)+P(K_rub)*P(D_lic|K_rub)
# rovnice 120/320=0.5*x+0.5*0.5
(120/320-0.5^2)/0.5

# * Bonus - Monty Hall Problem ####
#
# Začneme s vygenerováním n instancí soutěže - cena bude náhodný index dveří (1,2,3) za
# kterými se může nacházet cena

n = 10000 # počet pokusů
cena = sample.int(n = 3, size = n, replace = TRUE) # náhdný výběr dveří
head(cena) # head vykresli prvních 6 prvků/řádků

# Totéž pro naši původní volbu - náhodný index dveří.

volba_orig = sample.int(n = 3, size = n, replace = TRUE) # původní volba
head(volba_orig)

# V prvním kole moderátor jedny prázdné dveře otevře, takto se to dá nasimulovat:

otevrene_dvere = rep(0, n) # inicializace vektoru
dvere_c = 1:3 # pomocná proměnná - identifikátory dveří
for (i in 1:n){
    dvere_k_otevereni = c(TRUE, TRUE, TRUE) # inicializace
    dvere_k_otevereni[cena[i]] = FALSE # nesmíme otevřít dveře s cenou
    dvere_k_otevereni[volba_orig[i]] = FALSE # ani naše vybrané dveře
    # ve zbytku jsou buď 2 (pokud jsme se trefili) nebo 1 dveře (pokud ne)
    idx_dvere = dvere_c[dvere_k_otevereni]
    if (length(idx_dvere) == 1){
        otevrene_dvere[i] = idx_dvere # pokud jedny otevřeme je
    } else { # pokud 2 tak jedny náhodně vybereme a otevřeme je
        otevrene_dvere[i] = sample(x = idx_dvere, size = 1)
    }
}
head(otevrene_dvere)

# Naše nová volba pokud se tak rozhodneme - součet indexů je 1+2+3=6 takže pokud my máme
# vybraný nějaký index, dále nějaký index se otevře, tak do zbytku 6 jsou ty třetí =
# naše nová volba.

nova_volba = 6 - (volba_orig + otevrene_dvere)
head(nova_volba)

# Úspěšnost při originální volbě:

p_orig = sum(cena == volba_orig)/n
p_orig

# Úspěšnost při výměně:

p_zmena = sum(cena == nova_volba)/n
p_zmena

p_orig + p_zmena


library(R0)
library(uuid)
library(igraph)
library(data.table)
library(EpiDynamics)
library(scales)
library(ggraph)
library(tidyverse)
library(cowplot)
setwd("~/Public_Policy/Projects/COVID-19")

# https://www.ijidonline.com/article/S1201-9712(20)30119-3/fulltext
# SD of 4.8 days (95% CrI: 3.8, 6.1) and 2.3 days
serial_interval_mean = 4.8
serial_interval_sd = 2.3

fit_weibull = function(par) {
  the_weibull = rweibull(10000, par[1], par[2])
  abs(mean(the_weibull) - serial_interval_mean) + abs(sd(the_weibull) - serial_interval_sd)
}

si_solution = optim(c(6, 3),fit_weibull)

set.seed(19)

run_case_simulation = function(
  initial_susceptible = 20e6, the_r0,
  lockdown_date = NULL,
  lockdown_effect = NULL,
  lockdown_prevalence = NULL
  ) {
  # initial_susceptible = 100
  # the_r0 = 2.5
  this_r0 = the_r0
  current_susceptible = initial_susceptible

  case_info_list = list()

  generation = 0

  cases_gen_df = tibble(
    parent_id = NA,
    si_start = 0
  )
  n_cases_generated = 1

  continue_loop = T

  while (continue_loop) {
    loop_start = proc.time()

    # decrement the number of susceptible
    if (n_cases_generated > current_susceptible) {
      n_cases_generated = current_susceptible
      suseptible_by_id = current_susceptible - 1:n_cases_generated
      cases_gen_df = head(cases_gen_df, n_cases_generated)
    } else {
      suseptible_by_id = current_susceptible - 1:n_cases_generated
    }

    if (current_susceptible < 0) {
      break
    }

    # increment the ids
    the_id = initial_susceptible - suseptible_by_id

    # https://wwwnc.cdc.gov/eid/article/26/6/20-0357_article
    # https://www.ijidonline.com/article/S1201-9712(20)30119-3/pdf

    # incubation_time = rnorm(n_cases_generated, 3.96, 4.75)
    # incubation_time = rgamma(n_cases_generated, 4.37,  scale = 1.25)
    # incubation_time = rweibull(n_cases_generated, weibull_params$par[1], weibull_params$par[2])

    # serial_interval = rweibull(n_cases_generated, si_solution$par[1], si_solution$par[2])
    serial_interval = 5
    si_start_date = cases_gen_df$si_start
    si_end_date = si_start_date + serial_interval

    # each person has a different probability of running into someone else and infecting them
    # if 99 people have already been infected, the 100th person in a group of 100 has no chance of infecting someone
    # else

    prob_running_into_someone_else = suseptible_by_id / initial_susceptible

    if (!is.null(lockdown_date)) {
      lockdown_effects = ifelse(si_start_date >= lockdown_date, (1-lockdown_effect), 1)
      r0_adj = the_r0 * prob_running_into_someone_else * lockdown_effects
    } else if (!is.null(lockdown_prevalence)) {
      # lockdown_effects = ifelse((cumulative_cases/initial_susceptible) >= lockdown_prevalence, (1-lockdown_effect), 1)
      # r0_adj = the_r0 * prob_running_into_someone_else * lockdown_effects
    } else {
      r0_adj = the_r0 * prob_running_into_someone_else
    }

    # this simulates "fractions" of new cases and says they are either one or zero based on the fraction percentage
    cases_generated = floor(r0_adj) + rbinom(length(r0_adj), 1, r0_adj - floor(r0_adj))
    n_cases_generated = sum(cases_generated)

    # pack up data on the new cases
    these_cases_df = data.table(
      the_id = the_id %>% as.integer(),
      generation = generation,
      parent_id = cases_gen_df$parent_id,
      serial_interval,
      si_start_date,
      si_end_date,
      prob_running_into_someone_else,
      r0_adj,
      cases_generated
    ) %>%
      setkey(the_id)

    case_info_list[[length(case_info_list) + 1]] = these_cases_df

    if (n_cases_generated > 0) {
      # important to sort by cases generated so the recyling works
      with_gen_cases = filter(these_cases_df, cases_generated > 0) %>% arrange(-cases_generated)

      cases_gen_df = data.table(
        parent_id = rep(with_gen_cases$the_id, length.out = n_cases_generated),
        # this assumes uniform infection rate. In reality, people are more infectious later on, but there are
        # cases of people spreading covid within a short time of infection (12 hours or so)
        si_start = rep(with_gen_cases$si_end_date, length.out = n_cases_generated)
        # incubation_start = runif(n_cases_generated, with_gen_cases$si_start_date, with_gen_cases$si_end_date)
      ) %>%
        setorder(si_start)

      stopifnot(nrow(cases_gen_df) == n_cases_generated)
    }

    # print(proc.time() - loop_start)
    generation = generation + 1

    current_susceptible = min(suseptible_by_id)
    continue_loop = n_cases_generated > 0 & current_susceptible > 0
  }

  return(rbindlist(case_info_list))
}

covid_ifr = 0.005
n_susceptible = 10000000
covid_case_simulation = run_case_simulation(
  lockdown_date = 21,
  lockdown_effect = .5,
  lockdown_prevalence = NULL,
  the_r0 = 3,
  initial_susceptible = n_susceptible
) %>%
  mutate(
    start_day = floor(si_start_date),
    died = rbinom(length(the_id), 1, covid_ifr),
    death_date = ifelse(died, start_day + 14, NA)
  ) %>%
  arrange(
    start_day
  )
nrow(covid_case_simulation)

date_df = data.frame(start_day = 0:360)
cases_by_day = group_by(covid_case_simulation, start_day) %>%
  summarize(
    new_cases = n_distinct(the_id)
  ) %>%
  full_join(date_df) %>%
  arrange(start_day) %>%
  mutate(
    new_cases = ifelse(is.na(new_cases), 0, new_cases),
    cumulative_cases = cumsum(new_cases)
  )

ggplot(cases_by_day, aes(start_day, new_cases)) +
  geom_bar(stat = 'identity')

ggplot(cases_by_day, aes(start_day, cumulative_cases/n_susceptible)) +
  geom_line() +
  scale_x_continuous(limits = c(0, 360)) +
  scale_y_continuous(labels = percent)

simulations_stacked = map(1:nrow(simulation_params), function(sim_it){
  the_row = simulation_params[sim_it,]

  simulation_df = map(1:500, function(it){
    covid_case_simulation = run_case_simulation(
      lockdown_date = the_row$lockdown_date,
      lockdown_effect = the_row$lockdown_effect,
      the_r0 = 2.5,
      initial_susceptible = 100
      ) %>%

      mutate(
        start_day = floor(si_start_date),
        died = rbinom(length(the_id), 1, covid_ifr),
        death_date = ifelse(died, start_day + 14, NA)
      ) %>%
      arrange(
        start_day
      )

    date_df = data.frame(start_day = 0:120)
    cases_by_day = group_by(covid_case_simulation, start_day) %>%
      summarize(
        new_cases = n_distinct(the_id)
      ) %>%
      full_join(date_df) %>%
      arrange(start_day) %>%
      mutate(
        new_cases = ifelse(is.na(new_cases), 0, new_cases),
        cumulative_cases = cumsum(new_cases),
        it = it
      )
  }) %>%
    bind_rows() %>%
    mutate(
      lockdown_date = the_row$lockdown_date,
      lockdown_effect = the_row$lockdown_effect
    )

})

simulations_df = bind_rows(simulations_stacked)

stats_by_day = group_by(simulations_df, start_day, lockdown_date, lockdown_effect) %>%
  summarize(
    obs = n(),
    median_cases = median(cumulative_cases),
    sd_cumulative_cases = sd(cumulative_cases),
    q95 = quantile(cumulative_cases, probs = 0.95),
    q5 = quantile(cumulative_cases, probs = 0.05),
    q75 = quantile(cumulative_cases, probs = 0.75),
    q25 = quantile(cumulative_cases, probs = 0.25)
    ) %>%
  mutate(
    action = ifelse(lockdown_effect == 0, 'No Social Distancing', 'Social Distancing at'),
    effect_date = paste0(lockdown_date, ' days, ', percent(lockdown_effect), ' effect'),
    Action_Pretty = ifelse(lockdown_effect == 0, action, paste0(action, ' ', effect_date))
  ) %>%
  arrange(Action_Pretty, start_day)

write.csv(stats_by_day, 'output/distancing_simulation_stats.csv', row.names = F)

ggplot(stats_by_day, aes(start_day, median_cases,  fill = Action_Pretty)) +
  theme_bw() +
  theme(
    panel.grid.minor = element_blank(),
    strip.background = element_blank(),
    plot.subtitle = element_text(size = 10, face = 'italic')
  ) +
  facet_wrap(~Action_Pretty, ncol = 2) +
  geom_ribbon(aes(ymin = q25, ymax =  q75), alpha = 0.3, size = 0, show.legend = F) +
  geom_line(aes(colour = Action_Pretty), size = 1, show.legend = F) +
  scale_x_continuous(breaks = seq(0, 60, by = 10), limits = c(0, 60)) +
  scale_y_continuous(breaks = seq(0, 100, by = 10)) +
  labs(
    y = 'Median Cumulative Cases\n25th and 75th Percentiles',
    x = 'Day',
    title = 'Network Simulations of Covid Infections',
    subtitle = 'Assumptions: closed group of 100, 2.5 initial R0, serial interval 4.8 days'
  )
ggsave('output/simulation_comparison_plot.png', height = 8, width = 8, units = 'in', dpi = 600)

# ggsave('output/cumulative_cases_simulated.png', height = 8, width = 8, units = 'in', dpi = 450)

sample_covid_case_simulation = run_case_simulation(the_r0 = 2.5,
                                            initial_susceptible = 100) %>%
  mutate(
    start_day = floor(si_start_date),
    died = rbinom(length(the_id), 1, covid_ifr),
    death_date = ifelse(died, start_day + 14, NA)
  ) %>%
  arrange(
    the_id
  )

the_edgelist = filter(sample_covid_case_simulation, !is.na(parent_id)) %>%
  mutate(
    parent = paste0('_', parent_id),
    child = paste0('_', the_id)
  )

the_graph = igraph::graph_from_edgelist(as.matrix(select(the_edgelist, parent, child)))
V(the_graph)$page_rank_centrality = page_rank(the_graph)$vector
V(the_graph)$v_id = str_extract(V(the_graph)$name, '[0-9]+')
V(the_graph)$generation = sample_covid_case_simulation$generation
V(the_graph)$betweenness_centrality = betweenness(the_graph)

network_plot = ggraph(the_graph, 'kk') +
  geom_edge_link() +
  geom_node_point(aes(size = -generation), colour = 'tomato') +
  scale_size(name='Generation', range = c(3, 7), labels = function(x){-1*x}) +
  geom_node_text(aes(label = v_id, size = -generation), show.legend = F) +
  theme_graph() +
  theme(
    plot.title = element_text(size = 14, face = 'plain')
  ) +
  labs(
    title = 'A Simulated Network of Infections'
  )

ggsave('output/network_example.png', height = 8, width = 10, units = 'in', dpi = 400, plot = network_plot)

full_grid = plot_grid(cumulative_case_plot, network_plot, nrow = 2)
full_grid_sub = add_sub(full_grid, "Chart: Taylor G. White",
                        x = 0.05, y = 0.35, hjust = 0, size = 10, fontface = 'italic')

save_plot('output/combined_network_analysis.png', base_width = 12, base_height = 14, dpi = 600, plot = full_grid_sub)


# Recursion with Memoization

RecTable <- c(1, 1, rep(NA, 100))
FibMem <- function(x) {
  if(!is.na(RecTable[x])) return(RecTable[x])
  ans <- FibMem(x-2) + FibMem(x-1)
  RecTable[x] <<- ans
  ans
}

StartTime <- Sys.time()
paste("20th Fibonacci number is: ",FibMem(20))
EndTime <- Sys.time()

paste("Computational time using Memoization is: ",EndTime - StartTime)


rm(list = ls())

library(stargazer)

myurl <- "https://docs.google.com/spreadsheets/d/e/2PACX-1vSlgk7b5SzbowsX8pUBgqB9nqNUM0YYq-s8jSF-C8nZSUOeW2qWBnXK_vLAjYk9Lnbt0RwcOoJ1Tm_m/pub?output=csv"
df <- read.csv(url(myurl))

# descriptive statistics;
stargazer(
  df,
  type = "text"
)

# Transfer factor var to numeric; prepare for regression;
df$population_wan_2018 <- gsub(",","", df$population_wan_2018)
df$gdp_i <- gsub(",","", df$gdp_i)

df$population_wan_2018 <- as.numeric(as.character(df$population_wan_2018))
df$gdp_i <- as.numeric(as.character(df$gdp_i))

# Transfer first-half
# & second-half instead of index
df$doing_business <- ifelse(df$do_business_index_rank <=15, "Easy_top_15", "hard_top_15")
df$cost <- ifelse(df$cost <= 15, "Easy_business_top_15", "Expensive_start_business")

#################################################################
##             Predictor: Blacklisted Corporations             ##
#################################################################

reg0 <- lm(
  data = df,
  df$corporation ~ df$population_wan_2018 + gdp_i
)

# regression - 1 that only includes the population in 10,000;
reg1 <- lm(
  data = df,
  df$corporation ~ df$population_wan_2018 + gdp_i + male + female
)

# regression - 2; Includes doing business index.
reg2 <- lm(
  data = df,
  df$corporation ~ df$population_wan_2018 + gdp_i + male + female + df$doing_business
)

# regression - 3;
reg3 <- lm(
  data = df,
  df$corporation ~ df$population_wan_2018 + gdp_i + male + female +  df$cost
)

stargazer(reg1, type  = "text")
stargazer(reg2, type = "text")
stargazer(reg3, type = "text")

reg0 <- lm(
  data = df,
  df$corporation ~ df$population_wan_2018
)

reg1 <- lm(
  data = df,
  df$corporation ~   gdp_i
)

reg2 <- lm(
  data = df,
  df$corporation ~ df$population_wan_2018 + gdp_i
)

stargazer(
  reg0,
  reg1,
  reg2,
  type="latex"
)


# Example : 7   Chapter : 5.2     Page No: 261
# Determinants of matrices
B4<-matrix(c(1,-1,0,0,-1,2,-1,0,0,-1,2,-1,0,0,-1,2),ncol=4)
print(det(B4))


mergesort <- function(m)
{
   merge_ <- function(left, right)
   {
      result <- c()
      while(length(left) > 0 && length(right) > 0)
      {
         if(left[1] <= right[1])
         {
            result <- c(result, left[1])
            left <- left[-1]
         } else
         {
            result <- c(result, right[1])
            right <- right[-1]
         }
      }
      if(length(left) > 0) result <- c(result, left)
      if(length(right) > 0) result <- c(result, right)
      result
   }

   len <- length(m)
   if(len <= 1) m else
   {
      middle <- length(m) / 2
      left <- m[1:floor(middle)]
      right <- m[floor(middle+1):len]
      left <- mergesort(left)
      right <- mergesort(right)
      if(left[length(left)] <= right[1])
      {
         c(left, right)
      } else
      {
         merge_(left, right)
      }
   }
}

executeTask <- function(i) {

mergesort(c(16+i,93,-99,95,-96,-24,-53,-71,96,-66,-21,72,-12,-32,-96,62,-42,-50,49,53,-65,52,-25,-69,88,-43,60,66,-94,-69,53,-71,-17,-58,-30,32,-16,-94,-42,-86,59,-53,94,97,-12,15,65,-35,-12,-82,-82,48,-48,66,-42,-63,33,-49,41,-85,94,66,-60,60,-65,-73,-50,-9,-48,-3,15,-77,81,95,-93,83,-21,34,-78,-61,-22,-58,65,78,41,-7,-59,20,88,-38,-15,-69,42,97,-35,61,8,2,-22,-85)) # -31   0   1   2   4  65  83  99 78
return(i)
}

r=0
for(i in 0:1000000) {
	r = executeTask(i)
}


input<-file('stdin')
open(input)

layout_raw <- readLines(input, n=1)
layout <- as.vector(as.numeric(unlist(strsplit(layout_raw, "\\s+"))))
features <- layout[1]

rows <- layout[2]

data <- read.table(input, sep = "", nrows = rows, header = F)

#print(data)

price <- colnames(data)[ncol(data)]

f <- paste(names(data)[-ncol(data)], collapse=" + ") # all columns except the last one

fit <- lm(as.formula(paste(price, " ~ ", f)), data=data)

#summary(fit) # show results

testcases <- as.integer(readLines(input, n=1))
for(i in seq(1, testcases)) {
    testdata <- read.table(input, sep = "", nrows = 1, header = F)
    vanga <- predict(fit, testdata)

    # answer:
    write(round(vanga, 2), stdout())
}


#!/usr/bin/env Rscript

#Andrew Burt - a.burt@ucl.ac.uk

bivariateStats <- function(data)
{
	func_d <- log(agb) ~ log(d)
	model_d <- fitOLS(data,func_d)
	print(summary(model_d))
	rainbow_test(model_d)
	studentised_breusch_pagan_test(data,func_d,model_d)
	studentised_white_test(data,func_d,model_d)
	shapiro_wilk_test(model_d)
	anderson_darling_test(model_d)
	#
	func_h <- log(agb) ~ log(h)
	model_h <- fitOLS(data,func_h)
	print(summary(model_h))
	rainbow_test(model_h)
	studentised_breusch_pagan_test(data,func_h,model_h)
	studentised_white_test(data,func_h,model_h)
	shapiro_wilk_test(model_h)
	anderson_darling_test(model_h)
}

covariateStats <- function(data)
{
	#
	func_drho <- log(agb) ~ log(d) + log(rho)
	model_drho <- fitOLS(data,func_drho)
	print(summary(model_drho))
	rainbow_test(model_drho)
	studentised_breusch_pagan_test(data,func_drho,model_drho)
	studentised_white_test(data,func_drho,model_drho)
	shapiro_wilk_test(model_drho)
	anderson_darling_test(model_drho)
	#
	func_dh <- log(agb) ~ log(d) + log(h)
	model_dh <- fitOLS(data,func_dh)
	print(summary(model_dh))
	rainbow_test(model_dh)
	studentised_breusch_pagan_test(data,func_dh,model_dh)
	studentised_white_test(data,func_dh,model_dh)
	shapiro_wilk_test(model_dh)
	anderson_darling_test(model_dh)
	#
	func_dhrho <- log(agb) ~ log(d) + log(h) + log(rho)
	model_dhrho <- fitOLS(data,func_dhrho)
	print(summary(model_dhrho))
	rainbow_test(model_dhrho)
	studentised_breusch_pagan_test(data,func_dhrho,model_dhrho)
	studentised_white_test(data,func_dhrho,model_dhrho)
	shapiro_wilk_test(model_dhrho)
	anderson_darling_test(model_dhrho)
}

crossvalidateStats <- function(data)
{
	####
	func_d <- log(agb) ~ log(d)
	results_d <- crossValidateOLS(data,func_d)
	print("b~fn(d)")
	#
	print("Median symmetric accuracy, mean, min, max")
	print(mean(results_d[[2]][,1]))
	print(min(results_d[[2]][,1]))
	print(max(results_d[[2]][,1]))
	#
	print("Symmetric signed percentage bias, mean, min, max")
	print(mean(results_d[[2]][,2]))
	print(min(results_d[[2]][,2]))
	print(max(results_d[[2]][,2]))
	####
	func_h <- log(agb) ~ log(h)
	results_h <- crossValidateOLS(data,func_h)
	print("b~fn(h)")
	#
	print("Median symmetric accuracy, mean, min, max")
	print(mean(results_h[[2]][,1]))
	print(min(results_h[[2]][,1]))
	print(max(results_h[[2]][,1]))
	#
	print("Symmetric signed percentage bias, mean, min, max")
	print(mean(results_h[[2]][,2]))
	print(min(results_h[[2]][,2]))
	print(max(results_h[[2]][,2]))
	####
	func_dh <- log(agb) ~ log(d) + log(h)
	results_dh <- crossValidateOLS(data,func_dh)
	print("b~fn(d,h)")
	#
	print("Median symmetric accuracy, mean, min, max")
	print(mean(results_dh[[2]][,1]))
	print(min(results_dh[[2]][,1]))
	print(max(results_dh[[2]][,1]))
	#
	print("Symmetric signed percentage bias, mean, min, max")
	print(mean(results_dh[[2]][,2]))
	print(min(results_dh[[2]][,2]))
	print(max(results_dh[[2]][,2]))
	####
	func_drho <- log(agb) ~ log(d) + log(rho)
	results_drho <- crossValidateOLS(data,func_drho)
	print("b~fn(d,rho)")
	#
	print("Median symmetric accuracy, mean, min, max")
	print(mean(results_drho[[2]][,1]))
	print(min(results_drho[[2]][,1]))
	print(max(results_drho[[2]][,1]))
	#
	print("Symmetric signed percentage bias, mean, min, max")
	print(mean(results_drho[[2]][,2]))
	print(min(results_drho[[2]][,2]))
	print(max(results_drho[[2]][,2]))
	####
	func_dhrho <- log(agb) ~ log(d) + log(h) + log(rho)
	results_dhrho <- crossValidateOLS(data,func_dhrho)
	print("b~fn(d,h,rho)")
	#
	print("Median symmetric accuracy, mean, min, max")
	print(mean(results_dhrho[[2]][,1]))
	print(min(results_dhrho[[2]][,1]))
	print(max(results_dhrho[[2]][,1]))
	#
	print("Symmetric signed percentage bias, mean, min, max")
	print(mean(results_dhrho[[2]][,2]))
	print(min(results_dhrho[[2]][,2]))
	print(max(results_dhrho[[2]][,2]))
}


# Machine Learning - Regressão
# Prevendo Despesas Hospitalares

# Obs: Caso tenha problemas com a acentuação, consulte este link:
# https://support.rstudio.com/hc/en-us/articles/200532197-Character-Encoding

# Configurando o diretório de trabalho
# Coloque entre aspas o diretório de trabalho que você está usando no seu computador
setwd("~/project1-data-prediction")
getwd()

# Problema de Negócio: Previsão de Despesas Hospitalares

# Para esta análise, vamos usar um conjunto de dados simulando despesas médicas hipotéticas
# para um conjunto de pacientes espalhados por 4 regiões do Brasil.
# Esse dataset possui 1.338 observações e 7 variáveis.

# Etapa 1 - Coletando os dados
library(readr)
despesas <- read_csv(file.choose())
View(despesas)

# Etapa 2: Explorando e Preparando os Dados
# Visualizando as variáveis
str(despesas)

# Medias de Tendência Central da variável gastos
summary(despesas$gastos)

# Construindo um histograma
hist(despesas$gastos, main = 'Histograma', xlab = 'Gastos')

# Tabela de contingência das regiões
table(despesas$regiao)

# Explorando relacionamento entre as variáveis: Matriz de Correlação
cor(despesas[c("idade", "bmi", "filhos", "gastos")])

# Nenhuma das correlações na matriz é considerada forte, mas existem algumas associações interessantes.
# Por exemplo, a idade e o bmi (IMC) parecem ter uma correlação positiva fraca, o que significa que
# com o aumento da idade, a massa corporal tende a aumentar. Há também uma correlação positiva
# moderada entre a idade e os gastos, além do número de filhos e os gastos. Estas associações implicam
# que, à media que idade, massa corporal e número de filhos aumenta, o custo esperado do seguro saúde sobe.

# Visualizando relacionamento entre as variáveis: Scatterplot
# Perceba que não existe um claro relacionamento entre as variáveis
pairs(despesas[c("idade", "bmi", "filhos", "gastos")])

# Scatterplot Matrix
install.packages("psych")
library(psych)

# Este gráfico fornece mais informações sobre o relacionamento entre as variáveis
pairs.panels(despesas[c("idade", "bmi", "filhos", "gastos")])

# Etapa 3: Treinando o Modelo (usando os dados de treino)
?lm
modelo <- lm(gastos ~ idade + filhos + bmi + sexo + fumante + regiao, data = despesas)

# Similar ao item anterior
modelo <- lm(gastos ~ ., data = despesas)

# Visualizando os coeficientes
modelo

# Prevendo despesas médicas
?predict

# Aqui verificamos os gastos previstos pelo modelo que devem ser iguais aos dados de treino
previsao1 <- predict(modelo)
View(previsao1)

# Prevendo os gastos com Dados de teste
despesasteste <- read_csv(file.choose())
View(despesasteste)
previsao2 <- predict(modelo, despesasteste)
View(previsao2)

# Etapa 4: Avaliando a Performance do Modelo
# Mais detalhes sobre o modelo
summary(modelo)

# ****************************************************
# *** Estas informa??es abaixo ? que far?oo de voc? ***
# *** um verdadeiro conhecedor de Machine Learning ***
# ****************************************************

# Equa??o de Regress?o
# y = a + bx (simples)
# y = a + b0x0 + b1x1 (m?ltipla)

# Res?duos
# Diferen??a entre os valores observados de uma vari?vel e seus valores previstos
# Seus res?duos devem se parecer com uma distribui??o normal, o que indica
# que a m?dia entre os valores previstos e os valores observados ? pr?ximo de 0 (o que ? bom)

# Coeficiente - Intercept - a (alfa)
# Valor de a na equa??o de regress?o

# Coeficientes - Nomes das vari?veis - b (beta)
# Valor de b na equa??o de regress?o

# Obs: A quest?o ? que lm() ou summary() t?m diferentes conven??es de
# rotulagem para cada vari?vel explicativa.
# Em vez de escrever slope_1, slope_2, ....
# Eles simplesmente usam o nome da vari?vel em qualquer sa?da para
# indicar quais coeficientes pertencem a qual vari?vel.

# Erro Padr?o
# Medida de variabilidade na estimativa do coeficiente a (alfa). O ideal ? que este valor
# seja menor que o valor do coeficiente, mas nem sempre isso irá ocorrer.

# Asteriscos
# Os asteriscos representam os n?veis de signific?ncia de acordo com o p-value.
# Quanto mais estrelas, maior a signific?ncia.
# Aten??o --> Muitos astericos indicam que ? improv?vel que n?o exista
# relacionamento entre as vari?veis.

# Valor t
# Define se coeficiente da vari?vel ? significativo ou n?o para o modelo.
# Ele ? usado para calcular o p-value e os n?veis de signific?ncia.

# p-value
# O p-value representa a probabilidade que a vari?vel n?o seja relevante.
# Deve ser o menor valor poss?vel.
# Se este valor for realmente pequeno, o R ir? mostrar o valor
# como nota??o cient?fica

# Signific?ncia
# S?o aquelas legendas pr?ximas as suas vari?veis
# Espa?o em branco - ruim
# Pontos - razo?vel
# Asteriscos - bom
# Muitos asteriscos - muito bom

# Residual Standar Error
# Este valor representa o desvio padr?o dos res?duos

# Degrees of Freedom
# ? a diferen?a entre o n?mero de observa??es na amostra de treinamento
# e o n?mero de vari?veis no seu modelo

# R-squared (coeficiente de determina??o - R^2)
# Ajuda a avaliar o n?vel de precis?o do nosso modelo.
# Quanto maior, melhor, sendo 1 o valor ideal.

# F-statistics
# ? o teste F do modelo. Esse teste obt?m os par?metros do nosso modelo
# e compara com um modelo que tenha menos par?metros.
# Em teoria, um modelo com mais par?metros tem um desempenho melhor.

# Se o seu modelo com mais par?metros N?O tiver perfomance
# melhor que um modelo com menos par?metros, o valor do p-value ser? bem alto.

# Se o modelo com mais par?metros tiver performance
# melhor que um modelo com menos par?metros, o valor do p-value ser? mais baixo.

# Lembre-se que correla??o n?o implica causalidade

# Etapa 5: Otimizando a Performance do Modelo

# Adicionando uma vari?vel com o dobro do valor das idades
despesas$idade2 <- despesas$idade ^ 2

# Adicionando um indicador para BMI >= 30
despesas$bmi30 <- ifelse(despesas$bmi >= 30, 1, 0)

View(despesas)

# Criando o modelo final
modelo_v2 <- lm(gastos ~ idade + idade2 + filhos + bmi + sexo +
                   bmi30 * fumante + regiao, data = despesas)

summary(modelo_v2)

# Dados de teste
despesasteste <- read_csv(file.choose())
View(despesasteste)
previsao <- predict(modelo, despesasteste)
class(previsao)
View(previsao)


#!/usr/bin/env Rscript

numsteps <- 10000000

args <- commandArgs(trailingOnly=TRUE)

if (length(args)>0) {
  numsteps <- strtoi(args)
}

cat("Calculating PI using:\n ", numsteps, "slices \n")
cat("  1 process\n")

start <- Sys.time()

sum <- 0.0
step <- 1.0/numsteps

for (i in 1:numsteps) {
  x <- (i - 0.5) * step
  sum <- sum + 4.0/(1.0 + (x^2))
}

mypi = sum * step

stop <- Sys.time()
elapsed <- stop - start

cat("Obtained value of PI:", mypi, "\n")
cat("Time taken:", elapsed, "seconds\n")


NCPgen <- function(q,R,K,CaseN,ConN) {
  # q is the AF
  # R is the RR

  p <- 1-q;

  p_d_aa <- K / (p*p + 2*p*q*R + q*q*R*R);
  p_d_ab <- p_d_aa * R;
  p_d_bb <- p_d_aa * R * R;

  p_aa_d <- p_d_aa * p * p/ K ;
  p_ab_d <- p_d_ab * p * q * 2 / K ;
  p_bb_d <- p_d_bb * q * q/ K ;

  p_aa_u <- (p*p - K * p_aa_d)  / (1-K) ;
  p_ab_u <- (2*p*q - K * p_ab_d) / (1-K) ;
  p_bb_u <- (q*q - K * p_bb_d)  / (1-K)	;

  p_case <- p_aa_d + 0.5*p_ab_d;
  p_con <- p_aa_u + 0.5*p_ab_u;
  q_case <- 1 - p_case ;
  q_con <- 1 - p_con ;

#  NCP <- chisq.test(matrix(c(2*p_case*CaseN,2*p_con*ConN,2*q_case*CaseN,2*q_con*ConN),2,2),correct=F);

  summary(as.table(matrix(c(2*p_case*CaseN,2*p_con*ConN,2*q_case*CaseN,2*q_con*ConN),2,2)))$statistic;

}

denovoGen <- function(R, q,f,CaseN,ConN) {

    # q is number of de novo mutations
    # R is the relative risk of having a variant
    # CaseN is the number of cases - N*r/(1+r)
    # CaseN is the number of controls - N/(1+r)
    MutCases = rpois(CaseN, q * 1* (1-f) )  + rpois(CaseN, q * R * f )
    MutCon = rpois(ConN, q * 1)

    m <- glm(c(MutCases, MutCon)~ c(rep(1, CaseN), rep(0, ConN)), family="poisson")
    -(m$deviance-m$null.deviance)

}

denovoGenPower <- function(R, q,f,CaseN,ConN, p_cut_denovo) {

   pchisq(qchisq(p_cut_denovo, 1, low=F), 1, ncp=denovoGen(R, q,f,CaseN,ConN), low=F)

}

getSingleVarPower <- function(f, AF, R, K, N, r, P_cut_single){
  chi <- unlist(lapply(AF[1:f], function(i){ NCPgen(i,R,K,N*r/(1+r),N/(1+r)) }))
  power_snp <- pchisq(qchisq(P_cut_single, 1, low=F), 1, ncp=chi, low=F)
  ret <- 1-prod(1-power_snp)
  ret
}

getBurdenPower <- function(f, AF, sum_var, R, K, N, r, p_cut_burden){

  ratio <- sum(AF[1:f] * (1-AF[1:f]) ) / sum_var
  chi <- NCPgen(sum(AF) , exp(log(R)*ratio), K, N*r/(1+r),N/(1+r))
  pchisq(qchisq(p_cut_burden, 1, low=F), 1, ncp=chi , low=F)
}

getDenovoPower_parametric <- function(rr, q,f, N, r,  p_cut_denovo){

  MutCases <- N*r/(1+r)
  MutCon <- N/(1+r)
  x1 <- q * 1* (1-f) +  q * rr * f
  x0 <- q * 1
  chi <- (x1-x0)^2/(x1/MutCases+x0/MutCon)
  power <- pchisq(qchisq(p_cut_denovo, 1, low=F), 1, ncp=chi, low=F)
  power
}


Full_Data<-structure(list(item = c("map", "compass", "water", "sandwich",
"glucose", "tin", "banana", "apple", "cheese", "beer", "suntan_cream",
"camera", "T-shirt", "trousers", "umbrella", "waterproof_trousers",
"waterproof_overclothes", "note-case", "sunglasses", "towel",
"socks", "book"), weigth = c(9, 13, 153, 50, 15, 68, 27, 39,
23, 52, 11, 32, 24, 48, 73, 42, 43, 22, 7, 18, 4, 30), value = c(150,
35, 200, 160, 60, 45, 60, 40, 30, 10, 70, 30, 15, 10, 40, 70,
75, 80, 20, 12, 50, 10)), .Names = c("item", "weigth", "value"
), row.names = c(NA, 22L), class = "data.frame")

Bounded_knapsack<-function(Data,W)
{
	K<-matrix(NA,nrow=W+1,ncol=dim(Data)[1]+1)
	0->K[1,]->K[,1]
	matrix_item<-matrix('',nrow=W+1,ncol=dim(Data)[1]+1)
	for(j in 1:dim(Data)[1])
	{
		for(w in 1:W)
		{
			wj<-Data$weigth[j]
			item<-Data$item[j]
			value<-Data$value[j]
			if( wj > w )
			{
				K[w+1,j+1]<-K[w+1,j]
				matrix_item[w+1,j+1]<-matrix_item[w+1,j]
			}
			else
			{
				if( K[w+1,j] >= K[w+1-wj,j]+value )
				{
					K[w+1,j+1]<-K[w+1,j]
					matrix_item[w+1,j+1]<-matrix_item[w+1,j]
				}
				else
				{
					K[w+1,j+1]<-K[w+1-wj,j]+value
					matrix_item[w+1,j+1]<-item
				}
			}
		}
	}
return(list(K=K,Item=matrix_item))
}

backtracking<-function(knapsack, Data)
{
	W<-dim(knapsack$K)[1]
	itens<-c()
	col<-dim(knapsack$K)[2]
	selected_item<-knapsack$Item[W,col]
	while(selected_item!='')
	{
		selected_item<-knapsack$Item[W,col]
		if(selected_item!='')
		{
			selected_item_value<-Data[Data$item == selected_item,]
			if(-knapsack$K[W - selected_item_value$weigth,col-1]+knapsack$K[W,col]==selected_item_value$value)
			{
				W <- W - selected_item_value$weigth
				itens<-c(itens,selected_item)
			}
			col <- col - 1
		}
	}
return(itens)
}

print_output<-function(Data,W)
{
	Bounded_knapsack(Data,W)->Knap
	backtracking(Knap, Data)->Items
	output<-paste('You must carry:', paste(Items, sep = ', '), sep=' ' )
	return(output)
}

print_output(Full_Data, 400)