# Q1
library(plyr)

q1_Hoeffding <- function(...) {
  tot_coins = 1000
  tosses = 10
  # Toss 1000 coins 10 times
  # Could have used a shortcut here but being literal
#   coins <- matrix(rbinom(1000*tosses, 1, .5), nrow=1000,
#                   dimnames=list(paste0("coin", 1:1000),
#                                 paste0("trail", 1:tosses)))

  # Note: laply took a LOT longer than above
  coins <- laply(1:tot_coins, function(x) rbinom(tosses,1,.5))
  rownames(coins) <- paste0("coin", 1:tot_coins)
  colnames(coins) <- paste0("trial", 1:tosses)

  # Cound number of heads
  heads <- apply(coins, 1, sum)

  # pick first coin
#  c1 = coins[1,]

  # pick random coin
  randIdx <- sample(nrow(coins), 1)
#  c_rand = coins[randIdx, ]

  # Pick minimum
  minIdx <- which(heads == min(heads))[1] # First one in case of tie
#  c_min <- coins[minIdx, ]

  cbind(v1 = heads[1]/tosses, vrand = heads[randIdx]/tosses, vmin = heads[minIdx]/tosses)
}

# Run experiment a bunch of times
exp_q1 <- laply(1:100000, q1_Hoeffding)

apply(exp_q1, 2, mean)
# v1    vrand     vmin
# 0.499724 0.499814 0.037491 !!!
# 0.499579 0.499819 0.037702
# 0.499997 0.500360 0.037609

linearRegression <- function(x, y) {
  # Add in bias
  x <- cbind(bias = rep(1, nrow(x)), x)

  # Calculate pseudo inverse
  pseudo = solve(t(x) %*% x) %*% t(x)
  w = pseudo %*% y
  error = sum(y != sign(t(w) %*% t(x)))
  list(w = w, error = error)
}

# Test one
fit <- linearRegression(x, y)

plot(x[,1], x[,2], pch = y+2, col = y+2)
abline(-fit$w[1]/fit$w[3], -fit$w[2]/fit$w[3], lty=4)

# Run many simulations
N <- 100
# N2 <- 1000
# iterations = data.frame()
iterations <- vector()
for (runs in seq(1000)) {
  # Create linearly separable data
  # Choose a line in X^2 {-1, 1}
  f <- matrix(c(runif(2, min = -1, max = 1), -1, 1),
              nrow = 2)
  # Get uniformly distributed points in {-1, 1}
  x <- matrix(runif(2 * N, min=-1, max=1), ncol=2)
  # Figure out which side of our line they are on
  y <- apply(x, 1, function(z) chooseSide(f, z))

#   x_out <- matrix(runif(2 * N2, min=-1, max=1), ncol=2)
#   y_out <- apply(x, 1, function(z) chooseSide(f, z))
#
  # Fit linear model
  fit <- linearRegression(x, y)

  # Feed into PLA
  fit.pla <- PLA(x, y,maxit=10000, w = t(fit$w))

  # Out of sample error
#   x_out1 <- cbind(bias = rep(1, nrow(x_out)), x_out)
#   Eout <- sum(y_out != sign(t(fit$w) %*% t(x_out1)))

#   iterations <- rbind(iterations, cbind(Ein = fit$error/N, Eout = Eout/N2))
  iterations <- c(iterations, fit.pla$iter)
}

summary(iterations)
# Ein               Eout
# Min.   :0.00000   Min.   :0.0000
# 1st Qu.:0.02000   1st Qu.:0.3800
# Median :0.03000   Median :0.4625

# Mean   :0.03703   Mean   :0.4085

# 3rd Qu.:0.05000   3rd Qu.:0.4890
# Max.   :0.16000   Max.   :0.5470

# Min. 1st Qu.  Median    Mean 3rd Qu.    Max.
# 1.000   1.000   1.000   5.612   3.000 475.000
# 1.000   1.000   1.000   5.363   1.000 584.000

N <- 1000
f <- function(x) sign(x[,1] ^2 + x[,2] ^2 - 0.6)
phi <- function(x) cbind(x[,1], x[,2], x[,1] * x[,2], x[,1]^2, x[,2]^2)

iterations <- data.frame()
iterations <- vector()
for(i in seq(1000)) {
  # Generate data
  x <- matrix(runif(2 * N, min=-1, max=1), ncol=2)
  y <- f(x)
  # Add Noise
  sampIdx <- sample(N, .1 * N)
  y[sampIdx] <- -y[sampIdx]

  # Get new data
  x_out <- matrix(runif(2 * N, min=-1, max=1), ncol=2)
  y_out <- f(x)
  # Add Noise
  sampIdx <- sample(N, .1 * N)
  y_out[sampIdx] <- -y_out[sampIdx]

  fit.lin <- linearRegression(x,y)
  fit.transformed <- linearRegression(phi(x), y)

  # Out of sample error
    x_out1 <- cbind(bias = rep(1, nrow(x_out)), phi(x_out))
    Eout <- sum(y_out != sign(t(fit.transformed$w) %*% t(x_out1)))

  iterations <- c(iterations, Eout/N)

#   iterations <- rbind(iterations, t(fit.transformed$w))
#   iterations <- c(iterations, fit.lin$error/N)
}

summary(iterations)
# Min. 1st Qu.  Median    Mean 3rd Qu.    Max.
# 0.3840  0.4690  0.5040  0.5056  0.5440  0.6010

# bias               V2                   V3                   V4                   V5
# Min.   :-1.0996   Min.   :-1.154e-01   Min.   :-1.451e-01   Min.   :-0.2121800   Min.   :1.313
# 1st Qu.:-1.0182   1st Qu.:-2.843e-02   1st Qu.:-3.053e-02   1st Qu.:-0.0512053   1st Qu.:1.511
# Median :-0.9922   Median : 7.166e-05   Median :-3.502e-04   Median : 0.0006909   Median :1.558

# Mean   :-0.9921   Mean   : 5.774e-04   Mean   :-9.418e-05   Mean   : 0.0012421   Mean   :1.558

# 3rd Qu.:-0.9679   3rd Qu.: 2.880e-02   3rd Qu.: 2.883e-02   3rd Qu.: 0.0546515   3rd Qu.:1.608
# Max.   :-0.8448   Max.   : 1.512e-01   Max.   : 1.219e-01   Max.   : 0.2652424   Max.   :1.786
# V6
# Min.   :1.353
# 1st Qu.:1.509
# Median :1.561

# Mean   :1.558

# 3rd Qu.:1.605
# Max.   :1.803

# Min. 1st Qu.  Median    Mean 3rd Qu.    Max.
# 0.4550  0.4900  0.5010  0.5005  0.5100  0.5460

# Wrongs
# 3(d) 4(e)
# 6(e)10(d)


print("loaded spam.r")

demoSimpleSpamClassifiers <- function(debug = TRUE){

	# Load spam data set
	library(kernlab)
	data(spam)

	# Exploring the data to see if the feature 'your' is predictive of spam vs ham
	plot(density(spam$your[spam$type=="nonspam"]),col="blue",main="",xlab="Frequency of 'your'")
	lines(density(spam$your[spam$type=="spam"]),col="red")

	# It looks like a cutoff could be at 0.5
	abline(v=0.5,col="black")

	# Create a column of predicted spam/nonspam based on the above cutoff
	predictionBasedOnOnlyYour <- ifelse(spam$your > 0.5, "spam", "nonspam")

	# View the precision and recall scores
	table(predictionBasedOnOnlyYour,spam$type)/length(spam$type)

	# Set random seed
	set.seed(333)

	# Get a small sample (very small)
	smallSpam <- spam[sample(dim(spam)[1], size=10),]

	# Take a look at the data
	if(debug) {
		head(smallSpam)
		str(smallSpam)
	}

	# Create a color for the scatterplot
	spamLabel <- (smallSpam$type=="spam")*1+1
	plot(smallSpam$capitalAve, col=spamLabel)
	plot(smallSpam$edu, col=spamLabel)

	# Create a very simple 'classifier' which just divides the data
	usingAnOverfittedRuleBasedOnOnlyAverageOfCapitalLetters <- function(x){
		# print(x)
		prediction <- rep(NA, length(x))
		prediction[x > 2.7] <-"spam"
		prediction[x < 2.40] <-"nonspam"
		# example of overfitting the data to this small sample size by carving a small hole that is spam in the nonspam section
		prediction[(x >= 2.40 & x <=2.45)] <- "spam"
		prediction[(x > 2.45 & x <= 2.70)] <- "nonspam"
		prediction <- rep(NA, length(x))
		# print(prediction)
		return(prediction)
	}

	table(usingAnOverfittedRuleBasedOnOnlyAverageOfCapitalLetters(smallSpam$capitalAve), smallSpam$type)

	# Create another random sample
	smallSpam <- spam[sample(dim(spam)[1], size=10),]
	spamLabel <- (smallSpam$type=="spam")*1+1
	plot(smallSpam$capitalAve,col=spamLabel)

	# Change the colors since red looks like it would be spam
	spamLabel <- (smallSpam$type=="spam")*1 +3
	plot(smallSpam$capitalAve,col=spamLabel)

	predicitonBasedOnOverfittedAveOfCapitalLetters <- usingAnOverfittedRuleBasedOnOnlyAverageOfCapitalLetters(smallSpam$capitalAve)
	table(predicitonBasedOnOverfittedAveOfCapitalLetters, smallSpam$type)

	# Create a more general 'classifer' which does not try to overfit the sample
	usingOnlyAverageOfCapitalLetters <- function(x){
		prediction <- rep(NA, length(x))
		prediction[x >2.8] <- "spam"
		prediction[x  <= 2.8] <- "nonspam"
		return(prediction)
	}

	predictionBasedOnAverageOfCapitalLetters <- usingOnlyAverageOfCapitalLetters(smallSpam$capitalAve)
	table(predictionBasedOnAverageOfCapitalLetters, smallSpam$type)

	sum(usingAnOverfittedRuleBasedOnOnlyAverageOfCapitalLetters(spam$capitalAve)==spam$type)
	sum(usingOnlyAverageOfCapitalLetters(spam$capitalAve)==spam$type)

	# Compare the prediction results for the three rules
	#
	# Using only the feature 'your'
	table(predictionBasedOnOnlyYour,spam$type)/length(spam$type)
		# prediction   nonspam      spam
		#    nonspam 0.4590306 0.1017170
		#    spam    0.1469246 0.2923278

	# Using only the overfitted function based on the feature 'Average of capital letters'
	table(usingAnOverfittedRuleBasedOnOnlyAverageOfCapitalLetters(spam$capitalAve),spam$type)/length(spam$type)
		#           nonspam      spam
		# nonspam 0.4653336 0.1277983
		# spam    0.1406216 0.2662465

	# Using only the feature 'Average of capital letters'
	table(usingOnlyAverageOfCapitalLetters(spam$capitalAve),spam$type)/length(spam$type)
		#         nonspam      spam
		# nonspam 0.4833732 0.1395349
		# spam    0.1225820 0.2545099

	# Calculate the quality of the prediction rules
	calculateFScores <- function(confusionMatrix){
		sensitivity <- confusionMatrix[1] / (confusionMatrix[1] + confusionMatrix[2])
		specificity <- confusionMatrix[4] / (confusionMatrix[3] + confusionMatrix[4])
		positivePredictiveValue <- (confusionMatrix[1] + confusionMatrix[2]) / (confusionMatrix[1] + confusionMatrix[3])
		negativePredictiveValue <- (confusionMatrix[3] + confusionMatrix[4]) / (confusionMatrix[2] + confusionMatrix[4])
		accuracy <- confusionMatrix[1] + confusionMatrix[4]

		return( c("sensitivity"=sensitivity, "specificity"=specificity, "positivePredictiveValue"=positivePredictiveValue, "negativePredictiveValue"=negativePredictiveValue, "accuracy"=accuracy))
	}

	calculateFScores(table(usingAnOverfittedRuleBasedOnOnlyAverageOfCapitalLetters(spam$capitalAve),spam$type)/length(spam$type))
		# sensitivity             specificity positivePredictiveValue negativePredictiveValue
		#   0.7679340               0.6756757               1.0216196               0.9684829
		#    accuracy
		#   0.7315801

	calculateFScores(table(usingOnlyAverageOfCapitalLetters(spam$capitalAve),spam$type)/length(spam$type))
		# sensitivity             specificity positivePredictiveValue negativePredictiveValue
		#   0.7977044               0.6458908               0.9727844               1.0449568
		#    accuracy
		#   0.7378831

	# The predictionBasedOnOnlyYour is more accurate but less sensitive so some good emails will lost
	calculateFScores(table(predictionBasedOnOnlyYour,spam$type)/length(spam$type))
		# sensitivity             specificity positivePredictiveValue negativePredictiveValue
		#   0.7575323               0.7418643               1.0806202               0.8970807
		#    accuracy
		#   0.7513584
}


result = 0
b = 1
for i in range(0,n):
    temp = result
    result = b
    b = temp + b


myDataFile <- read.csv('/Users/saugat/Downloads/2008.csv')

table(myDataFile$Origin)
sort(table(myDataFile$Origin))
sort(table(myDataFile$Origin), decreasing=TRUE)

seq(0, 100, by=10)
cut(myDataFile$DepTime, breaks = seq(0, 2400, 100))

plot(table(cut(myDataFile$DepTime, breaks = seq(0, 2400, by = 100))))

sort(tapply(myDataFile$DepDelay, myDataFile$Origin, mean, na.rm = TRUE))

sort(tapply(myDataFile$Distance, myDataFile$Origin, mean), decreasing = TRUE)

tapply(myDataFile$ArrDelay, myDataFile$DayOfWeek, mean, na.rm = TRUE)
tapply(myDataFile$ArrDelay[myDataFile$Dest == 'IND'], myDataFile$DayOfWeek[myDataFile$Dest == 'IND'], mean, na.rm = TRUE)

sort(tapply(myDataFile$DepDelay, myDataFile$UniqueCarrier, mean, na.rm = TRUE), decreasing = TRUE)

dates <- paste(myDataFile$Month, myDataFile$DayofMonth, myDataFile$Year, sep = "/")
sort(tapply(myDataFile$DepDelay, dates, mean, na.rm = TRUE), decreasing = TRUE)

sort(tapply(myDataFile$DepDelay[myDataFile$Origin == 'ORD'], dates[myDataFile$Origin == 'ORD'], mean, na.rm = TRUE), decreasing = TRUE)

atlToLax <- myDataFile$Origin == 'ATL' & myDataFile$Dest == 'LAX'
tail(sort(tapply(myDataFile$DepDelay[atlToLax], dates[atlToLax], mean, na.rm = TRUE)))


library(tidyverse)

d1 = read_csv('data-batch-1.csv') %>%
  filter(
    # remove test runs by MF
    ! submission_id %in% c(43, 65,66),
    trial_name == "main_trials"
  )

d2 = read_csv('data-batch-2.csv') %>%
  filter(
    prolific_id != "testmf",
    trial_name == "main_trials"
  )

d = full_join(
  select(d1, condition, response, stimulus, column_number, bias),
  select(d2, condition, response, stimulus, column_number, bias)
)

counts =  d %>%
  group_by(condition, response) %>%
  tally() %>%
  pivot_wider(
    names_from = condition,
    values_from = n
  )

counts %>% arrange(- high) %>% head()
counts %>% arrange(- low) %>% head()

## semantics of expressions ----

evaluate_quantifier = function(quantifier, bool_vector) {
  case_when(
    quantifier == "all"  ~ sum(bool_vector) == length(bool_vector),
    quantifier == "some" ~ sum(bool_vector) >= 1,
    quantifier == "many" ~ sum(bool_vector) > 0.3 * length(bool_vector),
    quantifier == "most" ~ sum(bool_vector) > 0.5 * length(bool_vector),
    quantifier == "none" ~ sum(bool_vector) == 0,
    quantifier == "few"  ~ sum(bool_vector) <= 0.3 * length(bool_vector)
  )
}

evaluate_predicate = function(resp, stimulus){
  if (resp[3] == "wrong") {
    return(1 - stimulus)
  }
  else {
    return(stimulus)
  }
}

evaluate_truth = function(resp, stimulus) {
  resp = resp %>% str_split("\\|", simplify = F) %>% unlist()
  stimulus = evaluate_predicate(resp, stimulus)
  stimulus = map_dbl(
    1:nrow(stimulus),
    function(i) {
      evaluate_quantifier(resp[2], stimulus[i,])
    }
  )
  evaluate_quantifier(resp[1], stimulus)
}

# calculate the probability that a single quantifier
# statement is true for a given bias and number of observations
calculate_probability_quantifier = function(quantifier, bias, n_observations) {
  case_when(
    quantifier == "all"  ~ dbinom(x= n_observations, size = n_observations, prob = bias) %>% sum,
    quantifier == "some" ~ dbinom(x= 1:n_observations, size = n_observations, prob = bias) %>% sum,
    quantifier == "many" ~ dbinom(x= ceiling(0.3*n_observations):n_observations, size = n_observations, prob = bias) %>% sum,
    quantifier == "most" ~ dbinom(x= ceiling(0.5*n_observations):n_observations, size = n_observations, prob = bias) %>% sum,
    quantifier == "none" ~ dbinom(x= 0, size = n_observations, prob = bias) %>% sum,
    quantifier == "few"  ~ dbinom(x= 0:ceiling(0.3*n_observations), size = n_observations, prob = bias) %>% sum
  )
}

# calculate the probability P(sentence|H) analytically
# for a given bias (=hypothesis)
calculate_probability = function(resp, bias) {
  #unpack sentence
  resp = resp %>% str_split("\\|", simplify = F) %>% unlist()
  # reverse success probability if predicate is "wrong"
  bias = ifelse(resp[3] == "wrong", 1-bias, bias)
  # get probability of inner quantifier being true or a single itm
  inner_prob = calculate_probability_quantifier(resp[2], bias, 12)
  # get probability of outer quantifier statement
  calculate_probability_quantifier(resp[1], inner_prob, 5)
}

calculate_probability("all|all|right", 0.8)
calculate_probability("some|all|right", 0.8)

get_truth_value = function(example_index) {

  resp     = d$response[example_index]
  stimulus = d$stimulus[example_index] %>% str_split("\\|", simplify = F) %>% unlist()

  if (length(stimulus) <= d$column_number[example_index]) {
    return(NA)
  }
  else {
    stimulus = stimulus %>% as.numeric() %>% matrix(byrow = T, ncol = d$column_number[example_index])
    stimulus = 1 - stimulus
  }

  evaluate_truth(resp, stimulus)

}

truth = map_lgl(1:nrow(d), function(i){
  get_truth_value(i)
})

d$truth = truth

# truth = truth[!is.na(truth)]
# (sum(truth) / length(truth)) %>% show()

d %>% group_by(condition, bias) %>%
  summarise(
    mean_true = mean(truth, na.rm = T)
  ) %>% show()

## calculate probabilities with MC

# mc_probability = function(bias, n_samples = 100) {
#   out = expand_grid(
#     outer = c("all", "some", "most", "none", "many", "few"),
#     inner = c("all", "some", "most", "none", "many", "few"),
#     predicate = c("right", "wrong"),
#     bias = bias
#   ) %>%
#     group_by(outer, inner, predicate) %>%
#     mutate(
#       response = paste0(outer, "|", inner, "|", predicate),
#       probability = sum(map_dbl(1:n_samples, function(i){
#         stimulus = sample(0:1, prob = c(1-bias, bias), size = 5*12, replace = T) %>% matrix(ncol=12)
#         evaluate_truth(response, stimulus)
#       })) / n_samples
#   )
#   out
# }

# out_75 = mc_probability(0.75, 10)
# out_25 = mc_probability(0.25, 10)

# calculate argumentative strength for a given bias
get_argument_strength = function(bias) {
  out = expand_grid(
    outer = c("all", "some", "most", "none", "many", "few"),
    inner = c("all", "some", "most", "none", "many", "few"),
    predicate = c("right", "wrong"),
    bias = bias
  ) %>%
    group_by(outer, inner, predicate) %>%
    mutate(
      sentence = paste0(outer, "|", inner, "|", predicate),
      bias = bias,
      probability = calculate_probability(sentence, bias)
    )
  out
}

get_argument_strength(0.8)

arg_strength = rbind(get_argument_strength(0.2), get_argument_strength(0.8)) %>%
  pivot_wider(
    names_from = bias,
    names_prefix = "bias_",
    values_from = probability
  ) %>%
  mutate(
    arg_str = log(bias_0.8) - log(bias_0.2)
  ) %>%
  ungroup() %>%
  select(sentence, arg_str, bias_0.2, bias_0.8) %>%
  rename(response = sentence)

plot_data = counts %>% ungroup() %>%
  pivot_longer(
    -response,
    names_to = "condition",
    values_to = "count"
  ) %>%
  full_join(arg_strength) %>%
  mutate(
    arg_str = ifelse(condition == "high", arg_str, -arg_str)
  )

plot_data %>%
  filter(count > 10 ) %>%
  ggplot(aes(y = count, x = (arg_str), color = condition)) +
  geom_point() +
  geom_smooth(method = "lm")


# https://www.statforbiology.com/2019/stat_nlmm_interaction/

library(devtools)
# install_github("OnofriAndreaPG/aomisc")

library(lattice)
library(nlme)
library(aomisc)

dataset <- read.csv("https://raw.githubusercontent.com/OnofriAndreaPG/agroBioData/master/growthNGEN.csv",
  header=T)
dataset$Block <- factor(dataset$Block)
head(dataset)

table(dataset$Block, dataset$Plot)

# Without blocking, plots, "naive"
modNaive1 <- drm(Yield ~ DAS, fct = L.3(), data = dataset,
            curveid = GEN:N,
            pmodels = c( ~ 1,  ~ N*GEN,  ~ N*GEN))

# With blocking and plots
modnlme1 <- nlme(Yield ~ nlsL.3(DAS, b, d, e), data = dataset,
                    random = d + e ~ 1|Block/Plot,
                    fixed = list(b ~ 1, d ~ N*GEN, e ~ N*GEN),
                    weights = varPower(),
                    start = coef(modNaive1), control = list(msMaxIter = 200))


library(gmp)
large=pow.bigz(5,pow.bigz(4,pow.bigz(3,2)))
largestr=as.character(large)
cat("first 20 digits:",substr(largestr,1,20),"\n",
    "last 20 digits:",substr(largestr,nchar(largestr)-19,nchar(largestr)),"\n",
    "number of digits: ",nchar(largestr),"\n")


# Include libraries.
library(quantmod)

# Configure plots.
par(mfrow=c(2, 1))

# Retrieve Google stock.
stock <- na.omit(get(getSymbols('GOOG')))
stock <- to.monthly(stock)
stock <- as.matrix(stock)

# Open buy in. Close sell out.
cash <- setNames(numeric(nrow(stock)), rownames(stock))
for (m in rownames(stock)) {
    cash[m] <- stock[m, 4] - stock[m, 1]
}
plot(cumsum(cash),
     main='Cash without commission fee',
     type='l')

# Take into account commission fee being 0.1425%.
# Commission fee is rebated by 50%.
# Seller must also pay 0.3% government tax.
for (m in rownames(stock)) {
    cash[m] <- stock[m, 4] * (1 - 0.001425 * 0.5 - 0.003) - stock[m, 1] * (1 + 0.001425 * 0.5)
}
plot(cumsum(cash),
     main='Cash with commission fee',
     type='l')


#' f_bbgd
#'
#' The descent algorithm with Barzilar-borwein 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 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_bbgd <- function(v_y, v_x, v_k0, v_m, init = NULL,
                        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
    #Define dimensions
    k1 <- v_k0[1]; k2 <- v_k0[2]; m1 <- v_m[1]; m2 <- v_m[2]
    #Require
    m_n1 <- f_n1(v_x, k1, m1)
    m_g1 <- f_g1(k2, m2)
    m_g2 <- f_g2(k2, m2)
    m_sigmatau <- f_sigmatau(k2 + m2)
    m_sigma <- f_sigma(k1 + m1, k2 + m2)
    m_s <- f_mats(k1 + m1, k2 + m2, v_smooth)
    n_m2 <- rep(0, k2 + m2); n_m2[k2 + m2] <- 1

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

    #Initialization
    if (is.null(init)) {
        init <- f_init(v_y, v_x, m_sigma, m_n1, v_k0, v_m, m_s)
    }
    til_beta0 <- init
    v_beta0 <- og_beta(til_beta0, k1 + m1, k2 + m2)
    v_grad0 <- 0

    #Calculate H2 (most time consuming)
    v_taustar <- f_tausearch(v_y, m_n1, til_beta0, m_sigma, k2, m2)
    m_ntau <- f_ntau(v_taustar, k2, m2)
    m_h2 <- f_h2(m_n1, m_ntau, m_g1, m_sigmatau)

    ##Loss
    s_loss <- f_loss(v_beta0, til_beta0, v_taustar, v_y, m_sigma, m_h1, m_h2, m_s)

    ##trace
    if (!is.null(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_beta0,
                    iter = iter,
                    loss = s_loss,
                    alpha = 0,
                    bet = 0)
        cq_plot(trace, con_quan)
    }

    #Standard gradient updates
    v_deriv <- f_lossderiv(til_beta0, v_k0 + v_m, m_sigma, m_h1, m_h2)
    v_grad1 <- f_grad(v_beta0, v_deriv, m_s)
    #Calculate new coefficients
    s_step <- 0.25
    v_beta1 <- v_beta0 - s_step * v_grad1
    til_beta1 <- tilde_beta(v_beta1, k1 + m1, k2 + m2)
    new_loss <- f_loss(v_beta1, til_beta1, v_taustar, v_y, m_sigma, m_h1, m_h2, m_s)

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

        #Calculate difference
        v_delta <- v_beta1 - v_beta0
        v_gdiff <- v_grad1 - v_grad0

        #bb stepsize
        s_delgrad <- crossprod(v_delta, v_gdiff)
        step1 <- crossprod(v_delta) / s_delgrad
        step2 <- s_delgrad / crossprod(v_gdiff)
        s_step <- min(step1, step2, 100)
        if (s_step < 0) s_step <- 0.25

        #update v_beta0, til_beta0, v_grad0, s_loss
        v_beta0 <- v_beta1
        til_beta0 <- til_beta1
        v_grad0 <- v_grad1
        s_loss <- new_loss

        #Update H2 (most time consuming)
#ptm <- proc.time()# Start the clock!
        v_taustar <- f_tausearch(v_y, m_n1, til_beta1, m_sigma, k2, m2)
#print(proc.time() - ptm)# Stop the clock
        m_ntau <- f_ntau(v_taustar, k2, m2)
        m_h2 <- f_h2(m_n1, m_ntau, m_g1, m_sigmatau)

        #Calculate gradient
        v_deriv <- f_lossderiv(til_beta1, v_k0 + v_m, m_sigma, m_h1, m_h2)
        v_grad1 <- f_grad(v_beta1, v_deriv, m_s)

        #Update v_beta1, til_beta1, new_loss
        v_beta1 <- v_beta0 - s_step * v_grad1
        til_beta1 <- tilde_beta(v_beta1, k1 + m1, k2 + m2)
        new_loss <- f_loss(v_beta1, til_beta1, v_taustar, v_y, m_sigma, m_h1, m_h2, m_s)

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

        ##trace
        if (!is.null(trace)) {
            con_quan$til_beta <- til_beta1
            con_quan$loss <- new_loss
            con_quan$iter <- iter
            cq_plot(trace, con_quan)
        }

        #If gradient size criteria
        if (converge) break

    }

#-------------------------------------------------------
##### Output #####
#-------------------------------------------------------

    out <- list(
        beta = v_beta1,
        til_beta = til_beta1,
        gradient = v_grad1,
        converge = converge,
        stepsize = s_step,
        grad_size = norm_2(v_grad1),
        iter = iter,
        loss = new_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 = 0,
        bet = 0,
        call = function_call)

    return(out)
}


# From Yong Hao Pua <puayonghao@gmail.com>
require(rms)
n.subjects <- 100    # original number is 30 on the rms documentation
ages <- rnorm(n.subjects, 50, 15)
sexes <- factor(sample(c('female','male'), n.subjects, TRUE))
logit <- (ages - 50) / 5
prob <- plogis(logit) # true prob not related to sex
id <- sample(1:n.subjects, 300, TRUE) # subjects sampled multiple times
length(unique(id))   # note that don't always get n.subjects sampled
length(table(id))
table(table(id)) # frequencies of number of obs/subject
age <- ages[id]
sex <- sexes[id]
# In truth, observations within subject are independent:
y <- ifelse(runif(300) <= prob[id], 1, 0)
f <- lrm(y ~ lsp(age, 50) * sex, x=TRUE, y=TRUE )
g <- robcov(f, id)
g$clusterInfo

# From Jennifer Thompson, modified
afun <- function(...) bootcov(..., B=500)   # or just robcov
set.seed(56)
df <- data.frame(y = rnorm(n = 100),
                 x1 = rnorm(n = 100),
                 x2 = rnorm(mean = 5, sd = 0.5, n = 100))

cat('Error expected in solvet when nsides=2\n')
for(nsites in 7:2) {
  cat('nsites:', nsites, '\n')
  df$site <- sample(LETTERS[1:nsites], size = 100, replace = TRUE)
  f <- ols(y ~ rcs(x1, 3) + rcs(x2, 3), data = df, x = TRUE, y = TRUE)
  g <- afun(f, cluster=df$site)
  print(anova(g))
}


##### Chapter 3: Classification using Nearest Neighbors --------------------
pacman::p_load("class", "gmodels", "tidyverse")
## Example: Classifying Cancer Samples ----
## Step 2: Exploring and preparing the data ----

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

# examine the structure of the wbcd data frame
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)

# 타이디문법으로 재구성
install.packages("modeldata")
pacman::p_load("dplyr", "class", "gmodels", "tidyverse", "ggplot2", "rsample", "recipes", "caret", "modeldata") # 없는 패키지는 자동으로 다운로드받아줌
library(modeldata)

options(scipen = 999)
ggplot2::theme_set(ggplot2::theme_light())

".//Chapter03//wisc_bc_data.csv" %>%
  read.csv(stringsAsFactors = FALSE) %>%
  as.tibble %>%
  mutate_if(is.ordered, factor, ordered = FALSE) -> wbcd

wbcd %>% # 양성과 음성 수 보기
  select(-id) %>%
  glimpse() %>%
  mutate(diagnosis = str_replace_all(diagnosis, "M", "Malignant")) %>%
  mutate(diagnosis = str_replace_all(diagnosis, "B", "Benign")) %>%
  count(diagnosis)

wbcd %>% # 양성과 음성 비율 보기
  select(-id) %>%
  mutate(diagnosis = str_replace_all(diagnosis, "M", "Malignant")) %>%
  mutate(diagnosis = str_replace_all(diagnosis, "B", "Benign")) %>%
  count(diagnosis) %>%
  mutate(prop=format(prop.table(n)*100, digits=3))

library(tidymodels) # 머신러닝용 타이디패키지
wbcd %>% # 훈련데이터, 테스트데이터 생성 (7:3 비율로 나누었다!)
  select(-id) %>%
  mutate(diagnosis = str_replace_all(diagnosis, "M", "Malignant")) %>%
  mutate(diagnosis = str_replace_all(diagnosis, "B", "Benign")) %>%
  ungroup() %>%
  rsample::initial_split(prop = 0.7, strata = diagnosis) -> wbcd_split

wbcd_split %>% # 데이터 어떻게 생겼나?
  training() %>% # 테스트 데이터 보려면 testing()
  glimpse()

wbcd_split %>% training() -> train_df
wbcd_split %>% testing() -> test_df

# 이제부터 직관적인 분석이 시작됩니다.
df_rec <- recipe(diagnosis ~., data = train_df) %>%
  step_downsample(diagnosis) %>% # 훈련데이터 정제작업
  step_center(-diagnosis) %>% # 숫자 데이터를 평균0으로 정규화
  step_scale(-diagnosis) %>% # 숫자 데이터를 표준편차 1로 정규화
  prep()

df_juiced <- juice(df_rec)

df_juiced %>% pivot_longer(-diagnosis) %>%
  ggplot() +
  geom_histogram(aes(value, fill = diagnosis)) +
  facet_wrap(~name)

baked_test <- bake(df_rec, new_data = test_df)

install.packages("kknn")
#make a knn spec
knn_spec <- nearest_neighbor() %>%
  set_engine("kknn") %>%
  set_mode("classification")

#make a rf spec
rf_spec <- rand_forest() %>%
  set_engine("ranger") %>%
  set_mode("classification")

#use the knn spec to fit the pre-processed training data
knn_fit <- knn_spec %>%
  fit(diagnosis ~., data = df_juiced)

#use the rf spec to fit the pre-processed training data
rf_fit <- rf_spec %>%
  fit(diagnosis ~., data = df_juiced)

rf_fit

knn_fit %>%
  predict(baked_test) %>%
  bind_cols(baked_test) %>%
  metrics(truth = diagnosis, estimate = .pred_class)

knn_fit %>%
  predict(df_juiced) %>%
  bind_cols(df_juiced) %>%
  metrics(truth = diagnosis, estimate = .pred_class)

rf_fit %>%
  predict(df_juiced) %>%
  bind_cols(df_juiced) %>%
  metrics(truth = diagnosis, estimate = .pred_class)

results_train <- knn_fit %>%
  predict(df_juiced) %>%
  mutate(model = "knn",
         truth = df_juiced$diagnosis) %>%
  bind_rows(rf_fit %>%
              predict(df_juiced) %>%
              mutate(model = "rf",
                     truth = df_juiced$diagnosis)

  ) %>%
  mutate(accuracy = if_else(.pred_class == truth, "yes", "no"))

results_test <- knn_fit %>%
  predict(baked_test) %>%
  mutate(model = "knn",
         truth = baked_test$diagnosis) %>%
  bind_rows(rf_fit %>%
              predict(baked_test) %>%
              mutate(model = "rf",
                     truth = baked_test$diagnosis)

  ) %>%
  mutate(accuracy = if_else(.pred_class == truth, "yes", "no"))

results_train %>%
  ggplot() +
  geom_bar(aes(accuracy, fill = accuracy)) +
  facet_wrap(~ model)

results_test %>%
  ggplot() +
  geom_bar(aes(accuracy, fill = accuracy)) +
  facet_wrap(~ model)


## Dexter Barrows
## dbarrows.github.io
## McMaster University
## 2016

library(pracma) # needed for tiling function

smap <- function(data, E, theta, stepsAhead) {

    # construct library
    tseries <- as.vector(data)
    liblen  <- length(tseries) - E + 1 - stepsAhead
    lib     <- matrix(NA, liblen, E)

    for (i in 1:E) {
        lib[,i] <- tseries[(E-i+1):(liblen+E-i)]
    }

    # predict from the last index
    tslen <- length(tseries)
    predictee <- rev(t(as.matrix(tseries[(tslen-E+1):tslen])))
    predictions <- numeric(stepsAhead)

    # for each prediction index (number of steps ahead)
    for(i in 1:stepsAhead) {

        # set up weight calculation
        predmat <- repmat(predictee, liblen, 1)
        distances <- sqrt( rowSums( abs(lib - predmat)^2 ) )
        meanDist <- mean(distances)

        # calculate weights
        weights <- exp( - (theta * distances) / meanDist )

        # construct A, B

        preds <- tseries[(E+i):(liblen+E+i-1)]

        A <- cbind( rep(1.0, liblen), lib ) * repmat(as.matrix(weights), 1, E+1)
        B <- as.matrix(preds * weights)

        # solve system for C

        Asvd <- svd(A)
        C <- Asvd$v %*% diag(1/Asvd$d) %*% t(Asvd$u) %*% B

        # get prediction

        predsum <- sum(C * c(1,predictee))

        # save

        predictions[i] <- predsum

    }

    return(predictions)

}


#' @title calcHullEff
#'
#' @description Calculate the hull efficiency (\code{hullEff}) (dimensionless)
#' for a specified vessel.
#'
#' @param thrustFactor Thrust deduction coefficient (vector of numericals, dimensionless)
#' (see \code{\link{calcHMThrustFactor}} and \code{\link{calcKristThrustFactor}})
#' @param wakeFraction Wake fraction coefficient (vector of numericals, dimensionless)
#' (see \code{\link{calcHMWakeFraction}} and \code{\link{calcKristWakeFrac}})
#'
#'@seealso \itemize{
#'\item \code{\link{calcHMThrustFactor}}
#'\item \code{\link{calcKristThrustFactor}}
#'\item \code{\link{calcHMWakeFraction}}
#'\item \code{\link{calcKristWakeFrac}}}
#'
#' @return \code{hullEff} (vector of numericals, dimensionless)
#'
#' @examples
#' calcHullEff(c(0.19,0.17), c(0.32,0.29))
#'
#' @export

calcHullEff <- function(thrustFactor, wakeFraction ){

  hullEff<- (1-thrustFactor)/(1-wakeFraction)

  return(hullEff)
}


# 1. Matrix Factorization using NMF

# Load Data
library(recommenderlab)
data("MovieLense")
dim(MovieLense)

mat <- as(MovieLense, "matrix")
mat[is.na(mat)] <- 0
# Because of Biobase not supported in R 4.0.2
# nmf() is nor working
res <- nmf(mat, 10)
res

r.hat <- fitted(res)
dim(r.hat)
p <- basis(res)
dim(p)
q <- coef(res)
dim(q)

# 2. Matrix Factorization using SVD

# Load Data
simpleMat <- function(n) {
    i <- 1:n;
    1 / outer(i-1, i, "+")
}

original.mat <- simpleMat(9)[, 1:6]
original.mat
s <- svd(original.mat)
D <- diag(s$d)
s$u %*% D %*% t(s$v)


library(dbscan)

#par(bg="#F0F0F0")

data(iris)
iris <- as.matrix(iris[,1:4])

## example data from fpc
set.seed(665544)

n <- 100

x <- cbind(
    x = runif(10, 0, 10) + rnorm(n, sd = 0.2),
    y = runif(10, 0, 10) + rnorm(n, sd = 0.2)
)

plot(x)

#plot(x, col=res$cluster + 1L)

res <- dbscan::dbscan(x, eps = .4, minPts = 2)
points(x, col=res$cluster + 1L)


# I uploaded the  my response to the applied questions (8 to 10) in jupyter notebooks at the following link

# http://nbviewer.jupyter.org/github/ajhalthor/statistical-learning-with-R/tree/master/Chapter%202/notebooks/

# Just click on the question numbers to see my notebooks on the response. I used jupyter becuase you can also see the output for the code dynamically for every statement.

# Note: I just extracted the R code from the notebooks in this file. So there is no sub-numbering (a,b, etc.) This is there in the notebooks.

# Question 8

college = read.csv("Datasets/College.csv")
head(college) #Use fix(college) in R-Studio to display in internal beditor

names(college)

rownames(college)[1:10] #Display the first 10 row names

rownames(college) = college[ , 1]
head(college)

college = college[ , -1] #Exclude first column
head(college)

summary(college)

pairs(college[,1:10])

plot(college$Private, college$Outstate, xlab="Public/Private Indicator", ylab="Out of State Tuition($)", main="Boxplot of Outstate Vs. Private")

Elite = rep("No", length(rownames(college))) #Initialize all entries of Elite to 'No'
Elite[college$Top10perc > 50] = "Yes" #If Top10Perc > 50, assign field as 'Yes'
Elite = as.factor(Elite)
college = data.frame(college, Elite)

head(college)

summary(college$Elite)

plot(college$Elite, college$Outstate, ylab="Out of State Tuition ($)", xlab="Is the University Elite?",main="Elite Vs. Outstate")

par(mfrow=c(2,2))
for (numBins in 1:20){
    hist(college$Outstate, breaks=numBins, xlab="OutState", ylab="Freq", main=paste("Bins = ",numBins))
}

par(mfrow=c(2,2))
for (numBins in 1:20){
    hist(college$Books, breaks=numBins, xlab="Book Cost", ylab="Freq", main=paste("Bins = ",numBins))
}

par(mfrow=c(5,2))
for (numBins in 1:20){
    hist(college$Books, breaks=numBins, xlab="Book Cost", ylab="Freq", main=paste("Bins = ",numBins))
}

# Question 9

Auto = read.csv("Datasets/Auto.csv", header=TRUE, na.strings="?")
head(Auto)

print(paste("Total Number of Sample cars = ", dim(Auto)[1]))
Auto=na.omit(Auto)
print(paste("Number of sample cars after deleting incomplete sample data = ", dim(Auto)[1]))

n_occur = data.frame(table(Auto$name)) # This is a Frequency Distribution Table
n_occur[n_occur$Freq > 1,] #Get only duplicate entries

car_names = Auto[,ncol(Auto)] #Store Car Names for later use
Auto = Auto[,-ncol(Auto)] #Remove the names column
head(Auto)

variable = c("mpg", "displacement", "horsepower", "weight", "acceleration", "year")
minimum = c(min(Auto$mpg), min(Auto$displacement), min(Auto$horsepower), min(Auto$weight), min(Auto$acceleration), min(Auto$year))
maximum = c(max(Auto$mpg), max(Auto$displacement), max(Auto$horsepower), max(Auto$weight), max(Auto$acceleration), max(Auto$year))
tab = data.frame(variable, minimum, maximum)
tab

range(Auto$mpg)
range(Auto$displacement)
range(Auto$horsepower)
range(Auto$weight)
range(Auto$acceleration)
range(Auto$year)

summary(Auto)

mean = c(mean(Auto$mpg), mean(Auto$displacement), mean(Auto$horsepower), mean(Auto$weight), mean(Auto$acceleration), mean(Auto$year))
sd = c(sd(Auto$mpg), sd(Auto$displacement), sd(Auto$horsepower), sd(Auto$weight), sd(Auto$acceleration), sd(Auto$year))
tab = data.frame(variable, mean, sd)
tab

sub_Auto = Auto[-c(10:85),] #Remove 10th to 85th row, keep all columns

minimum = c(min(sub_Auto$mpg), min(sub_Auto$displacement), min(sub_Auto$horsepower), min(sub_Auto$weight), min(sub_Auto$acceleration), min(sub_Auto$year))
maximum = c(max(sub_Auto$mpg), max(sub_Auto$displacement), max(sub_Auto$horsepower), max(sub_Auto$weight), max(sub_Auto$acceleration), max(sub_Auto$year))
mean = c(mean(sub_Auto$mpg), mean(sub_Auto$displacement), mean(sub_Auto$horsepower), mean(sub_Auto$weight), mean(sub_Auto$acceleration), mean(sub_Auto$year))
sd = c(sd(sub_Auto$mpg), sd(sub_Auto$displacement), sd(sub_Auto$horsepower), sd(sub_Auto$weight), sd(sub_Auto$acceleration), sd(sub_Auto$year))
tab = data.frame(variable, minimum, maximum, mean, sd)
tab

pairs(c(Auto['mpg'], Auto['displacement'], Auto['horsepower'], Auto['weight'], Auto['acceleration'], Auto['year']))

# Question 10

library(MASS)
head(Boston)
# ?Boston for information

dim(Boston)

pairs(Boston)

corr_matrix = cor(Boston, method="pearson") # Generate Correlation Matrix
corr_matrix

#heatmap(corr_matrix, col=heat.colors(256))

hist(Boston$crim, breaks=20, xlab="Crime Rate", main="Histogram of Crime Rates")

hist(Boston$tax, breaks=20, xlab="Tax Rate", main="Histogram of Tax Rates")

hist(Boston$ptratio, breaks=20, xlab="Pupil Teacher Ratio", main="Histogram of Pupil Teacher Ratios")

length(Boston$ptratio[20 < Boston$ptratio & Boston$ptratio < 20.5])

length(Boston$chas[Boston$chas == 1])

median(Boston$ptratio)

index = which.min(Boston$medv) #Get index  minimum medv
Boston[index,] #Access this row.

percentile = ecdf(Boston$crim) #ecdf takes a vector and returns function for computing percentile.
print(paste("Crime Rate = ", percentile(Boston[index,'crim'])))#We can now compute the "percentile" of a value

fields = names(Boston)
for (field in 1:length(fields)){
    percentile = ecdf(Boston[[field]])
    print(paste(fields[field], " = ", percentile(Boston[index,'crim'])))
}

length(Boston$rm[Boston$rm > 7])

length(Boston$rm[Boston$rm > 8])

Boston[Boston$rm > 8,]

summary( Boston[Boston$rm > 8,] )

summary(Boston)


library(networkD3)
# force-directed graphs with D3
#
# create fake data
#
src <- c("A","A","A","A", "B","B","C","C","D")
target <- c("B","C","D","J","E","F","G","H","I")
networkData <- data.frame(src, target)
#
# plot
simpleNetwork(networkData)
#
data("MisLinks")
data("MisNodes")
#
forceNetwork(Links=MisLinks, Nodes=MisNodes,
             Source="source", Target="target",
             Value="value", NodeID="name",
             Group="group", opacity=0.8)
#
# Sankey diagrams
#
# load energy projection data
URL <- paste0("https://cdn.rawgit.com/christophergandrud/networkD3/",
              "master/JSONdata/energy.json")
Energy <- jsonlite::fromJSON(URL)
#
# plot
sankeyNetwork(Links=Energy$links, Nodes=Energy$nodes,
              Source="source", Target="target",
              Value="value", NodeID="name",
              units="TWh", fontSize=12, nodeWidth=30)
#
# Radial or 'tree' graphs
#
URL <- paste0("https://cdn.rawgit.com/christophergandrud/networkD3/",
              "master/JSONdata/flare.json")
# convert to list format
Flare <- jsonlite::fromJSON(URL, simplifyDataFrame=FALSE)
#
# use subset of data for more readable diagram
Flare$children = Flare$children[1:3]

radialNetwork(List=Flare, fontSize=10, opacity=0.9)
#
diagonalNetwork(List=Flare, fontSize=10, opacity=0.9)
#
# fun with geography :)
install.packages("ggmap", type="source")
library(ggmap)

qmap(location="hood college", zoom=16, source="google")
qmap(location="harrisburg university PA", zoom=14, source="google")
qmap(location="warwick, RI", zoom=14, source="google")

#
#
mydata = read.csv("~/Downloads/vehicle-accidents.csv")

mydata$State <- as.character(mydata$State)
mydata$MV.Number = as.numeric(mydata$MV.Number)
mydata = mydata[mydata$State != "Alaska",]
mydata = mydata[mydata$State != "Hawaii",]
mydata = mydata[mydata$State != "USA",]
for (i in 1:nrow(mydata)) {
  latlon = geocode(mydata[i,1])
  mydata$lon[i] = as.numeric(latlon[1])
  mydata$lat[i] = as.numeric(latlon[2])
}
mv_num_collisions = data.frame(mydata$MV.Number, mydata$lon, mydata$lat)
colnames(mv_num_collisions) = c('collisions','lon','lat')
circle_scale_amt = 0.1
usa_center = as.numeric(geocode("United States"))
USAMap = ggmap(get_googlemap(center=usa_center, scale=2, zoom=4),extent="normal")
USAMap + geom_point(aes(x=lon,y=lat), data=mv_num_collisions, col="orange",
                    alpha=0.4, size=mv_num_collisions$collisions*circle_scale_amt) +
  scale_size_continuous(range=range(mv_num_collisions$collisions))

# heat maps
#
library(ggplot2)
library(ggmap)

tartu_housing <- read.csv("~/Desktop/R-Work/data/tartu.csv", sep=";")
tartu_map <- get_map(location="tartu", maptype="satellite", zoom=12)
ggmap(tartu_map, extent='device') +
  geom_point(aes(x=lon,y=lat), colour="red", alpha=0.1, size=2, data=tartu_housing)

tartu_map_g_str <- get_map(location="tartu", zoom=13)
ggmap(tartu_map_g_str, extent='device') +
  geom_density2d(data=tartu_housing, aes(x=lon, y=lat),size=0.3) +
  stat_density2d(data=tartu_housing, aes(x=lon, y=lat, fill= ..level.., alpha= ..level..),
                 size=0.01, bins=16, geom="polygon") +
  scale_fill_gradient(low="green",high="red") +
  scale_alpha(range=c(0,0.3), guide=FALSE)

#
#
jg_housing <- read.csv("~/Desktop/R-Work/data/jg_housing.csv", sep=";")
jogeva_map_g_str <- c(lon=26.4, lat=58.7)
jogeva_map_g_str_m <- get_map(jogeva_map_g_str, zoom=9)
ggmap(jogeva_map_g_str_m, extent='device') +
  geom_density2d(data=jg_housing, aes(x=lon, y=lat), size=0.3) +
  stat_density2d(data=jg_housing, aes(x=lon, y=lat, fill = ..level.., alpha = ..level..),
                 size=0.01, bins=16, geom = 'polygon') +
  scale_fill_gradient(low="green", high="red", guide=FALSE) +
  scale_alpha(range = c(0, 0.30), guide=FALSE)

# housing density
#
housing_sett <- read.csv("~/Desktop/R-Work/data/housing_sett.csv", sep=";")
jmap <- get_map(location=jogeva_map_g_str, maptype="hybrid", zoom=9)
ggmap(jmap, extent='device') +
  geom_density2d(data=housing_sett, aes(x=lon,y=lat), size=0.3) +
  stat_density2d(data=housing_sett, aes(x=lon,y=lat, fill=..level.., alpha=..level..),
                 size=0.01, bins=16, geom = 'polygon') +
  scale_fill_gradient(low="green", high="red", guide=FALSE) +
  scale_alpha(range=c(0, 0.30), guide=FALSE)


# 1A
# X... pocet stad na 1km^2
# X - pouzijeme Poissonovu vetu
lambda = 1/25
t = 100
lt = lambda*t # parametr Poissonova rozdeleni

# P(x <= 6)
# V oblasti 100km^2 bude nejvyse 6 stad
ppois(6, lt) # s pravdepodobnosti 88,93 %

# 1B
# P(1<=X<=7) = P(X <= 7) - P(X <= 0)
# V oblasti 100km^2 bude alespon 1 ale nejvyse 7 stad
ppois(7, lt) - ppois(0, lt) # s pravdepodobnosti 93,06 %

# 1C
# V oblasti 100km^2 bude alespon 5 stad, jestlize 2 stada byla nalezena
(1-ppois(4,lt)) / (1-ppois(1,lt)) # 0.4085801

# 1D
lambda = 1/25
t = 50
# P(X >= 1) = P(X > 0) = 1 - P(X <= 0)
# V oblasti 50km^2 bude alespon jedno stado
1 - ppois(0, lambda*t) # s pravdepodobnosti 86,47 %

# 2A
# X... pocet opravenych domacich ukolu za 1h
# X - pouzijeme Poissonovu vetu
lambda = 6 # cetnost vyskytu za hodinu
t = 8 # behem 8mi hodin
lt = lambda*t # parametr Poissonova rozdeleni

# P(x > 50) = 1 - P(X <= 49)
# Opravi vice jak 50 ukolu
1 - ppois(50, lt) # s 35,13% pravdepodobnosti

#Pravd fun
x = 20:80
P_x = dpois(x-1, lt)
plot(x, P_x)
grid()

#Dist fun
x = 20:80
F_x = ppois(x-1, lt)
plot(x, F_x, type='s')
grid()

# 2B
# Opravi 45 az 55 ukolu
ppois(55, lt) - ppois(45-1, lt) # s 54,67% sanci

# 2C
# Opravi 55 ukolu jestlize 40 opravil
(1 - ppois(54, lt)) / (1 - ppois(39, lt)) # s pravdepodobnosti 19,4 %

# 2D
# X ... pocet pokusu nez vybereme spatny ukol
# X ~ NB(k = 3,p = 0.2)
x = 17
k = 3
p = 0.2
# P(X > 15) = 1 - P(X <= 15)
# Narazi na tri spatne ukoly nejdrive za 17 pokusu
1-pnbinom(x - k, k, p) # s pravdepodobnosti 30,96 %

# 3A
# X ... doba do restartu ve dnech
## X ~ Exp(lambda), kde E(X)=1/lambda
lambda = 1/365

x = seq(from = 0, to = 2500, by = 1)
f_x = dexp(x-1, lambda)
plot(x, f_x, cex = 0.1, main="Hustota pravdepodobnosti po dnech")
grid()

F_x = pexp(x-1, lambda)
plot(x, F_x, type='s', main="Distribucni funkce po dnech")
grid()

# 3B
# Restart bude potreba nejdrive za 13 mesicu
1 - pexp(365/12*13, lambda) # s pravdepodobnosti 33,85 %
x = seq(from = 0, to = 2500, by = 1)
f_x = dexp(x-1, lambda)
plot(x, f_x, cex = 0.1, main="Hustota pravdepodobnosti a restart po 13 mesicich")
lines(c(0, 2500),c(dexp(365/12*13, lambda), dexp(365/12*13, lambda)))
lines(c(365/12*13, 365/12*13),c(0, max(f_x)))
grid()

# 3C
# Pravdepodobnost restartu po roce pouzivani v nasledujicich 14 dnech
pexp(365 + 365/52*2, lambda) - pexp(365, lambda) # je 1,38 %.

# 3D
# P(X<t)=0,9 -> F(t)=0,9 -> t… 90% kvantil
# Server bude treba restartovat s 90 % pravdepodobnosti
qexp(0.9, lambda) # po 840,4 dnech.

# 4A
# Systolicky krevni tlak, normalni rozdeleni se stredni hodnotou 112 a smerodatnou odchylkou 10
mu = 112
sigma = 10

# vykreslime si Hustotu pravdepodobnosti
x = seq(from = 70, to = 150, by = 0.1)
f_x = dnorm(x, mean=mu, sd=sigma)
plot(x, f_x, cex = 0.01, main="Hustota pravdepodobnosti")
grid()

# vykreslime si Distribucni funkci
F_x = pnorm(x, mean=mu, sd=sigma)
plot(x, F_x, type = 'l', main="Distribucni funkce")
grid()

# 4B
# Tlak mimo rozmezi 90 az 120g
1- (pnorm(120, mean=mu, sd=sigma) - pnorm(90, mean=mu, sd=sigma)) # s pravdepodobnosti 22,58 %

# Zaznaceni do grafu
# x = c(seq(from = 50, to = 90, by = 0.1),seq(from = 120, to = 180, by = 0.1))
# Vysrafovana oblast je pod krivkou v levo od hodnoty 90 a v pravo od hodnoty x=120 a y<0
x = seq(from = 70, to = 150, by = 0.1)
f_x = dnorm(x, mean=mu, sd=sigma)
plot(x, f_x, cex = 0.01, main="Hustota pravdepodobnosti")
lines(c(90,90),c(0,max(f_x)))
lines(c(120,120),c(0,max(f_x)))
grid()

# 4C
# Tlak nizsi nez 105mmHg
pnorm(105, mean=mu, sd=sigma) # s pravdepodobnosti 24,2 %
F_x = pnorm(x, mean=mu, sd=sigma)
plot(x, F_x, type = 'l', main="Distribucni funkce s tlakem")
lines(c(105,105),c(0,max(F_x)))
lines(c(70,150),c(pnorm(105, mean=mu, sd=sigma),pnorm(105, mean=mu, sd=sigma)))
grid()

# 4D
# 82. percentil
qnorm(0.82, mean=mu, sd=sigma) # je 121.15 mmHg
# Vysvetleni percentilu: 82% lidi ma hodnotu systolickeho krevniho tlaku do hranice 121.15 mmHg


#############################################################################
# Chapter 3 cross-sectional figures
#############################################################################
data("pwt10.0") # extract PWT data
p <- pwt10.0 # save into dataframe

# Create variables of interest
p$rgdpo_pop <- p$rgdpo/p$pop # GDP per worker

p <- p %>% group_by(isocode) %>% mutate(mean_csh_i = mean(csh_i,na.rm = TRUE)) # avg cap formation share
p <- p[p$mean_csh_i>0 & p$mean_csh_i<.5,] # eliminate outliers

p <- p %>% group_by(isocode) %>% # 30-year population growth rate
        mutate(gpop = (log(pop) - log(lag(pop, n = 30)))/30)
p <- p[p$gpop<.04,] # eliminate outliers

p <- p[p$rgdpo_pop<100000 & p$rgdpo_pop>500,] # eliminate outliers

p <- p[p$year==2019,] # narrow to only 2019 for graphing and uploading

p <- p %>% drop_na(year) # slims down the dataset for posting

## Plot GDP per capita against capital formation share
f <- ggplot(p, aes(x = mean_csh_i, y = rgdpo_pop, label = isocode)) +
    geom_text(size=3) +
    labs(x = "Avg. capital formation share of GDP, 1989-2019", y = "GDP per capita, 2019") +
    scale_y_continuous(breaks=c(0,1000,2000,4000,8000,16000,32000,64000),trans = scales::log_trans()) +
    scale_x_continuous(breaks=c(0,0.05,0.1,0.15,0.2,0.25,0.3,.35,.4,.45,.5),limits=c(0,0.5)) +
    theme_bw()
ggsave("Ch3_xsection_csh_i.eps",path=drafts) # save static version for book
up <- ggplotly(f) # convert to plotly
api_create(up, filename = "Ch3-xsection-cshi") # upload to plotly

## Plot GDP per capita against population growth rate
f <- ggplot(p, aes(x = gpop, y = rgdpo_pop, label = isocode)) +
  geom_text(size=3) +
  labs(x = "Avg. growth rate of population, 1989-2019", y = "GDP per capita, 2019") +
  scale_y_continuous(label=comma,breaks=c(0,1000,2000,4000,8000,16000,32000,64000),trans = scales::log_trans()) +
  scale_x_continuous(breaks=c(-0.01,0,0.01,0.02,0.03,0.04),limits=c(-0.01,0.04)) +
  theme_bw()
ggsave("Ch3_xsection_gpop.eps",path=drafts) # save static version for book
up <- ggplotly(f) # convert to plotly
api_create(up, filename = "Ch3-xsection-gpop") # upload to plotly


library(tidyr)
library(ggplot2)
library(dplyr)
library(cowplot)

# read in simulation output
t <- read.csv("../processed_results/evolved_q_trajectories.csv")

t %>% filter(time >= 2000000) %>%
  group_by(q_prob, q_start, rep) %>%
  summarise(mean_sim_fitness = mean(mean_fitness), mean_sim_q = mean(epistasis_coef)) %>%
  mutate(q_change = mean_sim_q - q_start, percent_change = q_change/q_start*100) -> t_sum

t_sum %>% filter(q_change == 0) %>%
  mutate(percent_change = 0) -> t_temp

t_sum %>% filter(q_change != 0) %>%
  bind_rows(t_temp) -> t_final

#######################################################
# Plotting starting q against change in q             #
#######################################################
# make separate figures for different probabilities of q changing
# probability q changing for each time step (p) = 0.001
p1 <- t_final %>% filter(q_prob == 0.001) %>%
  ggplot(aes(x = q_start, y = q_change)) +
  stat_summary(fun.y = mean,
               fun.ymin = function(x) mean(x) - sd(x)/sqrt(length(x)),
               fun.ymax = function(x) mean(x) + sd(x)/sqrt(length(x)),
               geom = "pointrange",
               size=0.1) +
  scale_y_continuous(name = "change in q",
                     limits = c(-2, 2),
                     breaks = seq(-2, 2, 0.5)) +
  scale_x_continuous(name = "starting q",
                     breaks = seq(0, 2, 0.2)) +
  draw_text(x = 0, y = 2.0, hjust = 0, vjust = 0, text = "p = 0.001", size = 12, fontface = 'bold')

# probability q changing for each time step (p) = 0.01
p2 <- t_final %>% filter(q_prob == 0.01) %>%
  ggplot(aes(x = q_start, y = q_change)) +
  stat_summary(fun.y = mean,
               fun.ymin = function(x) mean(x) - sd(x)/sqrt(length(x)),
               fun.ymax = function(x) mean(x) + sd(x)/sqrt(length(x)),
               geom = "pointrange",
               size=0.1)+
  scale_y_continuous(name = "change in q",
                     limits = c(-2, 2),
                     breaks = seq(-2, 2, 0.5)) +
  scale_x_continuous(name = "starting q",
                     breaks = seq(0, 2, 0.2)) +
  draw_text(x = 0, y = 2.0, hjust = 0, vjust = 0, text = "p = 0.01", size = 12, fontface = 'bold')

# probability q changing for each time step (p) = 0.1
p3 <- t_final %>% filter(q_prob == 0.1) %>%
  ggplot(aes(x = q_start, y = q_change)) +
  stat_summary(fun.y = mean,
               fun.ymin = function(x) mean(x) - sd(x)/sqrt(length(x)),
               fun.ymax = function(x) mean(x) + sd(x)/sqrt(length(x)),
               geom = "pointrange",
               size=0.1) +
  scale_y_continuous(name = "change in q",
                     limits = c(-2, 2),
                     breaks = seq(-2, 2, 0.5)) +
  scale_x_continuous(name = "starting q",
                     breaks = seq(0, 2, 0.2)) +
  draw_text(x = 0, y = 2.0, hjust = 0, vjust = 0, text = "p = 0.1", size = 12, fontface = 'bold')

# arrange subfigures
p <- plot_grid(p1,
               p2 + theme(axis.title.y = element_blank()),
               p3 + theme(axis.title.y = element_blank()),
               align = 'vh',
               hjust = -1,
               ncol=3,
               nrow=1)

save_plot("../plots/q_start_v_q_change.png", p,
          ncol = 3, # we're saving a grid plot of 3 columns
          nrow = 1, # and 1 rows
          # each individual subplot should have an aspect ratio of 1.3
          base_height=4,
          base_width=4)

#######################################################
# Plotting starting q against percent change in q     #
#######################################################
# make separate figures for different probabilities of q changing
# probability q changing for each time step (p) = 0.001
p1 <- t_final %>% filter(q_prob == 0.001) %>%
  ggplot(aes(x = q_start, y = percent_change)) +
  stat_summary(fun.y = mean,
               fun.ymin = function(x) mean(x) - sd(x)/sqrt(length(x)),
               fun.ymax = function(x) mean(x) + sd(x)/sqrt(length(x)),
               geom = "pointrange",
               size=0.1) +
  scale_y_continuous(name = "% change in q",
                     limits = c(-100, 100),
                     breaks = seq(-100, 100, 50)) +
  scale_x_continuous(name = "starting q",
                     breaks = seq(0, 2, 0.2)) +
  draw_text(x = 0, y = 100, hjust = 0, vjust = 0, text = "p = 0.001", size = 12, fontface = 'bold')

# probability q changing for each time step (p) = 0.01
p2 <- t_final %>% filter(q_prob == 0.01) %>%
  ggplot(aes(x = q_start, y = percent_change)) +
  stat_summary(fun.y = mean,
               fun.ymin = function(x) mean(x) - sd(x)/sqrt(length(x)),
               fun.ymax = function(x) mean(x) + sd(x)/sqrt(length(x)),
               geom = "pointrange",
               size=0.1)+
  scale_y_continuous(name = "% change in q",
                     limits = c(-100, 100),
                     breaks = seq(-100, 100, 50)) +
  scale_x_continuous(name = "starting q",
                     breaks = seq(0, 2, 0.2)) +
  draw_text(x = 0, y = 100, hjust = 0, vjust = 0, text = "p = 0.01", size = 12, fontface = 'bold')

# probability q changing for each time step (p) = 0.1
p3 <- t_final %>% filter(q_prob == 0.1) %>%
  ggplot(aes(x = q_start, y = percent_change)) +
  stat_summary(fun.y = mean,
               fun.ymin = function(x) mean(x) - sd(x)/sqrt(length(x)),
               fun.ymax = function(x) mean(x) + sd(x)/sqrt(length(x)),
               geom = "pointrange",
               size=0.1) +
  scale_y_continuous(name = "% change in q",
                     limits = c(-100, 100),
                     breaks = seq(-100, 100, 50)) +
  scale_x_continuous(name = "starting q",
                     breaks = seq(0, 2, 0.2)) +
  draw_text(x = 0, y = 100, hjust = 0, vjust = 0, text = "p = 0.1", size = 12, fontface = 'bold')

# arrange subfigures
p <- plot_grid(p1,
               p2 + theme(axis.title.y = element_blank()),
               p3 + theme(axis.title.y = element_blank()),
               align = 'vh',
               hjust = -1,
               ncol=3,
               nrow=1)

save_plot("../plots/q_start_v_percent_change.png", p,
          ncol = 3, # we're saving a grid plot of 3 columns
          nrow = 1, # and 1 rows
          # each individual subplot should have an aspect ratio of 1.3
          base_height=4,
          base_width=4)

#######################################################
# Plotting evolved q against q start                  #
#######################################################
# make separate figures for different probabilities of q changing
# probability q changing for each time step (p) = 0
p0 <- t_final %>% filter(q_prob == 0) %>%
  ggplot(aes(x = q_start, y = mean_sim_q)) +
  stat_summary(fun.y = mean,
               fun.ymin = function(x) mean(x) - sd(x)/sqrt(length(x)),
               fun.ymax = function(x) mean(x) + sd(x)/sqrt(length(x)),
               geom = "pointrange",
               size = 0.4) +
  scale_y_continuous(name = "evolved q",
                     limits = c(0, 2.1),
                     breaks = seq(0, 2, 0.5)) +
  scale_x_continuous(name = "starting q",
                     limits = c(0, 2.1),
                     breaks = seq(0, 2, 0.5)) +
  draw_text(x = 0, y = 2.0, hjust = 0, vjust = 0, text = "p = 0", size = 12, fontface = 'bold') +
  background_grid(major = "xy", minor = "none")

# probability q changing for each time step (p) = 0.001
p1 <- t_final %>% filter(q_prob == 0.001) %>%
  ggplot(aes(x = q_start, y = mean_sim_q)) +
  stat_summary(fun.y = mean,
               fun.ymin = function(x) mean(x) - sd(x)/sqrt(length(x)),
               fun.ymax = function(x) mean(x) + sd(x)/sqrt(length(x)),
               geom = "pointrange",
               size = 0.4) +
  scale_y_continuous(name = "evolved q",
                     limits = c(0, 2.1),
                     breaks = seq(0, 2, 0.5)) +
  scale_x_continuous(name = "starting q",
                     limits = c(0, 2.1),
                     breaks = seq(0, 2, 0.5)) +
  draw_text(x = 0, y = 2.0, hjust = 0, vjust = 0, text = "p = 0.001", size = 12, fontface = 'bold') +
  background_grid(major = "xy", minor = "none")

# probability q changing for each time step (p) = 0.01
p2 <- t_final %>% filter(q_prob == 0.01) %>%
  ggplot(aes(x = q_start, y = mean_sim_q)) +
  stat_summary(fun.y = mean,
               fun.ymin = function(x) mean(x) - sd(x)/sqrt(length(x)),
               fun.ymax = function(x) mean(x) + sd(x)/sqrt(length(x)),
               geom = "pointrange",
               size = 0.4) +
  scale_y_continuous(name = "evolved q",
                     limits = c(0, 2.1),
                     breaks = seq(0, 2, 0.5)) +
  scale_x_continuous(name = "starting q",
                     limits = c(0, 2.1),
                     breaks = seq(0, 2, 0.5)) +
  draw_text(x = 0, y = 2.0, hjust = 0, vjust = 0, text = "p = 0.01", size = 12, fontface = 'bold') +
  background_grid(major = "xy", minor = "none")

# probability q changing for each time step (p) = 0.1
p3 <- t_final %>% filter(q_prob == 0.1) %>%
  ggplot(aes(x = q_start, y = mean_sim_q)) +
  stat_summary(fun.y = mean,
               fun.ymin = function(x) mean(x) - sd(x)/sqrt(length(x)),
               fun.ymax = function(x) mean(x) + sd(x)/sqrt(length(x)),
               geom = "pointrange",
               size = 0.4) +
  scale_y_continuous(name = "evolved q",
                     limits = c(0, 2.1),
                     breaks = seq(0, 2, 0.5)) +
  scale_x_continuous(name = "starting q",
                     limits = c(0, 2.1),
                     breaks = seq(0, 2, 0.5)) +
  draw_text(x = 0, y = 2.0, hjust = 0, vjust = 0, text = "p = 0.1", size = 12, fontface = 'bold') +
  background_grid(major = "xy", minor = "none")

# arrange subfigures
p <- plot_grid(p0,
               p1 + theme(axis.title.y = element_blank()),
               p2,
               p3 + theme(axis.title.y = element_blank()),
               align = 'vh',
               hjust = -1,
               ncol=2,
               nrow=2)

save_plot("../plots/q_start_v_mean_sim_q.png", p,
          ncol = 2, # we're saving a grid plot of 3 columns
          nrow = 2, # and 1 rows
          # each individual subplot should have an aspect ratio of 1.3
          base_height = 4,
          base_width = 4.2)

#######################################################
# Plotting mean fitness against q start               #
#######################################################
# make separate figures for different probabilities of q changing
# probability q changing for each time step (p) = 0
p0 <- t_final %>% filter(q_prob == 0) %>%
  ggplot(aes(x = q_start, y = mean_sim_fitness)) +
  stat_summary(fun.y = mean,
               fun.ymin = function(x) mean(x) - sd(x)/sqrt(length(x)),
               fun.ymax = function(x) mean(x) + sd(x)/sqrt(length(x)),
               geom = "pointrange",
               size = 0.4) +
  scale_y_continuous(name = "fitness",
                     limits = c(0, 1.1),
                     breaks = seq(0, 1, 0.2)) +
  scale_x_continuous(name = "starting q",
                     limits = c(0, 2.1),
                     breaks = seq(0, 2, 0.5)) +
  draw_text(x = 0, y = 1.1, hjust = 0, vjust = 0, text = "p = 0", size = 12, fontface = 'bold') +
  background_grid(major = "xy", minor = "none")

# probability q changing for each time step (p) = 0.001
p1 <- t_final %>% filter(q_prob == 0.001) %>%
  ggplot(aes(x = q_start, y = mean_sim_fitness)) +
  stat_summary(fun.y = mean,
               fun.ymin = function(x) mean(x) - sd(x)/sqrt(length(x)),
               fun.ymax = function(x) mean(x) + sd(x)/sqrt(length(x)),
               geom = "pointrange",
               size = 0.4) +
  scale_y_continuous(name = "fitness",
                     limits = c(0, 1.1),
                     breaks = seq(0, 1, 0.2)) +
  scale_x_continuous(name = "starting q",
                     limits = c(0, 2.1),
                     breaks = seq(0, 2, 0.5)) +
  draw_text(x = 0, y = 1.1, hjust = 0, vjust = 0, text = "p = 0.001", size = 12, fontface = 'bold') +
  background_grid(major = "xy", minor = "none")

# probability q changing for each time step (p) = 0.01
p2 <- t_final %>% filter(q_prob == 0.01) %>%
  ggplot(aes(x = q_start, y = mean_sim_fitness)) +
  stat_summary(fun.y = mean,
               fun.ymin = function(x) mean(x) - sd(x)/sqrt(length(x)),
               fun.ymax = function(x) mean(x) + sd(x)/sqrt(length(x)),
               geom = "pointrange",
               size = 0.4) +
  scale_y_continuous(name = "fitness",
                     limits = c(0, 1.1),
                     breaks = seq(0, 1, 0.2)) +
  scale_x_continuous(name = "starting q",
                     limits = c(0, 2.1),
                     breaks = seq(0, 2, 0.5)) +
  draw_text(x = 0, y = 1.1, hjust = 0, vjust = 0, text = "p = 0.01", size = 12, fontface = 'bold') +
  background_grid(major = "xy", minor = "none")

# probability q changing for each time step (p) = 0.1
p3 <- t_final %>% filter(q_prob == 0.1) %>%
  ggplot(aes(x = q_start, y = mean_sim_fitness)) +
  stat_summary(fun.y = mean,
               fun.ymin = function(x) mean(x) - sd(x)/sqrt(length(x)),
               fun.ymax = function(x) mean(x) + sd(x)/sqrt(length(x)),
               geom = "pointrange",
               size = 0.4) +
  scale_y_continuous(name = "fitness",
                     limits = c(0, 1.1),
                     breaks = seq(0, 1, 0.2)) +
  scale_x_continuous(name = "starting q",
                     limits = c(0, 2.1),
                     breaks = seq(0, 2, 0.5)) +
  draw_text(x = 0, y = 1.1, hjust = 0, vjust = 0, text = "p = 0.1", size = 12, fontface = 'bold') +
  background_grid(major = "xy", minor = "none")

# arrange subfigures
p <- plot_grid(p0,
               p1 + theme(axis.title.y = element_blank()),
               p2,
               p3 + theme(axis.title.y = element_blank()),
               align = 'vh',
               hjust = -1,
               ncol=2,
               nrow=2)

save_plot("../plots/q_start_v_mean_sim_fitness.png", p,
          ncol = 2, # we're saving a grid plot of 3 columns
          nrow = 2, # and 1 rows
          # each individual subplot should have an aspect ratio of 1.3
          base_height=4,
          base_width=4.2)


library(tidyr)
library(ggplot2)
library(dplyr)
library(cowplot)
library(readr)

predict_mean_fitness <- function(Ne, L, s, eps)
{
  k <- c(0:L)
  f <- exp(-s*k^(1-eps))
  p_k <- (f^(2*Ne-2)*choose(L, k))/sum(f^(2*Ne-2)*choose(L, k))
  sum(f*p_k)
}

#file_lst <- list.files("sim_results",pattern="n100.txt",full.names=T)
t <- read_csv("../processed_results/all.csv")

t %>% group_by(sel_coef,epistasis_coef,mu_prob) %>%
  mutate(an_mean_fitness=predict_mean_fitness(100,100,sel_coef,epistasis_coef),q=1-epistasis_coef)-> t_sum

for (s in c(0.1, 0.01, 0.001, 0.0001)){
  t_sum %>% filter(sel_coef==s) -> f

  p <- ggplot(f, aes(x=mu_prob*100, y=mean_fitness,color=factor(q)))+
    stat_summary(fun.y = mean,
                 fun.ymin = function(x) mean(x) - sd(x)/sqrt(length(x)),
                 fun.ymax = function(x) mean(x) + sd(x)/sqrt(length(x)),
                 geom = "pointrange",
                 size=0.4)+
    geom_line(aes(y = an_mean_fitness,group=factor(epistasis_coef),color=factor(q)))+
    xlab('Ne*mu')+
    ylab('Mean fitness')+
    scale_x_log10()+
    #scale_y_continuous(breaks=seq(0.99,1,0.005))+
    guides(col = guide_legend(title="Q",reverse = TRUE))+
    theme(axis.title = element_text(size = 14),
          axis.text = element_text(size = 12),
          legend.text = element_text(size = 11),
          legend.title = element_text(size = 12))

  save_plot(paste0("../plots/mean_fit_v_time_s",s,".pdf"), p)
}


#' Calculates mean and standard error of frequency data
#'
#' Helper function for Francis ESS calculations.
#' @param bins the values in the class marks (ages in this case)
#' @param N the total number (ESS in this case)
#' @param frdist the frequency distribution (should sum to one over the bins)
#' @return vector of mean and standard error
#' @export

CalcFreqMeanSE <- function(bins,N,frdist){
  Y <- bins
  f <- N*frdist
  n <- sum(f)
  sumfY <- sum(f*Y)
  Ybar <- sumfY/n
  sumfY2 <- sum(f*Y*Y)
  CT <- sumfY^2/n
  sumfy2 <- sumfY2-CT
  s2 <- sumfy2/(n-1)
  sigma <- sqrt(s2)
  stderror <- sigma/sqrt(n)  # note this is standard deviation of the mean
  meanstderror <- c(Ybar,stderror)
  return(meanstderror)
}


#This calculates the f-measure
library(foreach)
library(doParallel)
fscore <- function(tp, tn, fp, fn) {
  if(tp + fn == 0) {
    re <- 0
  } else {
    re <- (tp / (tp + fn))
  }
  if(tp + fp == 0) {
    pr <- 0
  } else {
    pr <- (tp / (tp + fp))
  }

  if(tn + fp == 0){
    spec <- 0
  } else {
    spec <- (tn / (tn + fp))
  }

  if(pr + re == 0)
  {
    f <- 0
    res <- data.frame(f, pr, re, spec)
    return(res)
  } else {
    f <- (2 * (pr * re) / (pr + re) )
    res <- data.frame(f, pr, re, spec)
    return( res )
  }
}

ratesOfPredict <- function(predicted, gt) {
  tp <- 0
  fp <- 0
  tn <- 0
  fn <- 0

  tp <- length(which((predicted == gt) & (predicted == 1)))
  tn <- length(which((predicted == gt) & (predicted == 0)))
  fp <- length(which((predicted != gt) & (predicted == 1)))
  fn <- length(which((predicted != gt) & (predicted == 0)))

  return(data.frame(tp, tn, fp, fn))
}

allROC_par <- function(response, gt) {

  registerDoParallel(cores=8)

  min.val <- min(response)
  max.val <- max(response)
  vals <- seq(min.val, max.val, (max.val - min.val)/100)
  max.f <- 0
  best.res <- NA
  best.val <- min.val
  all.vals <- foreach(i=1:length(vals), .combine=rbind) %dopar% {
    v <- vals[i]
    pred <- rep(0, length(response))
    pred[which(response >= v)] <- 1
    #values <- ratesOfPredict(pred, gt)
    tp <- 0
    fp <- 0
    tn <- 0
    fn <- 0

    tp <- length(which((pred == gt) & (pred == 1)))
    tn <- length(which((pred == gt) & (pred == 0)))
    fp <- length(which((pred != gt) & (pred == 1)))
    fn <- length(which((pred != gt) & (pred == 0)))

    if(tp + fn == 0) {
      re <- 0
    } else {
      re <- (tp / (tp + fn))
    }
    if(tp + fp == 0) {
      pr <- 0
    } else {
      pr <- (tp / (tp + fp))
    }

    if(tn + fp == 0){
      spec <- 0
    } else {
      spec <- (tn / (tn + fp))
    }

    if(pr + re == 0)
    {
      f.score <- 0
      #res <- data.frame(f, pr, re, spec)
      #return(res)
    } else {
      f.score <- (2 * (pr * re) / (pr + re) )
      #res <- data.frame(f, pr, re, spec)
      #return( res )
    }

    #results <- fscore(values$tp, values$tn, values$fp, values$fn)
    data.frame(min.val, max.val, v, tp, tn, fp, fn, pr, re, spec, f.score)
  }

  best.res <- all.vals[which(all.vals$f.score == max(all.vals$f.score)),]

  res.final <- list()
  res.final[[1]] <- best.res
  res.final[[2]] <- all.vals
  return(res.final)
}

generateLabels <- function(response, thresh) {

}


=begin
  # sample-algebraicfield02.rb

  require "algebra"

  F = AlgebraicExtensionField(Rational, "x") {|x| x**2 + x + 1}
  x = F.var
  p( (x + 1)**100 )
  p( (x-1)** 3 / (x**2 - 1) )

  H = AlgebraicExtensionField(F, "y") {|y| y**5 + x*y + 1}
  y = H.var
  p( 1/(x + y + 1)**7 )
((<_|CONTENTS>))
=end


outliers_fnc <- function(x, conf.level = 0.95)
{
  x <- x[!is.na(x)]
  del.val <- NULL

  while (TRUE) {
    n <- length(x)
    if (n < 3) {
      break
    }

    r <- range(x)
    t <- abs(r - mean(x)) / sd(x)
    q <- sqrt((n - 2) / ((n - 1) ^ 2 / t ^ 2 / n - 1))
    p <- n * pt(q, n - 2, lower.tail = FALSE)

    if (t[1] < t[2]) {
      if (p[2] < 1 - conf.level) {
        del.val <- c(del.val, r[2])
        x <- x[x != r[2]]
        next
      }
    } else {
      if (p[1] < 1 - conf.level) {
        del.val <- c(del.val, r[1])
        x <- x[x != r[1]]
        next
      }
    }
    break
  }
  return(list(x = x, del.val = del.val))
}


#####################################################
#
# Usage: R --vanilla --slave < linear_reqgression.r
# 	http://d.hatena.ne.jp/n_shuyo/20090709/predictive
#
#####################################################

M <- 9		# number of basis function
alpha <- 2	# hyper parameter α
beta <- 25	# hyper parameter β
Lattice <- 30	# number of graph's lattice
s<-0.1
u_i<-0.5

# training data
xlist <- seq(0, 1, length=25)
tlist <- sin(2*pi*xlist) + rnorm(length(xlist), sd=0.2)
D0 <- data.frame(x=xlist, t=tlist)

predictive <- function(D) {
    # design matrix
    gauss_base_func <- function(x)exp(-(x-u_i)^2/(2*s*s))
    phi <- function(x) sapply(x,function(x){exp(-(x-seq(0,1,length=9))^2/(2*s*s))})
    PHI <- t(phi(D$x))

    # convariance matrix & means
    S_N_inv <- alpha * diag(9) + beta * t(PHI) %*% PHI
    S_N <- solve(S_N_inv)
    m_N <- beta * S_N %*% t(PHI) %*% D$t

    # regression function
    y <- function(x)(t(phi(x)) %*% m_N)
    plot(y, xlim=c(0,1), ylim=c(-1.2, 1.2))
    par(new=T)
    plot(D, xlim=c(0,1), ylim=c(-1.2, 1.2), ylab="")

    # predictive distribution
    var_N <- function(x) {1/beta + (t(phi(x)) %*% S_N %*% phi(x))[1]}
    function(x,t) {
        mapply(function(x,t)dnorm(t,m=(t(m_N) %*% phi(x))[1], s=var_N(x), log=T), x, t)
    }
}
draw_dist <- function(p){
    x <- seq(0, 1, length=Lattice)
    t <- seq(-1.5, 1.5, length=Lattice*2)
    z <- outer(x, t, p)
    persp(x, t, z, theta=0, phi=60, shade=0.4)
}

p <- predictive(D0[sample(length(D0$x))[1:1],])
draw_dist(p);
p <- predictive(D0[sample(length(D0$x))[1:2],])
draw_dist(p);
p <- predictive(D0[sample(length(D0$x))[1:4],])
draw_dist(p);
p <- predictive(D0)
draw_dist(p);

# pdf("PRML_graph.pdf")
# dev.off()


source("../power_priors_aux.r")
source("../data_Gaussian.r")

gs.data <- list(
  N0 = N_0,
  y0 = y_0,
  mu0 = mu_0,
  kappa0 = kappa_0,
  alpha0 = alpha_0,
  beta0 = beta_0,
  a_0 = 1
)

###
get_l_a0_gaussian <- function(y0, n0, alpha0, beta0, m0, k0, a_0){
  nstar <- a_0 * n0
  ybar <- mean(y0)
  s <- mean( (y0-ybar)^2 )
  kappa_n <- k0 + nstar
  alpha_n <- alpha0 + nstar/2
  beta_n <- beta0 + .5 * (nstar * s +  (k0 * nstar * (ybar - m0)^2 )/kappa_n )
  ans <- lgamma(alpha_n)-lgamma(alpha0)
  ans <- ans + alpha0 * log(beta0) - alpha_n * log(beta_n)
  ans <- ans + .5 *( log(k0) - log(kappa_n) )-nstar/2 * log(2*pi)
  return(ans)
}

############
l_a0 <- function(x) {
  get_l_a0_gaussian(
    y0 = gs.data$y0,
    n0 = gs.data$N0,
    alpha0 = gs.data$alpha0,
    beta0 = gs.data$beta0,
    m0 = gs.data$mu0,
    k0 = gs.data$kappa0,
    a_0 = x
  )
}
l_a0 <- Vectorize(l_a0)
l_a0_p <- function(x) numDeriv::grad(l_a0, x)
l_a0_p <- Vectorize(l_a0_p)
#########
#########

d10 <- read.csv("../../data/Gaussian_logCA0_adaptive_J=10.csv")
d15 <- read.csv("../../data/Gaussian_logCA0_adaptive_J=15.csv")
d20 <- read.csv("../../data/Gaussian_logCA0_adaptive_J=20.csv")

gam10 <- mgcv::gam(lc_a0 ~ s(a0, k = 10), data = d10)
gam15 <- mgcv::gam(lc_a0 ~ s(a0, k = 15), data = d15)
gam20 <- mgcv::gam(lc_a0 ~ s(a0, k = 20), data = d20)

scam10 <- scam::scam(lc_a0 ~ s(a0, bs = "cx"), data = d10)

maxA <- 10
K <- 20000
pred_a0s <- seq(0, maxA, length.out = K)

pred10 <- predict(gam10, newdata = data.frame(a0 = pred_a0s))
pred15 <- predict(gam15, newdata = data.frame(a0 = pred_a0s))
pred20 <- predict(gam20, newdata = data.frame(a0 = pred_a0s))

curve(l_a0, 0, 10, lwd = 4, xlab = expression(a[0]))
lines(pred_a0s, pred10, col = 2, lwd = 2, lty = 2)
lines(pred_a0s, pred15, col = 3, lwd = 2, lty = 2)
lines(pred_a0s, pred20, col = 5, lwd = 2, lty = 2)
legend(x = "bottomright",
       legend = c("J=10", "J=15", "J=20"), col = c(2, 3, 5),
       bty = 'n', lty = 2, lwd = 2)

curve(l_a0, 0, 1, lwd = 4, xlab = expression(a[0]))
lines(pred_a0s, pred10, col = 2, lwd = 2, lty = 2)
lines(pred_a0s, pred15, col = 3, lwd = 2, lty = 2)
lines(pred_a0s, pred20, col = 5, lwd = 2, lty = 2)
legend(x = "bottomright",
       legend = c("J=10", "J=15", "J=20"), col = c(2, 3, 5),
       bty = 'n', lty = 2, lwd = 2)

curve(l_a0, 0.1, .3, lwd = 4, xlab = expression(a[0]))
lines(pred_a0s, pred10, col = 2, lwd = 2, lty = 2)
lines(pred_a0s, pred15, col = 3, lwd = 2, lty = 2)
lines(pred_a0s, pred20, col = 5, lwd = 2, lty = 2)
legend(x = "topright",
       legend = c("J=10", "J=15", "J=20"), col = c(2, 3, 5),
       bty = 'n', lty = 2, lwd = 2)

curve(l_a0, .4, .6, lwd = 4, xlab = expression(a[0]))
lines(pred_a0s, pred10, col = 2, lwd = 2, lty = 2)
lines(pred_a0s, pred15, col = 3, lwd = 2, lty = 2)
lines(pred_a0s, pred20, col = 5, lwd = 2, lty = 2)

curve(l_a0, 1.1, 1.3, lwd = 4, xlab = expression(a[0]))
lines(pred_a0s, pred10, col = 2, lwd = 2, lty = 2)
lines(pred_a0s, pred15, col = 3, lwd = 2, lty = 2)
lines(pred_a0s, pred20, col = 5, lwd = 2, lty = 2)
legend(x = "bottomright",
       legend = c("J=10", "J=15", "J=20"), col = c(2, 3, 5),
       bty = 'n', lty = 2, lwd = 2)

true.ls <- l_a0(pred_a0s)

rmse <- function(x, y){
  sqrt(mean( (x-y)^2 ))
}

scaled_rmse <- function(x, y){
  sqrt(mean( (x-y)^2 / x ))
}

rmse(x = true.ls[-1], y = pred10[-1])
rmse(x = true.ls[-1], y = pred15[-1])
rmse(x = true.ls[-1], y = pred20[-1])

scaled_rmse(x = true.ls[-1], y = pred10[-1])
scaled_rmse(x = true.ls[-1], y = pred15[-1])
scaled_rmse(x = true.ls[-1], y = pred20[-1])

###

plot(lc_a0 ~ a0, d15, xlab = "x", ylab = "y")
points(deriv_lc ~a0, data = d15,  col = 2)
legend(x = "topleft", legend = c("y", "y_deriv"), col = 1:2, pch = 16, bty = 'n')

plot(lc_a0 ~ a0, d15, xlab = "x", ylab = "y", ylim = c(-10, 100))
points(deriv_lc ~a0, data = d15,  col = 2)
legend(x = "bottomright", legend = c("y", "y_deriv"), col = 1:2, pch = 16, bty = 'n')


# https://fivethirtyeight.com/features/who-will-win-the-lucky-derby/
# The bugle sounds, and 20 horses make their way to the starting gate for the first annual Lucky Derby.
# These horses, all trained at the mysterious Riddler Stables, are special.
# Each second, every Riddler-trained horse takes one step. Each step is exactly one meter long.
# But what these horses exhibit in precision, they lack in sense of direction.
# Most of the time, their steps are forward (toward the finish line) but the rest of the time they are backward
# (away from the finish line). As an avid fan of the Lucky Derby, you’ve done exhaustive research on these 20 competitors.
# You know that Horse One goes forward 52 percent of the time, Horse Two 54 percent of the time, Horse Three 56 percent, and so on,
# up to the favorite filly, Horse Twenty, who steps forward 90 percent of the time.
# The horses’ steps are taken independently of one another, and the finish line is 200 meters from the starting gate.

# Handicap this race and place your bets! In other words, what are the odds (a percentage is fine) that each horse wins?

# Libraries
library(tidyverse)

# Inputs
n_horses <- 20                    # horses in race
stp      <- 1                     # length of each step
dir_fwd  <- seq(52, 90, 2) / 100  # chance each horse takes step forward
dst      <- 200                   # length of race

# Code
# Odds each horse wins
trials  <- 10000
winners <- rep(0, n_horses)
for (i in 1:trials) {
  track <- tibble(horses = 1:n_horses,
                  pos = rep(0, n_horses),
                  fwd = dir_fwd)
  a <- runif(1000, 0, 1)
  while(max(track$pos) < dst) {
    b <- sample(a, n_horses)
    track <- track %>%
      mutate(pos = pmax(0, pos + ifelse(fwd >= b, 1, -1)))
  }
  # Tally wins
  # Count ties as wins
  winners[which(track$pos >= dst)] <- winners[which(track$pos >= dst)] + 1
}

# Output
track <- track %>% mutate(win = winners / sum(winners))
print(track)
ggplot(track) +
  geom_point(mapping = aes(win, horses))


setwd("C:\\Users\\anush\\OneDrive\\Desktop\\final")
getwd()
library(factoextra)
library(purrr)
library(cluster)
library(fclust)
library(ppclust)
library(dplyr)
library(ClusterR)
library(fpc)
data <- read.csv("C:\\Users\\anush\\OneDrive\\Desktop\\final\\ORIGINAL.csv")
data[is.na(data$L1.norm.)]
data[is.na(data$BTC.)]
rownames(data) <- data$Date
data.frame <- as.data.frame(data)
data_final <- data.frame[626:679,2:3]
res.fcm <- fcm(na.omit(data_final), centers = 4, m = 2)
fm_stats <- cluster.stats(dist(data_final),  res.fcm$cluster)
print(fm_stats)
#------------------------------------------------------------------>
# res.fcm3 <- ppclust2(res.fcm, "fanny")
#
# cluster::clusplot(data_final, res.fcm3$cluster,
#                   main = "Clusters",
#                   color=TRUE, labels = 2, lines = 2, cex=1)
#------------------------------------------------------------------>
# summary(res.fcm)
res.fcm2 <- ppclust2(res.fcm, "kmeans")
fviz_cluster(res.fcm2, data = na.omit(data_final),
ellipse.type = "convex",
palette = "jco",
repel = TRUE)
#------------------------------------------------------------------>
# res.fcm4 <- ppclust2(res.fcm, "fclust")
# idxsf <- SIL.F(res.fcm4$Xca, res.fcm4$U, alpha=1)
# idxpe <- PE(res.fcm4$U)
# idxpc <- PC(res.fcm4$U)
# idxmpc <- MPC(res.fcm4$U)
#
# cat("Partition Entropy: ", idxpe)
# cat("Partition Coefficient: ", idxpc)
# cat("Modified Partition Coefficient: ", idxmpc)
# cat("Fuzzy Silhouette Index: ", idxsf)


#' Calculate Information Value for defined columns in data frame
#'
#' Calculates information value for defined columns in given data frame. Columns can have numeric or character type (including factors).
#' @details Information Value (IV) is concept used in risk management to assess predictive power of variable.
#' IV is defined as:
#' WoE (Weight of Evidence) is defined as:
#' @param df data frame with at least two columns
#' @param y column (integer or factor) with binary outcome. It is suggested that y is factor with two levels "bad" and "good" If there are no levels good/bad than the following assumptions are applied - if y is integer, than 0=good and 1=bad. If y is factor than level 2 is assumed to mean bad and 1 good.
#' @param summary Only total information value for variable is returned when summary is TRUE. Output is sorted by
#' information value, starting with highest value.
#' @param vars List of variables. If not specified, all character variables will be used
#' @param verbose Prints additional details when TRUE. Useful mainly for debugging.
#' @param rcontrol Additional parameters used for rpart tree generation. Use \code{?rpart.control()} to get more details.
#' @export
#' @examples
#' iv.mult(german_data,"gb")
#' iv.mult(german_data,"gb",TRUE)
#' iv.mult(german_data,"gb",TRUE,c("ca_status","housing","job","duration")) # str(german_data)
#' iv.mult(german_data,"gb",vars=c("ca_status","housing","job","duration"))
#' iv.mult(german_data,"gb",summary=TRUE, verbose=TRUE)
#' # Use varlist() function to get all numeric variables
#' iv.mult(german_data,y="gb",vars=varlist(german_data,"numeric"))

iv.mult <- function(df,y,summary=FALSE,vars=NULL,verbose=FALSE,rcontrol=NULL) {
  if(verbose) {
    cat(paste("Started processing of data frame:", deparse(substitute(df)),"\n"))
  }

  if(is.null(vars)) {
    vars <- names(df)[names(df) !=y]
  }

  ivlist <- lapply(vars, function (x) {
      if(is.numeric(df[,x])) {
        if (verbose) cat(paste("Calling iv.num for variable:", x, "\n"))
        iv.num(df,x,y,verbose=verbose,rcontrol=rcontrol)
      } else {
        if (verbose) cat(paste("Calling iv.str for variable:", x, "\n"))
        iv.str(df,x,y,verbose=verbose)
      }
    }
                  )

  if (summary) {
    if (verbose) cat(paste("Preparing summary","\n"))
    ivlist <- rbind.fill(ivlist)
    ivlist <- sqldf("select
                        variable as Variable,
                        sum(miv) as InformationValue,
                        count(*) as Bins,
                        sum(case when outcome_0 = 0 or outcome_1 = 0 then 1 else 0 end) as ZeroBins
                     from ivlist
                     group by variable
                     order by InformationValue desc")

    ivlist$Strength[ivlist$InformationValue >= 1] <- 1
    ivlist$Strength[ivlist$InformationValue >= .5 & ivlist$InformationValue < 1] <- 2
    ivlist$Strength[ivlist$InformationValue >= .2 & ivlist$InformationValue < .5] <- 3
    ivlist$Strength[ivlist$InformationValue >= .1 & ivlist$InformationValue < .2] <- 4
    ivlist$Strength[ivlist$InformationValue >= .02 & ivlist$InformationValue < .1] <- 5
    ivlist$Strength[ivlist$InformationValue < .02] <- 6
    ivlist$Strength <- factor(ivlist$Strength, levels=c(1,2,3,4,5,6),
                              labels= c("Suspicious","Very strong","Strong","Average","Weak","Wery weak"))
  }
  ivlist
}


\name{generate_fit_only}
\alias{generate_fit_only}
%- Also NEED an '\alias' for EACH other topic documented here.
\title{
  Simulating networks from the Caldarelli model}
\description{
  This function generates networks from the Caldarelli model. In this model, the preferential attachment function is constant, i.e. \eqn{A_k = 1}, and node fitnesses are sampled from some probability distribution.
}
\usage{
generate_fit_only(N             = 1000   ,
                 num_seed       = 2      ,
                 multiple_node  = 1      ,
                 m              = 1      ,
                 mode_f         = "gamma",
                 s              = 10     )
}

%- maybe also 'usage' for other objects documented here.
\arguments{
  The parameters can be divided into two groups.

  The first group specifies basic properties of the network:
    \item{N}{
      Integer. Total number of nodes in the network (including the nodes in the seed graph). Default value is \code{1000}.
    }
  \item{num_seed}{
    Integer. The number of nodes of the seed graph (the initial state of the network). The seed graph is a cycle. Default value is \code{2}.
  }
  \item{multiple_node}{
    Positive integer. The number of new nodes at each time-step. Default value is \code{1}.
  }
  \item{m}{
    Positive integer. The number of edges of each new node. Default value is \code{1}.
  }

  The final group of parameters specifies the distribution from which node fitnesses are generated:
    \item{mode_f}{
      String. Possible values:\code{"gamma"}, \code{"log_normal"} or \code{"power_law"}. This parameter indicates the true distribution for node fitness. \code{"gamma"} = gamma distribution, \code{"log_normal"} = log-normal distribution. \code{"power_law"} = power-law (pareto) distribution. Default value is "gamma".
    }
\item{s}{
Non-negative numeric. The inverse variance parameter. The mean of the distribution is kept at \eqn{1} and the variance is \eqn{1/s} (since node fitnesses are only meaningful up to scale). This is achieved by setting shape and rate parameters of the Gamma distribution to \eqn{s}; setting mean and standard deviation in log-scale of the log-normal distribution to \eqn{-1/2*log (1/s + 1)} and \eqn{(log (1/s + 1))^{0.5}}; and setting shape and scale parameters of the pareto distribution to \eqn{(s+1)^{0.5} + 1} and \eqn{(s+1)^{0.5}/((s+1)^{0.5} + 1)}. If \code{s} is \code{0}, all node fitnesses \eqn{\eta} are fixed at \code{1} (i.e., \enc{Barabási}{Barabasi}-Albert model). The default value is \code{10}.
}
}

\value{
  The output is a \code{PAFit_net} object, which is a List contains the following four fields:
    \item{graph}{a three-column matrix, where each row contains information of one edge, in the form of \code{(from_id, to_id, time_stamp)}. \code{from_id} is the id of the source, \code{to_id} is the id of the destination.}
    \item{type}{a string indicates whether the network is \code{"directed"} or \code{"undirected"}.}
    \item{PA}{a numeric vector contains the true PA function.}
  \item{fitness}{fitness values of nodes in the network. The name of each value is the ID of the node.}
}
\author{
  Thong Pham \email{thongpham@thongpham.net}
}
\references{
  1. Caldarelli, G., Capocci, A. , De Los Rios, P. & \enc{Muñoz}{Munoz}, M.A. (2002). Scale-Free Networks from Varying Vertex Intrinsic Fitness. Phys. Rev. Lett., 89, 258702 (\url{http://link.aps.org/doi/10.1103/PhysRevLett.89.258702}).
}
\seealso{
  For subsequent estimation procedures, see \code{\link{get_statistics}}.

  For other functions to generate networks, see \code{\link{generate_net}}, \code{\link{generate_BA}}, \code{\link{generate_ER}} and \code{\link{generate_BB}}. }

\examples{
  library("PAFit")
  # generate a network from the Caldarelli model with alpha = 1, N = 100, m = 1
  # the inverse variance of distribution of node fitnesses is s = 10
  net <- generate_fit_only(N = 100,m = 1,mode = 1, s = 10)
  str(net)
  plot(net)
}

% Add one or more standard keywords, see file 'KEYWORDS' in the
% R documentation directory.
\concept{ fitness model }% __ONLY ONE__ keyword per line