dset1=c(199809,200665,199607,200270,199649)
dset2=c(522573,244456,139979,71531,21461)

chi2IsUniform<-function(dataset,significance=0.05){
  chi2IsUniform=(chisq.test(dataset)$p.value>significance)
}

for (ds in list(dset1,dset2)){
  print(c("Data set:",ds))
  print(chisq.test(ds))
  print(paste("uniform?",chi2IsUniform(ds)))
}


require(tidyverse)
# Data calculated using muEstimation.R
jack.all <- readRDS("./cleanVersions/datafiles/jackknifeResults_w_Hart_w_supp.rds")
mu.all <- readRDS("./cleanVersions/datafiles/MuEstimates_w_Hart_w_supp.rds")

estimateJackCI <- function(s,y,sp, jack, mu) {
  jack.df <- filter(jack, site == s & year == y & species == sp)

  mu.df <- filter(mu, SITE == s & YEAR == y & SPECIES == sp)
  if(nrow(mu.df) <1){return(NA)}
  N <- jack.df %>% filter(!is.na(mu)) %>% nrow
  # print(N)
  if(N <= 1) {return(tibble(SITE = s, YEAR = y, SPECIES = sp,MU = mu.df$MU, lci = NA, uci=NA, N,
                            var.i=NA, var2=NA, ci=NA, unbiasedCI = NA,
                            unbiased_lci = NA, unbiased_uci = NA))  }
  theta <- mu.df$MU * N - (N -1) * jack.df$mu
  unbiased_theta <- mu.df$MU + (N-1)*(mu.df$MU - jack.df$mu)
  var.i <- 1/(N-1) * sum((theta-mu.df$MU)^2, na.rm = T)
  var2 <- var(theta, na.rm=T)
  ci <- 1.96*sqrt(var.i)
  unbiasedCI <- qt(0.975,N-1)*sqrt(var(unbiased_theta, na.rm = T)/N)
  lci <- mu.df$MU - qt(0.975,N-1)*sqrt(var(theta, na.rm = T)/N)
  uci <- mu.df$MU + qt(0.975,N-1)*sqrt(var(theta, na.rm = T)/N)
  unbiased_lci <- mu.df$MU - unbiasedCI
  unbiased_uci <- mu.df$MU + unbiasedCI
  return(tibble(SITE = s, YEAR = y, SPECIES = sp,MU = mu.df$MU, lci, uci, N, var.i, var2, ci, unbiasedCI,
                unbiased_lci, unbiased_uci))
}

require(purrr)
yrs <- unique(mu.all$YEAR)
species <- unique(mu.all$SPECIES)
sites <- unique(mu.all$SITE)
runs <- expand.grid(sites, yrs, species)
results <- apply(runs,1,function(x,y,z) estimateJackCI(x[1], x[2], x[3], jack = jack.all, mu = mu.all))
res.df <- results[!is.na(results)] %>% do.call('rbind', .)


library(tidyr)
library(plyr)
library(dplyr)
library(reshape)
library(ggplot2)

setwd(".")

############################
# Read the dataCollapsed
############################

data = read.csv("./data.csv", stringsAsFactors = TRUE)

data_lg <- data %>% filter(Phone == 'Lg')
data_sam <- data %>% filter(Phone == 'Samsung')

############################
# Plots
############################
par(mar=c(5,6,4,1)+.1)
par(cex.lab=2) # is for y-axis
par(cex.axis=2) # is for x-axis
par(cex.main=2) # is for the main title
boxplot(data_lg$Cpu ~ data_lg$Type, main='LG Cpu Usage', ylab="Cpu Usage (%)", ylim=c(0, max(data_lg$Cpu)))
boxplot(data_sam$Cpu ~ data_sam$Type, main='Samsung Cpu Usage', ylab="Cpu Usage (%)", ylim=c(0, max(data_sam$Cpu)))
boxplot(data_lg$Memory ~ data_lg$Type, main='LG Memory Usage', ylab="Memory Usage (kB)", ylim=c(0, max(data_lg$Memory)))
boxplot(data_sam$Memory ~ data_sam$Type, main='Samsung Memory Usage', ylab="Memory Usage (kB)", ylim=c(0, max(data_sam$Memory)))
boxplot(data_lg$Batterystats ~ data_lg$Type, main='LG Energy Usage', ylab="Energy Usage (J)", ylim=c(0, max(data_lg$Batterystats)))
boxplot(data_sam$Batterystats ~ data_sam$Type, main='Samsung Energy Usage', ylab="Energy Usage (J)", ylim=c(0, max(data_sam$Batterystats)))

######Making the Q-Q plots#####
par(mar=c(5,6,4,1)+.1)
par(cex.lab=1.9) # is for y-axis
par(cex.axis=2) # is for x-axis
par(cex.main=2) # is for the main title
#LG-CPU
#qqnorm(data_lg$Cpu, main = 'Q-Q Plot for Normality (LG-CPU)', ylab = 'LG cpu consumption sample quantile (%)')
#qqline(data_lg$Cpu)
#LG-RELATE-CPU
data_ad_lg <- data_lg %>% filter(Type == 'RELATE')
qqnorm(data_ad_lg$Cpu, main = 'Q-Q Plot for Normality (LG-RELATE)', ylab = 'Cpu Usage Sample Quantile (%)')
qqline(data_ad_lg$Cpu)
#LG-BaseApp-CPU
data_BaseApp_lg <- data_lg %>% filter(Type == 'BaseApp')
qqnorm(data_BaseApp_lg$Cpu, main = 'Q-Q Plot for Normality (LG-BaseApp)', ylab = 'Cpu Usage Sample Quantile (%)')
qqline(data_BaseApp_lg$Cpu)
#LG-Memory
#qqnorm(data_lg$Memory, main = 'Q-Q Plot for Normality (LG-Memory)', ylab = 'LG memory consumption sample quantile (kB)')
#qqline(data_lg$Memory)
par(cex.lab=1.7) # is for y-axis
#LG-RELATE-Memory
qqnorm(data_ad_lg$Memory, main = 'Q-Q Plot for Normality (LG-RELATE)', ylab = 'Memory Usage Sample Quantile (kB)')
qqline(data_ad_lg$Memory)
#LG-BaseApp-Memory
qqnorm(data_BaseApp_lg$Memory, main = 'Q-Q Plot for Normality (LG-BaseApp)', ylab = 'Memory Usage Sample Quantile (kB)')
qqline(data_BaseApp_lg$Memory)
#SAM-CPU
#qqnorm(data_sam$Cpu, main = 'Q-Q Plot for Normality (SAM-CPU)', ylab = 'Samsung cpu consumption sample quantile (%)')
#qqline(data_sam$Cpu)
par(cex.lab=1.9) # is for y-axis
#SAM-RELATE-CPU
data_ad_sam <- data_sam %>% filter(Type == 'RELATE')
qqnorm(data_ad_sam$Cpu, main = 'Q-Q Plot for Normality (SAM-RELATE)', ylab = 'Cpu Usage Sample Quantile (%)')
qqline(data_ad_sam$Cpu)
#SAM-BaseApp-CPU
data_BaseApp_sam <- data_sam %>% filter(Type == 'BaseApp')
qqnorm(data_BaseApp_sam$Cpu, main = 'Q-Q Plot for Normality (SAM-BaseApp)', ylab = 'Cpu Usage Sample Quantile (%)')
qqline(data_BaseApp_sam$Cpu)
#SAM-Memory
#qqnorm(data_sam$Memory, main = 'Q-Q Plot for Normality (SAM-Memory)', ylab = 'Samsung memory consumption sample quantile (kB)')
#qqline(data_sam$Memory)
par(cex.lab=1.7) # is for y-axis
#SAM-RELATE-Memory
qqnorm(data_ad_sam$Memory, main = 'Q-Q Plot for Normality (SAM-RELATE)', ylab = 'Memory Usage Sample Quantile (kB)')
qqline(data_ad_sam$Memory)
#SAM-BaseApp-Memory
qqnorm(data_BaseApp_sam$Memory, main = 'Q-Q Plot for Normality (SAM-BaseApp)', ylab = 'Memory Usage Sample Quantile (kB)')
qqline(data_BaseApp_sam$Memory)
#LG-Energy
#qqnorm(data_lg$Batterystats, main = 'Q-Q Plot for Normality (LG-Energy)', ylab = 'LG energy consumption sample quantile (J)')
#qqline(data_lg$Batterystats)
#LG-RELATE-Energy
qqnorm(data_ad_lg$Batterystats, main = 'Q-Q Plot for Normality (LG-RELATE)', ylab = 'Energy Usage Sample Quantile (J)')
qqline(data_ad_lg$Batterystats)
#LG-BaseApp-Energy
qqnorm(data_BaseApp_lg$Batterystats, main = 'Q-Q Plot for Normality (LG-BaseApp)', ylab = 'Energy Usage Sample Quantile (J)')
qqline(data_BaseApp_lg$Batterystats)
#SAM-Energy
#qqnorm(data_sam$Batterystats, main = 'Q-Q Plot for Normality (SAM-Energy)', ylab = 'Samsung energy consumption sample quantile (J)')
#qqline(data_sam$Batterystats)
#SAM-RELATE-Energy
qqnorm(data_ad_sam$Batterystats, main = 'Q-Q Plot for Normality (SAM-RELATE)', ylab = 'Energy Usage Sample Quantile (J)')
qqline(data_ad_sam$Batterystats)
#SAM-BaseApp-Energy
qqnorm(data_BaseApp_sam$Batterystats, main = 'Q-Q Plot for Normality (SAM-BaseApp)', ylab = 'Energy Usage Sample Quantile (J)')
qqline(data_BaseApp_sam$Batterystats)

#####Shapiro-Wilk tests######
#LG-CPU
#shapiro.test(data_lg$Cpu)
#LG-RELATE-CPU
shapiro.test(data_ad_lg$Cpu)
#LG-BaseApp-CPU
shapiro.test(data_BaseApp_lg$Cpu)
#LG-Memory
#shapiro.test(data_lg$Memory)
#LG-RELATE-Memory
shapiro.test(data_ad_lg$Memory)
#LG-BaseApp-Memory
shapiro.test(data_BaseApp_lg$Memory)
#SAM-CPU
#shapiro.test(data_sam$Cpu)
#SAM-RELATE-CPU
shapiro.test(data_ad_sam$Cpu)
#SAM-BaseApp-CPU
shapiro.test(data_BaseApp_sam$Cpu)
#SAM-Memory
#shapiro.test(data_sam$Memory)
#SAM-RELATE-Memory
shapiro.test(data_ad_sam$Memory)
#SAM-BaseApp-Memory
shapiro.test(data_BaseApp_sam$Memory)
#LG-Energy
#shapiro.test(data_lg$Batterystats)
#LG-RELATE-Energy
shapiro.test(data_ad_lg$Batterystats)
#LG-BaseApp_Energy
shapiro.test(data_BaseApp_lg$Batterystats)
#SAM-Energy
#shapiro.test(data_sam$Batterystats)
#SAM-RELATE-Energy
shapiro.test(data_ad_sam$Batterystats)
#SAM-BaseApp-Energy
shapiro.test(data_BaseApp_sam$Batterystats)


postscript("speedup.ps",horizontal=F)
logx<-0:5
y<-c(1,1.9,3.9,6.6,3.9,3.3)
logy<-log(y,base=2)
plot(logx,logy,type="o",ylim=range(c(logx,logy)),
main="Speedup",xaxt="n",yaxt="n",xlab="OMP_NUM_THREADS",
ylab="speedup")
points(logx,logx,type="o",col="red")
axis(1,at=logx,lab=2^logx)
axis(2,at=logx,lab=2^logx)
for(i in 1:6)
{
 abline(h=logx[i],lty=2)
 abline(v=logx[i],lty=2)
}
dev.off()


cube <- function(x) x*x*x
elements <- 1:5
cubes <- cube(elements)


# Data Wrangling in R
# 4.4 Converting Data Types

# Let's say that we have a vector of numbers representing the number of foul shots made
# by a team of basketball players

foulshots <- c(18, 22, 15, 13, 5)

# I can use the sum() function to total them up

sum(foulshots)

# But what if they are read in as strings?

foulshot_strings <- c("18", "22", "15", "13", "5")
sum(foulshot_strings)
class(foulshot_strings)

# We can fix it with as.numeric

foulshot_converted <- as.numeric(foulshot_strings)
class(foulshot_converted)
sum(foulshot_converted)

# There are also tests to help us determine whether

is.numeric(foulshots)
is.character(foulshots)

is.numeric(foulshot_strings)
is.character(foulshot_strings)

# Let's look at a tibble containing the names of players and their team numbers

names <- c("Mike", "Rae", "Dennis", "Sally", "Ian", "Sue")
teams <- c(1,1,1,2,2,2)
assignments <- tibble(names, teams)
assignments

# That's not really correct, because team isn't a numeric value, it's a factor

assignments$teams <- as.factor(assignments$teams)
assignments

# And there is an is.factor function to test them

is.factor(assignments$names)
is.factor(assignments$teams)


qroots <- function(a, b, c) {
  r <- sqrt(b * b - 4 * a * c + 0i)
  if (abs(b - r) > abs(b + r)) {
    z <- (-b + r) / (2 * a)
  } else {
    z <- (-b - r) / (2 * a)
  }
  c(z, c / (z * a))
}

qroots(1, 0, 2i)
[1] -1+1i  1-1i

qroots(1, -1e9, 1)
[1] 1e+09+0i 1e-09+0i


x<-c(20,23,29,27,30,34,35,37,40,43)
y<-c(1.32,1.67,2.17,2.70,2.75,2.87,3.65,2.86,3.61,4.25)
z<-(x-mean(x))*(y-mean(y))

A<-sum(z)
p<-sum((x-mean(x))*(x-mean(x)))
q<-sum((y-mean(y))*(y-mean(y)))
B<-sqrt(p*q)
cofficient<-A/B
print((cofficient))


\name{generate_BA}
\alias{generate_BA}
%- Also NEED an '\alias' for EACH other topic documented here.
\title{
  Simulating networks from the generalized Barabasi-Albert model}
\description{
  This function generates networks from the generalized \enc{Barabási}{Barabasi}-Albert model. In this model, the preferential attachment function is power-law, i.e. \eqn{A_k = k^\alpha}, and node fitnesses are all equal to \eqn{1}. It is a wrapper of the more powerful function \code{\link{generate_net}}.
}
\usage{
generate_BA(N              = 1000,
            num_seed       = 2   ,
            multiple_node  = 1   ,
            m              = 1   ,
            alpha          = 1)
}

%- maybe also 'usage' for other objects documented here.
\arguments{
\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}.
}
\item{alpha}{
Numeric. This is the attachment exponent in the attachment function \eqn{A_k = k^\alpha}. }
}

\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 fitnesses are all equal to \eqn{1}.}
}
\author{
  Thong Pham \email{thongpham@thongpham.net}
}
\references{
  1. Albert, R. & \enc{Barabási}{Barabasi}, A. (1999). Emergence of scaling in random networks. Science, 286,509–512 (\url{http://science.sciencemag.org/content/286/5439/509}).
}
\seealso{
For subsequent estimation procedures, see \code{\link{get_statistics}}.

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

\examples{
  library("PAFit")
  # generate a network from the BA model with alpha = 1, N = 100, m = 1
  net <- generate_BA(N = 100)
  str(net)
  plot(net)
}

\concept{Barabasi-Albert model}


```{r echo= FALSE,message=TRUE}

require("igraph",quietly = T)
require("networkD3",quietly = T)
require("d3heatmap")
require("plotly")
require("ggplot2")
require("GGally")
# require("fields")

setwd("~/git/ExploratoryGraph/Code/Functions/")

graph <- read.graph("../DataIngest/p.pacificus_neural.synaptic_1.graphml",format = "graphml")
# graph <- read.graph("../DataIngest/kasthuri2015_ramon_v4.graphml",format = "graphml")

if(!is.connected(graph)){
  graph<-decompose.graph(graph)[[1]]
}

# graph<- as.undirected(graph, mode="collapse")

members <- rep(1, length(V(graph)))
graph_d3 <- igraph_to_networkD3(graph, members)

#Plot it in the fancy & interactive D3!
forceNetwork(Links = graph_d3$links, Nodes = graph_d3$nodes, Source = 'source', Target = 'target', NodeID = 'name', Group = 'group')

#Simpel walktrap to cluster the nodes
# graphClusters<- cluster_walktrap(graph)
# members <- membership(graphClusters)
members <- rep(1,length(V(graph)))
graph_d3 <- igraph_to_networkD3(graph, members)

#Plot it in the fancy & interactive D3!
forceNetwork(Links = graph_d3$links, Nodes = graph_d3$nodes, Source = 'source', Target = 'target', NodeID = 'name', Group = 'group')

#Let's compute the adjacency and convert it to a boolean matrix

adjacency<- get.adjacency(graph,type = "both",attr = NULL,sparse = T, edges = F)
adjacency = adjacency>0

#Compute the degree
degreeGraph<- rowSums(as.matrix(adjacency))
orderByDegree<- order(degreeGraph,decreasing = T)

A<- as.matrix(adjacency*1)

require(plyr)
library(reshape)

m<-melt(A)

p <- ggplot(m, aes(X1, X2)) + geom_tile(aes(fill = value), colour = "white") + scale_fill_gradient(low = "white", high = "steelblue") #+ theme(axis.ticks = element_blank(), axis.text.x = element_blank(),axis.text.y = element_blank())
p

ggplotly(p)

#degree dist
# plot_ly(x = degreeGraph,type = "histogram")

df <- data.frame(x <- degreeGraph, group <- 1)

p <- ggplot(df, aes(x)) +
  geom_histogram(aes(y = ..density..), alpha = 0.7, fill = "#333333", binwidth = 1) +
  stat_density(fill = "skyblue", alpha = 0.5,adjust= 1) +
  theme(panel.background = element_rect(fill = '#ffffff')) +
  ggtitle("Degree Distribution")

ggplotly(p)

## Adjacency Matrix: ordered by degree
# image(adjacency[orderByDegree,orderByDegree])

sortedA<- adjacency[orderByDegree,orderByDegree]
sortedD<- degreeGraph[orderByDegree]
d3heatmap(as.matrix(sortedA), scale = "none", colors = ("Blues"))

D_half<- sqrt((sortedD))
L <-  diag(1/D_half)%*%as.matrix(sortedA) %*%diag(1/D_half)
rownames(L) <- rownames(sortedA)
colnames(L) <- colnames(sortedA)
d3heatmap(L, scale = "none", colors = ("Blues"))

#scree plot

plot_ly(y=svdL$d)

#3D embedding

d<- 3
svdL<- svd(sortedA)
# plot(svdL$d)
sigma<- svdL$d[1:d]
X<- svdL$u[,1:d] %*% diag( sqrt(sigma))

#let's do k-means

K = 5
kmeans_X <- kmeans(X,K)

plot_ly(x= X[,1],y= X[,2],z= X[,3], type = "scatter3d",mode = "markers", color=kmeans_X$cluster)

blockMembership<- kmeans_X$cluster
names(blockMembership)<- rownames(sortedA)

listVertex<- names(V(graph))

listBlockMembership<- as.list(blockMembership)

reorderedBlockMembership<- do.call("c",lapply(listVertex, function(x){listBlockMembership[[x]]}))

graph_d3 <- igraph_to_networkD3(graph,reorderedBlockMembership)

#Plot it in the fancy & interactive D3!
forceNetwork(Links = graph_d3$links, Nodes = graph_d3$nodes, Source = 'source', Target = 'target',
             NodeID = 'name', Group = 'group')

###
ggpairs(X, colour=X[,1], alpha=0.4)

m<-melt(A)

p <- ggplot(m, aes(X1, X2)) +
  geom_tile(aes(fill =  value), colour = "white") + scale_fill_gradient(low = "white",  high = "red", limits=c(0,1))

ggplotly(p)

#theme(axis.ticks = element_blank(), axis.text.x = element_blank(),axis.text.y = element_blank())


#!/usr/bin/Rscript
# Copyright © 2016 Martin Ueding <dev@martin-ueding.de>
# Licensed under the MIT license.

bin_count = 50
samples_count = 100000

pdf = function(x) {
    sqrt(1/x - log(1 - x))
}

gm = function(x) {
    4 / (pi * sqrt(x * (1 - x)))
}

# Plot the original function.
x_orig = seq(0.01, 0.99, length.out=200)
y_orig = pdf(x_orig)
plot(x_orig, y_orig, type='l', main='Original PDF', xlab='x', ylab='y',
     col='red')

# Also plot the majorizing function.
y = gm(x_orig)
lines(x_orig, y)

inverse_cdf = function(u) {
    sin(pi * u / 2)^2
}

u = runif(samples_count)
x = inverse_cdf(u)

u2 = runif(samples_count)
idx = u2 < pdf(x) / gm(x)
accepted = x[idx]

hist(accepted, breaks=bin_count, freq=FALSE)

# The pdf above needs to be normalized, on the problem/solution set the
# normalization is given as this particular magic number.
lines(x_orig, y_orig / 2.32812, col='red')


sieve <- function(n)
{
   n <- as.integer(n)
   if(n > 1e6) stop("n too large")  # restricting for larger values of n
   primes <- rep(TRUE, n) # initially all false
   primes[1] <- FALSE # trivial case
   last.prime <- 2L
   for(i in last.prime:floor(sqrt(n)))  # looping through the array
   {
      primes[seq.int(2L*last.prime, n, last.prime)] <- FALSE
      last.prime <- last.prime + min(which(primes[(last.prime+1):n]))
   }
   which(primes)
}

 sieve(1000000) # calling the function


.logit <- function(x) { log(x / (1 - x)) }
.dlogit <- function(x) { 1 / (x - x * x) }
.logistic <- function(x) { 1 / (1 + exp(-x)) }
.logit_scale <- function(x, a, b) { log((a - x) / (x - b)) }
.dlogit_scale <- function(x, a, b) {(b - a) / ((a - x) * (x - b)) }
.logistic_scale <- function(x, a, b) { ex <- exp(x); (a + b * ex) / (ex + 1) }

#' Transform to an unbounded domain
#'
#' description
#' @param x Matrix or vector of samples. For matrices, rows are samples and columns are variables.
#' @param bounds Dx2 matrix specifying the lower and upper bound for each variable.
#' @export
mvd.transform_to_unbounded <- function(x, bounds) {
    transformed <- matrix(NA, nrow = nrow(x), ncol = ncol(x))
    for (i in 1:ncol(x)) {
        if (bounds[i, 1] >= bounds[i, 2]) {
            stop("Upper bound must be strictly higher than lower bound")
        }

        if (bounds[i, 1] == 0 && bounds[i, 2] == 1) {
            # [0,1] -> logit
            transformed[, i] <- .logit(x[, i])
        } else if (bounds[i, 1] == 0 && bounds[i, 2] == Inf) {
            # [0,inf] -> log
            transformed[, i] <- log(x[, i])
        } else if (bounds[i, 1] == -Inf && bounds[i, 2] == 0) {
            # [0,inf] -> log
            transformed[, i] <- log(-x[, i])
        } else if (bounds[i, 1] == -Inf && bounds[i, 2] == Inf) {
            # [-inf,inf] -> no transform
            transformed[, i] <- x[, i]
        } else {
            # [a,b] -> scaled logit
            transformed[, i] <- .logit_scale(x[, i], bounds[i, 1], bounds[i, 2])
        }
    }
    return(transformed)
}

#' Reverse transform from an unbounded domain
#'
#' description
#' @param transformed_x Matrix or vector of transformed samples. For matrices, rows are samples and columns are variables.
#' @param bounds Dx2 matrix specifying the lower and upper bound for each variable.
#' @export
mvd.transform_from_unbounded <- function(transformed_x, bounds) {
    x <- matrix(NA, nrow = nrow(x), ncol = ncol(x))
    for (i in 1:ncol(x)) {
        if (bounds[i, 1] == 0 && bounds[i, 2] == 1) {
            # [0,1] -> logit -> inverse = logistic
            x[, i] <- .logistic(transformed_x[, i])
        } else if (bounds[i, 1] == 0 && bounds[i, 2] == Inf) {
            # [0,inf] -> log -> inverse = exp
            x[, i] <- exp(transformed_x[, i])
        } else if (bounds[i, 1] == -Inf && bounds[i, 2] == 0) {
            # [0,inf] -> log -> inverse = exp
            x[, i] <- -exp(transformed_x[, i])
        } else if (bounds[i, 1] == -Inf && bounds[i, 2] == Inf) {
            # [-inf,inf] -> no transform
            x[, i] <- transformed_x[, i]
        } else {
            # [a,b] -> scaled logit -> inverse = scaled logistic
            x[, i] <- .logistic_scale(transformed_x[, i], bounds[i, 1], bounds[i, 2])
        }
    }
    return(x)
}

#' Probability density correction for variable transformation
#' @param x Matrix or vector of samples. For matrices, rows are samples and columns are variables.
#' @param bounds Dx2 matrix specifying the lower and upper bound for each variable.
#' @param p Probability densities to correct
#' @param log Specifies whether p is in log scale
#' @export
mvd.correct_p_for_transformation <- function(x, bounds, p, log = T) {
    if (log) {
        for (i in 1:ncol(x)) {
            if (bounds[i, 1] == 0 && bounds[i, 2] == 1) {
                # [0,1] -> logit -> derivative = dlogit
                p <- p + log(.dlogit(x[, i]))
            } else if (bounds[i, 1] == 0 && bounds[i, 2] == Inf) {
                # [0,inf] -> log -> derivative = 1/log
                p <- p - log(x[, i])
            } else if (bounds[i, 1] == -Inf && bounds[i, 2] == 0) {
                # [0,inf] -> log -> derivative = 1/log
                p <- p - log(x[, i])
            } else if (bounds[i, 1] == -Inf && bounds[i, 2] == Inf) {
                # [-inf,inf] -> no transform
            } else {
                # [a,b] -> scaled logit -> derivative = dlogit_scale
                p <- p + log(.dlogit_scale(x[, i], bounds[i, 1], bounds[i, 2]))
            }
        }
    } else {
        for (i in 1:ncol(x)) {
            if (bounds[i, 1] == 0 && bounds[i, 2] == 1) {
                # [0,1] -> logit -> derivative = dlogit
                p <- p * .dlogit(x[, i])
            } else if (bounds[i, 1] == 0 && bounds[i, 2] == Inf) {
                # [0,inf] ->log(x) -> 1/x
                p <- p / x[, i]
            } else if (bounds[i, 1] == -Inf && bounds[i, 2] == 0) {
                # [0,inf] ->log(x) -> 1/x
                p <- p / x[, i]
            } else if (bounds[i, 1] == -Inf && bounds[i, 2] == Inf) {
                # [-inf,inf] -> no transform
            } else {
                # [a,b] -> scaled logit -> derivative = dlogit_scale
                p <- p * .dlogit_scale(x[, i], bounds[i, 1], bounds[i, 2])
            }
        }
    }
    return(p)
}

.mvd.transform_name <- function(bounds, i) {
    if (bounds[i, 1] == 0 && bounds[i, 2] == 1) {
        return("logit")
    } else if (bounds[i, 1] == 0 && bounds[i, 2] == Inf) {
        return("log")
    } else if (bounds[i, 1] == -Inf && bounds[i, 2] == 0) {
        return("negative log")
    } else if (bounds[i, 1] == -Inf && bounds[i, 2] == Inf) {
        return("no transform")
    } else {
        return("scaled logit")
    }
}


#' MLE for the trunckated normal distribution
#'
#' Creating a Function that Returns the Log Likelihood, Gradient and Hessian Functions
#'
#' @param data numeric vector
#' @param t truncation limits
#' @param ... additional options
#'
#' @export
#'

mklhood <- function(data, t, ...) {

    data <- na.omit(data)
    n <- length(data)
    t <- sort(t)

    psi<-function(y, mu, sigma){
        exp(-(y-mu)^2/(2*sigma^2))/(sigma*sqrt(2*pi))
    }

    psi.mu<-function(y,mu,sigma){
        exp(-(y-mu)^2/(2*sigma^2)) * ((y-mu)/(sigma^3*sqrt(2*pi)))
    }

    psi.sigma<-function(y,mu,sigma){
        exp(-(y-mu)^2/(2*sigma^2)) *
            (((y-mu)^2)/(sigma^4*sqrt(2*pi)) - 1/(sigma^2*sqrt(2*pi)))
    }

    psi2.mu<-function(y,mu,sigma){
        exp(-(y - mu)^2/(2*sigma^2)) *
            (((y - mu)^2)/(sigma^5*sqrt(2*pi))-1/(sigma^3*sqrt(2*pi)))
    }

    psi2.sigma<-function(y,mu,sigma){
        exp(-(y-mu)^2/(2*sigma^2)) *
            ((2)/(sigma^3*sqrt(2*pi)) - (5*(y-mu))/(sigma^5*sqrt(2*pi)) +
             ((y-mu)^4)/(sigma^7*sqrt(2*pi)))
    }

    psi12.musig<-function(y,mu,sigma){
        exp(-(y-mu)^2/(2*sigma^2)) *
            (((y-mu)^3)/(sigma^6*sqrt(2*pi)) - (3*(y-mu))/(sigma^4*sqrt(2*pi)))
    }

    ll.tnorm2<-function(p){
        out <- (-n*log(pnorm(t[2],p[1],p[2])-pnorm(t[1],p[1],p[2]))) -
            (n*log(sqrt(2*pi*p[2]^2))) - (sum((data-p[1])^2)/(2*p[2]^2))
        -1*out
    }

    grad.tnorm<-function(p){
        g1 <- (-n*(integrate(psi.mu,t[1],t[2],mu=p[1],sigma=p[2], stop.on.error = FALSE)$value) /
               (pnorm(max(t),p[1],p[2])-pnorm(min(t),p[1],p[2]))) - ((n*p[1]-sum(data))/p[2]^2)
        g2 <- (-n*(integrate(psi.sigma,t[1],t[2],mu=p[1],sigma=p[2], stop.on.error = FALSE)$value) /
               (pnorm(max(t),p[1],p[2])-pnorm(min(t),p[1],p[2]))) - ((n)/(p[2])) + ((sum((data-p[1])^2))/(p[2]^3))
        out <- c(g1,g2)
        return(out)
    }

    hessian.tnorm<-function(p){

        h1<- -n*(integrate(psi,t[1],t[2],mu=p[1],sigma=p[2], stop.on.error = FALSE)$value *
                                                                                integrate(psi2.mu,t[1],t[2],mu=p[1],sigma=p[2], stop.on.error = FALSE)$value -
                                                                                integrate(psi.mu,t[1],t[2],mu=p[1],sigma=p[2], stop.on.error = FALSE)$value^2) /
            (integrate(psi,t[1],t[2],mu=p[1],sigma=p[2], stop.on.error = FALSE)$value^2) -
            n/(p[2]^2)

        h3<- -n*(integrate(psi,t[1],t[2],mu=p[1],sigma=p[2], stop.on.error = FALSE)$value *
                                                                                integrate(psi12.musig,t[1],t[2],mu=p[1],sigma=p[2], stop.on.error = FALSE)$value -
                                                                                integrate(psi.mu,t[1],t[2],mu=p[1],sigma=p[2], stop.on.error = FALSE)$value *
                                                                                integrate(psi.sigma,t[1],t[2],mu=p[1],sigma=p[2], stop.on.error = FALSE)$value) /
            (integrate(psi,t[1],t[2],mu=p[1],sigma=p[2], stop.on.error = FALSE)$value^2) +
            (2*(n*p[1]-sum(data)))/(p[2]^3)

        h2<- -n*(integrate(psi,t[1],t[2],mu=p[1],sigma=p[2], stop.on.error = FALSE)$value *
                                                                                integrate(psi2.sigma,t[1],t[2],mu=p[1],sigma=p[2], stop.on.error = FALSE)$value -
                                                                                integrate(psi.sigma,t[1],t[2],mu=p[1],sigma=p[2], stop.on.error = FALSE)$value^2) /
            (integrate(psi,t[1],t[2],mu=p[1],sigma=p[2], stop.on.error = FALSE)$value^2) +
            (n)/(p[2]^2)-(3*sum((data-p[1])^2))/(p[2]^4)

        H<-matrix(0,nrow=2,ncol=2)
        H[1,1]<-h1
        H[2,2]<-h2
        H[1,2]<-H[2,1]<-h3
        return(H)
    }

    return(list(ll.tnorm2 = ll.tnorm2, grad.tnorm = grad.tnorm, hessian.tnorm = hessian.tnorm))
}

#' Newton Raphson Function
#'
#' This takes in the Objects Returned from mklhood Function above
#'
#' @param lhood lhood
#' @param p p
#' @param tol tolerance
#' @param maxit max iterations
#'
#' @export
#'
NewtonRaphsonLike <- function(lhood, p, tol = 1e-07, maxit = 100) {

    cscore <- lhood$grad.tnorm(p)
    if(sum(abs(cscore)) < tol)
        return(list(estimate = p, value = lhood$ll.tnorm2(p), iter = 0))
    cur <- p
    for(i in 1:maxit) {
        inverseHess <- solve(lhood$hessian.tnorm(cur))
        cscore <- lhood$grad.tnorm(cur)
        new <- cur - cscore %*% inverseHess
        if (new[2] <= 0) stop("Sigma < 0")
        cscore <- lhood$grad.tnorm(new)

        if(((abs(lhood$ll.tnorm2(cur)- lhood$ll.tnorm2(new))/(lhood$ll.tnorm2(cur))) < tol))
            return(list(estimate = new, value= lhood$ll.tnorm2(new), iter = i))
        cur <- new
    }

    return(list(estimate = new, value= lhood$ll.tnorm2(new), iter = i))
}

#' Based on the MLE Functions (mklhood) and NewtonRaphson Function
#'
#' (NewtonRaphsonLike), This function estimates the MEAN and SD from the Truncated using Newton Raphson.
#'
#' @param missingdata matrix
#' @param perc perc
#' @param iter iterations in NR algorithm
#'
#' @export
#'

EstimatesComputation <- function(missingdata, perc, iter=50) {

    ## 2 column matrix where column 1 = means, column 2 = SD
    ParamEstim <- matrix(NA, nrow = nrow(missingdata), ncol = 2)
    nsamp <- ncol(missingdata)

    ## sample means / SDs
    ParamEstim[,1] <- rowMeans(missingdata, na.rm = TRUE)
    ParamEstim[,2] <- apply(missingdata, 1, function(x) sd(x, na.rm = TRUE))

    ## Case 1: missing % > perc => use sample mean / SD
    na.sum <- apply(missingdata, 1, function(x) sum(is.na(x)))
    idx1 <- which(na.sum/nsamp >= perc)

    ## Case 2: sample mean > 3 SD away from LOD => use sample mean / SD
    lod <- min(missingdata, na.rm=TRUE) ## why use the min of whole data set??????
    idx2 <- which(ParamEstim[,1] > 3*ParamEstim[,2] + lod)

    ## Case 3: for all others, use NR method to obtain truncated mean / SD estimate
    idx.nr <- setdiff(1:nrow(missingdata), c(idx1, idx2))
    ## t = limits of integration (LOD and upper)
    upplim <- max(missingdata, na.rm=TRUE) + 2*max(ParamEstim[,2])
    for (i in idx.nr) {
        Likelihood <- mklhood(missingdata[i,], t=c(lod, upplim))
        res <- tryCatch(NewtonRaphsonLike(Likelihood, p = ParamEstim[i,]),
                        error = function(e) 1000)

        if (length(res) == 1) {
            next
        } else if (res$iter >= iter) {
            next
        } else {
            ParamEstim[i,] <- as.numeric(res$estimate)
        }
    }
    return(ParamEstim)
}

#' This Function imputes the data BASED on KNN-EUCLIDEAN
#'
#' @param data data set to be imputed
#' @param k number of neighbors for imputing values
#' @param rm.na remove NA
#' @param rm.nan remove NaN
#' @param rm.inf remove Inf
#'
#' @export
#'
KNNEuc <- function (data, k, rm.na = TRUE, rm.nan = TRUE, rm.inf = TRUE) {

    nr <- dim(data)[1]

    imp.knn <- data
    imp.knn[is.finite(data) == FALSE] <- NA
    t.data<-t(data)

    mv.ind <- which(is.na(imp.knn), arr.ind = TRUE)
    arrays <- unique(mv.ind[, 2])
    array.ind <- match(arrays, mv.ind[, 2])
    nfeatures <- 1:nr

    for (i in 1:length(arrays)) {
        set <- array.ind[i]:min((array.ind[(i + 1)] - 1), dim(mv.ind)[1], na.rm = TRUE)
        cand.features <- nfeatures[-unique(mv.ind[set, 1])]
        cand.vectors <- t.data[,cand.features]
        exp.num <- arrays[i]

        for (j in set) {
            feature.num <- mv.ind[j, 1]
            tar.vector <- data[feature.num,]

            dist <- sqrt(colMeans((tar.vector-cand.vectors)^2, na.rm = TRUE))
            dist[is.nan(dist) | is.na(dist)] <- Inf
            dist[dist==0] <- ifelse(is.finite(min(dist[dist>0])), min(dist[dist>0])/2, 1)

            if (sum(is.finite(dist)) < k) {
                stop(message = "Fewer than K finite distances found")
            }
            k.features.ind <- order(dist)[1:k]
            k.features <- cand.features[k.features.ind]
            wghts <- 1/dist[k.features.ind]/sum(1/dist[k.features.ind])
            imp.knn[feature.num, exp.num] <- wghts %*% data[k.features, exp.num]
        }
    }

    if (!rm.na) {
        imp.knn[is.na(data) == TRUE & is.nan(data) == FALSE] <- NA
    }
    if (!rm.inf) {
        index <- is.finite(data) == FALSE & is.na(data) == FALSE &
            is.nan(data) == FALSE
        imp.knn[index] <- data[index]
    }
    if (!rm.nan) {
        imp.knn[is.nan(data) == TRUE] <- NaN
    }
    return(imp.knn)
}

#' imputeKNN
#'
#' This Function imputes the data based on KNN-CORRELATION or
#' KNN-TRUNCATION. The Parameter Estimates based on the Truncated
#' Normal from EstimateComputation function is run on this function
#'
#' @param data data
#' @param k k
#' @param distance distance
#' @param rm.na remove NA
#' @param rm.nan remove NaN
#' @param rm.inf remove Inf
#' @param perc percentage
#' @param ... additional options
#'
#' @export
#'

imputeKNN <- function (data, k , distance = "correlation",
                       rm.na = TRUE, rm.nan = TRUE, rm.inf = TRUE, perc=1,...) {

    if (!(is.matrix(data))) {
        stop(message = paste(deparse(substitute(data)),
                             " is not a matrix.", sep = ""))
    }

    distance <- match.arg(distance, c("correlation","truncation"))

    nr <- dim(data)[1]
    if (k < 1 | k > nr) {
        stop(message = "k should be between 1 and the number of rows")
    }

    if (distance=="correlation"){
        genemeans<-rowMeans(data,na.rm=TRUE)
        genesd<-apply(data, 1, function(x) sd(x, na.rm = TRUE))
        data<-(data-genemeans)/genesd
    }

    if (distance=="truncation"){

	ParamMat <- EstimatesComputation(data, perc = perc)

    	genemeans<-ParamMat[,1]
        genesd<-ParamMat[,2]
        data<-(data-genemeans)/genesd
    }

    imp.knn <- data
    imp.knn[is.finite(data) == FALSE] <- NA
    t.data<-t(data)

    mv.ind <- which(is.na(imp.knn), arr.ind = TRUE)
    arrays <- unique(mv.ind[, 2])
    array.ind <- match(arrays, mv.ind[, 2])
    ngenes <- 1:nr

    for (i in 1:length(arrays)) {
        set <- array.ind[i]:min((array.ind[(i + 1)] - 1), dim(mv.ind)[1],
                                na.rm = TRUE)
        cand.genes <- ngenes[-unique(mv.ind[set, 1])]
        cand.vectors <- t.data[,cand.genes]
        exp.num<- arrays[i]
        for (j in set) {

            gene.num <- mv.ind[j, 1]
            tar.vector <- data[gene.num,]

            r <- (cor(cand.vectors,tar.vector, use = "pairwise.complete.obs"))
            dist <- switch(distance,
                           correlation = (1 - abs(r)),
                           truncation = (1 - abs(r)))
            dist[is.nan(dist) | is.na(dist)] <- Inf
            dist[dist==0]<-ifelse(is.finite(min(dist[dist>0])), min(dist[dist>0])/2, 1)
            dist[abs(r) == 1] <- Inf

            if (sum(is.finite(dist)) < k) {
                stop(message = "Fewer than K finite distances found")
            }
            k.genes.ind <- order(dist)[1:k]
            k.genes <- cand.genes[k.genes.ind]

            wghts <- (1/dist[k.genes.ind]/sum(1/dist[k.genes.ind])) * sign(r[k.genes.ind])
            imp.knn[gene.num, exp.num] <- wghts %*% data[k.genes, exp.num]
        }
    }

    if (distance=="correlation") {
        imp.knn <- (imp.knn * genesd) + genemeans
    }

    if(distance=="truncation") {
        imp.knn <- (imp.knn * genesd) + genemeans
    }

    if (!rm.na) {
        imp.knn[is.na(data) == TRUE & is.nan(data) == FALSE] <- NA
    }
    if (!rm.inf) {
        index <- is.finite(data) == FALSE & is.na(data) == FALSE &
            is.nan(data) == FALSE
        imp.knn[index] <- data[index]
    }
    if (!rm.nan) {
        imp.knn[is.nan(data) == TRUE] <- NaN
    }
    return(imp.knn)
}

#' Root Mean Squared Error Function
#'
#' @param imp imputation
#' @param mis missing
#' @param true true data
#' @param norm normal
#'
#' @export
#'
Rmse <- function(imp, mis, true, norm = FALSE) {
    imp <- as.matrix(imp)
    mis <- as.matrix(mis)
    true <- as.matrix(true)
    missIndex <- which(is.na(mis))
    errvec <- imp[missIndex] - true[missIndex]
    rmse <- sqrt(mean(errvec^2))
    if (norm) {
        rmse <- rmse/sd(true[missIndex])
    }
    return(rmse)
}

#' Compute the Errors for the Different Imputation Methods
#'
#' @param trunc truncation
#' @param corr corr
#' @param euc euc
#' @param miss missing
#' @param complete complete
#'
#' @export
#'

ErrorsComputation <- function(trunc, corr, euc, miss, complete) {

    ImputeErrors <- NULL
    missing <- t(miss)
    original <- t(complete)
    KnnTrunc <- Rmse(trunc, missing, original)
    KnnCorr <- Rmse(corr, missing, original)
    KnnEuc <- Rmse(euc, missing, original)
    ImputeErrors <- c(KnnTrunc, KnnCorr, KnnEuc)
    return(ImputeErrors)

}


calc <- function(x) {
    cat("Trung binh: ", mean(x), "\n")
    cat("Phuong sai: ", var(x), "\n")
    cat("Trung vi: ", median(x), "\n")
}

draw <- function(x) {
    x11()
    par(mfrow = c(2, 1))
    plot(x, type = "l")  # l is line
    boxplot(x)
}

data1 <- read.csv("../../data/data01.csv")
# Tinh toan
cat("FPSA: ", "\n")
calc(data1$FPSA)
cat("TPSA: ", "\n")
calc(data1$TPSA)
# Ve
draw(data1$FPSA)
draw(data1$TPSA)
# Tach
k0 = data1$FPSA[data1$K == 0]
k1 = data1$FPSA[data1$K == 1]
# Merge
data2 <- read.csv("../../data/data02.csv")
datmerge <- merge(data1, data2, by = "K")
# New var
tPSA <- c()
for (i in 1:nrow(data1)) {
    if (data1$Age[i] <= 30) {
        tPSA <- c(tPSA, 0)
    } else if (data1$Age[i] <= 50) {
        tPSA <- c(tPSA, 1)
    } else {
        tPSA <- c(tPSA, 2)
    }
}
print(table(tPSA))


library(ggplot2)
library(latex2exp)
library(reshape2)

plot_calibration_map <- function(scores_set, info, legend_set, color_set, alpha=1){
  n_lines <- length(legend_set)
  sizes <- seq(1.5, 0.5, length.out = n_lines)
  bins <- seq(0, 1, length.out = 11)
  hist_tot <- hist(info$prob, breaks=bins, plot = FALSE)
  hist_pos <- hist(info$prob[info$labels == 1], breaks=bins, plot = FALSE)
  centers <- hist_tot$mids
  empirical <- (hist_pos$counts+alpha) / (hist_tot$counts+2*alpha)

  pdata <- melt(scores_set, id="linspace")
  i <- 1
  g <- ggplot(pdata, aes(x=linspace, y=value, colour=variable))
  for (legend in legend_set){
    g <- g + geom_line(size=sizes[i])
    i <- i + 1
  }

  df <- data.frame(centers, empirical)
  d <- melt(df, id="centers")
  g <- g + geom_point(data=d, aes(x=centers, y=value, colour=variable))

  g <- g + scale_colour_manual(values=c(color_set,'black'))
  g <- g + labs(x=TeX("$s$"),y=TeX("$\\hat{p}$"), title="Calibration map")
  g <- g + theme(plot.title = element_text(hjust = 0.5))
  g <- g + guides(colour = guide_legend("Method"))
  print(g)
}


pascalTriangle <- function(h) {
  lapply(0:h, function(i) choose(i, 0:i))
}


setwd("~/Projetos/Projetos_Python/tcc/extratores")

library(readr)
library(moments)
library(ggplot2)
library(ggpubr)
library(corrplot)
library(ggthemes)
library(dplyr)

dt = read_csv("data-mining.csv")

View(dt)

moda = function(data) {
  vec = table(as.vector(data))
  names(vec)[vec == max(vec)]
}

#### Analise individual da VARIAVEL BITCOIN - Expressão  "Bitcoin" Google Trends
####

x = dt$value

# Média, Mediana, Moda e Amplitude
mean(x)
median(x)
moda(x)
max(x)
min(x)
range(x)
diff(range(x))

# Quartil
quantile(x)

#Desvio Padrão
sd(x)

# Variância
var(x)

# Coeficiente de Variação
coef = (sd(x) / mean(x)) * 100
coef

# Histograma para analisar a distribuição dos dados
hist(x, main="Bitcon Google Trend Topic", xlab="Bitcoin score", breaks=10)

# Coeficiente de assimetria
skewness(x)

#Coeficiente de curtose
kurtosis(x)

# Histograma
df = data.frame(x)
ggplot(df, aes(x = x), binwidth = 2) +
  geom_histogram(aes(y = ..density..), fill = 'red', alpha = 0.5, binwidth = 7) +
  geom_density(colour = 'blue') + xlab(expression(bold('Dados'))) +
  ylab(expression(bold('Densidade')))

# Boxplot
boxplot(x)

# Distribuição normal
rnorm(x)
hist(rnorm(x))

plot(x, rnorm(x), type="p")

### Correlação entre variáveis Trends: Bitcoin e Bitcoin Price
x = dt$bitcoin
y = dt$bitcoinPrice

# Coeficiente de Correlação
ggscatter(dt, x = "bitcoin", y = "bitcoinPrice",
          add = "reg.line", conf.int = TRUE,
          cor.coef = TRUE, cor.method = "pearson",
          xlab = "Bitcoin Trends", ylab = "Bitcoin Price Trends")

# Covariância
cov(x,y)

# Correlação
cor(x,y)

### Correlação entre variáveis: Bitcoin(Trends) e value
x = dt$bitcoin
y = dt$value

# Coeficiente de Correlação
ggscatter(dt, x = "bitcoin", y = "value",
          add = "reg.line", conf.int = TRUE,
          cor.coef = TRUE, cor.method = "pearson",
          xlab = "Bitcoin Trends", ylab = "Value")

# Covariância
cov(x,y)

# Correlação
cor(x,y)

#### ANALISANDO CORRELAÇÕES DO PREÇO
### Correlação entre variáveis: VALUE E BITCOIN
x = dt$value
y = dt$bitcoin

# Coeficiente de Correlação
ggscatter(dt, x = "value", y = "bitcoin",
          add = "reg.line", conf.int = TRUE,
          cor.coef = TRUE, cor.method = "pearson",
          xlab = "Bitcoin Trends", ylab = "Value")

# Covariância
cov(x,y)

# Correlação
cor(x,y)

### Correlação entre variáveis: VALUE E UNIQUE
x = dt$value
y = dt$unique

# Coeficiente de Correlação
ggscatter(dt, x = "value", y = "unique",
          add = "reg.line", conf.int = TRUE,
          cor.coef = TRUE, cor.method = "pearson",
          xlab = "Bitcoin Trends", ylab = "Bitcoin Price Trends")

# Covariância
cov(x,y)

# Correlação
cor(x,y)

### Correlação entre variáveis: VALUE E REVENUE
x = dt$value
y = dt$revenue

# Coeficiente de Correlação
ggscatter(dt, x = "value", y = "revenue",
          add = "reg.line", conf.int = TRUE,
          cor.coef = TRUE, cor.method = "pearson",
          xlab = "Bitcoin Trends", ylab = "Bitcoin Price Trends")

# Covariância
cov(x,y)

# Correlação
cor(x,y)

## ANALISE GERAL
# Obtendo apenas as colunas numéricas
colunas_numericas <- sapply(dt, is.numeric)
colunas_numericas

# Filtrando as colunas numéricas para correlação
data_cor <- cor(dt[,colunas_numericas])
data_cor
corrplot(data_cor, method = 'color')

### ANALISANDO A VARIACAO
?plot
plot(dt$value, type='l')
lines(dt$bitcoin,  type='l', col='red')

# Correlação dos dados


# PCA_EXAMPLE.R
#
# Program to load in data matrix, calculate principal
# components and plot resulting scores.

rm(list=ls())			# clear workspace

source("rangescale.r")	# define our rangescale function

# load data matrix from file
X <- read.table("http://www.bixsolutions.net/profiles.csv", sep=",", header=TRUE)

Xscaled = rangescale(X)	# scale the profiles

result = prcomp(t(Xscaled), center=FALSE) # perform PCA on transpose

# extract the scores matrix from the result
scores=result$x

# plot PC1 against PC2
plot(scores[,1], scores[,2], xlab="PC1",ylab="PC2")

# add labels to points (note 0.005,0.003 offset to avoid obscuring points)
text(scores[,1]+0.005, scores[,2]+0.003, names(X))


library(ggplot2)
library(dplyr)
options(na.action = "na.exclude")

# Helper functions ----------------------------------------------------------
deseas <- function(var, month) {
  resid(lm(var ~ factor(month))) + mean(var, na.rm = TRUE)
}

# Explore multiple cities ----------------------------------------------------
tx <- read.csv("../data/tx-house-sales.csv")

# We know from our exploration of Houston data that many of the series
# have strong seasonal components.  It's a good idea to check that's true for
# all cities.  We'll start with sales.
qplot(date, sales, data = tx, geom = "line", group = city)

# Hmmmm.  Problem!  There's a large variation in the number of sales between
# cities.  The seasonal pattern does look pretty constant though.

# First possible solution, just remove the seasonal effect as we did for a
# single city, but applied to multiple cities (using model as a tool)
tx_city <- tx %>% group_by(city)

tx = tx_city %>% mutate(sales_ds = deseas(sales, month))

qplot(date, sales_ds, data = tx, geom = "line", group = city)

# It works, but we don't gain much insight into what's going on.
# Let's fit the models, and actually look at them this time
models = tx %>% group_by(city) %>% do(model=lm(sales ~ factor(month), data=.))

models[[1, 'model']]

coef(models[[1, 'model']])

# To extract the coefficients, we want to go from a list to data frame
# Notice how plyr remembers the city names that we originally broke the
# models up by.
(models %>% group_by(city) %>% do(data.frame(t(coef(.[[1, 'model']])), check.names=FALSE)))[1:5, 1:3]

# Two problems with the model:
#   * Coefficients aren't comparable, because of varying sizes
#     Solution: log-transform to convert to ratios
#   * Coefficients not in useful form for plotting
#     Solution: create data frame ourselves
qplot(date, log10(sales), data = tx, geom = "line", group = city)

models2 <- tx_city %>% do(model=lm(log10(sales) ~ factor(month), data = .))

coef2 <- models2 %>% group_by(city) %>% do((function(row) {
  mod = row[['model']][[1]]
  data.frame(
    month = 1:12,
    effect = c(0, coef(mod)[-1]),
    intercept = coef(mod)[1])
})(.))

# Pretty consistent pattern, although there are few outliers
qplot(month, effect, data = coef2, group = city, geom = "line")
# More interpretable if we back-transform - can now interpret as ratios
qplot(month, 10 ^ effect, data = coef2, group = city, geom = "line")
# What are the outliers?
qplot(month, 10 ^ effect, data = coef2, geom = "line") + facet_wrap(~ city)
# They are small cities. Hmmmmm

# Have a look at the distributions
qplot(effect, data = coef2, binwidth = 0.05) + facet_wrap(~ month)

# Single model ----------------------------------------------------

mod <- lm(log10(sales) ~ city + factor(month), data = tx)

tx$sales2 <- 10 ^ resid(mod)
qplot(date, sales2, data = tx, geom = "line", group = city)
# Now we're starting to get somewhere!  Can see general pattern, although
# there are a few outliers.  Look at cities individually to identify:
last_plot() + facet_wrap(~ city)
# Some problem cities:
#   * Bryan-College station: has different seasonal pattern (Texas A&M?)
#   * Similarly with San Marcos (a lot of missing data)
#   * Palestine: massive increase beginning 2007

# Can resolve seasonal problems by fitting separate seasonal pattern to each
# city (Challenge: how is this different to the indivudal models we fit
# before?)  But probably better to use more sophisticated model (e.g. mixed
# effects) model.
mod2 <- lm(log10(sales) ~ city:factor(month), data = tx)
tx$sales3 <- 10 ^ resid(mod2)
qplot(date, sales3, data = tx, geom = "line") + facet_wrap(~ city)

# Further exploration
qplot(date, sales2, data = tx, geom = "line", group = city, alpha = I(0.2))
last_plot() + geom_smooth(aes(group = 1))

# Could smooth individual cities - again just using model as a tool
library(mgcv)
smooth <- function(var, date) {
  predict(gam(var ~ s(date)))
}
tx <- tx %>% group_by(city) %>% mutate(sales2_sm = as.vector(smooth(sales2, date)))

qplot(date, sales2_sm, data = tx, geom = "line", group = city)

# Another approach -----------------------------------------------------------

# Essence of most cities is seasonal term plus long term smooth trend.  We
# could fit this model to each city, and then look for model which don't
# fit well.

library(splines)
models3 <- tx %>% group_by(city) %>% do(model=lm(log10(sales) ~ factor(month) + ns(date, 3), data = .))

# Extract rsquared from each model
rsq <- function(mod) c(rsq = summary(mod[[1]])$r.squared)
quality <- models3 %>% group_by(city) %>% summarise(rsq=rsq(model))
qplot(rsq, city, data = quality)

qplot(rsq, reorder(city, rsq), data = quality)

quality$poor <- quality$rsq < 0.7
tx2 <- inner_join(tx, quality, by = "city")

# The cities don't look particularly differnet
qplot(date, log10(sales), data = tx2, geom = "line", colour = poor) +
  facet_wrap(~ city) + opts(legend.position = "none")

# But we should probably look at the residuals & predictions
mfit <- models3 %>% do((function(mod) {
  data.frame(resid = resid(mod$model), pred = predict(mod$model))
})(.))

tx2 <- cbind(tx2, mfit)
qplot(date, pred, data = tx2, geom = "line", colour = poor) +
  facet_wrap(~ city) + opts(legend.position = "none")
qplot(date, resid, data = tx2, geom = "line", colour = poor) +
  facet_wrap(~ city) + opts(legend.position = "none")


nxt <- function(d, mu=0., sigma=1.) {
  n <- length(d$x)
  d$x <- d$x + rnorm(n,mu,sigma)
  d$y <- d$y + rnorm(n,mu,sigma)
  return(d)
}

nxt.unif <- function(d, mu=0., sigma=1.) {
  n <- length(d$x)
  limit <- sqrt(3)*sigma
  d$x <- d$x + runif(n,mu-limit,mu+limit)
  d$y <- d$y + runif(n,mu-limit,mu+limit)
  return(d)
}

plot.snap <- function(d, i, prefix, edge=10.0) {
  png(sprintf("%s_%5.5d.png", prefix, i), width=760, height=760)
  plot(d$x, d$y, xlim=c(-edge/2.,edge/2.), ylim=c(-edge/2.,edge/2.), main="", xlab="", ylab="", cex=0.2, col="grey")
  dev.off()
}

plot.snap <- function(d, i, prefix, edge=10.0) {
  png(sprintf("%s_%5.5d.png", prefix, i), width=760, height=760)
  plot(d$x, d$y, xlim=c(-edge/2.,edge/2.), ylim=c(-edge/2.,edge/2.), main="", xlab="", ylab="", cex=0.2, col="grey")
  dev.off()
}

snaps <- function(n, n.iter, prefix, mu=0.0, sigma=1.0, edge=10.0) {
  std.x <- numeric(n.iter)
  std.y <- numeric(n.iter)
  d <- data.frame(x=numeric(n), y=numeric(n))
  for(i in 1:n.iter) {
    plot.snap(d, i, prefix, edge)
    d <- nxt(d, mu, sigma)
    std.x[i] <- sd(d$x)
    std.y[i] <- sd(d$y)
    print(sprintf("Iteration %d made", i))
  }
  return(list(data=d,std.x=std.x,std.y=std.y))
}

snaps.unif <- function(n, n.iter, prefix, mu=0.0, sigma=1.0, edge=10.0) {
  std.x <- numeric(n.iter)
  std.y <- numeric(n.iter)
  d <- data.frame(x=numeric(n), y=numeric(n))
  for(i in 1:n.iter) {
    plot.snap(d, i, prefix, edge)
    d <- nxt.unif(d, mu, sigma)
    std.x[i] <- sd(d$x)
    std.y[i] <- sd(d$y)
    print(sprintf("Iteration %d made", i))
  }
  return(list(data=d,std.x=std.x,std.y=std.y))
}

process.normal <- function(n.part=3000, n.snaps=900) {
  par(mfrow=c(1,1))
  l<-snaps(n.part, n.snaps, "normal/snap", 0.0, 0.03, 10)
  d <- l$data
  png(file="normal/marginal.png", width=760*2, height=760)
  par(mfrow=c(1,2))
  hist(d$x, main="", xlab="x", ylab="Densità", prob=TRUE, col="pink")
  lines(density(d$x),lw=2,col="red")
  mu <- mean(d$x)
  s  <- sd(d$x)
  x.min <- -10.0/2
  x.max <-  10.0/2
  x <- seq(from=x.min,to=x.max,by=10/100)
  lines(x, dnorm(x,mu,s), col="black", lw=2)
  rug(jitter(d$x))
  hist(d$y, main="", xlab="y", ylab="Densità", prob=TRUE, col="pink")
  lines(density(d$y),lw=2,col="red")
  mu <- mean(d$y)
  s  <- sd(d$y)
  y.min <- -10.0/2
  y.max <-  10.0/2
  y <- seq(from=y.min,to=y.max,by=10/100)
  lines(y, dnorm(y,mu,s), col="black", lw=2)
  rug(jitter(d$y))
  par(mfrow=c(1,1))
  dev.off()
  png(file="normal/devstd.png", height=720, width=720)
  par(mfrow=c(2,1))
  plot((1:n.snaps)/30, l$std.x, type="l", xlab="Tempo (s)", ylab="Dev.std. asse X (m)", col="red")
  plot((1:n.snaps)/30, l$std.y, type="l", xlab="Tempo (s)", ylab="Dev.std. asse Y (m)", col="red")
  par(mfrow=c(1,1))
  dev.off()
}

process.unif <- function(n.part=3000, n.snaps=900) {
  par(mfrow=c(1,1))
  l<-snaps.unif(n.part, n.snaps, "uniform/snap", 0.0, 0.03, 10)
  d <- l$data
  png(file="uniform/marginal.png", width=760*2, height=760)
  par(mfrow=c(1,2))
  hist(d$x, main="", xlab="x", ylab="Densità", prob=TRUE, col="pink")
  lines(density(d$x),lw=2,col="red")
  mu <- mean(d$x)
  s  <- sd(d$x)
  x.min <- -10.0/2
  x.max <-  10.0/2
  x <- seq(from=x.min,to=x.max,by=10/100)
  lines(x, dnorm(x,mu,s), col="black", lw=2)
  rug(jitter(d$x))
  hist(d$y, main="", xlab="y", ylab="Densità", prob=TRUE, col="pink")
  lines(density(d$y),lw=2,col="red")
  mu <- mean(d$y)
  s  <- sd(d$y)
  y.min <- -10.0/2
  y.max <-  10.0/2
  y <- seq(from=y.min,to=y.max,by=10/100)
  lines(y, dnorm(y,mu,s), col="black", lw=2)
  rug(jitter(d$y))
  par(mfrow=c(1,1))
  dev.off()
  png(file="uniform/devstd.png", height=720, width=720)
  par(mfrow=c(2,1))
  plot((1:n.snaps)/30, l$std.x, type="l", xlab="Tempo (s)", ylab="Dev.std. asse X (m)", col="red")
  plot((1:n.snaps)/30, l$std.y, type="l", xlab="Tempo (s)", ylab="Dev.std. asse Y (m)", col="red")
  par(mfrow=c(1,1))
  dev.off()
}


# Plots of Black-Scholes Model

source("black-scholes.r")

heat.persp <- function(t,s,v,expand=0.45,...) {
  nrz <- nrow(v)
  ncz <- ncol(v)
  nb.col <- 256
  color <- heat.colors(nb.col)
  facet <- - (v[-1, -1] + v[-1, -ncz] + v[-nrz, -1] + v[-nrz, -ncz])
  facetcol <- cut(facet, nb.col)

  persp(t,s,v,col=color[facetcol],expand=expand,...) -> res

  return(res)
}

the.lines <- function(t,s,v,res) {
  hs <- head(s,1)
  ts <- tail(s,1)
  ms <- 100
  ht <- head(t,1)
  tt <- tail(t,1)
  hv <- max(v,na.rm=TRUE)
  lv <- min(v,na.rm=TRUE)

  lines(trans3d(c(ht,ht,ht,tt,tt,tt),
                c(ms,ms,ms,ms,ms,ms),
                c(lv,hv,hv,hv,hv,lv),
                res),
        lty='dashed')

  text(trans3d(c(tt),
               c(ms),
               c(lv),
               res),
       labels=c("S=K"),
       pos=1,
       offset=.5)
}

S <- 100
K <- 100
N <- 10
r <- 0.10
tau <- 1
sigma <- 0.15

s <- sort(c(K-EPS/10,K+EPS/10,seq(0.5*K,1.5*K,length=31)))
t <- sort(c(EPS/10,seq(0,tau,length=31)))

opar <- par(mar=rep(0,4))

doit <- function(f, filename, name) {
  fn <- paste("images/", filename, sep="")
  png(file=fn,width=480,height=480)
  v <- outer(t,s,Vectorize(function(t, s) f(s,K,t,r,sigma)))
  heat.persp(t,s,v,
             zlab="",
             xlab="TTM",
             ylab="S",
             theta=108,
             phi=40,
             axes=FALSE) -> res
  the.lines(t,s,v,res)
  #title(name, line=0)
  dev.off()
  system(paste("convert -trim", fn, fn))
}

doit(bscall.value, "bscall-value.png", "Black-Scholes Call Value")
doit(bscall.delta, "bscall-delta.png", "Black-Scholes Call Delta")
doit(bscall.gamma, "bscall-gamma.png", "Black-Scholes Call Gamma")
doit(bscall.vega, "bscall-vega.png", "Black-Scholes Call Vega")
doit(bscall.rho, "bscall-rho.png", "Black-Scholes Call Rho")

par(opar)


# take input from the user
num = as.integer(readline(prompt="Enter a number: "))
# initialize sum
sum = 0
# find the sum of the cube of each digit
temp = num
while(temp > 0) {
digit = temp %% 10
sum = sum + (digit ^ 3)
temp = floor(temp / 10)
}
# display the result
if(num == sum) {
print(paste(num, "is an Armstrong number"))
} else {
print(paste(num, "is not an Armstrong number"))
}


fisheryatesknuthshuffle <- function(n)
{
   a <- seq_len(n)
   while(n >=2)
   {
      k <- sample.int(n, 1)
      if(k != n)
      {
         temp <- a[k]
         a[k] <- a[n]
         a[n] <- temp
      }
      n <- n - 1
   }
   a
}

#Example usage:
fisheryatesshuffle(6)                # e.g. 1 3 6 2 4 5
x <- c("foo", "bar", "baz", "quux")
x[fisheryatesknuthshuffle(4)]        # e.g. "bar"  "baz"  "quux" "foo"


# percentile of normal distribution using r
# we will use qnorm function
# 75th percentile of Normal distribution Mean = 530 and SD=205
mu=530
sigma=205
z_75percentile=0.67
y=mu+sigma*z_75percentile
print(y)
 print("  Thus , 25% of the tax returns in this classification exceed $667.35 in the amount owed the government.")


# For details of this cuts this file is demonstrating see http://arxiv.org/abs/1512.04644

# assumes theta bounds are +/- around 0, w.o.l.g.
# this allows us to easily take the projection through reference angle of theta = 0

animation_steps = 60

#theta_ub = 0.261799 # 15 degrees in radians
theta_ub = 0.5236 # 30 degrees in radians
vi_ub = 1.2
vi_lb = 0.8

vj_ub = 1.2
vj_lb = 0.8

vi_sigma = vi_ub+vi_lb
vj_sigma = vj_ub+vj_lb

wi_ub = vi_ub^2
wi_lb = vi_lb^2

wj_ub = vj_ub^2
wj_lb = vj_lb^2

vj_val = vj_lb
wj_val = vj_val^2

line_width = 3
receding_color = rgb(0.5,0.5,0.5)
lnc1_color = "darkorange1"
lnc2_color = "dodgerblue1"

file_name_prefix = "lnc"

vj_steps = seq(vj_lb, vj_ub, length.out=animation_steps)
#vj_steps = c((vj_lb+vj_ub)/2)
for (i in 1:length(vj_steps)) {

  vj_val = vj_steps[i]
  wj_val = vj_val^2

  pdf(paste("./pdfs/",file_name_prefix,"_",sprintf("%03d",i),".pdf",sep=""), pointsize=14, width=7, height=7, bg="white")
    x_lims = c(vi_lb*vj_lb*cos(theta_ub), vi_ub*vj_ub)
    y_lims = c(wi_lb, wi_ub)
    #print(x_lims)
    #print(y_lims)

    wi_steps = seq(wi_lb, wi_ub, length.out=30)

    plot(x_lims, y_lims,
      main="Lifted Nonlinear Cuts for AC Power Flow",
      sub=substitute(paste(w[i] %in% {}, "(", wil, ",", wiu,")  ", w[j] %in% {}, "(", wjl, ",", wju,")  ", theta %in% {}, "(", -tu, ",", tu, ")", sep=""), list(wil = wi_lb, wiu = wi_ub, wjl = wj_lb, wju = wj_ub, tu = theta_ub) ),
      xlab=expression({w^r}[ij]), ylab=expression(w[i]), type="n")

    # cut through theta=0
    points(sqrt(wi_steps*wj_val), wi_steps, type="l", lwd=line_width)

    # cut through the extreme value of theta, theta_ub
    points(sqrt(wi_steps*wj_val)*cos(theta_ub), wi_steps, type="l", lty=1, lwd=line_width, col=receding_color)

    # UB connecting line
    points(c(sqrt(wi_ub*wj_val)*cos(theta_ub), sqrt(wi_ub*wj_val)), c(wi_ub, wi_ub), type="l", lty=1, lwd=line_width, col=receding_color)

    # LB connecting line
    points(c(sqrt(wi_lb*wj_val)*cos(theta_ub), sqrt(wi_lb*wj_val)), c(wi_lb, wi_lb), type="l", lty=1, lwd=line_width, col=receding_color)

    # lnc 1
    # vj_ub*cos(theta_ub)*vj_sigma*w_i == vi_sigma*vj_sigma*wr_ij - vi_ub*cos(theta_ub)*vi_sigma*w_j - vi_ub*vj_ub*cos(theta_ub)*(vi_lb*vj_lb - vi_ub*vj_ub)
    lnc1_m = vi_sigma*vj_sigma/(vj_ub*cos(theta_ub)*vj_sigma)
    lnc1_b = (-vi_ub*vi_sigma*wj_val - vi_ub*vj_ub*(vi_lb*vj_lb - vi_ub*vj_ub))/(vj_ub*vj_sigma)
    abline(lnc1_b, lnc1_m, col=lnc1_color, lwd=line_width)

    # lnc 2
    # vj_lb*cos(theta_ub)*vj_sigma*w_i  == vi_sigma*vj_sigma*wr_ij - vi_lb*cos(theta_ub)*vi_sigma*w_j - vi_lb*vj_lb*cos(theta_ub)*(vi_ub*vj_ub - vi_lb*vj_lb)
    lnc2_m = vi_sigma*vj_sigma/(vj_lb*cos(theta_ub)*vj_sigma)
    lnc2_b = (-vi_lb*vi_sigma*wj_val - vi_lb*vj_lb*(vi_ub*vj_ub - vi_lb*vj_lb))/(vj_lb*vj_sigma)
    abline(lnc2_b, lnc2_m, col=lnc2_color, lwd=line_width)

    # documentation
    text( x_lims[1], y_lims[2]*0.97, pos=4, substitute(paste(w[j], " = ", wjv), list(wjv = sprintf("%.4f",wj_val))) ) #,     adj = c( 0, 1 ), col = "blue" )

    legend("bottomright", c("Surface", "Receding", "LNC 1", "LNC 2"), col = c("black", receding_color, lnc1_color, lnc2_color),
         lwd = c(line_width, line_width, line_width),
         merge = TRUE, bg="white")

  dev.off()
}


sorted_list = r('''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)
     qsort(vs)
     ''')


# Assignment: ASSIGNMENT 1
# Name: Pahmer, David
# Date: 2022-03-27

## Create a numeric vector with the values of 3, 2, 1 using the `c()` function
## Assign the value to a variable named `num_vector`
## Print the vector
num_vector <- c(3, 2, 1)
num_vector

## Create a character vector with the values of "three", "two", "one" "using the `c()` function
## Assign the value to a variable named `char_vector`
## Print the vector
char_vector <- c("three", "two","one")
char_vector

## Create a vector called `week1_sleep` representing how many hours slept each night of the week
## Use the values 6.1, 8.8, 7.7, 6.4, 6.2, 6.9, 6.6
week1_sleep <- c(6.1, 8.8, 7.7, 6.4, 6.2, 6.9, 6.6)

## Display the amount of sleep on Tuesday of week 1 by selecting the variable index
week1_sleep[3]

## Create a vector called `week1_sleep_weekdays`
## Assign the weekday values using indice slicing
week1_sleep_weekdays <- week1_sleep[2:6]

## Add the total hours slept in week one using the `sum` function
## Assign the value to variable `total_sleep_week1`
total_sleep_week1 <- sum(week1_sleep)

## Create a vector called `week2_sleep` representing how many hours slept each night of the week
## Use the values 7.1, 7.4, 7.9, 6.5, 8.1, 8.2, 8.9
week2_sleep <- c(7.1, 7.4, 7.9, 6.5, 8.1, 8.2, 8.9)

## Add the total hours slept in week two using the sum function
## Assign the value to variable `total_sleep_week2`
total_sleep_week2 <- sum(week2_sleep)

## Determine if the total sleep in week 1 is less than week 2 by using the < operator
total_sleep_week1 < total_sleep_week2

## Calculate the mean hours slept in week 1 using the `mean()` function
mean(week1_sleep)

## Create a vector called `days` containing the days of the week.
## Start with Sunday and end with Saturday
days <- c("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday")

## Assign the names of each day to `week1_sleep` and `week2_sleep` using the `names` function and `days` vector
names(week1_sleep) <- days
names(week2_sleep) <- days

## Display the amount of sleep on Tuesday of week 1 by selecting the variable name
week1_sleep["Tuesday"]

## Create vector called weekdays from the days vector
weekdays <- days[2:6]

## Create vector called weekends containing Sunday and Saturday
weekends <- c("Sunday","Saturday")

## Calculate the mean about sleep on weekdays for each week
## Assign the values to weekdays1_mean and weekdays2_mean
weekdays1_mean <- mean(week1_sleep[weekdays])
weekdays2_mean <- mean(week2_sleep[weekdays])

## Using the weekdays1_mean and weekdays2_mean variables,
## see if weekdays1_mean is greater than weekdays2_mean using the `>` operator
weekdays1_mean > weekdays2_mean

## Determine how many days in week 1 had over 8 hours of sleep using the `>` operator
week1_sleep > 8

## Create a matrix from the following three vectors
student01 <- c(100.0, 87.1)
student02 <- c(77.2, 88.9)
student03 <- c(66.3, 87.9)

students_combined <- c(student01, student02, student03)

grades <- matrix(students_combined, byrow = TRUE, nrow = 3)

## Add a new student row with `rbind()`
student04 <- c(95.2, 94.1)
grades <- rbind(grades, student04, deparse.level = 0)

## Add a new assignment column with `cbind()`
assignment04 <- c(92.1, 84.3, 75.1, 97.8)
grades <- cbind(grades, assignment04, deparse.level = 0)

## Add the following names to columns and rows using `rownames()` and `colnames()`
assignments <- c("Assignment 1", "Assignment 2", "Assignment 3")
students <- c("Florinda Baird", "Jinny Foss", "Lou Purvis", "Nola Maloney")

rownames(grades) <- students
colnames(grades) <- assignments

## Total points for each assignment using `colSums()`
colSums(grades)

## Total points for each student using `rowSums()`
rowSums(grades)

## Matrix with 10% and add it to grades
weighted_grades <- grades * 0.1 + grades

## Create a factor of book genres using the genres_vector
## Assign the factor vector to factor_genre_vector
genres_vector <- c("Fantasy", "Sci-Fi", "Sci-Fi", "Mystery", "Sci-Fi", "Fantasy")
factor_genre_vector <- factor(genres_vector)

## Use the `summary()` function to print a summary of `factor_genre_vector`
summary(factor_genre_vector)

## Create ordered factor of book recommendations using the recommendations_vector
## `no` is the lowest and `yes` is the highest
recommendations_vector <- c("neutral", "no", "no", "neutral", "yes")
factor_recommendations_vector <- factor(
  recommendations_vector,
  ordered = TRUE,
  levels = c("no", "neutral", "yes")
)

## Use the `summary()` function to print a summary of `factor_recommendations_vector`
summary(factor_recommendations_vector)

## Using the built-in `mtcars` dataset, view the first few rows using the `head()` function
head(mtcars, n=4L)

## Using the built-in mtcars dataset, view the last few rows using the `tail()` function
tail(mtcars)

## Create a dataframe called characters_df using the following information from LOTR
name <- c("Aragon", "Bilbo", "Frodo", "Galadriel", "Sam", "Gandalf", "Legolas", "Sauron", "Gollum")
race <- c("Men", "Hobbit", "Hobbit", "Elf", "Hobbit", "Maia", "Elf", "Maia", "Hobbit")
in_fellowship <- c(TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE)
ring_bearer <- c(FALSE, TRUE, TRUE, FALSE, TRUE, TRUE, FALSE, TRUE, TRUE)
age <- c(88, 129, 51, 7000, 36, 2019, 2931, 7052, 589)

characters_df <- data.frame(name, race, in_fellowship, ring_bearer, age)

## Sorting the characters_df by age using the order function and assign the result to the sorted_characters_df
sorted_characters_df <- characters_df[order(age),]
## Use `head()` to output the first few rows of `sorted_characters_df`
head(sorted_characters_df)

## Select all of the ring bearers from the dataframe and assign it to ringbearers_df
ringbearers_df <- characters_df[characters_df$ring_bearer == TRUE,]
## Use `head()` to output the first few rows of `ringbearers_df`
head(ringbearers_df)


############################################################
# For macaque paper, 09.20
# Just does some of the Chi-squared tests for gene counts.
# Gregg Thomas
############################################################

this.dir <- dirname(parent.frame(2)$ofile)
setwd(this.dir)

cat("----------\n\n")

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

cat("HUMAN AND MACAQUE GENE RATIOS BY CNV TYPE\n\n")
gene_ratios = matrix(c(1212,5483,226,1132), nrow=2, dimnames=list(c("macaque", "human"), c("del","dup")))
gene_ratio_chi = chisq.test(gene_ratios)
print(gene_ratio_chi)
cat("----------\n\n")
#
cat("HUMAN AND MACAQUE 10KB UPSTREAM RATIOS BY CNV TYPE\n\n")
up_ratios = matrix(c(469,3132,147,647), nrow=2, dimnames=list(c("macaque", "human"), c("del","dup")))
up_ratio_chi = chisq.test(up_ratios)
print(up_ratio_chi)
cat("----------\n\n")
#
cat("HUMAN AND MACAQUE 10KB DOWNSTREAM RATIOS BY CNV TYPE\n\n")
down_ratios = matrix(c(537,3174,149,693), nrow=2, dimnames=list(c("macaque", "human"), c("del","dup")))
down_ratio_chi = chisq.test(down_ratios)
print(down_ratio_chi)
cat("----------\n\n")
#
cat("HUMAN AND MACAQUE TRANSCRIPT RATIOS BY CNV TYPE\n\n")
transcript_ratios = matrix(c(2665,22246,476,4176), nrow=2, dimnames=list(c("macaque", "human"), c("del","dup")))
transcript_ratio_chi = chisq.test(transcript_ratios)
print(transcript_ratio_chi)
cat("----------\n\n")

cat("HUMAN AND MACAQUE EXON RATIOS BY CNV TYPE\n\n")
exon_ratios = matrix(c(936,7597,425,2587), nrow=2, dimnames=list(c("macaque", "human"), c("del","dup")))
exon_ratio_chi = chisq.test(exon_ratios)
print(exon_ratio_chi)
cat("----------\n\n")
# Numbers for these test come from adding full and partial events in TABLE 1
cat("----------\n\n")

cat("MACAQUE TOTAL CNVS BY TYPE TO CNVS OVERLAPPING EXONS BY TYPE\n\n")
mq_exon_ratio = matrix(c(432,90,3214,291), nrow=2, dimnames=list(c("total", "exon"), c("dup","del")))
mq_exon_chi = chisq.test(mq_exon_ratio)
print(mq_exon_chi)
cat("----------\n\n")
#
cat("HUMAN TOTAL CNVS BY TYPE TO CNVS OVERLAPPING EXONS BY TYPE\n\n")
hu_exon_ratio = matrix(c(1784,443,13745,2267), nrow=2, dimnames=list(c("total", "exon"), c("dup","del")))
hu_exon_chi = chisq.test(hu_exon_ratio)
print(hu_exon_chi)
cat("----------\n\n")
# Numbers for these test come from adding full and partial events in TABLE 2 and from cnv_counts.r


# Intro to Computational Finance with R

# Section 1 - Return Calculations

# Assign the URL to the CSV file
data_url <- "http://assets.datacamp.com/course/compfin/sbuxPrices.csv"

# Load the data frame using read.csv
sbux_df <- read.csv(data_url, header=TRUE, stringsAsFactors=FALSE)

# The sbux_df data frame is already loaded in your work space

# Check the structure of 'sbux_df'
str(sbux_df)

# Check the first and last part of 'sbux_df'
head(sbux_df)
tail(sbux_df)

# Get the class of the Date column of 'sbux_df'
class(sbux_df$Date)

# The sbux_df data frame is already loaded in your work space
closing_prices <- sbux_df['Adj.Close',drop=FALSE]

# The sbux_df data frame is already loaded in your work space

# Find indices associated with the dates 3/1/1994 and 3/1/1995
index_1 <- which(sbux_df$Date == '3/1/1994')
index_2 <- which(sbux_df$Date == '3/1/1995')

# Extract prices between 3/1/1994 and 3/1/1995
some_prices <- sbux_df[index_1:index_2, 'Adj.Close']

# The sbux_df data frame is already loaded in your work space

# Create a new data frame that contains the price data with the dates as the row names
sbux_prices_df <- sbux_df[, "Adj.Close", drop=FALSE]
rownames(sbux_prices_df) <- sbux_df$Date
head(sbux_prices_df)

# With Dates as rownames, you can subset directly on the dates.
# Find indices associated with the dates 3/1/1994 and 3/1/1995.
price_1 <- sbux_prices_df['3/1/1994', ];
price_2 <- sbux_prices_df['3/1/1995', ];

# Now add all relevant arguments to the plot function below to get a nicer plot
plot(sbux_df$Adj.Close, type='l', col='blue', lwd=2, ylab='Adjusted close', main='Monthly closing price of SBUX')
legend(x='topleft', legend='SBUX', lty=1, lwd=2, col='blue')

# The sbux_df data frame is already loaded in your work space
sbux_prices_df <- sbux_df[, "Adj.Close", drop=FALSE]

# Denote n the number of time periods
n <- nrow(sbux_prices_df)
sbux_ret <- (sbux_prices_df[2:n,1] - sbux_prices_df[1:(n-1),1]) / sbux_prices_df[1:(n-1),1]

# Notice that sbux_ret is not a data frame object
class(sbux_ret)# The sbux_df data frame is already loaded in your work space
sbux_prices_df <- sbux_df[, "Adj.Close", drop=FALSE]

# Denote n the number of time periods:
n <- nrow(sbux_prices_df)
sbux_ret <- ((sbux_prices_df[2:n, 1] - sbux_prices_df[1:(n-1), 1])/sbux_prices_df[1:(n-1), 1])

# Notice that sbux_ret is not a data frame object
class(sbux_ret)

# Now add dates as names to the vector and print the first elements of sbux_ret to the console to check
names(sbux_ret) <- sbux_df[2:n, 1]
head(sbux_ret)

# The sbux_df data frame is already loaded in your work space
sbux_prices_df <- sbux_df[, "Adj.Close", drop=FALSE]

# Denote n the number of time periods:
n <- nrow(sbux_prices_df)
sbux_ret <- ((sbux_prices_df[2:n, 1] - sbux_prices_df[1:(n-1), 1])/sbux_prices_df[1:(n-1), 1])

# Compute continuously compounded 1-month returns
sbux_ccret <- log(sbux_prices_df[2:n, 1]) - log(sbux_prices_df[1:(n-1), 1])

# Assign names to the continuously compounded 1-month returns
names(sbux_ccret) <- sbux_df[2:n,1]

# Show sbux_ccret
head(sbux_ccret)

# The sbux_df data frame is already loaded in your work space
sbux_prices_df <- sbux_df[, "Adj.Close", drop=FALSE]

# Denote n the number of time periods:
n <- nrow(sbux_prices_df)
sbux_ret <- ((sbux_prices_df[2:n, 1] - sbux_prices_df[1:(n-1), 1])/sbux_prices_df[1:(n-1), 1])

# Compute continuously compounded 1-month returns
sbux_ccret <- log(sbux_prices_df[2:n,1]) - log(sbux_prices_df[1:(n-1),1])
names(sbux_ccret) <- sbux_df[2:n,1]
head(sbux_ccret)

# Compare the simple and cc returns
head(cbind(sbux_ret, sbux_ccret))

# The simple returns (sbux_ret) and the continuously compounded returns (sbux_ccret) have been preloaded in your workspace

# Plot the returns on the same graph
plot(sbux_ret, type="l", col="blue", lwd=2, ylab="Return",
               main="Monthly Returns on SBUX")

# Add horizontal line at zero
abline(h=0)

# Add a legend
legend(x="bottomright", legend=c("Simple", "CC"),
       lty=1, lwd=2, col=c("blue","red"))

# Add the continuously compounded returns
lines(sbux_ccret, col='red', lwd=2)

# The simple returns (sbux_ret) and the continuously compounded returns (sbux_ccret) have been preloaded in your workspace

# Compute gross returns
sbux_gret <- sbux_ret + 1

# Compute future values
sbux_fv <-  cumprod(sbux_gret)

# Plot the evolution of the $1 invested in SBUX as a function of time
plot(sbux_fv, type="l", col="blue", lwd=2, ylab="Dollars",
     main="FV of $1 invested in SBUX")

# Section 2 Random Variables and Probabilities

# X ~ N(0.05, (0.10)^2)
mu_x <- 0.05
sigma_x <- 0.10

# Pr(X > 0.10)
1 - pnorm(0.10, mean = mu_x, sd = sigma_x)

# Pr(X < -0.10)
pnorm(-0.10, mean = mu_x, sd = sigma_x)

# Pr(-0.05 < X < 0.15)
1 - pnorm(-0.05, mean = mu_x, sd = sigma_x) - pnorm(0.15, mean = mu_x, sd = sigma_x, lower.tail=FALSE)

# The mean (mu_x) and the standard deviation (sigma_x) are still in your workspace

# 1%, 5%, 95% and 99% quantile
qnorm(c(0.01, 0.05, 0.95, 0.99), mean = mu_x, sd = sigma_x)

# Normally distributed monthly returns
x_vals <- seq(-0.25, 0.35, length.out = 100)
MSFT <- dnorm(x_vals, mean = 0.05, sd = 0.1)
SBUX <- dnorm(x_vals, mean=0.025, sd=0.05)

# MSFT and x_vals are still in your workspace

# Normal curve for MSFT
plot(x_vals, MSFT, type='l', col='blue', ylab='Normal curves', ylim=c(0,8))

# MSFT, SBUX and x_vals are still in your workspace

# Normal curve for MSFT
plot(x_vals, MSFT, type = "l", col = "blue", ylab = "Normal curves",
     ylim = c(0, 8))

# Add a normal curve for SBUX
lines(x_vals, SBUX, col='red')

# Add a plot legend
legend("topleft", legend = c("Microsoft", "Starbucks"),
       col = c("blue", "red"), lty = 1)

# R ~ N(0.04, (0.09)^2)
mu_R <- 0.04
sigma_R <- 0.09

# Initial wealth W0 equals $100,000
W0 <- 100000

# The 1% value-at-risk
(1 + qnorm(0.01, mean = mu_R, sd = sigma_R)) * W0 - W0

# The 5% value-at-risk
(1 + qnorm(0.05, mean = mu_R, sd = sigma_R)) * W0 - W0

# r ~ N(0.04, (0.09)^2)
mu_r <- 0.04
sigma_r <- 0.09

# Initial wealth W0 equals $100,000
W0 <- 100000

# The 1% value-at-risk
(1 + (exp(qnorm(0.01, mean = mu_r, sd = sigma_r)) - 1)) * W0 - W0

# The 5% value-at-risk
(1 + (exp(qnorm(0.05, mean = mu_r, sd = sigma_r)) - 1)) * W0 - W0

# Vectors of prices
PA <- c(38.23, 41.29)
PC <- c(41.11, 41.74)

# Simple monthly returns
RA <- (PA[2] - PA[1]) / PA[1]
RC <- (PC[2] - PC[1]) / PC[1]

# The simple returns on Amazon (RA) and Costco (RC) are still in your workspace

# Continuously compounded returns
rA <- log(PA[2]) - log(PA[1])
rC <- log(PC[2]) - log(PC[1])

# The prices for Amazon (PA) are still in your workspace

# Cash dividend per share
DA <- 0.1

# Simple total return
RA_total <- ((PA[2] + DA) - PA[1])/PA[1]

# Dividend yield
DY <- DA / PA[1]

# The simple monthly return on Amazon (RA) is still in your workspace

# Simple annual return
RA_annual <- ((1 + RA)^12) - 1

# Continuously compounded annual return
rA_annual <- log(1 + RA_annual)

# The simple returns on Amazon (RA) and Costco (RC) are still in your workspace

# Portfolio shares
xA <- 8000/10000
xC <- 2000/10000

# Simple monthly return
xA * RA + xC * RC

# Section 3 Bivariate Distributions

# Standard deviations and correlation
sig_x <- 0.10
sig_y <- 0.05
rho_xy <- 0.9

# Covariance between X and Y
sig_xy <- rho_xy * sig_x * sig_y

# Covariance matrix
Sigma_xy <- matrix(c(sig_x^2, sig_xy, sig_xy, sig_y^2), nrow=2, ncol=2, byrow=TRUE)

# Load the mvtnorm package
library("mvtnorm")

# The covariance matrix (Sigma_xy) is still in your workspace

# Means
mu_x <- 0.05
mu_y <- 0.025

# Simulate 100 observations
set.seed(123)  # for reproducibility
xy_vals <- rmvnorm(100, mean = c(mu_x, mu_y), sigma=Sigma_xy)

# Have a look at the first observations
head(xy_vals)

# The simulated values (xy_vals) are still in your workspace

# Create scatterplot
plot(xy_vals, pch=16, cex=2, col='blue', main='Bivariate normal: rho=0.9', xlab='x', ylab='y')

# Simulated values (xy_vals) and means (mu_x, mu_y) are still in your workspace

# create scatterplot
plot(xy_vals[, 1], xy_vals[, 2], pch = 16, cex = 2, col = "blue",
     main = "Bivariate normal: rho=0.9", xlab = "x", ylab = "y")

# Add lines
abline(v=mu_x, h=mu_y)

# Means (mu_x, mu_y) and covariance matrix (Sigma_xy) are still in your workspace

# create scatterplot
plot(xy_vals[, 1], xy_vals[, 2], pch = 16, cex = 2, col = "blue",
     main = "Bivariate normal: rho=0.9", xlab = "x", ylab = "y")

# Add lines
abline(h = mu_y, v = mu_x)

# Add line segments
segments(x0 = 0, y0 = -1e10, x1 = 0, y1 = 0, col="red")
segments(x0 = -1e10, y0 = 0, x1 = 0, y1 = 0, col="red")

# Compute joint probability
pmvnorm(lower = c(-Inf, -Inf), upper = c(0, 0), mean = c(mu_x, mu_y), sigma = Sigma_xy)

# Standard deviations and correlation
sig_x <- 0.10
sig_y <- 0.05
rho_xy <- -0.9
# Covariance between X and Y
sig_xy <- rho_xy * sig_x * sig_y
# Covariance matrix
Sigma_xy <- matrix(c(sig_x^2, sig_xy, sig_xy, sig_y^2), nrow = 2, ncol = 2)

# Means
mu_x <- 0.05
mu_y <- 0.025
# Simulate 100 observations
set.seed(123)  # for reproducibility
xy_vals <- rmvnorm(100, mean=c(mu_x, mu_y), sigma = Sigma_xy)
head(xy_vals)

# Create scatterplot
plot(xy_vals[, 1], xy_vals[, 2], pch = 16, cex = 2, col = "blue",
     main = "Bivariate normal: rho=-0.9", xlab = "x", ylab = "y")
# Add lines
abline(h = mu_y, v = mu_x)
# Add line segments
segments(x0 = 0, y0 = -1e10, x1 = 0, y1 = 0, col="red")
segments(x0 = -1e10, y0 = 0, x1 = 0, y1 = 0, col="red")

# Compute joint probability
pmvnorm(lower = c(-Inf, -Inf), upper = c(0, 0),
        mean = c(mu_x, mu_y), sigma = Sigma_xy)

# Standard deviations and correlation
sig_x <- 0.10
sig_y <- 0.05
rho_xy <- 0
# Covariance between X and Y
sig_xy <- rho_xy * sig_x * sig_y
# Covariance matrix
Sigma_xy <- matrix(c(sig_x^2, sig_xy, sig_xy, sig_y^2), nrow = 2, ncol = 2)

# Means
mu_x <- 0.05
mu_y <- 0.025
# Simulate 100 observations
set.seed(123)  # for reproducibility
xy_vals <- rmvnorm(100, mean=c(mu_x, mu_y), sigma = Sigma_xy)
head(xy_vals)

# Create scatterplot
plot(xy_vals[, 1], xy_vals[, 2], pch = 16, cex = 2, col = "blue",
     main = "Bivariate normal: rho=0", xlab = "x", ylab = "y")
# Add lines
abline(h = mu_y, v = mu_x)
# Add line segments
segments(x0 = 0, y0 = -1e10, x1 = 0, y1 = 0, col="red")
segments(x0 = -1e10, y0 = 0, x1 = 0, y1 = 0, col="red")

# Compute joint probability
pmvnorm(lower = c(-Inf, -Inf), upper = c(0, 0),
        mean = c(mu_x, mu_y), sigma = Sigma_xy)

# Section 4 Simulating Time Series Data

set.seed(123);
# Simulate 250 observations from the described MA(1) model
ma1_sim <- 0.05 + arima.sim(model=list(ma=0.5), n=250, mean=0, sd=0.1)

set.seed(123);
# Simulate 250 observations from the described MA(1) model
ma1_sim <- arima.sim(model=list(ma=0.5), n=250, mean=0, sd=0.1) + 0.05;

# A line plot of the simulated observations
plot(ma1_sim, type='l', xlab='time', ylab='y(t)', main='MA(1) Process: mu=0.05, theta=0.5')
abline(h=0)

set.seed(123);
# Simulate 250 observations from the described MA(1) model
ma1_sim <- arima.sim(model=list(ma=0.5), n=250, mean=0, sd=0.1) + 0.05;
# Generate the theoretical ACF with upto lag 10
acf_ma1_model <- ARMAacf(ma=0.5, lag.max=10)

# Split plotting window in three rows
par(mfrow=c(3,1))

# First plot: The simulated observations
plot(ma1_sim, type="l",main="MA(1) Process: mu=0.05, theta=0.5",xlab="time",ylab="y(t)")
abline(h=0)

# Second plot: Theoretical ACF
plot(1:10, acf_ma1_model[2:11], type="h", col="blue",  ylab="ACF", main="theoretical ACF")

# Third plot: Sample ACF
# Assign to tmp the Sample ACF
tmp <- acf(ma1_sim, lag.max=10, main='Sample ACF')

# Reset graphical window to only one graph
par(mfrow=c(1,1))

set.seed(123);
# Simulate 250 observations from the described MA(1) model
ma1_sim <- arima.sim(model=list(ma=0.9), n=250, mean=0, sd=0.1) + 0.05;
# Generate the theoretical ACF with upto lag 10
acf_ma1_model <- ARMAacf(ma=0.9, lag.max=10)

# Split plotting window in three rows
par(mfrow=c(3,1))

# First plot: The simulated observations
plot(ma1_sim, type="l",main="MA(1) Process: mu=0.05, theta=0.9",xlab="time",ylab="y(t)")
abline(h=0)

# Second plot: Theoretical ACF
plot(1:10, acf_ma1_model[2:11], type="h", col="blue", main="theoretical ACF")

# Third plot: Sample ACF
tmp=acf(ma1_sim, lag.max=10, main="Sample ACF")

# Reset graphical window to only one graph
par(mfrow=c(1,1))

set.seed(123);
# Simulate 250 observations from the described AR(1) model
ar1_sim <- arima.sim(model=list(ar=0.5), n=250, mean=0, sd=0.1) + 0.05
# Generate the theoretical ACF with ten lags
acf_ar1_model <- ARMAacf(ar=0.5, lag.max=10)

# Split plotting window in three rows
par(mfrow=c(3,1))

# Generate the same three graphs as in the previous exercise
par(mfrow=c(3,1))

# First plot: The simulated observations
plot(ar1_sim, type="l", main="AR(1) Process: mu=0.05, phi=0.5",xlab="time",ylab="y(t)")
abline(h=0)

# Second plot: Theoretical AFC
plot(1:10, acf_ar1_model[2:11], type="h", col="blue", main="theoretical ACF")

# Third plot: Sample AFC
tmp <- acf(ar1_sim, lag.max=10., main='Sample ACF')

# Reset plotting window to default
par(mfrow=c(1,1));

# Section 5 - Analyzing Stock Returns

# Load relevant packages
library(PerformanceAnalytics);library(zoo);library(tseries);

# Get the monthly adjusted closing price data on VBLTX, FMAGX and SBUX from Yahoo! using the tseries function get.hist.quote(). Set the sample to Jan 1998 through Dec 2009.

# Get the adjusted closing prices from Yahoo!
VBLTX_prices <- get.hist.quote(instrument="vbltx", start="1998-01-01",end="2009-12-31", quote="AdjClose",provider="yahoo", origin="1970-01-01",compression="m", retclass="zoo", quiet=TRUE)

FMAGX_prices <- get.hist.quote(instrument="fmagx", start="1998-01-01",end="2009-12-31", quote="AdjClose",provider="yahoo", origin="1970-01-01",compression="m", retclass="zoo", quiet=TRUE)

SBUX_prices <- get.hist.quote(instrument="sbux", start="1998-01-01",end="2009-12-31", quote="AdjClose",provider="yahoo", origin="1970-01-01",compression="m", retclass="zoo", quiet=TRUE)

# Change the class of the time index to yearmon which is appropriate for monthly data
# index() and as.yearmon() are functions in the zoo package

index(VBLTX_prices) <- as.yearmon(index(VBLTX_prices))
index(FMAGX_prices) <- as.yearmon(index(FMAGX_prices))
index(SBUX_prices) <- as.yearmon(index(SBUX_prices))

# Inspect your data
start(VBLTX_prices)
end(VBLTX_prices)

# The variables VBLTX_prices, FMAGX_prices and SBUX_prices are preloaded in your workspace

# Create merged price data
all_prices = merge(VBLTX_prices, FMAGX_prices, SBUX_prices)
# Rename columns
colnames(all_prices) <- c("VBLTX", "FMAGX", "SBUX")

# Calculate cc returns as difference in log prices
all_returns = diff(log(all_prices))

# Look at the return data
start(all_returns)
end(all_returns)
colnames(all_returns)
head(all_returns)

# 'all_returns' is preloaded in your workspace.

# Plot returns after using the PerformanceAnalytics function chart.TimeSeries().
# This function creates a slightly nicer looking plot than plot.zoo()
chart.TimeSeries(all_returns, legend.loc="bottom", main=" ")

# The previous charts are a bit hard to read. The PerformanceAnalytics function
# chart.Bar makes it easier to compare the returns of different assets on the
# same plot
chart.Bar(all_returns, legend.loc="bottom", main=" ")

# Cumulative return plot - must use simple returns (!) and not cc returns for this
# Use PerformanceAnalytics function chart.CumReturns()
simple_returns <- diff(all_prices)/lag(all_prices, k=-1);
chart.CumReturns(simple_returns, wealth.index=TRUE, legend.loc='topleft', main='Future Value of $1 invested')

# Create matrix with returns
return_matrix <- coredata(all_returns);

# Generate four panel plots
par(mfrow=c(2,2))
hist(return_matrix[,"VBLTX"],main="VBLTX monthly returns",
     xlab="VBLTX", probability=T, col="slateblue1")
boxplot(return_matrix[,"VBLTX"],outchar=T, main="Boxplot", col="slateblue1")
plot(density(return_matrix[,"VBLTX"]),type="l", main="Smoothed density",
     xlab="monthly return", ylab="density estimate", col="slateblue1")
qqnorm(return_matrix[,"VBLTX"], col="slateblue1")
qqline(return_matrix[,"VBLTX"])
par(mfrow=c(1,1))

# Create matrix with returns
return_matrix <- coredata(all_returns);

# Show boxplot of three series on one plot
boxplot(return_matrix[,"VBLTX"], return_matrix[,"FMAGX"], return_matrix[,"SBUX"],
        names=colnames(return_matrix), col="slateblue1")

# Do the same thing using the PerformanceAnalytics function chart.Boxplot
chart.Boxplot(all_returns)

# Note: all_returns is preloaded in your workspace

# Create matrix with returns
return_matrix <- coredata(all_returns);

summary(return_matrix)

# Compute descriptive statistics by column using the base R function apply()
args(apply)
apply(return_matrix, 2, mean)
apply(return_matrix, 2, var)
apply(return_matrix, 2, sd)

apply(return_matrix, 2, skewness)
apply(return_matrix, 2, kurtosis)
# A nice PerformanceAnalytics function that computes all of the relevant descriptive statistics is table.Stats
table.Stats(all_returns)

# Note: return_matrix is preloaded in your workspace

# Annualized continuously compounded mean
12 * apply(return_matrix, 2, mean)
# Annualized simple mean
exp(12*apply(return_matrix, 2, mean)) - 1;

# Annualized standard deviation values
12^0.5 * apply(return_matrix, 2, sd)

# Note: return_matrix is preloaded in your workspace

# Display all possible pair-wise scatter plots
pairs(return_matrix, pch=16, col='slateblue1')

# Compute 3 x 3 covariance and correlation matrices
var(return_matrix)
cor(return_matrix)

# Section 6 Constant expected return model

VBLTX_prices <- get.hist.quote(instrument="vbltx", start="2005-09-01", end="2010-09-30", quote="AdjClose",provider="yahoo", origin="1970-01-01",compression="m", retclass="zoo", quiet = TRUE)
FMAGX_prices <- get.hist.quote(instrument="fmagx", start="2005-09-01", end="2010-09-30", quote="AdjClose",provider="yahoo", origin="1970-01-01",compression="m", retclass="zoo", quiet = TRUE)
SBUX_prices <- get.hist.quote(instrument="sbux", start="2005-09-01",end="2010-09-30", quote="AdjClose",provider="yahoo", origin="1970-01-01",compression="m", retclass="zoo", quiet = TRUE)

# Change the class of the time index to yearmon, which is appropriate for monthly data.
# index() and as.yearmon() are functions in the zoo package
index(VBLTX_prices) <- as.yearmon(index(VBLTX_prices))
index(FMAGX_prices) <- as.yearmon(index(FMAGX_prices))
index(SBUX_prices) <- as.yearmon(index(SBUX_prices))

# Create merged price data
all_prices <- merge(VBLTX_prices, FMAGX_prices, SBUX_prices)
# Rename columns
colnames(all_prices) <- c("VBLTX", "FMAGX", "SBUX")

# Calculate cc returns as difference in log prices
all_returns <- diff(log(all_prices))

# Create matrix with returns
return_matrix <- coredata(all_returns)

# The variable return_matrix is preloaded in your workspace

# Number of observations
n_obs <- nrow(return_matrix)

# Estimates of sigma2hat
sigma2hat_vals <- apply(return_matrix, 2, var)

# Standard Error of sigma2hat
se_sigma2hat <- sigma2hat_vals / sqrt(n_obs/2)

se_sigma2hat

# Calculate the correlation matrix
cor_matrix <- cor_matrix(return_matrix)

# Get the lower triangular part of that 'cor_matrix'
rhohat_vals <- c(cor_matrix[4],cor_matrix[7],cor_matrix[8])

# Set the names
names(rhohat_vals) <- c("VBLTX,FMAGX","VBLTX,SBUX","FMAGX,SBUX")

# Compute the estimated standard errors for correlation
se_rhohat <- (1 - rhohat_vals^2) / sqrt(nrow(return_matrix))

se_rhohat

# The "all_returns" zoo object is preloaded in your workspace
t.test(all_returns[,1])

# The "all_returns" zoo object is preloaded in your workspace

# Test the correlation between VBLTX,FMAGX
cor.test(all_returns[,1],all_returns[,2])

# The "all_returns" zoo object is preloaded in your workspace

# Test the normality of the returns of VBLTX
jarque.bera.test(all_returns[,1])

library("boot")
# Function for bootstrapping sample mean:
mean_boot <- function(x, idx) {
  ans <- mean(x[idx])
  ans
}
# Construct VBLTX_mean_boot:
VBLTX_mean_boot <- boot(return_matrix[, 'VBLTX'], statistic = mean_boot, 999)

# Print the class of VBLTX_mean_boot
class(VBLTX_mean_boot)

# Print VBLTX_mean_boot
VBLTX_mean_boot

# Plot bootstrap distribution and qq-plot against normal
plot(VBLTX_mean_boot)

# Section 7 - Intro to Portfolio Theory

# Load relevant packages
library("PerformanceAnalytics")
library("zoo")

# Load the data
ds_url <- "http://s3.amazonaws.com/assets.datacamp.com/course/compfin/lab8.RData"
load(url(ds_url))
# Explore the data set
head(returns_df)
tail(returns_df)

# The returns_df data is preloaded in your workspace

# Estimate the parameters: multivariate
mu_hat_annual <- apply(returns_df,2,mean)*12
sigma2_annual <- apply(returns_df, 2, var)*12
sigma_annual <- sqrt(sigma2_annual)
cov_mat_annual <- cov(returns_df)*12
cov_hat_annual <- cov(returns_df)[1,2]*12
rho_hat_annual <- cor(returns_df)[1,2]

# The annual estimates of the CER model parameters for Boeing and Microsoft
mu_boeing <- mu_hat_annual["rboeing"]
mu_msft <- mu_hat_annual["rmsft"]
sigma2_boeing <-  sigma2_annual["rboeing"]
sigma2_msft <- sigma2_annual["rmsft"]
sigma_boeing <- sigma_annual["rboeing"]
sigma_msft <- sigma_annual["rmsft"]
sigma_boeing_msft <- cov_hat_annual
rho_boeing_msft <- rho_hat_annual

# All data and CER parameters are preloaded in your workspace.
# Type "ls()" in the console to see them.

# The ratio Boeing stock vs Microsoft stock (adds up to 1)
boeing_weights <- seq(from=-1, to=2, by=0.1)
msft_weights <- seq(from=2, to=-1, by=-0.1)

# Portfolio parameters
mu_portfolio <-  mu_boeing * boeing_weights + mu_msft * msft_weights

sigma2_portfolio <- boeing_weights^2 * sigma2_boeing + msft_weights^2 * sigma2_msft + 2*boeing_weights*msft_weights*sigma_boeing_msft

sigma_portfolio <- sqrt(sigma2_portfolio)

# Plotting the different portfolios
plot(sigma_portfolio, mu_portfolio, type="b", pch=16, ylim=c(0, max(mu_portfolio)), xlim=c(0, max(sigma_portfolio)), xlab=expression(sigma[p]), ylab=expression(mu[p]),col=c(rep("green", 18), rep("red", 13)))
text(x=sigma_boeing, y=mu_boeing, labels="Boeing", pos=4)
text(x=sigma_msft, y=mu_msft, labels="Microsoft", pos=4)

# All data and CER parameters are preloaded in your workspace.
# Type "ls()" in the console to see them.

# Annual risk-free rate of 3% per year for the T-bill
t_bill_rate <- 0.03

# Ratio Boeing stocks
boeing_weights <- seq(from=-1, to=2, by=0.1)
t_bill_weights <- (1 - boeing_weights)
# Portfolio parameters
mu_portfolio_boeing_bill <- boeing_weights * mu_boeing + t_bill_weights * t_bill_rate

sigma_portfolio_boeing_bill <- boeing_weights * sigma_boeing

# Plot previous exercise
plot(sigma_portfolio, mu_portfolio, type="b", pch=16, ylim=c(0, max(mu_portfolio)), xlim=c(0, max(sigma_portfolio)), xlab=expression(sigma[p]), ylab=expression(mu[p]),col=c(rep("green", 18), rep("red", 13)))
text(x=sigma_boeing, y=mu_boeing, labels="Boeing", pos=4)
text(x=sigma_msft, y=mu_msft, labels="MSFT", pos=4)

# Portfolio Combination Boeing and T-bills
points(sigma_portfolio_boeing_bill, mu_portfolio_boeing_bill, col='blue', type='b')

# All data and CER parameters are preloaded in your workspace.
# Type "ls()" in the console to see them.

# Sharp ratio Boeing
sharp_ratio_boeing <- (mu_boeing - t_bill_rate) / sigma_boeing

# All data and CER parameters are preloaded in your workspace.
# Type "ls()" in the console to see them.

# The global minimum variance portfolio
global_min_var_portfolio <- globalMin.portfolio(mu_hat_annual, cov_mat_annual)

global_min_var_portfolio

# Summary of global_min_var_portfolio that takes into account the annual risk-free rate of 3% per year
summary(global_min_var_portfolio, risk.free=0.03)

# Portfolio weights Boeing and Microsoft
plot(global_min_var_portfolio)

# Plot previous exercises
plot(sigma_portfolio, mu_portfolio, type="b", pch=16, ylim=c(0, max(mu_portfolio)), xlim=c(0, max(sigma_portfolio)), xlab=expression(sigma[p]), ylab=expression(mu[p]),col=c(rep("green", 18), rep("red", 13)))
text(x=sigma_boeing, y=mu_boeing, labels="Boeing", pos=4)
text(x=sigma_msft, y=mu_msft, labels="MSFT", pos=4)

# Plot the position of the global minimum variance portfolio
text(x=global_min_var_portfolio$sd, y=global_min_var_portfolio$er, labels="Global min", pos=2)

# All data and CER parameters are preloaded in your workspace.
# Type "ls()" in the console to see them.

# The tangency portfolio
tangency_portfolio <-  tangency.portfolio(mu_hat_annual, cov_mat_annual, risk.free=0.03)

tangency_portfolio

# Summary of tangency_portfolio with annual risk free rate of 3%
summary(tangency_portfolio, risk.free=0.03)

# Portfolio weights Boeing and Microsoft
plot(tangency_portfolio)

# All data and CER parameters are preloaded in your workspace.
# Type "ls()" in the console to see them.

# Annual risk-free rate of 3% per year for the T-bill
t_bill_rate <- 0.03

# Set of tangency portfolio weights
tangency_weights <- seq(from=0, to=2, by=0.1)
t_bill_weights <- 1 - tangency_weights
# Portfolio parameters
mu_portfolio_tangency_bill <- tangency_weights * tangency_portfolio$er + t_bill_weights * t_bill_rate

sigma_portfolio_tangency_bill <- tangency_weights * tangency_portfolio$sd

# Plot previous exercises
plot(sigma_portfolio, mu_portfolio, type="b", pch=16, ylim=c(0, max(mu_portfolio)), xlim=c(0, max(sigma_portfolio)), xlab=expression(sigma[p]), ylab=expression(mu[p]),col=c(rep("green", 18), rep("red", 13)))
text(x=sigma_boeing, y=mu_boeing, labels="Boeing", pos=4)
text(x=sigma_msft, y=mu_msft, labels="MSFT", pos=4)

# Plot portfolio combinations of tangency portfolio and T-bills
text(x=tangency_portfolio$sd, y=tangency_portfolio$er, labels="Tangency", pos=2)
points(sigma_portfolio_tangency_bill, mu_portfolio_tangency_bill, col='blue', type='b', pch=16)

# All data and CER parameters are preloaded in your workspace.
# Type "ls()" in the console to see them.

# Define the portfolio ratio's
tangency_weight <- 0.3
t_bill_weight <- (1 - tangency_weight)

# Define the portfolio parameters
mu_portfolio_efficient <- tangency_weight * tangency_portfolio$er + t_bill_weight * 0.03

sd_portfolio_efficient <- tangency_weight * tangency_portfolio$sd

# Plot previous exercises
plot(sigma_portfolio, mu_portfolio, type="b", pch=16, ylim=c(0, max(mu_portfolio)), xlim=c(0, max(sigma_portfolio)), xlab=expression(sigma[p]), ylab=expression(mu[p]),col=c(rep("green", 18), rep("red", 13)))
text(x=sigma_boeing, y=mu_boeing, labels="Boeing", pos=4)
text(x=sigma_msft, y=mu_msft, labels="MSFT", pos=4)
text(x=tangency_portfolio$sd, y=tangency_portfolio$er, labels="Tangency", pos=2)
points(sigma_portfolio_tangency_bill, mu_portfolio_tangency_bill, type="b", col="blue", pch=16)

# Plot Efficient Portfolio with 30% Tangency

text(x=sd_portfolio_efficient, y=mu_portfolio_efficient, labels="Efficient Portfolio with 30% Tangency", pos=4, cex=0.75)
points(sd_portfolio_efficient, mu_portfolio_efficient, type='b', col='orange', pch=16, cex=2)

# All data and CER parameters are preloaded in your workspace.
# Type "ls()" in the console to see them.

# Calculate the weight of the tangency portfolio in the portfolio
tangency_weight  <- sigma_boeing / tangency_portfolio$sd

# Calculate the portfolio parameters
mu_portfolio_efficient <- t_bill_rate + tangency_weight * (tangency_portfolio$er - t_bill_rate)

sd_portfolio_efficient <- tangency_weight * tangency_portfolio$sd

# Plot previous exercises
plot(sigma_portfolio, mu_portfolio,bg="NA", type="b", pch=16, ylim=c(0, max(mu_portfolio)), xlim=c(0, max(sigma_portfolio)), xlab=expression(sigma[p]), ylab=expression(mu[p]),col=c(rep("green", 18), rep("red", 13)))
text(x=sigma_boeing, y=mu_boeing, labels="Boeing", pos=4)
text(x=sigma_msft, y=mu_msft, labels="MSFT", pos=4)
text(x=tangency_portfolio$sd, y=tangency_portfolio$er, labels="Tangency", pos=2)
points(sigma_portfolio_tangency_bill, mu_portfolio_tangency_bill, type="b", col="blue", pch=16)

# Plot Efficient Portfolio with the same risk as Boeing
points(sd_portfolio_efficient, mu_portfolio_efficient, type="p", col="orange", pch=16, cex=2)
text(x=sd_portfolio_efficient, y=mu_portfolio_efficient, labels="Efficient Portfolio with same risk as Boeing", pos=2, cex=0.75)

# Section 8 - Computing Efficient Potfolio

# All data and CER parameters are preloaded in your workspace.  Type 'ls()' in the console to see them.

# Load the relevant packages
library("zoo")

# Load the working environment
load(url("http://s3.amazonaws.com/assets.datacamp.com/course/compfin/lab9.RData"))

# Explore the data set
head(returns_df)
tail(returns_df)

# Timeplots with stocks on individual graphs
my.panel <- function(...) {
  lines(...)
  abline(h=0)
}
plot(returns_df, lwd=2, panel=my.panel, col="blue")

# Timeplots with stocks on same graph
plot(returns_df, plot.type = "single", main="Returns", col=1:4, lwd=2)
abline(h=0)
legend(x="bottomleft", legend=colnames(returns_df), col=1:4, lwd=2)

# All data is preloaded in your workspace.  Type 'ls()' in the console to see what has been loaded.

# Parameters CER model
mu_hat_month <- apply(returns_df, 2, mean)
mu_hat_month
sigma2_month <-apply(returns_df, 2, var)

sigma2_month
sigma_month <-sqrt(sigma2_month)

sigma_month
cov_mat_month <- var(returns_df)
cov_mat_month
cor_mat_month <- cor(returns_df)

cor_mat_month

# Pairwise scatterplots
pairs(coredata(returns_df), col='blue', pch=16)

# All data and CER parameters are preloaded in your workspace.  Type 'ls()' in the console to see them.

# Calculate the global minimum variance portfolio
global_min_var_portfolio = globalMin.portfolio(er=mu_hat_month, cov.mat=cov_mat_month, shorts=TRUE)

global_min_var_portfolio

# Plot the portfolio weights of our four stocks
plot(global_min_var_portfolio)

# All data and CER parameters are preloaded in your workspace.  Type 'ls()' in the console to see them.

# set restriction matrices
D_matrix <- 2* cov_mat_month
D_matrix
d_vector <- rep(0,4)
d_vector
A_matrix <- cbind(rep(1,4),diag(4))
A_matrix
b_vector <- c(1,rep(0,4))
b_vector

# use solve.QP to minimize portfolio variance
quad_prog <- solve.QP(D_matrix, d_vector, A_matrix, b_vector)

quad_prog

# All data and CER parameters are preloaded in your workspace.  Type 'ls()' in the console to see them.

# The global minimum variance portfolio
global_min_var_portfolio <- globalMin.portfolio(mu_hat_month, cov_mat_month, shorts=FALSE)

global_min_var_portfolio

# All data and CER parameters are preloaded in your workspace.  Type 'ls()' in the console to see them.

# highest average return
mu_target <- max(mu_hat_month)

# short sales allowed
efficient_porfolio_short <- efficient.portfolio(er = mu_hat_month, cov.mat = cov_mat_month, target = mu_target, shorts = TRUE)

efficient_porfolio_short
plot(efficient_porfolio_short)

# no short sales allowed
efficient_porfolio_no_short <- efficient.portfolio(er = mu_hat_month, cov.mat = cov_mat_month, target = mu_target, shorts = FALSE)

efficient_porfolio_no_short
plot(efficient_porfolio_no_short)

# All data and CER parameters are preloaded in your workspace.  Type 'ls()' in the console to see them.

# The efficient frontier of risky assets
efficient_frontier <- efficient.frontier(mu_hat_month, cov_mat_month, alpha.min=-1, alpha.max=1)
summary(efficient_frontier)

summary(efficient_frontier)

# The plot
plot(efficient_frontier, plot.assets=T, col= "blue", lwd = 2)

# All data and CER parameters are preloaded in your workspace.  Type 'ls()' in the console to see them.

# risk free rate
t_bill_rate <- 0.005

# Tangency portfolio short sales allowed
tangency_portfolio_short <- tangency.portfolio(er = mu_hat_month,
                                               cov.mat =cov_mat_month,
                                               risk.free = t_bill_rate,
                                               shorts = T)

summary(tangency_portfolio_short)
#plot
plot(tangency_portfolio_short)

# Tangency portfolio short sales not allowed
tangency_portfolio_no_short <- tangency_portfolio_no_short <- tangency.portfolio(er = mu_hat_month,
                                               cov.mat =cov_mat_month,
                                               risk.free = t_bill_rate,
                                               shorts = F)

summary(tangency_portfolio_no_short)
#plot
plot(tangency_portfolio_no_short)

Introduction to Computational Finance with R.r


# Include libraries.
library(quantmod)

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

# Retrieve Google stock.
stock <- na.omit(get(getSymbols('GOOG')))
stock <- to.monthly(stock)
#chartSeries(stock,
#            theme='white',
#            up.col='red', dn.col='green' # chinese convention
#           )

# Open buy in. Close sell out.
cash <- -Op(stock) + Cl(stock)
plot(cumsum(cash), main='Cash without commission fee')

# Take into account commission fee being 0.1425%.
# Commission fee is rebated by 50%.
# Seller must also pay 0.3% government tax.
buy_in <- Op(stock) * (1 + 0.001425 * 0.5)
sell_out <- Cl(stock) * (1 - 0.001425 * 0.5 - 0.003)
cash <- sell_out - buy_in
plot(cumsum(cash), main='Cash with commission fee')