library("coda")

# posterior distribution of converged chain
set.seed(61)
post0 = mh(n=n, ybar=ybar, n_iter=10e3, mu_init=0.0, cand_sd=0.9)
traceplot(as.mcmc(post0$mu[-c(1:500)]))

# posterior distribution of wondering chain
post1 = mh(n=n, ybar=ybar, n_iter=1e3, mu_init=0.0, cand_sd=0.04)
traceplot(as.mcmc(post1$mu[-c(1:500)]))

# posterior distribution wondering chain converged
post2 = mh(n=n, ybar=ybar, n_iter=100e3, mu_init=0.0, cand_sd=0.04)
traceplot(as.mcmc(post2$mu))

# effective sample size - number of independent MC samples (more = greater information)

# effective sample size how many indipendent sampe needed to get the same information

# want chain with low auto correaltion - good converging properties - good chain

# need to check the effective sample size - relyable estimates need a high number of effective sample size

# a chain with high auto correaltion will lead to more sampling to get a good (significant) effective sample

# lesson - drawing from a population who are correlated will take longer to understand the entire distribution

autocorr.plot(as.mcmc(post0$mu))
autocorr.diag(as.mcmc(post0$mu))

autocorr.plot(as.mcmc(post1$mu))
autocorr.diag(as.mcmc(post1$mu))

str(post2)

effectiveSize(as.mcmc(post2$mu))

autocorr.plot(as.mcmc(post2$mu), lag.max=500)

thin_interval = 400 # how far apart the iterations are for autocorrelation to be essentially 0.
thin_indx = seq(from=thin_interval, to=length(post2$mu), by=thin_interval)
head(thin_indx)

post2mu_thin = post2$mu[thin_indx]
traceplot(as.mcmc(post2$mu))

traceplot(as.mcmc(post2mu_thin))

autocorr.plot(as.mcmc(post2mu_thin), lag.max=10)

effectiveSize(as.mcmc(post0$mu))

?effectiveSize

raftery.diag(as.mcmc(post0$mu))

raftery.diag(as.mcmc(post0$mu), q=0.005, r=0.001, s=0.95)


source('ifm_func.r')

# Strategy C - trend trading:
# Long-term moving average is 56-day simple moving average (SMA) of closing pri-
# ce of the given stock, while short-term moving average is 42-day exponential
# moving average (EMA). When short-term moving average crosses above long-term
# moving average (golden cross), we buy in at opening price on the next day, and
# then hold to sell out at opening price on the following day when short-term m-
# oving average crosses below long-term moving average (death cross).
strategy <- function(stock) {
    # Strategy.
    LMA_DAYS_N <- 56
    SMA_DAYS_N <- 42
    M_START <- LMA_DAYS_N + 1

    # Prepare data.
    opp <- Op(stock) # [op]en [p]rices
    clp <- Cl(stock) # [cl]ose [p]rices
    lmap <- SMA(clp, n=LMA_DAYS_N) # [l]ong-term [m]oving [a]verage [p]rices
    smap <- EMA(clp, n=SMA_DAYS_N) # [s]hort-term [m]oving [a]verage [p]rices
    yesterday <- nrow(stock) - 1

    # Execute the strategy.
    pl <- setNames( rep( 0, length(clp) ), time(stock) )
    is_bought <- FALSE
    for (m in M_START:yesterday) {
        if ( !is_bought
             && as.numeric( smap[m-1] ) <  as.numeric( lmap[m-1] )
             && as.numeric( smap[m]   ) >= as.numeric( lmap[m]   ) ) {
            bought <- long( as.numeric( opp[m+1] ) )
            is_bought <- TRUE
        }
        else if ( is_bought
                  && as.numeric( smap[m-1] ) >  as.numeric( lmap[m-1] )
                  && as.numeric( smap[m]   ) <= as.numeric( lmap[m]   ) ) {
            pl[m] <- -bought + short( as.numeric( opp[m+1] ) )
            is_bought <- FALSE
        }
    }

    # Return [p]rofit-[l]oss.
    return(pl)
}


factIter <- function(n) {
  f = 1
  for (i in 2:n) f <- f * i
  f
}


# take input from the user
n = as.integer(readline(prompt="Enter Number of Terms "))
# first two terms
a = 0
b = 1
count = 2
# check if the number of terms is valid
if(n <= 0) {
print("Plese enter a positive integer")
} else {
if(n == 1) {
print("Fibonacci sequence:")
print(a)
} else {
print("Fibonacci sequence:")
print(a)
print(b)
while(count < n) {
c = a + b
print(c)
# update values
a = b
b = c
count = count + 1
}
}
}


Seatbelts <- data.frame(Seatbelts)
str(Seatbelts)
head(Seatbelts,n=10)
summary(Seatbelts)

BeforeLaw <-subset(Seatbelts,law ==0)
AfterLaw <- subset(Seatbelts,law!=0)

summary(BeforeLaw)
summary(AfterLaw)

par(mfrow=c(1,2))
boxplot(BeforeLaw$DriversKilled,ylim=c(50,200),main="Before Law",ylab="Drivers Killed")
boxplot(AfterLaw$DriversKilled,ylim=c(50,200),main="After Law",ylab="Drivers Killed")

library(glmnet)

x <- model.matrix(DriversKilled~., BeforeLaw)[,-c(1,8)]
y <- BeforeLaw$DriversKilled

RidgeMod <- glmnet(x, y, alpha=0, nlambda=100, lambda.min.ratio=0.0001)

plot(RidgeMod,xvar="lambda",label=TRUE)

CvRidgeMod <- cv.glmnet(x, y, alpha=0, nlambda=100, lambda.min.ratio=0.0001)

plot(CvRidgeMod)

best.lambda <- CvRidgeMod$lambda.min
best.lambda

predict(RidgeMod, s=best.lambda, type="coefficients")[1:6, ]


#import the Dataset
dataset = read.csv('Position_Salaries.csv')
dataset = dataset[2:3]

# Fitting the SVR to the dataset
install.packages('e1071')
library(e1071)
regressor = svm(formula = Salary ~ .,
                data = dataset,
                type = 'eps-regression',
                kernel = 'radial')

# Visualising the SVR Model results
library(ggplot2)
ggplot() +
  geom_point(aes(x = dataset$Level, y = dataset$Salary),
             colour = 'red') +
  geom_line(aes(x = dataset$Level, y = predict(regressor, newdata = dataset)),
            colour = 'blue') +
  ggtitle('Truth or Bluff (SVR Model)') +
  xlab('Level') +
  ylab('Salary')

# Predicting a new result
y_pred = predict(regressor, data.frame(Level = 6.5))

R/Regression/Support Vector Regression (SVR)/svr.r


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

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

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

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

source("function.r") #source the file with all the subroutines
input_file = "assunpink.csv" #file name for the dataset
output_file = "assunpink" #prefix for output plots
data_col = 3 #column in the dataset with the values of flow in cubic meter per second
year_col = 1 #column in the daatset with the year information
col_names = TRUE #boolean to specify whether the dataset contains the column names as the first line

CSVFile = read.csv(file = input_file, header = col_names) #read the file
Data = CSVFile[,data_col] #find column with flow data
Year = CSVFile[,year_col] #find column with year data
referenceyear = 2018 #set a reference year (t=0) for all the computations
time_index = time.index(Year,referenceyear) #generate time index, t = 1,2,3,...
lmfit = lm(Data~time_index) #Use a linear regression model to estimate the initial values for mu0 and mu1
mu0.int = lmfit$coefficients[1]
mu1.int = abs(lmfit$coefficients[2])
scale.int = sd(Data) #Use standard deviation as the initial value for scale parameter
set.seed(2) #setting the random seed
shape.int = runif(1,-1,1) #randomly initialiaze the shape parameter

#define the objective function for optimization
llf = function(x) {
    k =(1 + (x[4]*(Data-(x[1]+(x[2]*time_index)))/x[3]))^(-1/x[4])
    pdf = (1/x[3])*((k)^(x[4]+1))*exp(-k)
    -sum(log(pdf))
}

#evaluate the objective function at the intial values; if the value is not finite, try a different value to initialize shape parameter
result = try(
    expr =  optim(par = c(mu0.int,mu1.int,scale.int,shape.int), method = "L-BFGS-B", fn = llf, lower = c(0,-Inf,0,-Inf)), silent = TRUE
)
while (class(result) == "try-error"){
    shape.int = runif(1,-1,1)
    result = try(
      expr =  optim(par = c(mu0.int,mu1.int,scale.int,shape.int), method = "L-BFGS-B", fn = llf, lower = c(0,-Inf,0,-Inf)), silent = TRUE
    )
}

#extract the optimal values for the parameters
mu0 = result$par[1]
mu1 = result$par[2]
scale = result$par[3]
shape = result$par[4]
NLLH = result$value

#use the optimal values for the parameters to calculate the 100-year return event
retevent = calc.nstat.ret.event(mu0,mu1,scale,shape,100,baseyear = referenceyear,analysisyear = referenceyear,1)

#Display the results
cat('Maximum Likelihood Estimation (Unconstrained)','\n')
cat('mu0 = ',mu0,'mu1 = ',mu1,'scale = ',scale,'shape = ',shape,'100yr return event = ',retevent,"NLLH =",NLLH,'\n')


IterBinSearch <- function(A, value) {
  low = 1
  high = length(A)
  i = 0
  while ( low <= high ) {
    mid <- floor((low + high)/2)
    if ( A[mid] > value )
      high <- mid - 1
    else if ( A[mid] < value )
      low <- mid + 1
    else
      return(mid)
  }
  NULL
}


## 2. Useful Qualities of Probability Distributions ##

are_uniforms <- FALSE
most_probable_A <- 1
total_probability_B <- 0.2 + 0.2 + 0.2 + 0.2 + 0.3
is_B_valid <- FALSE

## 4. Example: Sum of Two Dice Rolls ##

prob_2 <- 1/36
prob_4 <- 3/36
prob_7 <- 6/36
prob_10 <- prob_4

## 5. Cumulative Probability ##

prob_leq_6 <- 1/36 + 2/36 + 3/36 + 4/36 + 5/36
prob_gt_9 <- 6/36
prob_btwn_6_and_8 <- 5/36 + 6/36 + 5/36

## 8. Probability Distribution Function for the Normal ##

prob_norm_0 <- dnorm(0)
prob_norm_5 <- dnorm(5, 5, 5)
prob_norm_1 <- dnorm(-1, 1, 2)

Data Analyst in R/Step 5 - Probability and Statistics/5. Hypothesis Testing in R/1. Probability Distributions.r


n = 600851475143

i = 2
while (n != 1) {
    if (n %% i == 0) {
        n = n / i
    } else {
        i = i + 1
    }
}

cat(i, "\n")


readMatrix <- function()
{
  #---------------------------------------------#
  # function to read Matrix data file
  #---------------------------------------------#
  cat("\n ----   TYPE the DATA File Name : ")
  name <- readline()
  data.m <- scan(name)

        cat("\n -------------------------------")
        cat("\n   (1) Upper Triangular Matrix  ")
        cat("\n   (2) Lower Triangular Matrix  ")
        cat("\n -------------------------------")
        cat("\n  Type the number(Default=1) : ")
        upperValue <- readline()
        cat("\n --- Number of rows : ")
        n <- readline()
        n <- as.integer(n)
        if( upperValue == "2")
        {  DistanceArray <- array(0, n*(n-1)/2 )
           for(i in 1:(n-1) )
             for(j in (i+1):n )
                 { kk1 <- (j-1)*(j-2)/2 + i
                   kk2 <- n*(i-1)- i*(i-1)/2 + j-i
                   DistanceArray[kk2] <- data.m[kk1] }
        }
        else
             DistanceArray <- data.m

     DistanceArray = 10 - DistanceArray

     MD <- matrix(0, nrow=n, ncol=n)

     for(j in 1:(n-1) )
        for(k in (j+1):n)
        {    kk <- n*(j-1) - j*(j-1)/2 + k-j
             MD[j,k] <- MD[k,j] <- DistanceArray[kk]
        }

     return(MD)
}


primes <- c(2, 3, 5, 7, 11, 13)
isPrime <- function(a) {
  i <- 1
  while (a %% primes[i] > 0) {
    if (primes[i] * primes[i] > a) {
      primes <<- append(primes, a)
      return(TRUE)
    }
    i <- i + 1
  }
  FALSE
}

primeSeq <- function() {
  p0 <- 1
  i <- 0
  return(function() {
    if (p0 <= length(primes)) {
      i <<- primes[p0]
      p0 <<- p0 + 1
      return(i)
    }
    i <<- i + 2
    while (!isPrime(i)) {
      i <<- i + 2
    }
    p0 <<- p0 + 1
    return(i)
  })
}

primeless <- function(n) {
  r <- c()
  nextPrime <- primeSeq()
  i <- nextPrime()
  while (i < n) {
    r <- append(r, i)
    i <- nextPrime()
  }
  paste(r, collapse=",")
}

for (line in readLines(tail(commandArgs(), n=1))) {
  cat(sapply(as.integer(line), primeless), sep="\n")
}


setwd('~/Documents/AdminInfo/HotelBookingDemand-AnalysisCC50')
path = "dataset/clean-hotel-bookings.csv"

hotel <- read.csv(path, na.strings="")
#View(hotel)

# a. ¿Cuántas  reservas  se  realizan  por  tipo  de  hotel?  o  ¿Qué  tipo  de  hotel  prefiere  la
# gente?
barplot(table(hotel['hotel']),
        main='Type of hotel preference',
        ylab='Num. Reservations', xlab='Type of hotel')

# b. ¿Está aumentando la demanda con el tiempo?
# array of %Y-%m of original dates
#and table it
hotel <- hotel[order(as.Date(hotel$arrival_date, format="%Y-%m-%d")), ]
dates <- table(sub('(^.{8}).*','\\1', hotel$arrival_date))
barplot(dates, main="Number of reservations per month",
        xlab="Month", ylab="Num of reservations")

# c. ¿Cuándo se producen las temporadas de reservas: alta, media y baja?
mnts <- sort(substring(hotel$arrival_date,first=6,last=8))
barplot(sort(table(mnts)), horiz=TRUE, main="Bookings per month",
        xlab="Bookings", ylab="Month")

# d. ¿Cuándo es menor la demanda de reservas?
 # Winter
# e. ¿Cuántas reservas incluyen niños y/o bebes?
unblessed <- nrow(subset(hotel, children == 0 & babies == 0 ))
blessed <- nrow(subset(hotel, children > 0 | babies > 0 ))
# f. ¿Es importante contar con espacios de estacionamiento?
parking <- nrow(subset(hotel, required_car_parking_spaces > 0))
no_parking <- nrow(subset(hotel, required_car_parking_spaces == 0))
# g. ¿En qué meses del año se producen más cancelaciones de reservas?
cancelled <- subset(hotel, reservation_status == "Canceled")
mnts <- sort(substring(hotel$arrival_date,first=6,last=8))
barplot(sort(table(mnts)), horiz=TRUE, main="Cancelations per month",
        xlab="Bookings", ylab="Month")


#data<-read.csv("C:\\Users\\ritag\\Documents\\UNI STATISTICA\\MODELLI LINEARI GENERALIZZATI\\PRIMA PRESENTAZIONE\\Life Expectancy Data.csv", header = T, stringsAsFactors = F)
View(data)

dati<-data[-which(data$Year!=2015), -c(2,6, 7, 8,14, 21)]
aspettativa<-na.omit(dati)

for (i in 1:nrow(aspettativa)){
  if(aspettativa[i,2]=="Developing"){aspettativa[i,2] = as.numeric(0)} else {aspettativa[i,2]=as.numeric(1)}  }

which.min(aspettativa$Life.expectancy) #51
aspettativa[107, ]
which.max(aspettativa$Life.expectancy) #85
aspettativa[28, ]

m <- mean(aspettativa$Life.expectancy)
std <- sqrt(var(aspettativa$Life.expectancy))
plot(density(aspettativa[, 3]), xlab = "")
curve(dnorm(x, mean = m, sd = std), col="red", add=T)

round(cor(aspettativa[, -c(1, 2)]), digits=3)

cor(as.numeric(aspettativa$Status), aspettativa$Schooling)

dataset<-aspettativa[, -c(10, 14)]

mod_full<-lm(Life.expectancy~Status + Adult.Mortality + GDP + BMI + Hepatitis.B + Polio + Schooling + HIV.AIDS + Measles+ thinness.5.9.years+ Population + under.five.deaths, data = dataset)
summary(mod_full)

mod1<-lm(Life.expectancy~Status + Adult.Mortality + under.five.deaths+ GDP + BMI + Population + Schooling, data = dataset)
summary(mod1)

library(leaps)
status_BMI <- as.numeric(aspettativa$Status) * aspettativa$BMI
status_gdp <- as.numeric(aspettativa$Status) * aspettativa$GDP
formula <- Life.expectancy~Status + Adult.Mortality + GDP + BMI + Hepatitis.B + Polio + Schooling + HIV.AIDS + Measles+ thinness.5.9.years+ Population + under.five.deaths

modsub=regsubsets(formula,data=dataset, nbest = 1, nvmax = NULL, force.in = NULL, force.out = NULL, method = "exhaustive")
best.sub=summary(modsub)
# BIC
plot(-best.sub$bic,pch=19,cex=1.5,type="b",las=1,col="dodgerblue", xlab = "")
# Variable selection
plot(modsub,scale="bic",las=1,col="dodgerblue")
plot(modsub, scale = "adjr2", las=1, col="pink")

mod_consigliato <- lm(Life.expectancy~ Adult.Mortality +Polio + Schooling + HIV.AIDS, data = dataset)
summary(mod_consigliato)

mod_prova <- lm(Life.expectancy~ Status + Adult.Mortality  + Polio + Schooling + HIV.AIDS, data = dataset)
summary(mod_prova)

res1 <- t(mod_prova$residuals)%*% mod_prova$residuals
res2 <- t(mod_consigliato$residuals)%*%mod_consigliato$residuals
(res1 -res2)/(res2/(130-4))

mod_forse <- lm(Life.expectancy~Status + Adult.Mortality + GDP + BMI + Hepatitis.B + Polio + Schooling + HIV.AIDS + thinness.5.9.years, data = dataset)
summary(mod_forse)

mod_finale <- mod_consigliato
summary(mod_finale)
plot(mod_finale)
library(lmtest)
bptest(mod_finale)
dwtest(mod_finale)

hist(mod_finale$residuals, freq = F)
lines(density(mod_finale$residuals), col= "red")
qqnorm(mod_finale$residuals)

data[2923, ]
data[2907, ]
data[1475, ]
cook <- cooks.distance(mod_finale)
summary(cook)
which.max(cook)
plot(cook)
identify(cook)
modello_noleva <- lm(Life.expectancy~ Adult.Mortality +Polio + Schooling + HIV.AIDS, data = dataset[-c(130, 129), ])
summary(modello_noleva)
dataset[c(68, 129, 130), ]

mean(dataset$Life.expectancy) #70.74154
mean(dataset$Adult.Mortality) #158.68
mean(dataset$Polio) #81.12308
mean(dataset$HIV.AIDS) #0.7853846
mean(dataset$Schooling) #12.74692

mod_prova1 <- lm(Life.expectancy~Status + Adult.Mortality + Hepatitis.B + Polio + Schooling + HIV.AIDS + thinness.5.9.years, data = dataset)
AIC(mod_prova1)
summary(mod_prova1)

confint(mod_finale, level = 0.99)
predict <- predict(mod_finale, level=0.99, interval = "prediction")
plot(predict)

status_BMI <- as.numeric(dataset$Status) * dataset$BMI
status_gdp <- as.numeric(dataset$Status) * dataset$GDP
status_adultmort <- as.numeric(dataset$Status) * dataset$Adult.Mortality
status_hepatitis <- as.numeric(dataset$Status) * dataset$Hepatitis.B
status_polio <- as.numeric(dataset$Status) * dataset$Polio
status_schooling <- as.numeric(dataset$Status) * dataset$Schooling
status_hiv <- as.numeric(dataset$Status) * dataset$HIV.AIDS
status_measles <- as.numeric(dataset$Status) * dataset$Measles
status_thinness <- as.numeric(dataset$Status) * dataset$thinness.5.9.years
status_pop <- as.numeric(dataset$Status) * dataset$Population
status_underfive <- as.numeric(dataset$Status) * dataset$under.five.deaths
mod_full1<-lm(Life.expectancy~Status + Adult.Mortality + GDP + BMI + Hepatitis.B + Polio + Schooling + HIV.AIDS + Measles+ thinness.5.9.years+
                Population + under.five.deaths + status_adultmort + status_gdp + status_BMI + status_hepatitis + status_polio
              + status_schooling + status_hiv + status_measles + status_thinness + status_pop + status_underfive, data = dataset)
summary(mod_full1)


#This script models the relationship between ppgis points and distance from roads
#and creates a raster of 'bias' across the landscape

library(raster)
library(rgdal)
library(ggplot2)
library(nlme)

##########################################
#Setup

options(stringsAsFactors=FALSE) # turn off automatic factor coersion
# options(scipen=9999)            # turn off plotting axis lables in scientific notation

wd <- "/home/runge/Data/Arctic_Cultural_ES/"
#wd <- "C:/Claire/Arctic_Cultural_ES/"
setwd(wd)

########################
## Setting system preferences for better work with raster
# Define your temp folder
#my_tmpdir=paste0(wd, "tmpRaster")

# Create it (handles the case where the folder already exists)
#dir.create(my_tmpdir, showWarnings=F)

# Set the raster option to this folder
#rasterOptions(tmpdir= my_tmpdir)

## Maximum Memory
# Often server has more RAM than desktop. Therefore the mamximum amount of memory that can be allocated
# to process a raster can be increased. Aurora has a lot of RAM (384GB), so we recommend to use the following
# settings:
rasterOptions(maxmemory =1e+09)
rasterOptions(chunksize=1e+08)

############################
rastDir <- paste0(wd, "Spatial data/Processed/")
rastTemplate = raster(paste0(rastDir, "Templates and boundaries/Norway_template_raster.tif"))

############################
#PPGIS data
southPPGIS <- readOGR(paste0(wd, "PPGIS data/Processed/shps"), "PPGIS_Markers_south_UTM33N_municipal")
northPPGIS <- readOGR(paste0(wd, "PPGIS data/Processed/shps"), "PPGIS_Markers_north_UTM33N_alpine")
#distance to road rasterOptions
disttoroadRast <- raster(paste0(rastDir, "2b_masked_no_water/Distance_to_Road_CR_no_water.tif"))

#############################
#extract distance to road for each ppgis points
disttoroadS <- extract(disttoroadRast, southPPGIS, df=TRUE, method='simple')
disttoroadN <- extract(disttoroadRast, northPPGIS, df=TRUE, method='simple')

allDat <- data.frame(disttoroad=append(disttoroadS[,2], disttoroadN[,2]), region=rep(c("South", "North"), times =c(nrow(disttoroadS), nrow(disttoroadN))))

ggplot(allDat, aes(disttoroad, fill=region)) +#or try group
 	geom_histogram() +
	theme_light(17) + #get rid of grey bkg and gridlines
	theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+
	labs(x="Distance to road", y="Number of records")+
	scale_x_continuous(expand = c(0.0, 0.0)) + scale_y_continuous(expand = c(0.01, 0.001))+ #set x and y limits
	theme(axis.title.x = element_text(vjust=-0.6),axis.title.y = element_text(vjust=1))+	#move xylabels away from graph
	theme(legend.position="bottom")#gets rid of legend

outPath <- paste0(wd, "/figures/Histogram_DistancetoRoad.png")
	ggsave(filename=outPath)

###############################
#Model relationship between number of records & distance to road
counttable <- table(allDat$disttoroad)
countdf <- data.frame(disttoroad=as.numeric(dimnames(counttable)[[1]]), frequ=as.vector(counttable))

with(countdf, plot(disttoroad, frequ))
with(countdf, plot(log(frequ)~log(disttoroad)))

mod1 <- with(countdf, lm(log(frequ)~-log(disttoroad))) #straight line, residuals are not normal
mod2 <- nls(frequ~exp(a+b*disttoroad), data=countdf, start=list(a=0, b=0)) #exponential line

with(countdf, plot(disttoroad, frequ))
lines(countdf$disttoroad, predict(mod2, list(disttoroad = countdf$disttoroad)), col="red") #mod2 is ok
#lines(countdf$disttoroad, exp(predict(mod1, list(disttoroad = countdf$disttoroad))), col="blue")#mod1 is a poor fit

#Try a subset of the data
countdfsub <- countdf[countdf$disttoroad<2000,]
summary(countdfsub)
mod3 <- nls(frequ~exp(a+b*disttoroad), data=countdfsub, start=list(a=0, b=0))
summary(mod3)
plot(mod3)

with(countdfsub, plot(disttoroad, frequ))
lines(countdfsub$disttoroad, predict(mod3, list(disttoroad = countdfsub$disttoroad)), col="red")
#lines(countdfsub$disttoroad, predict(mod2, list(disttoroad = countdfsub$disttoroad)), col="blue")

summary(mod2)
summary(mod3)#models are essentially the same

#Check that north and south data have same relationship to distance to road
counttable2 <- as.dataframe(table(allDat$disttoroad, allDat$region))
t.test(counttable2[counttable2$Var2=="South", "Freq"],counttable2[counttable2$Var2=="North", "Freq"])

###############################
#Predict model aross raster of distance to road
#need to normalise values between 0 and 1

#biasrast <- predict(disttoroadRast, mod2, fun=predict.nls, newdata=list(disttoroad=values(disttoroadRast)), filename=outPath, format="GTiff")#couldnt get this to work so did it the long way
newpreds <- getValues(disttoroadRast)
maxpreds <- predict(mod2, list(disttoroad=c(0)))
RastPredictions <- predict(mod2, list(disttoroad = newpreds))
RastPredictionsNorm <- round(predict(mod2, list(disttoroad = newpreds))/maxpreds, 2) #normalise #if outside max distance seen in data, then 0, if close to road then 1

#set the values of these rasters to model predictions
outPath <- paste0(rastDir, "Bias_grids/BiasGrid_distancetoroad.tif")
biasRast <- disttoroadRast
biasRast <- setValues(biasRast, RastPredictions)
writeRaster(biasRast, filename=outPath, format="GTiff",overwrite=TRUE)

outPath <- paste0(rastDir, "Bias_grids/BiasGrid_distancetoroad_normalised.tif")
biasRastNorm <- disttoroadRast
biasRastNorm <- setValues(biasRastNorm, RastPredictionsNorm)
writeRaster(biasRastNorm, filename=outPath, format="GTiff", overwrite=TRUE)

#Mask out areas outside study region as NA (norway no water)
maskTemplate <- readOGR(paste0(rastDir, "/Templates and boundaries"), "Norway_nowater")
outPath <- paste0(rastDir, "Bias_grids/BiasGrid_distancetoroad_no_water.tif")
biasRastMaskednowater <- mask(biasRast, maskTemplate, filename=outPath, format = "GTiff", datatype="INT4S")
outPath <- paste0(rastDir, "Bias_grids/BiasGrid_distancetoroad_normalised_no_water.tif")
biasRastNormMaskednowater <- mask(biasRastNorm, maskTemplate, filename=outPath, format = "GTiff", datatype="INT4S")

#Save as .asc
writeRaster(biasRastMaskednowater, filename=paste0(rastDir, "Bias_grids/BiasGrid_distancetoroad_no_water.asc"), format="ascii")

#Mask out areas outside North study region as NA
maskTemplate <- raster(paste0(rastDir, "/Templates and boundaries/North_municipalities_alpine.tif"))
outPath <- paste0(rastDir, "Bias_grids/BiasGrid_distancetoroad_North_municipalities_alpine.tif")
biasRastMaskedN <- mask(biasRast, maskTemplate, filename=outPath, format = "GTiff", datatype="INT4S")

#Mask out areas outside South study region as NA
maskTemplate <- raster(paste0(rastDir, "/Templates and boundaries/South_municipalities.tif"))
outPath <- paste0(rastDir, "Bias_grids/BiasGrid_distancetoroad_South_municipalities.tif")
biasRastMaskedS <- mask(biasRast, maskTemplate, filename=outPath, format = "GTiff", datatype="INT4S")

#Mask out areas outside Norway_alpine study region as NA
maskTemplate <- raster(paste0(rastDir, "/Templates and boundaries/Norway_alpine_clip.tif"))
outPath <- paste0(rastDir, "Bias_grids/BiasGrid_distancetoroad_Norway_alpine.tif")
biasRastMaskedNS <- mask(biasRast, maskTemplate, filename=outPath, format = "GTiff", datatype="INT4S")

###############################
#Plot the models and the bias raster

pdf(paste0(rastDir, "/Bias_grids/BiasGridModel_DistancetoRoad.pdf"))
par(mfrow=c(2,2), mar = c(4,4,1,1) + 0.1, mgp=c(2,1,0))

#plot panel 1 raw data
with(countdf, plot(disttoroad, frequ,
xlab="Distance to road (metres)", ylab="Frequency of PPGIS data", fg="grey70"))

#plot panel 2 log data
with(countdf, plot(log(frequ)~log(disttoroad),
xlab="Log distance to road (metres)", ylab="Log frequency of PPGIS data", fg="grey70"))

#plot panel 3 zoomed data plus model fit
with(countdfsub, plot(disttoroad, frequ,
xlab="Distance to road (metres)", ylab="Frequency of PPGIS data", fg="grey70"))
lines(countdfsub$disttoroad, predict(mod3, list(disttoroad = countdfsub$disttoroad)), col="red")
text(x=1500, y=2500, labels=expression(y == e^{8.1-0.006*x}))

#plot panel 4 normalised raster
plot(biasRastNormMaskednowater)
title("Bias grid for Maxent")

dev.off()

#run maxent models with default beta value or test aic across different beta values
#run maxent models with and without bias grid
#write up model selection - why use maxent as opposed to random forest? (answer - because random forest needs absenses, which we don't have)
#look at where people value biodiversity
#compare with expert predictions
#methods paper
#N model & predict across whole region
#S model & predict across whole region
#combined all data & predict across whole region
#for all values
#then calculate niche overlap between the different models


# take input from the user
nterms = as.integer(readline(prompt="How many terms? "))
# first two terms
n1 = 0
n2 = 1
count = 2
# check if the number of terms is valid
if(nterms <= 0) {
print("Plese enter a positive integer")
} else {
if(nterms == 1) {
print("Fibonacci sequence:")
print(n1)
} else {
print("Fibonacci sequence:")
print(n1)
print(n2)
while(count < nterms) {
nth = n1 + n2
print(nth)
# update values
n1 = n2
n2 = nth
count = count + 1
}
}
}


require(adehabitat)
require(CircStats)

"simm.crw2" <- function(date=1:100, h = 1, r = 0, R=57.5,
                        x0=c(0,0), id="A1", burst=id,
                        typeII=TRUE)
 {
     if (!require(CircStats))
         stop("package CircStats required")
     if (typeII)
         class(date) <- c("POSIX","POSIXct")
     n <- length(date)
     dt <- c(diff(unclass(date)))
     if (all(dt-dt[1]>1e-7))
         stop("the time lag between relocations should be constant")

         if (h>0) {
            v=sqrt(dt)*rchi(n-1) * h
          } else {
            v=dt/dt*(-h)

          }
		ang<-rwrpnorm(n-2,0,r)
         ang=cumsum(c(runif(1,0,2*pi),ang))
x=c(1:n)
y=x
x[1]= x0[1]
y[1] =x0[2]
for (i in c(2: n)){
		x[i]= x[i-1]+v[i-1]*cos(ang[i-1])
		y[i]= y[i-1]+v[i-1]*sin(ang[i-1])
		RR=(x[i]^2+y[i]^2)
		if ((RR> R^2) && (i< (n-1)) ){

			x[i]= R*x[i]/sqrt(RR)
			y[i]= R*y[i]/sqrt(RR)
			ang2<-rwrpnorm(n-2-i,0,r)
			ang2=cumsum(c(runif(1,0,2*pi),ang2))
			j=c(1:(n-i-1))
			ang[i+j]=ang2[j]

			}
		}

    res <- as.ltraj(data.frame(x,y),date, id, burst,
                     typeII=typeII)
     return(res)
 }

#
#
#  now levy walks!

 simm.levy2 <- function (date = 1:500, mu = 2, l0 = 1, x0 = c(0, 0), id = "A1", R=57.5,

    burst = id, typeII = TRUE)
 {
    if (typeII)
        class(date) <- c("POSIX", "POSIXct")
    n <- length(date)
    dt <- c(diff(unclass(date)))
    if (all(dt - dt[1] > 1e-07))
        stop("the time lag between relocations should be constant")
    ang <- runif(n - 2, -pi, pi)
    v = dt * (l0 * (runif(n - 1)^(1/(1 - mu))))
        ang = cumsum(c(runif(1, 0, 2 * pi), ang))
#    newcode
    x=c(1:n)
    y=x
    x[1]= x0[1]
    y[1] =x0[2]
    for (i in c(2: n)){
      	x[i]= x[i-1]+v[i-1]*cos(ang[i-1])
    		y[i]= y[i-1]+v[i-1]*sin(ang[i-1])
    		RR=(x[i]^2+y[i]^2)
    		if ((RR> R^2) && (i< (n-1)) ){

    			x[i]= R*x[i]/sqrt(RR)
    			y[i]= R*y[i]/sqrt(RR)
    			ang2<-rwrpnorm(n-2-i,0,r)
    			ang2=cumsum(c(runif(1,0,2*pi),ang2))
    			j=c(1:(n-i-1))
    			ang[i+j]=ang2[j]

    			}
    		}
    res <- as.ltraj(data.frame(co, si), date, id, burst, typeII = typeII)
    return(res)
 }

  simm.levycorr <- function (date = 1:500, mu = 2, l0 = 1, x0 = c(0, 0), id = "A1", R=57.5,r=0.6,

     burst = id, typeII = TRUE)
  {
     if (typeII)
         class(date) <- c("POSIX", "POSIXct")
     n <- length(date)
     dt <- c(diff(unclass(date)))
     if (all(dt - dt[1] > 1e-07))
         stop("the time lag between relocations should be constant")
    ang<-rwrpnorm(n-2,0,r)
    ang=cumsum(c(runif(1,0,2*pi),ang))
     v = dt * (l0 * (runif(n - 1)^(1/(1 - mu))))

 #    newcode
     x=c(1:n)
     y=x
     x[1]= x0[1]
     y[1] =x0[2]
     for (i in c(2: n)){
         x[i]= x[i-1]+v[i-1]*cos(ang[i-1])
     		y[i]= y[i-1]+v[i-1]*sin(ang[i-1])
     		RR=(x[i]^2+y[i]^2)
     		if ((RR> R^2) && (i< (n-1)) ){

     			x[i]= R*x[i]/sqrt(RR)
     			y[i]= R*y[i]/sqrt(RR)
     			ang2<-rwrpnorm(n-2-i,0,r)
           ang2=cumsum(c(runif(1,0,2*pi),ang2))
     			j=c(1:(n-i-1))
     			ang[i+j]=ang2[j]

     			}
     		}
     res <- as.ltraj(data.frame(co, si), date, id, burst, typeII = typeII)
     return(res)
  }

  "simm.crw2pauses" <- function(date=1:100, h = 1, r = 0, R=57.5,
                          x0=c(0,0), id="A1", burst=id,
                          typeII=TRUE,act =0.5)
   {
       if (!require(CircStats))
           stop("package CircStats required")
       if (typeII)
           class(date) <- c("POSIX","POSIXct")
       n <- length(date)
       dt <- c(diff(unclass(date)))
       if (all(dt-dt[1]>1e-7))
           stop("the time lag between relocations should be constant")
     #activity of probability 1-ttt
   t= runif(n - 1,0,1)
   t
   t=ifelse(t>act,1,0)
   t

           if (h>0) {
              v=sqrt(dt)*rchi(n-1) * h*t
            } else {
              v=dt/dt*(-h)*t

            }
  		ang<-rwrpnorm(n-2,0,r)
           ang=cumsum(c(runif(1,0,2*pi),ang))
  x=c(1:n)
  y=x
  x[1]= x0[1]
  y[1] =x0[2]
  for (i in c(2: n)){
  		x[i]= x[i-1]+v[i-1]*cos(ang[i-1])
  		y[i]= y[i-1]+v[i-1]*sin(ang[i-1])
  		RR=(x[i]^2+y[i]^2)
  		if ((RR> R^2) && (i< (n-1)) ){

  			x[i]= R*x[i]/sqrt(RR)
  			y[i]= R*y[i]/sqrt(RR)
  			ang2<-rwrpnorm(n-2-i,0,r)
  			ang2=cumsum(c(runif(1,0,2*pi),ang2))
  			j=c(1:(n-i-1))
  			ang[i+j]=ang2[j]

  			}
  		}

      res <- as.ltraj(data.frame(x,y),date, id, burst,
                       typeII=typeII)
       return(res)
   }

   simm.levycorrpauses <- function (date = 1:500, mu = 2, l0 = 1, x0 = c(0, 0), id = "A1", R=57.5,r=0.6,act=0.5,

      burst = id, typeII = TRUE)
   {
      if (typeII)
          class(date) <- c("POSIX", "POSIXct")
      n <- length(date)
      dt <- c(diff(unclass(date)))
      if (all(dt - dt[1] > 1e-07))
          stop("the time lag between relocations should be constant")
     ang<-rwrpnorm(n-2,0,r)
     ang=cumsum(c(runif(1,0,2*pi),ang))
     #activity of probability 1-ttt
     t= runif(n - 1,0,1)
     t
     t=ifelse(t>act,1,0)
     t
      v = t*dt * (l0 * (runif(n - 1)^(1/(1 - mu))))

  #    newcode
      x=c(1:n)
      y=x
      x[1]= x0[1]
      y[1] =x0[2]
      for (i in c(2: n)){
          x[i]= x[i-1]+v[i-1]*cos(ang[i-1])
        	y[i]= y[i-1]+v[i-1]*sin(ang[i-1])
      		RR=(x[i]^2+y[i]^2)
      		if ((RR> R^2) && (i< (n-1)) ){

      			x[i]= R*x[i]/sqrt(RR)
      			y[i]= R*y[i]/sqrt(RR)
      			ang2<-rwrpnorm(n-2-i,0,r)
            ang2=cumsum(c(runif(1,0,2*pi),ang2))
      			j=c(1:(n-i-1))
      			ang[i+j]=ang2[j]

      			}
      		}
      res <- as.ltraj(data.frame(x, y), date, id, burst, typeII = typeII)
      return(res)
   }

#############
############
#########
# i=1
# rrr=0.9
# ttt=0.4
# u <- simm.crw2pauses(1:9000, r = rrr, h=0.75, act=ttt,burst =paste(rrr,ttt,i))
# trajdyn(u)
# plut (sliwinltr(u)
###########
###########
###########
# setwd("d:/dokumente/My Dropbox/buridan/buridan_v2.3/simulated_data/simulated_all")
#
# for (rrr in c(0.8,0.6)) {
# group =ifelse(rrr==0.8,"corrw_r0.8","corrw_r0.6")
#   for (hhh in c(0.75,1)) {
#   group2 =ifelse(hhh==0.75,"_h0.75","_h1")
#     for (i in 0:9){
#       set.seed(872+i)
#
#       u <- simm.crw2(1:9000, r = rrr, h=hhh, burst =paste(rrr,hhh,i))
#
#
#       data=data.frame(c(1:9000),100*c(1:9000),u[[1]]$x,u[[1]]$y,0)
#       names(data)=c("frame","time","x","y", "burst")
#
#       write.table(data,file=paste(group,group2,"_",i,".txt",sep="",collapse = NULL),append = FALSE,sep = "\t", quote= FALSE, row.names= FALSE
#       )
#     }
#   }
# }
#
# for rrr in c(0,0.8)) {
# group =ifelse(rrr==0.8,"levycorrelated08","uncorrelated")
#
#  #for (hhh in c(0.75,1)) {
#  # group2 =ifelse(hhh==0.75,"_h0.75","_h1")
#     for (i in 0:9){
#       set.seed(872+i)
#
#       u <- simm.levycorr(1:9000, r = rrr, mu=3,l0 = 1, burst =paste(rrr,i))
#
#
#       data=data.frame(c(1:9000),100*c(1:9000),u[[1]]$x,u[[1]]$y,0)
#       names(data)=c("frame","time","x","y", "burst")
#
#       write.table(data,file=paste(group,group2,"_",i,".txt",sep="",collapse = NULL),append = FALSE,sep = "\t", quote= FALSE, row.names= FALSE
#       )
#    # }
#   }
# }
# ######with activity
#
# setwd("D:/dokumente/data/buridan/simulated_data/new")
# for (rrr in c(0.985,0.983)) {
# group =ifelse(rrr==0.985,"A","B")
#
#  for (ttt in c(0.4,0.3)) {
#  group2 =ifelse(ttt==0.3,"C","D")
#     for (i in 0:19){
#       set.seed(899+i)
#
#       u <- simm.levycorrpauses(1:9000, r = rrr, mu=3,l0 = 1, burst =paste(rrr,i), act=ttt)
#
#
#       data=data.frame(c(1:9000),100*c(1:9000),u[[1]]$x,u[[1]]$y,0)
#       names(data)=c("frame","time","x","y", "burst")
#
#       write.table(data,file=paste(group,group2,"_",i,".txt",sep="",collapse = NULL),append = FALSE,sep = "\t", quote= FALSE, row.names= FALSE
#       )
#    }
#   }
# }
#
# for (rrr in c(0.95,0.9)) {
# group =ifelse(rrr==0.9,"corrw_r0.8","corrw_r0.6")
#   for (ttt in c(0.66,0.8)) {
#   group2 =ifelse(ttt==0.8,"_h0.75","_h1")
#     for (i in 0:9){
#       set.seed(872+i)
#
#       u <- simm.crw2pauses(1:9000, r = rrr, h=0.75, act=ttt,burst =paste(rrr,ttt,i))
#
#
#       data=data.frame(c(1:9000),100*c(1:9000),u[[1]]$x,u[[1]]$y,0)
#       names(data)=c("frame","time","x","y", "burst")
#
#       write.table(data,file=paste(group,group2,"_",i,".txt",sep="",collapse = NULL),append = FALSE,sep = "\t", quote= FALSE, row.names= FALSE
#       )
#     }
#   }
# }

# traj=data
# newtraj= mindistkeep3(traj,0.6,35)
# traj=new_traj
# #####get env ???
# i=c(1:length(traj))
# env$ = env[1]
#
# g_outputdir= "D:/dokumente/data"
# rgghome="D:/dokumente/My Dropbox/buridan/buridan_v2.2/analysis"
# ###
#
# bla = paste(c(outputfile,"t",g_treshold,"Pt",g_duration_slider,".pdf"),collapse="")
# pdf(bla)
# setwd(rgghome)
# source ("scripts/general.r")
# source ("scripts/straightness.r")
# source ("scripts/occupancy.r")
# source ("scripts/thigmotaxis.r")
# source ("scripts/angledev.r")
# source ("scripts/activity_martin.r")
# g = dev.off()
# source ("scripts/saveworkspace2.r")
#
#

setwd("D:/dokumente/data/buridan/simulated_data/totestagainstcs_rrr=0.985_ttt=0.3")
#########
########## make 20 correlated walks

K=1.5*c(-4:4,-1:1,-3:3,0)
K[1]=2.5
K[2]=-0.5
K[13]=1
J= sample(K,20)
L= sample(K,20)
#for (rrr in c(0.9963)) {  #levy
for (rrr in c(0.9965)) {  #corrwalk
group ="A"

 for (ttt in c(0.85)) { #corr
  # for (ttt in c(0.875)) {  #levy
 group2 ="C"
    for (i in 0:19){
      set.seed(920+i)
      k= 0.7+ K[i+1]/10

#       u <- simm.levycorrpauses(1:9000, r = rrr, mu=3,l0 = 1, burst =paste(rrr,i), act=ttt)
#       u[[1]]$dist[u[[1]]$dist == 0]=NA
#       median(u[[1]]$dist, na.rm=TRUE)
    # u <- simm.levycorrpauses(1:9000, r = rrr+ J[i+1]/1000000, mu=2.6,l0 = 0.8+ K[i+1]/10, burst =paste(rrr,i), act=ttt)
     u <- simm.crw2pauses(1:9000, r = rrr, h=k, act=ttt,burst =paste(rrr,ttt,i))
      #print(median(u[[1]]$dist, na.rm=TRUE))

      data=data.frame(c(1:9000),100*c(1:9000),u[[1]]$x,u[[1]]$y,0)
      names(data)=c("frame","time","x","y", "burst")

      write.table(data,file=paste(group,group2,"_",i,".txt",sep="",collapse = NULL),append = FALSE,sep = "\t", quote= FALSE, row.names= FALSE
      )
   }
  }
}
#########
########## make 20 levy walks

K=1.5*c(-4:4,-1:1,-3:3,0)
K[1]=2.5
K[2]=-0.5
K[13]=1
J= sample(K,20)
L= sample(K,20)
for (rrr in c(0.9963)) {  #levy
#for (rrr in c(0.9965)) {  #corrwalk
group ="B"

 #for (ttt in c(0.85)) { #corr
   for (ttt in c(0.875)) {  #levy
 group2 ="D"
    for (i in 0:19){
      set.seed(920+i)
      k= 0.7+ K[i+1]/10

#       u <- simm.levycorrpauses(1:9000, r = rrr, mu=3,l0 = 1, burst =paste(rrr,i), act=ttt)
#       u[[1]]$dist[u[[1]]$dist == 0]=NA
#       median(u[[1]]$dist, na.rm=TRUE)
     u <- simm.levycorrpauses(1:9000, r = rrr+ J[i+1]/1000000, mu=2.6,l0 = 0.8+ K[i+1]/10, burst =paste(rrr,i), act=ttt)
    # u <- simm.crw2pauses(1:9000, r = rrr, h=k, act=ttt,burst =paste(rrr,ttt,i))
      #print(median(u[[1]]$dist, na.rm=TRUE))

      data=data.frame(c(1:9000),100*c(1:9000),u[[1]]$x,u[[1]]$y,0)
      names(data)=c("frame","time","x","y", "burst")

      write.table(data,file=paste(group,group2,"_",i,".txt",sep="",collapse = NULL),append = FALSE,sep = "\t", quote= FALSE, row.names= FALSE
      )
   }
  }
}

##### other tests

ttt= 0.88

rrr=0.9962
u <- simm.crw2pauses(1:9000, r = rrr, h=0.6, act=ttt,burst =paste(rrr,ttt,i))
v <- simm.levycorrpauses(1:9000, r = rrr, mu=2.6,l0 = 1, burst =paste(rrr,i), act=0.85)
new_traj <- v
    new_traj2 <- mindistkeep3(new_traj, thresholdmin = g_treshold/10,
        thresholdmax = 35)
u= new_traj2
v= new_traj2
median (abs(u[[1]]$rel.angle), na.rm=TRUE)/pi*180
X=c.activity(u,min_pause_length = 10)
Y=c.activity(v,min_pause_length = 10)
#head(X)
sum(X$act[X$act>0])
sum(Y$act[Y$act>0])
speeds = c.speeds(u)$speed_det
speeds2 = c.speeds(v)$speed_det
speeds = speeds[speeds>0]
speeds2 = speeds2[speeds2>0]
B= c(0:12, 2000)
B=B/2
B
hist(speeds, main="correlated", xlim=c(0,5), breaks = B)
hist(speeds2, main="levy", xlim=c(0,5), breaks = B)
length(speeds[speeds>0])
length(speeds2[speeds2>0])

speeds = speeds[speeds>0]
  speeds = speeds[!speeds>50]

median(speeds, na.rm=TRUE)


setwd ("c://R")
CementData=read.csv ("CementData.csv", header=TRUE,sep=",")
str(CementData)

x <- as.matrix(cbind(rep(1,13), CementData[,1:4]))
y <- CementData[,5]

Beta<-solve(t(x)%*%x)%*%t(x)%*%y
Beta

HeatRegFit<- x%*%Beta[,1]
Residual=y-HeatRegFit

plot(Residual,cex = 1.3,lwd = 10)
abline(a=0,b=0,lwd=5)

Rsq = 1 - sum((y - HeatRegFit)^2)/sum((y - mean(y))^2)
Rsq


#' Compute transitions of a given order
#'
#' @param seq  a vector containing observations from an stochastic process.
#' @param order the order of the transitions to be computed (an integer).
#'
#' @return an array with the transitions in the format n_{ijk}, where i, j, k are in states(seq).
#' @export get_contingency_array
#'
#' @examples
#' X <- rbinom(n = 1E5, size = 1, prob = 0.8)
#' get_contingency_array(X, order = 3)
get_contingency_array <- function(seq, order){
  ## Many thanks to https://stackoverflow.com/users/3358272/r2evans
  ## https://stackoverflow.com/questions/67004206/speeding-up-r-code-to-compute-higher-order-transitions-in-a-markov-chain
  N <- length(seq)
  states <- sort(unique(seq))
  nstates <- length(states)
  inds <- seq_along(states)
  K <- order + 1
  out <- array(0, dim = rep(nstates, K))
  for (z in K:N){
    pos <- matrix(match(seq[(z - K + 1):z], states), nrow = 1)
    out[pos] <- out[pos] + 1
  }
  return(out)
}
#' Compute the likelihood ratio statistic comparing a second-order to a first-order Markov chain model for \code{seq}
#'
#' @param seq a vector containing observations from an stochastic process.
#'
#' @return the likelihood ratio statistic (G^2) comparing a second-order model to a first-order one.
#' @export compute_Gsquared
#' @details  Under the null, G^2 has a chi-square(2) distribution.
#' @examples
#' X <- rbinom(n = 1E5, size = 1, prob = 0.8)
#' compute_Gsquared(X)
compute_Gsquared <- function(seq){
  states <- sort(unique(seq))
  nstates <- length(states)
  dt <-  get_contingency_array(seq, 2)
  stats <- c()
  for(k in 1:nstates){
    for( i in 1:nstates){
      for(j in 1:nstates){
        nijk <-  dt[i , j, k] + 1E-17
        nijp <- sum(dt[i, j, ]) + 1E-17
        npjk <- sum(dt[, j, k]) + 1E-17
        npjp <- sum(dt[, j, ]) + 1E-17
        s <- nijk * log((nijk/nijp)/(npjk/npjp))
        stats <- c(stats, s)
      }
    }
  }
  out <- 2*sum(stats)
  return(out)
}
#' Compute the Bayes factor comparing a second-order Markov model to a first-order one.
#'
#' @param seq a vector containing observations from an stochastic process.
#'
#' @return the approximate Bayes factor comparing a second- to a first-order Markov chain model for \code{seq}.
#' @export compute_BF
#'
#' @examples
#' X <- rbinom(n = 1E5, size = 1, prob = 0.8)
#' compute_BF(X)
compute_BF <- function(seq){
  n <- length(seq)
  m <- length(unique(seq))
  Gsq <- compute_Gsquared(seq)
  BF <- (Gsq - 2*log(n))/2
  return(BF)
}
#' Thin a sample until the first-order Markov model is preferred.
#'
#' @param seq a vector containing observations from an stochastic process.
#' @param max_k maximum thinning to be tried.
#'
#' @return a list containing the selected \code{k}, the achieved Bayes factor (\code{BF})
#'  and whether one could indeed find a \code{k} less than \code{max_k}
#'   such that the first-order model is preferred.
#' @export find_k
#' @details This is the same approach as Raftery & Lewis (1992) "How many iterations in the Gibbs sampler?"
#' @examples
#' library(markovchain)
#' M <- 1E4
#' p <-  runif(1)
#' ( maxA <- min(p/(1-p), 1) ) ## maximum alpha
#' a <- runif(1, 0, maxA)
#' b <- exp(log(a)  + log(1-p) - log(p))
#' mat <- matrix(c(1-a, a, b, 1-b), ncol = 2, nrow = 2, byrow = TRUE)
#' MC.binary <- new("markovchain",
#'  states = c("0", "1"),
#'   transitionMatrix = mat, name = "Binary")
#' out1 <- markovchainSequence(n = M, markovchain = MC.binary, t0 = "0")
#' X1 <- as.numeric(out1)
#'
#' rs <- runif(4^2)
#' mat2 <- structure(c(0.264985809735216, 0.598430024309721, 0.140708602965477,
#' 0.0566167324620894, 0.278728488803952, 0.0427599923571986, 0.453529988769559,
#' 0.604004074666218, 0.116827824413052, 0.0358869202453851, 0.181735130309576,
#' 0.266807259734723, 0.33945787704778, 0.322923063087696, 0.224026277955388,
#' 0.0725719331369693), .Dim = c(4L, 4L))
#'  MC.binary2nd <- new("markovchain",
#'   states = c("00", "01", "10", "11"),
#'    transitionMatrix = mat2, name = "Binary2nd")
#' out2 <- markovchainSequence(n = M/2, markovchain = MC.binary2nd, t0 = "01")
#' X2 <- as.numeric(strsplit(paste(out2, collapse = ""), "")[[1]])
#' find_k(X1)
#' find_k(X2)
find_k <- function(seq, max_k = 10){
  k <- 1
  BF <- compute_BF(seq)
  while(BF > 0){
    k <- k + 1
    inds <- seq.int(1L, length(seq), k)
    BF <- compute_BF(seq = seq[inds])
    if(k >= max_k) break
  }
  return(
    list(
      k = k,
      BF = BF,
      success = (BF < 0)
    )
  )
}


euclidean <- function(a, b) {
  return (sqrt(sum((a - b) ^ 2)))
}

fast_cvloo_knn <- function(dset) {
  maxK <- length(dset[,1]) - 1
  classes = unique(dset$class)

  ans <- rep(x = 0, times = maxK)
  for (i in 1:length(dset[,1])) {
    # for (i in 1:10) {
    cat("\r", "Processing sample ", i, " of ", length(dset[,1]))
    dataset <- dset[-i,]
    # print(dataset)
    distance <- array(dim=c(length(dataset[,1])))
    for (j in 1:(length(dataset[,1]))) {
      distance[j] <- euclidean(dataset[j, 1:2], dset[i, 1:2])
    }
    sortedDataset <- dataset[order(distance),]

    classesCount <- rep(x = 0, times = length(classes))
    names(classesCount) = classes
    for (j in 1:maxK) {
      classesCount[sortedDataset$class[j]] <- classesCount[sortedDataset$class[j]] + 1

      classForCurrentK = names(which.max(classesCount))[1]
      if (classForCurrentK == dset$class[i]) {
        ans[j] = ans[j] + 1
      }
    }

  }
  cat("\n")
  for (i in 1:length(ans)) {

    ans[i] = ans[i] / length(dset[,1] - 1)
  }

  return (ans)
}

kNN <- function(dataset, points, k, dist = euclidean) {
  answer <- array(dim=c(length(points[,1])))

  for (i in 1:length(points[,1])) {
    distance <- array(dim=dim(dataset)[1])
    for (j in 1:dim(dataset)[1]) {
      distance[j] <- dist(dataset[j, 1:2], points[i,])
    }
    sortedDataset <- dataset[order(distance),]

    classesCount <- c(0, 0, 0)
    names(classesCount) = unique(dataset$class)
    for (j in 1:k) {
      classesCount[sortedDataset$class[j]] <- classesCount[sortedDataset$class[j]] + 1
    }
    answer[i] = names(which.max(classesCount))[1]
  }

  return (answer)
}

df = data.frame(x = double(), y = double(), class = character())

df <- rbind(df, data.frame(x = 122, y = 2208, class = "class-1"))
df <- rbind(df, data.frame(x = 148, y = 1136, class = "class-2"))
df <- rbind(df, data.frame(x = 270, y = 2186, class = "class-1"))
df <- rbind(df, data.frame(x = 271, y = 2016, class = "class-1"))
df <- rbind(df, data.frame(x = 306, y = 1023, class = "class-2"))
df <- rbind(df, data.frame(x = 413, y = 1153, class = "class-2"))
df <- rbind(df, data.frame(x = 503, y = 2013, class = "class-1"))
df <- rbind(df, data.frame(x = 541, y = 971, class = "class-2"))
df <- rbind(df, data.frame(x = 706, y = 1018, class = "class-2"))
df <- rbind(df, data.frame(x = 837, y = 867, class = "class-2"))
df <- rbind(df, data.frame(x = 875, y = 1011, class = "class-2"))
df <- rbind(df, data.frame(x = 927, y = 1915, class = "class-1"))
df <- rbind(df, data.frame(x = 997, y = 897, class = "class-2"))
df <- rbind(df, data.frame(x = 1005, y = 529, class = "class-2"))
df <- rbind(df, data.frame(x = 1028, y = 1176, class = "class-2"))
df <- rbind(df, data.frame(x = 1050, y = 1429, class = "class-1"))
df <- rbind(df, data.frame(x = 1125, y = 781, class = "class-2"))
df <- rbind(df, data.frame(x = 1144, y = 1061, class = "class-2"))
df <- rbind(df, data.frame(x = 1146, y = 1751, class = "class-1"))
df <- rbind(df, data.frame(x = 1192, y = 1601, class = "class-1"))
df <- rbind(df, data.frame(x = 1264, y = 888, class = "class-2"))
df <- rbind(df, data.frame(x = 1275, y = 1412, class = "class-1"))
df <- rbind(df, data.frame(x = 1329, y = 576, class = "class-2"))
df <- rbind(df, data.frame(x = 1366, y = 1586, class = "class-1"))
df <- rbind(df, data.frame(x = 1405, y = 386, class = "class-2"))
df <- rbind(df, data.frame(x = 1432, y = 1226, class = "class-1"))
df <- rbind(df, data.frame(x = 1597, y = 279, class = "class-2"))
df <- rbind(df, data.frame(x = 1615, y = 1604, class = "class-1"))
df <- rbind(df, data.frame(x = 1631, y = 1200, class = "class-1"))
df <- rbind(df, data.frame(x = 1638, y = 1365, class = "class-1"))
df <- rbind(df, data.frame(x = 1765, y = 1262, class = "class-1"))
df <- rbind(df, data.frame(x = 1806, y = 1444, class = "class-1"))
df <- rbind(df, data.frame(x = 1821, y = 1056, class = "class-1"))
df <- rbind(df, data.frame(x = 1896, y = 877, class = "class-1"))
df <- rbind(df, data.frame(x = 1993, y = 695, class = "class-1"))
df <- rbind(df, data.frame(x = 2027, y = 1415, class = "class-1"))
df <- rbind(df, data.frame(x = 2087, y = 889, class = "class-1"))
df <- rbind(df, data.frame(x = 2189, y = 674, class = "class-1"))

z = array(c(c(1164, 1232)), dim = c(1,2))

par(mfrow=c(1,2), pty="s")
# LOO CV, looking for the best k
stats <- fast_cvloo_knn(df)
plot(1:(length(df[,1]) - 1), stats, type="l", xlab="k", ylab="Accuracy")

maxPoint = which(stats == max(stats))
points((1:(length(df[,1]) - 1))[maxPoint], stats[maxPoint], pch = 19, col = "red")

bestK <- which.max(stats)
cat("Best K =", bestK, "\n")

colors <- c("class-1" = "blue", "class-2" = "red")
plot(df[, 1:2], bg = colors[paste(df$class)], pch=23, asp=1)

result <- kNN(df, z, 5)
points(z[,1], z[,2], bg = colors[result], pch = 22)

1 - Nearest neighbors algorithm/knn-loocv-img-exp.r


## minimum cost network flow model for phase unwrapping

#' @describeIn brcutpuw Network flow algorithm for phase unwrapping
netflowpuw <- function(phase, wts=NULL, details=FALSE, trace=1) {
  nr <- nrow(phase)
  nc <- ncol(phase)
  dx <- zernike::wrap(diff(phase))
  dy <- zernike::wrap(t(diff(t(phase))))
  d2x <- dx[,2:nc] - dx[,1:(nc-1)]
  d2y <- dy[1:(nr-1),] - dy[2:nr,]
  ndx <- sum(!is.na(dx))
  ndy <- sum(!is.na(dy))
  charge <- -round((d2y+d2x)/(2*pi))

  if (sum(abs(charge), na.rm=TRUE) == 0) {
    cat("Phase map is trivial to unwrap, so calling idiffpuw\n")
    return(zernike::idiffpuw(phase, ucall=TRUE))
  }

  ## these weights are too simple, but this seems to work
  ## better than combining weights from each pixel that
  ## went into a given difference.

  if (!is.null(wts)) {
    wts <- wts/max(wts,na.rm=TRUE)
    wx <- wts[-1,]
    wy <- wts[,-1]
    wx <- wx[!is.na(dx)]
    wy <- wy[!is.na(dy)]
    obj <- c(wx, wx, wy, wy)
  } else {
    obj <- rep(1, 2*(ndx+ndy))
  }
  ## the optimal solution will cancel the map's charges

  kx <- dx
  kx[!is.na(kx)] <- 1:ndx
  ky <- dy
  ky[!is.na(ky)] <- 1:ndy

  ## these are the 1d indexes of the pixels that go into each 2 x 2 loop

  k2x1 <- kx[,1:(nc-1)][!is.na(charge)]
  k2x2 <- kx[,2:nc][!is.na(charge)]
  k2y1 <- ky[1:(nr-1),][!is.na(charge)]
  charge <- charge[!is.na(charge)]
  rm(d2x,d2y,kx,ky)

  nrow <- length(charge)
  ncol <- 2*(ndx+ndy)
  row <- c(-1., 1., 1., -1., 1., -1., -1., 1.)
  xvals <- rep(row, nrow)
  i_ind <- rep(1:nrow, each=8)
  j_ind <- as.numeric(rbind(k2x1, k2x2,
                            k2x1+ndx, k2x2+ndx,
                            k2y1+2*ndx, k2y1+2*ndx+1,
                            k2y1+2*ndx+ndy, k2y1+2*ndx+ndy+1)
              )
  if (packageVersion("Matrix") >= "1.3.0") {
    mat <- Matrix::sparseMatrix(i=i_ind, j=j_ind, x=xvals, dims=c(nrow, ncol), repr="T")
  } else {
    mat <- Matrix::sparseMatrix(i=i_ind, j=j_ind, x=xvals, dims=c(nrow, ncol), giveCsparse=FALSE)
  }

  lpout <- rcbc::cbc_solve(obj=obj, mat=mat,
                           row_ub=charge,
                           row_lb=charge,
                           col_lb=rep(0, ncol),
                           col_ub=rep(1, ncol),
                           cbc_args = list(log=trace, verbose=trace)
                 )
  if (rcbc::solution_status(lpout) != "optimal") {
    warning("non-convergence detected")
    return(lpout)
  }

  dx <- rbind(dx, rep(NA, nc))
  dy <- cbind(dy, rep(NA, nr))
  soln <- lpout$column_solution
  ex <- soln[1:ndx]-soln[(ndx+1):(2*ndx)]
  ey <- soln[(2*ndx+1):(2*ndx+ndy)]-soln[(2*ndx+ndy+1):(2*ndx+2*ndy)]
  ex.m <- dx
  ey.m <- dy
  ex.m[!is.na(dx)] <- ex
  ey.m[!is.na(dy)] <- ey
  puw <- zernike::idiffpuw(phase=phase, dx=dx+2*pi*ex.m, dy=dy+2*pi*ey.m)
  if (details) {
    ex.m[ex.m==0] <- NA
    ey.m[ey.m==0] <- NA
    list(puw=puw, ex=ex.m, ey=ey.m, lpout=lpout)
  } else {
    puw
  }

}


library(signal)

a0 <- 0.35875
a1 <- 0.48829
a2 <- 0.14128
a3 <- 0.01168
x <- seq(0.0, 1.0, by=1/40)
h <- a0 - a1 * cos(2 * pi * x) + a2 * cos(4 * pi * x) - a3 * cos(6 * pi * x)
h <- B/sum(B)

# Print filter coefficients
paste(sprintf("%.10e", h), collapse=", ")

fh <- freqz(h)

op <- par(mfrow = c(1, 2))

plot(fh$f / pi, abs(fh$h), type = "l", ylab = "magnitude", xlab = "Frequency", xlim = c(0, 0.2))

plot(fh$f / pi, 20*log10(abs(fh$h)+1e-5), type = "l", ylab = "dB", xlab = "Frequency", xlim = c(0, 0.2))

par(op)


n<-100
mu<-3
std<-1

vari=std^2

x<-rnorm(n, mean = mu, sd = std)
hist(x)

like<- -n/2*log(2*pi*vari) -1/(2*vari)*sum((x-mu)^2)
like


a <- as.hexmode(35)
b <- as.hexmode(42)
as.integer(a & b)      # 34
as.integer(a | b)      # 43
as.integer(xor(a, b))  # 9


S14ACJ Example Program Results

        X       psi(X)-log(X)

        0.1000  -8.1212
        0.5000  -1.2704
        3.6000  -0.1453
        8.0000  -0.0638


install.packages('data.table')
install.packages('MASS')
install.packages('VGAM')
install.packages("ggplot2")
install.packages("ggrepel")
install.packages('ggpubr')
install.packages('ggExtra')
install.packages('stargazer')
install.packages('corrplot')
install.packages('olsrr')
install.packages('eply')

library(data.table)
library(MASS)
library(car)
library(ggplot2)
library(ggrepel)
library(ggpubr)
library(ggExtra)
library(stargazer)
library(nlme)
library(corrplot)
library(Matrix)
library(olsrr)
library(eply)
setwd("C:/Users/Han/Desktop/Box Sync/Stat 501/Final Project")

dt_1 = fread('final project dataset 1.txt')
dt_2 = fread('final project dataset 2.txt')

dt = merge(dt_1,dt_2,by = 'State')

#[1] 0
## No NA value

#### 1.	Find an appropriate linear regression model with M as the dependent variables.
#### Among the independent variables include MA, D, PL, S, B, HT, UR, CR, HS, INC, PL, VT, and UR.
#### Add and subtract variables as you think fit.
#### Notice that you may need to detect influential points, multicollineaity, also do necessary transformation if needed.

dt1 = dt[,c('State','M','MA','D','PL','S','B','HT','UR','CR','HS','INC','VT')]
dt1[,2:13] = dt1[,2:13][,lapply(.SD,as.numeric)]
# standardize all X
dt1[,3:13] = dt1[,3:13][,lapply(.SD,scale)]

# orignal EDA
temp <- ggplot(dt1, aes(x=MA, y=M)) + geom_point() + theme_classic() + geom_smooth(method = 'lm')+ theme(text = element_text(size=26, face = 'bold'))
x11 = ggMarginal(temp,type = 'histogram', fill = "cyan")
temp <- ggplot(dt1, aes(x=D, y=M)) + geom_point() + theme_classic()+ geom_smooth(method = 'lm')+ theme(text = element_text(size=26, face = 'bold'))
x12 = ggMarginal(temp,type = 'histogram', fill = "cyan")
temp <- ggplot(dt1, aes(x=PL, y=M)) + geom_point() + theme_classic()+ geom_smooth(method = 'lm')+ theme(text = element_text(size=26, face = 'bold'))
x13 = ggMarginal(temp,type = 'histogram', fill = "cyan")
temp <- ggplot(dt1, aes(x=S, y=M)) + geom_point() + theme_classic()+ geom_smooth(method = 'lm')+ theme(text = element_text(size=26, face = 'bold'))
x14 = ggMarginal(temp,type = 'histogram', fill = "cyan")
temp <- ggplot(dt1, aes(x=B, y=M)) + geom_point() + theme_classic()+ geom_smooth(method = 'lm')+ theme(text = element_text(size=26, face = 'bold'))
x15 = ggMarginal(temp,type = 'histogram', fill = "cyan")
temp <- ggplot(dt1, aes(x=HT, y=M)) + geom_point() + theme_classic()+ geom_smooth(method = 'lm')+ theme(text = element_text(size=26, face = 'bold'))
x16 = ggMarginal(temp,type = 'histogram', fill = "cyan")
temp <- ggplot(dt1, aes(x=UR, y=M)) + geom_point() + theme_classic()+ geom_smooth(method = 'lm')+ theme(text = element_text(size=26, face = 'bold'))
x17 = ggMarginal(temp,type = 'histogram', fill = "cyan")
temp <- ggplot(dt1, aes(x=CR, y=M)) + geom_point() + theme_classic()+ geom_smooth(method = 'lm')+ theme(text = element_text(size=26, face = 'bold'))
x18 = ggMarginal(temp,type = 'histogram', fill = "cyan")
temp <- ggplot(dt1, aes(x=HS, y=M)) + geom_point() + theme_classic()+ geom_smooth(method = 'lm')+ theme(text = element_text(size=26, face = 'bold'))
x19 = ggMarginal(temp,type = 'histogram', fill = "cyan")
temp <- ggplot(dt1, aes(x=INC, y=M)) + geom_point() + theme_classic()+ geom_smooth(method = 'lm')+ theme(text = element_text(size=26, face = 'bold'))
x110 = ggMarginal(temp,type = 'histogram', fill = "cyan")
temp <- ggplot(dt1, aes(x=VT, y=M)) + geom_point() + theme_classic()+ geom_smooth(method = 'lm')+ theme(text = element_text(size=26, face = 'bold'))
x111 = ggMarginal(temp,type = 'histogram', fill = "cyan")
temp <- ggplot(dt1[-33,], aes(x=MA, y=M)) + geom_point() + theme_classic() + geom_smooth(method = 'lm')+ theme(text = element_text(size=18, face = 'bold'))+
        labs(x = 'influential pt temporarily removed MA')
x112 = ggMarginal(temp,type = 'histogram', fill = "cyan")
ggarrange(x11,x112,x12,x13,x14,x15,x16,x17,x18,x19,x110,x111,ncol = 4,nrow = 3)

tr <- function (m)
{
   total_sum <- 0
   if(is.matrix(m))
   {
      row_count <- nrow(m)
      col_count <- ncol(m)
      if(row_count == col_count)
      {
         total_sum <-sum(diag(m))
         total_sum
      }
      else
      {
         message ('Matrix is not square')
      }
   }
   else
   {
      message( 'Object is not a matrix')

   }
}
Near.Neighbor.Approach = function(x){
   x = as.data.frame(x)
   rns = x[,1]
   x = x[,-1]
   rownames(x) = rns
   x = as.matrix(x)

   n = nrow(x) ; k = ncol(x)
   y = x[,1]
   z = matrix(1,n,1)
   x[,1] = z

   prx = diag(n) - x %*% ginv(t(x)%*%x) %*% t(x)
   E = prx %*% y
   V = matrix(0,n,n)
   for (i in 1:(n-1)){
      for (j in (i+1):n){
         d = t(x[i,]-x[j,]) %*% (x[i,]-x[j,])
         if (d > 0) {
            V[i,j] = -2/d
            V[j,i] = -2/d
         }
      }
   }

   for (i in 1:n){
      V[i,i] = - sum(V[i,])
   }

   B = prx %*% V %*% prx

   NUM = t(E) %*% V %*% E
   DEN = t(E) %*% E/(n-k)
   STAT = NUM/DEN
   MEAN = tr(B)
   VAR = 2*((n-k)*tr(B %*% B)-(tr(B))^2)/(n-1)
   STAT = (STAT -MEAN)/sqrt(VAR)
   STAT = as.numeric(STAT)
   return(STAT)
}

t.1 = Near.Neighbor.Approach(dt1)
n = 50; k = 11
p_value = 2* pt(t.1,n-k+2)

# temporaliy elimate outliers/influential points
# temporaliy do proper transfer on X

# Variable selection

model1 = lm(M ~., data = dt1[,2:13])
k1 = ols_best_subset(model1)
plot(k1)
k1
plot(ols_stepaic_both(model1))

ols_stepwise(model1)
# choose the 9th model based on adj r^2, C(p) and AIC
dt1.a = dt1[,-c(1,6,8)]
# multicollinearity
model1.a = lm(M ~., data = dt1.a)
ols_coll_diag(model1.a)
X.corr.a = cor(dt1.a[,2:10])
corrplot(X.corr.a,method = 'circle',addCoef.col  = 'black')
# lets see if we further delete HS from dt1, how things will chagne
dt1.b = dt1[,-c(1,6,8,11)]
# multicollinearity
model1.b = lm(M ~., data = dt1.b)
ols_coll_diag(model1.b)
X.corr.b = cor(dt1.b[,2:9])
corrplot(X.corr.b,method = 'circle',addCoef.col  = 'black')
# lets see if we further delete HS from dt1, how things will chagne
dt1.c = dt1[,-c(1,3,6,7,8,10)]
# multicollinearity
model1.c = lm(M ~., data = dt1.c)
ols_coll_diag(model1.c)
X.corr.c = cor(dt1.c[,2:7])
corrplot(X.corr.c,method = 'circle',addCoef.col  = 'black')
# lets see if we further delete HS from dt1, how things will chagne
dt1.d = dt1[,-c(1,4,6,8,9)]
# multicollinearity
model1.d = lm(M ~., data = dt1.d)
ols_coll_diag(model1.d)
X.corr.d = cor(dt1.d[,2:7])
corrplot(X.corr.d,method = 'circle',addCoef.col  = 'black')

# regression and residual and influence diagonostic

summary(model1.a)
summary(model1.b)
summary(model1.c)
summary(model1.d)

ols_correlations(model.a)
ols_ovsp_plot(model.a)
http://www.rsquaredacademy.com/olsrr/articles/influence_measures.html
ols_diagnostic_panel(model.a)
ols_norm_test(model.a)
ols_corr_test(model.a)
ols_dfbetas_panel(model.a)
## Run LASSO
# provide an arithmetic series
l1 = seq(from =-7, to =7, by = .001)
# conver to geometric series to use as user provided lambda
l2 = exp(-l1)
set.seed(42)

fit.lasso.cv = cv.glmnet(x = as.matrix(dt1[,2:12]), y =as.matrix(dt1[,1]),type.measure = 'mse', alpha = 1, family = 'gaussian', nfolds=5,  lambda = l2)
fit.ridge.cv = cv.glmnet(x = as.matrix(dt1[,2:12]), y =as.matrix(dt1[,1]),type.measure = 'mse', alpha = 0, family = 'gaussian', nfolds=5,  lambda = l2)
par(mfrow=c(1,3))
plot(fit.lasso.cv)
plot(fit.lasso.cv$glmnet.fit, "norm",   label=TRUE)
plot(fit.lasso.cv$glmnet.fit, "lambda", label=TRUE)
par(mfrow=c(1,1))
plot(fit.ridge.cv)
fit.lasso.cv$lambda.1se

#
dt2 = cbind(dt[,15],dt[,-15])
dt2 = dt2[,c(2,1,3:27)]
dt2[,2:27] = dt2[,2:27][,lapply(.SD,as.numeric)]
# standardize all X
dt2[,3:27] = dt2[,3:27][,lapply(.SD,scale)]

t.2 = Near.Neighbor.Approach(dt2)
n = 50; k = 25
p_value = 2* pt(t.2,n-k+2)

dt2.a = dt2
dt2.a[,2] = 1/dt2.a[,2]

t.2.a = Near.Neighbor.Approach(dt2.a)
n = 50; k = 25
p_value.2a = 2* pt(t.2.a,n-k+2)
colnames(dt2.a)[2] = 'inv_MA'
model2.a = lm(inv_MA ~., data = dt2.a[,2:27])

dt2.b = dt2.a
dt2.b[,6:8] = dt2.b[,6:8][,lapply(.SD,rank)]
dt2.b[,6:8] = dt2.b[,6:8]/50
dt2.c = dt2.b[,c(1:8, 12,14:16, 19:20, 23, 26:27)]
model2.c = lm(inv_MA ~., data = dt2.c[,2:ncol(dt2.c)])

time = proc.time()
k2.c = ols_best_subset(model2.c)
proc.time() - time

ols_norm_test(model2.d)

g8 = list()
for (i in 3:ncol(dt2.a)){
  temp <- ggplot(dt2.a, aes_string(x=colnames(dt2.a)[i], y = colnames(dt2.a)[2])) + labs(y ='1/MA') +
    geom_point() + theme_classic() + geom_smooth(method = 'lm')+ theme(text = element_text(size=26, face = 'bold'))
  g8[[i-2]] <- ggMarginal(temp,type = 'histogram', fill = "cyan")
}
ggarrange(g8[[1]],g8[[2]],g8[[3]],g8[[4]],g8[[5]],g8[[6]],g8[[7]],
          g8[[8]],g8[[9]],g8[[10]],g8[[11]],g8[[12]],g8[[13]],g8[[14]],
          g8[[15]],g8[[16]],g8[[17]],g8[[18]],g8[[19]],g8[[20]],
          g8[[21]],g8[[22]],g8[[23]],g8[[24]],g8[[25]],ncol = 5,nrow = 5)

model2 = lm(MA ~., data = dt2[,2:27])
k2 = ols_best_subset(model2)
plot(k2)
k2
ols_stepaic_both(model2)
ols_stepwise(model2)

Near.Neighbor.Approach(dt2)

http://www.biostat.jhsph.edu/~iruczins/teaching/jf/ch10.pdf
https://stats.stackexchange.com/questions/61217/transforming-variables-for-multiple-regression-in-r
http://nymetro.chapter.informs.org/prac_cor_pubs/01-08%20INFORMS_Jan2008.pdf
http://www.stat.columbia.edu/~martin/W2024/R10.pdf
https://stats.stackexchange.com/questions/214682/stepwise-regression-in-r-how-does-it-work
http://www.columbia.edu/~so33/SusDev/Lecture_6.pdf

## directly do v selection based on R square


#Objetivo:  introducir concepto de curva ROC

#limpio la memoria
rm(list=ls())
gc()

library("data.table")

setwd("E:/UBA/2019-II/DM en Finanzas/Dropbox Prof/datasets")

#cargo los datos
dataset <- fread("201902.txt")

#creo una clase que se 1 cuando es BAJA+2   , y  0 en caso contrario
#esto me simplifica las cuentas
dataset[ , clase01:= as.numeric(clase_ternaria=="BAJA+2") ]

#calculos basicos
universo  <-  nrow(dataset )
pos_total <-  sum(dataset$clase01 )
neg_total <-  universo -  pos_total

#tambien podria hacer
neg_total <-  sum( 1 - dataset$clase01 )

#----------------

#Dibujo la curva ROC del predicado    mcuentas_saldo<= -120000

#positivos del predicado
pos_pred    <- sum(  dataset[ (mcuentas_saldo<= -120000) , clase01] )

#negativos del predicado
neg_pred    <- sum(  dataset[ (mcuentas_saldo<= -120000) , 1 - clase01] )

#Tener en cuenta que los NA's  no se estan contando en este predicado !

#la diagonal de la Curva Roc
azar_neg <- c( 0, neg_total )
azar_pos <- c( 0, pos_total )

#grafico
plot( azar_neg,
      azar_pos,
      type="n",
      main=paste( "ROC Curve", "(mcuentas_saldo<= -120000)" ),
      xlab="neg",
      ylab="pos",
      pch=19)

#dibujo la diagonal
lines( azar_neg, azar_pos,   type="l" , col="black", lwd=2)

#para el predicado creo el vector con los tres puntos
vneg <- c( 0, neg_pred,  neg_total )
vpos <- c( 0, pos_pred,  pos_total )

#dibujo la linea
lines( vneg, vpos,   type="l" , col="green", lwd=2)

#Calculo  AUC  Area Under Curve
triangulo_area <- pos_pred*neg_pred/2
trapecio_area  <- (pos_pred + pos_total)*(neg_total-neg_pred) / 2
AUC            <- (triangulo_area + trapecio_area ) / (pos_total*neg_total)

#----------------------
# Creo una funcion para automatizar

pred_graficar  = function(dataset, pcolumna, pvalor )
{
  #calculos basicos
  universo  <-  nrow(dataset )
  pos_total <-  sum(dataset$clase01 )
  neg_total <-  universo -  pos_total

  pos_pred <- sum( dataset[ get(pcolumna) <= pvalor , clase01] )
  neg_pred <- sum( 1 - dataset[ get(pcolumna) <= pvalor, clase01] )

  AUC <- (pos_pred*neg_pred + (pos_pred + pos_total)*(neg_total-neg_pred) ) / (2*pos_total*neg_total)

  #la diagonal
  azar_neg <- c( 0, neg_total )
  azar_pos <- c( 0, pos_total )

  #grafico
  plot( azar_neg,
        azar_pos,
        type="n",
        main=paste( "ROC Curve", "(", pcolumna, "<=", pvalor, ")", "AUC=", AUC ),
        xlab="neg",
        ylab="pos",
        pch=19)

  #dibujo la linea del azar
  lines( azar_neg, azar_pos,   type="l" , col="black", lwd=2)

  #creo el vector con los tres puntos
  vneg <- c( 0, neg_pred,  neg_total )
  vpos <- c( 0, pos_pred,  pos_total )

  #dibujo la curva del predicado
  lines( vneg, vpos,   type="l" , col="green", lwd=2)

  return( AUC )
}
#----------------------

#algunos cortes de la variable  mcuentas_saldo
pred_graficar( dataset, "mcuentas_saldo", -120000 )
pred_graficar( dataset, "mcuentas_saldo", 0 )
pred_graficar( dataset, "mcuentas_saldo", 10000 )

#algunos cortes de la variable  Visa_mconsumototal
pred_graficar( dataset, "Visa_mconsumototal", 200000 )

#una variable que no esta correlacionada con la clase
pred_graficar( dataset, "cliente_edad", 40 )

#una vieja conocida variable
pred_graficar( dataset, "Visa_cuenta_estado", 10 )

#por que esta por debajo de la linea de azar ?


MaxHit=function(song){
# song is a vector of 0's and 1's that represents the hits (0) and
# misses (1) of the notes in order

  streak_lengths=diff(c(0,which(song==1),length(song)+1))-1
  max_streak=max(streak_lengths)

  # About these commands:
  # which(song==1) returns a vector indicating which on which notes (indices) a miss occurs
  #                this is important for you because it will indicate the end of a streak
  # c(0,which(song==1),length(song)+1) creates a vector starting with 0 (indicates the beginning of the song),
  #                 then the locations of misses, and then the length of the song + 1 (indicates when the song has ended)

  return(max_streak)
}

# Hypothesis test based on the MaxHit method
MaxHit_test = function(song,B=1000){
    # song is a vector of 0's and 1's that represents the hits (0)
	# and misses (1) of the notes in order
	# B is the number of new samples to generate

	test_stat = MaxHit(song)
	n = length(song)
	tstar_b = numeric(B)
	for(b in 1:B){
		song_tmp = sample(song)  # for permutation test
#		song_tmp = sample(song,replace=T) # for non-parametric bootstrap
#		song_tmp = rbinom(n,1,mean(song)) # for parametric bootstrap
		tstar_b[b] = MaxHit(song_tmp)
	}

	# calculate the two-sided p-value from the sampling distribution
	pval = 2*min(sum(tstar_b >= test_stat),sum(tstar_b <= test_stat))/B
		# calculate a one sided p-value
#	pval = sum(tstar_b >= test_stat)/B
	return(pval)
}

# Examples using Songs A and B from Table 1

songA = c(1,0,0,0,0,0,1,0,1,0,0,1,0,0,0,0,1,0,0,0)
MaxHit(songA)
MaxHit_test(songA,5000)

songB = c(0,0,0,1,0,0,0,0,0,0,0,1,1,1,1,0,0)
MaxHit(songB)
MaxHit_test(songB,5000)


 DGELSY Example Program Results

 Least squares solution
      0.6344     0.9699    -1.4402     3.3678     3.3992

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


library(shiny)
library(ggplot2)
library(TTR)
library(dygraphs)
library(datasets)
library(xts)
library(plyr)

dataset1<- read.csv(file="Node383.csv", header = TRUE, stringsAsFactors = F)  # read csv file
dataset2 <- read.csv(file="Node384.csv", header = TRUE, skip=16,stringsAsFactors = F )  # read csv file
dataset3 <- read.csv(file="Node573.csv", header = TRUE, skip=16,stringsAsFactors = F )  # read csv file
dataset4 <- read.csv(file="Node574.csv", header = TRUE, skip=15,stringsAsFactors = F)  # read csv file
#-----------------------------------------------------------------------------------------------
#----------------------------------------------------------------------------------------------
shinyUI(pageWithSidebar(

  ## Application title
  titlePanel(title = h4("Analysis", align = "center")),

  ## Sidebar with a slider input for number of observations

  sidebarPanel (

   radioButtons(
    inputId="radio",
    label="Selection a Node:",
    choices=list(
      "Node 383",
      "Node 384",
	    "Node 573",
	    "Node 574"),
    #selectInput("plot","plot1","plot2","plot3"),
    selected="Node 383"),
	fileInput("file","upload a file"),
	helpText("Max. file size is 5MB"),

    sliderInput('samplesize','Select Sample Size', min=1, max=nrow(dataset1),
                value=min(500,nrow(dataset2)),
                step=50,
                round=0),

    selectInput('x','X',names(dataset1[c(3,4,5,6)]), selectize=FALSE),
    selectInput('y','Y',names(dataset1[c(3,4,5,6)]), names(dataset1)[[4]], selectize=FALSE),
  width=2

  ),

  ## Show a plot of the generated distribution

  mainPanel(
    tabsetPanel(type="tab",
               #tabPanel("test",  verbatimTextOutput("str"), plotOutput('plot_lm',height="400")),
                tabPanel("Summary", h4(textOutput("dataname")),
                         dygraphOutput("plot") , verbatimTextOutput("summary")),
                #tabPanel("Data",h4(textOutput("samplesize")), tableOutput("datadf")),
                tabPanel("Statistics",h4(textOutput("samplesize")), verbatimTextOutput("stats")),
                tabPanel("Similarity Measures",
                        helpText("Identify the model of the simulated data using the correlograms, the",
                                 strong("Autocorrelation Function"), "(ACF), ",
                                 strong("Crosscorrelation Function"), "(CCF) and the",
                                 strong("Partial Autocorrelation Function"), "(PACF).",
                                 br(),br()),
                        tabsetPanel(type = "tab",
                                    tabPanel("ACF",
                                             fluidRow (style= "padding-bottom: 20px",
                                               column(3, selectInput("acf_yvalue","Channel",names(dataset1[c(3,4,5,6)]))),
                                               column(3, numericInput("acf_lag","TimeLag", 4 , min=2, max =50)),
                                               column(3, radioButtons(
                                                 inputId="acf_options",label="Operations",
                                                 choices=c("Auto Covariance" = "covariance",
                                                           "Auto Correlation"= "correlation",
                                                           "partial Auto Correlation" ="partial"),
                                                 selected="covariance"))),
                                             #fluidRow(dygraphOutput("plot_acf"))),
                                    fluidRow(plotOutput("plot_acf"))),
                                    tabPanel("CCF",
                                             fluidRow (style= "padding-bottom: 20px",
                                                       column(4, selectInput("ccf_y2value","Choose data 2",names(dataset1[c(3,4,5,6)]), names(dataset1)[[4]])),
                                                     column(4, numericInput("ccf_lag","TimeLag", 4 , min=2, max =50)),
                                                       width=2),
                                             fluidRow(plotOutput("plot_ccf"), tableOutput("datadf"))),
                                             #fluidRow(dygraphtOutput("plot_ccf"), tableOutput("datadf"))),
                                    tabPanel("Differenced Series",
                                             helpText("Unless differencing is applied,
                                                      you will see nothing in this tab.",br(),
                                                      "Not needed for our project may be"))
                                    #     checkboxInput(
                                    #       inputId="dfdat",
                                    #       label = "Apply Differencing?",
                                    #       value = FALSE),
                                    #     conditionalPanel(
                                    #       condition = "input.dfdat == true",
                                    #       selectInput(
                                    #         inputId = "dfd",
                                    #         label = "",
                                    #         choices = list(
                                    #           "First-Order" = 1,
                                    #           "Second-Order" = 2),
                                    #         selected = "First-Order")),
                                    #     value = 2
                                             )),
                tabPanel("Regression analysis",
                         fluidRow (style= "padding-bottom: 20px",
                                   column(5, selectInput("acf_yvalue","Channel",names(dataset1[c(3,4,5,6)]))),
                                   column(5, radioButtons(
                                     inputId="reg_options",label="Operations",
                                     choices=c("Linear Regression" = "LM",
                                               "2nd order polyn Regression"= "PR2",
                                               "3nd order polyn Regression"= "PR3",
                                               "4nd order polyn Regression"= "PR4",
                                               "5nd order polyn Regression"= "PR5",
                                               "6nd order polyn Regression"= "PR6",
                                               "7nd order polyn Regression"= "PR7",
                                               "8nd order polyn Regression"= "PR8",
                                               "9nd order polyn Regression"= "PR9",
                                               "10nd order polyn Regression"= "PR10"),
                                     selected="LM"))),
                         fluidRow(plotOutput("plot_lm"), downloadButton(outputId="down",label="Download Plot"), actionButton(inputId="stat_check", label="Stationarity check"), verbatimTextOutput("st_text"), verbatimTextOutput("str"))
                         ),
                tabPanel("Filters", textOutput("text"), plotOutput("plot_ma")),
               #tabPanel("Filters", textOutput("text"), dygraphOutput("plot_ma")),
                tabPanel("Information",
                         #---function definition---#
                         h2("Function Definitions", align="center"),
                         h3("Correlation coefficient"),
                         p("Input:   timestamp (t), data (y)"),
                         code("Formula: r=(1/n)*(sum((t-t_mean).*(y-y_mean)))/(st*sy)"),
                         p("Output: -> 1 value: correlation coefficient r",br(),"-> 5 values: Correlation coefficient r, mean_x, mean_y, sx, sy"),
                         h3("Stationarity test"),
                         p("Input:   	-> Only data of a time series",br(),
                         "-> Desired number of intervals"),
                         code("Formula: interval=round(length(data)/i)"),
                         p("Output: 2 String-values- Hypothesis test result for T-Test and F-Test (Null-hypothesis failed to reject - Time series is stationary or Null-hypothesis rejected - Time series is not stationary)"),
                         h3("Auto Covariance and Corelation"),
                         p("Input:  	Time Series with timestamp (t) and data (y)"),
                         code("Formula: acf=zeros(round(n/4)+1,2)"),
                         p("Output: -> A shorter time series with time intervals (not time stamps) in t and auto covariance values in y"),
                         h3("Cross Corelation"),
                         p("Input:    2 Time Series with timestamp (t)(must be of same length) and data (y)"),
                         code("Formula: tau=round(length(t)/4)"),
                         p("Output: -> Cross correlation function with Lags-column and XCF-column",br(),"-> Time shifted version of second time series with data column y and corrected time-value column t_shift"),
                         h3("Regressions"),
                         p("Input:    Time Series with timestamp (t) and data (y)"),
                         h3("Moving Average"),
                         h3("Event Detection"),
                         a("http://shiny.rstudio.com/tutorial/lesson2/"))
    ),width=10
)
)

)


# Introduction to Data Visualization using ggplot2

# A. Initial plots
# 1. First plot
# Load the ggplot2 package
library(ggplot2)

# Explore the mtcars data frame with str()
str(mtcars)

# Execute the following command
ggplot(mtcars, aes(cyl, mpg)) +
  geom_point()

# 2. Change data column types for plots. Ensuring that the correct data type is being used
# Converting the numeric column to a categorical column
# Load the ggplot2 package
library(ggplot2)

# Change the command below so that cyl is treated as factor. Using the factor() method helps to convert the data type
ggplot(mtcars, aes(factor(cyl), mpg)) +
  geom_point()

# B. Grammar graphics
# Edit to add a color aesthetic mapped to disp
ggplot(mtcars, aes(wt, mpg, color = disp)) +
  geom_point()

# Change the color aesthetic to a size aesthetic
ggplot(mtcars, aes(wt, mpg, size = disp)) +
  geom_point()

# C. ggplot2 layers
# 1. Adding geometries
# geom_point(): adds points (as in a scatter plot)
# geom_smooth(): adds a smooth trend curve
ggplot(diamonds, aes(carat, price)) +
  geom_point() +
  geom_smooth()

# 2. Changing one or multiple geom attributes
# alpha: KW param is used to control the opacity of the data points
# adding color to the geometry makes a trend line for each of the clarity categories
ggplot(diamonds, aes(carat, price, color = clarity)) +
  geom_point(alpha = 0.4) +
  geom_smooth()

# 3. Saving plots as variables
# Draw a ggplot
plt_price_vs_carat <- ggplot(
  # Use the diamonds dataset
  diamonds,
  # For the aesthetics, map x to carat and y to price
  aes(carat, price)
)

# Add a point layer to plt_price_vs_carat
plt_price_vs_carat + geom_point()

# Edit this to make points 20% opaque: plt_price_vs_carat_transparent
plt_price_vs_carat_transparent <- plt_price_vs_carat + geom_point(alpha = 0.20)

# See the plot
plt_price_vs_carat_transparent

# Edit this to map color to clarity,
# Assign the updated plot to a new object
plt_price_vs_carat_by_clarity <- plt_price_vs_carat + geom_point(aes(color = clarity))

# See the plot
plt_price_vs_carat_by_clarity


library(corrplot)
library(caret)
pima <- read.csv("diabetes.csv", col.names=c("Pregnant","Plasma_Glucose","Dias_BP","Triceps_Skin","Serum_Insulin","BMI","DPF","Age","Diabetes"))
head(pima) # # visualize the header of Pima data
str(pima)
sapply(pima, function(x) sum(is.na(x)))
pairs(pima, panel = panel.smooth)
corrplot(cor(pima[, -9]), type = "lower", method = "number")
# Preparing the DataSet
set.seed(1000)
n <- nrow(pima)
train <- sample(n, trunc(0.70*n))
pima_training <- pima[train, ]
pima_testing <- pima[-train, ]

# Training The Model
glm_fm1 <- glm(Diabetes ~., data = pima_training, family = binomial)
summary(glm_fm1)
glm_fm2 <- update(glm_fm1, ~. - Triceps_Skin - Serum_Insulin - Age )
summary(glm_fm2)
par(mfrow = c(2,2))
plot(glm_fm2)
# Testing the Model
glm_probs <- predict(glm_fm2, newdata = pima_testing, type = "response")
glm_pred <- ifelse(glm_probs > 0.5, 1, 0)
test_tab1 <-table(Predicted = glm_pred, Actual = pima_testing$Diabetes)
test_tab1
accura1 <- round(sum(diag(test_tab1))/sum(test_tab1),2)
accura1
#confusionMatrix(glm_pred, pima_testing$Diabetes )
#acc_glm_fit <- confusionMatrix(glm_pred, pima_testing$Diabetes )$overall['Accuracy']
# Preparing the DataSet:
pima <- read.csv("diabetes.csv", col.names=c("Pregnant","Plasma_Glucose","Dias_BP","Triceps_Skin","Serum_Insulin","BMI","DPF","Age","Diabetes"))
pima$Diabetes <- as.factor(pima$Diabetes)

library(caret)
library(tree)
library(e1071)
set.seed(1000)
intrain <- createDataPartition(y = pima$Diabetes, p = 0.7, list = FALSE)
train <- pima[intrain, ]
test <- pima[-intrain, ]

# Training The Model
treemod <- tree(Diabetes ~ ., data = train)

summary(treemod)
treemod # get a detailed text output.
plot(treemod)
text(treemod, pretty = 0)
# Testing the Model
tree_pred <- predict(treemod, newdata = test, type = "class" )
confusionMatrix(tree_pred, test$Diabetes)
acc_treemod <- confusionMatrix(tree_pred, test$Diabetes)$overall['Accuracy']
# Training The Model
set.seed(123)
library(randomForest)
rf_pima <- randomForest(Diabetes ~., data = pima_training, mtry = 8, ntree=50, importance = TRUE)
# Testing the Model
rf_probs <- predict(rf_pima, newdata = pima_testing)
rf_pred <- ifelse(rf_probs > 0.5, 1, 0)
test_tab3 <-table(Predicted = rf_pred, Actual = pima_testing$Diabetes)
test_tab3
accura3 <- round(sum(diag(test_tab3))/sum(test_tab3),2)
accura3
#confusionMatrix(rf_pred, pima_testing$Diabetes )
#acc_rf_pima <- confusionMatrix(rf_pred, pima_testing$Diabetes)$overall['Accuracy']
importance(rf_pima)
par(mfrow = c(1, 2))
varImpPlot(rf_pima, type = 2, main = "Variable Importance",col = 'black')
plot(rf_pima, main = "Error vs no. of trees grown")
#Load the DataSet
pima <- read.csv("diabetes.csv", col.names=c("Pregnant","Plasma_Glucose","Dias_BP","Triceps_Skin","Serum_Insulin","BMI","DPF","Age","Diabetes"))
pima$Diabetes <- as.factor(pima$Diabetes)

library(e1071)

#Preparing the DataSet:
set.seed(1000)
intrain <- createDataPartition(y = pima$Diabetes, p = 0.7, list = FALSE)
train <- pima[intrain, ]
test <- pima[-intrain, ]
tuned <- tune.svm(Diabetes ~., data = train, gamma = 10^(-6:-1), cost = 10^(-1:1))
summary(tuned) # to show the results
svm_model  <- svm(Diabetes ~., data = train, kernel = "radial", gamma = 0.01, cost = 10)
summary(svm_model)
svm_pred <- predict(svm_model, newdata = test)
confusionMatrix(svm_pred, test$Diabetes)
acc_svm_model <- confusionMatrix(svm_pred, test$Diabetes)$overall['Accuracy']
accuracy <- data.frame(Model=c("Logistic Regression","Decision Tree","Random Forest", "Support Vector Machine (SVM)"), Accuracy=c(accura1, acc_treemod, accura3, acc_svm_model ))
ggplot(accuracy,aes(x=Model,y=Accuracy)) + geom_bar(stat='identity') + theme_bw() + ggtitle('Comparison of Model Accuracy')


#' @title getAxisAngles
#' @description Given a graph with vertice positions along axis, calculate the angles of the axes.
#' @details Given a graph with vertice positions along axis, calculate the angles of the axes.
#' @importFrom magrittr "%>%"
#' @importFrom igraph V
#' @aliases getAxisAngles
#' @export getAxisAngles
#' @author Jared P. Lander
#' @param graph An igraph object
#' @param firstAxis By defualt the first axis is positioned along the x-axis.  This arugment allows that to be adjusted, which would offset all the axes by that amount.
#' @param degrees Logical indicating of firstAxis is specified in degrees.  Default is \code{FALSE}.
#' @return A numerical vector giving the axis angle for each node in \code{graph}
#' @examples
#' library(igraph)
#' data(flights)
#' g <- graph.data.frame(flights, directed=FALSE)
#' g <- findAxes(g)
#' getAxisAngles(g)
#'
getAxisAngles <- function(graph, firstAxis=0, degrees=FALSE)
{
    # first axis at firstAxis radians
    # if firstAxis is in degrees convert it to radians
    if(degrees)
    {
        firstAxis <- firstAxis*pi/180
    }

    # find number of axes
    numAxes <- V(graph)$axis %>% unique %>% length
    # calculate angle between them
    radBetween <- 2*pi/numAxes

    # convert axis number to angle from x-axis
    (V(graph)$axis - 1)*radBetween + firstAxis
}

#' @title layout_with_hive
#' @description igraph layout function for hive plots
#' @details igraph layout function for hive plots
#' @export layout_with_hive
#' @aliases layout_with_hive
#' @importFrom magrittr "%<>%"
#' @importFrom igraph V
#' @importFrom dplyr select_
#' @importFrom useful pol2cart
#' @author Jared P. Lander
#' @param graph An igraph object
#' @return A two-dimensional matrix with x- and y-coordinates
#' @examples
#' library(igraph)
#' library(useful)
#' data(flights)
#' g <- graph.data.frame(flights, directed=FALSE)
#' l <- layout_with_hive(g)
#' plot(g, layout=l)
#'
layout_with_hive <- function(graph)
{
    # if axis is missing, compute it
    if(is.null(V(graph)$axis))
    {
        graph %<>% findAxes
    }

    # if nodePosition is missing, compute it
    if(is.null(V(graph)$nodePosition))
    {
        graph %<>% nodePosition
    }

    # figure out the angles needs
    theta <- getAxisAngles(graph)

    ## convert polar coordinates to cartesian
    ## theta is the angle and V(graph)$nodePosition is r, the magnitude
    pol2cart(r=V(graph)$nodePosition, theta=theta) %>% select_('x', 'y') %>% setNames(NULL) %>% as.matrix
}


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

Sales_table <- read.table("~/SeniorStats/HW2/STA372_Homework2.dat.txt")
colnames(Sales_table) <- c("Time", "Quarter", "Sales")
Sales_table$LogSales <- log(Sales_table$Sales)
head(Sales_table)

figure <- ggplot()
figure <- figure + geom_point(aes(x=Sales_table$Time, y=Sales_table$Sales), color="Black")
figure <- figure + geom_line(aes(x=Sales_table$Time, y=Sales_table$Sales), linetype=1, color="Black")
figure <- figure + scale_y_continuous()
figure <- figure + ggtitle("Sales vs. Time") + xlab("Time") + ylab("Sales")
print(figure)

figure2 <- ggplot()
figure2 <- figure2 + geom_point(aes(x=Sales_table$Time, y=Sales_table$LogSales), color="Red")
figure2 <- figure2 + geom_line(aes(x=Sales_table$Time, y=Sales_table$LogSales), linetype=1, color="Red")
figure2 <- figure2 + scale_y_continuous()
figure2 <- figure2 + ggtitle("log(Sales) vs. Time") + xlab("Time") + ylab("log(Sales)")
print(figure2)

print("The log transformation stabilized the variance")

LogSales_time_series <- ts(Sales_table$LogSales, frequency = 4)
LogSales_time_series_components <- stl(LogSales_time_series, s.window =7)
plot(LogSales_time_series_components)
seasonal <- LogSales_time_series_components$time.series[,1]

Sales_table$LogA <- Sales_table$LogSales - seasonal
head(Sales_table)

figure3 <- ggplot()
figure3 <- figure3 + geom_point(aes(x=Sales_table$Time, y=Sales_table$LogA), color="Black")
figure3 <- figure3 + geom_line(aes(x=Sales_table$Time, y=Sales_table$LogA), linetype=1, color="Black")
figure3 <- figure3 + scale_y_continuous()
figure3 <- figure3 + ggtitle("Seasonally adjusted log(Sales)") + xlab("Time") + ylab("LogA")
print(figure3)

Sales_table$A <- exp(Sales_table$LogSales - seasonal)
head(Sales_table)

figure4 <- ggplot()
figure4 <- figure4 + geom_point(aes(x=Sales_table$Time, y=Sales_table$A), color="Black")
figure4 <- figure4 + geom_line(aes(x=Sales_table$Time, y=Sales_table$A), linetype=1, color="Black")
figure4 <- figure4 + scale_y_continuous()
figure4 <- figure4 + ggtitle("Seasonally adjusted Sales") + xlab("Time") + ylab("A")
print(figure4)

print("The stl decomposition procedure did a good job of seasonally adjusting sales")


Y <- matrix(c(25,19,33,23),4,1)
X <- matrix(c(1,1,1,1,-2,-2,2,2,5,-5,5,-5),4,3)
transpose_X=t(X)
transpose_Y=t(Y)
transpose_X_X=transpose_X%*%X
transpose_X_Y=transpose_X%*%Y
inverse_transpose_X_X=solve(transpose_X_X)

beta=inverse_transpose_X_X%*%transpose_X_Y
transpose_Y_Y=transpose_Y%*%Y
SSresidual=transpose_Y_Y-t(beta)%*%transpose_X_Y
SSregression=t(beta)%*%transpose_X_Y-(sum(Y)^2/4)
SSregression
SStotal=SSregression+SSresidual
SStotal


# Anomaly Detection in R

if(!require("coindeskr")) install.packages("coindeskr")
if(!require("anomalize")) install.packages("anomalize")
if(!require("tidyverse")) install.packages("tidyverse")

library(anomalize) #tidy anomaly detectiom
library(tidyverse) #tidyverse packages like dplyr, ggplot, tidyr
library(coindeskr) #bitcoin price extraction from coindesk

# Bitcoin present comparing to 2016 |- 2017
btc <- get_historic_price(start = "2016-01-01")

btc_ts <- btc %>% rownames_to_column() %>% as.tibble() %>%
  mutate(date = as.Date(rowname)) %>% select(-one_of('rowname'))

windows(width = 720, height = 320)

btc_ts %>%
  time_decompose(Price, method = "stl", frequency = "auto", trend = "auto") %>%
  anomalize(remainder, method = "gesd", alpha = 0.05, max_anoms = 0.2) %>%
  plot_anomaly_decomposition()

windows(width = 720, height = 320)

btc_ts %>%
  time_decompose(Price) %>%
  anomalize(remainder) %>%
  time_recompose() %>%
  plot_anomalies(time_recomposed = TRUE, ncol = 3, alpha_dots = 0.5)

btc_ts %>%
  time_decompose(Price) %>%
  anomalize(remainder) %>%
  time_recompose() %>%
  filter(anomaly == 'Yes')

# Bitcoin present comparing to 2017
rm(btc, btc_ts)

btc <- get_historic_price(start = "2017-01-01")

btc_ts <- btc %>% rownames_to_column() %>% as.tibble() %>%
  mutate(date = as.Date(rowname)) %>% select(-one_of('rowname'))

windows(width = 720, height = 320)

btc_ts %>%
  time_decompose(Price, method = "stl", frequency = "auto", trend = "auto") %>%
  anomalize(remainder, method = "gesd", alpha = 0.05, max_anoms = 0.2) %>%
  plot_anomaly_decomposition()

windows(width = 720, height = 320)

btc_ts %>%
  time_decompose(Price) %>%
  anomalize(remainder) %>%
  time_recompose() %>%
  plot_anomalies(time_recomposed = TRUE, ncol = 3, alpha_dots = 0.5)

btc_ts %>%
  time_decompose(Price) %>%
  anomalize(remainder) %>%
  time_recompose() %>%
  filter(anomaly == 'Yes')

Fraud_Detection/Anomaly Detection in R.r


CH_3_select = CH5_onlyFilterTradingDaysAndOnlist[7:203,c("MKT","SMB","VMG")]
FF_3_select = FF5_onlyFilterTradingDaysAndOnlist[7:203,c("MKT","HML","SMB")]

library(lmtest)
library(sandwich)
library(GRS.test)
# FFSMB versus CH3
model_FFSMB = lm(FF_3_select$SMB~CH_3_select$MKT +
                   CH_3_select$SMB +
                   CH_3_select$VMG)
# summary(model_FFSMB)

# HC t-stat
coeftest(model_FFSMB, vcov = vcovHC(model_FFSMB))

# FFHML
model_FFHML = lm(FF_3_select$HML~CH_3_select$MKT  +
                 CH_3_select$SMB +
                 CH_3_select$VMG)
# summary(model_FFHML)

# HC t-stat
coeftest(model_FFHML, vcov = vcovHC(model_FFHML))

# SMB versus FF3
model_SMB = lm(CH_3_select$SMB~FF_3_select$MKT +
                 FF_3_select$SMB +
                 FF_3_select$HML)
coeftest(model_SMB, vcov = vcovHC(model_SMB))

# VMG versus FF3
model_VMG = lm(CH_3_select$VMG~FF_3_select$MKT +
                 FF_3_select$SMB +
                 FF_3_select$HML)
coeftest(model_VMG, vcov = vcovHC(model_VMG))

#GRS test 1, use FF3 to explain CH3
mat_CH3 = CH_3_select[,c( "SMB", "VMG")]
mat_FF3 = FF_3_select[,c( "SMB", "HML")]
GRS.test(mat_CH3, mat_FF3)$GRS.stat
GRS.test(mat_CH3, mat_FF3)$GRS.pval

# GRS test 2, use CH3 to explain FF3
GRS.test(mat_FF3, mat_CH3)$GRS.stat
GRS.test(mat_FF3, mat_CH3)$GRS.pval

03 Statistical testing/Compare FF and CH model.r


=begin
  # sample-groebner02.rb

  require "algebra"

  P = MPolynomial(Rational)
  x, y, z = P.vars "xyz"
  f1 = x**2 + y**2 + z**2 -1
  f2 = x**2 + z**2 - y
  f3 = x - z

  coeff, basis = Groebner.basis_coeff([f1, f2, f3])
  basis.each_with_index do |b, i|
    p [coeff[i].inner_product([f1, f2, f3]), b]
    p coeff[i].inner_product([f1, f2, f3]) == b #=> true
  end
((<_|CONTENTS>))
=end


#' @name getpolar
#' @rdname getpolar
#' @title Calculates the angle of the link between two points to the x-Axis.
#' @description
#' This function calculates the angle of a vector defined by two points
#' in radians. Optionally it can be converted to degrees.
#' For the use of the Operations-Research-Sweep-Algorithm
#' an offset angle can be set.
#' It's als possible return positive values only (2pi will be added).
#' @param n0 an object of class \code{\link{numeric}} with a length of 2 (x/y-coordinates) or a class derived from \code{\link{Node}}. Used as origin.
#' @param n1 an object of class \code{\link{numeric}} with a length of 2 (x/y-coordinates) or a class derived from \code{\link{Node}}.
#' @param ... see \emph{Optional Values}
#' @section Optional Parameters (\code{...}):
#' \subsection{used by getpolar}{
#'    \describe{
#'		\item{\code{nonnegative}}{
#'			 \emph{optional} \code{\link{logical}}. Indicating if 2pi should be added to negative values. \strong{Default} is \code{TRUE}}
#'		\item{\code{deg}}{
#'			 \emph{optional} \code{\link{logical}}. Indicating if the result should be converted to degrees. \strong{Default} is \code{FALSE}}
#'		\item{\code{log}}{
#'			 \emph{optional} \code{\link{logical}}. Indicating if the calculations should be logged. \strong{Default} is \code{FALSE}}
#'		\item{\code{offset}}{
#'			 \emph{optional} \code{\link{numeric}}. Should be when using rotated coordinate systems. \strong{Default} is 0. \strong{Has to be provided in RADIANS!}}
#'    }
#' }
#' \subsection{Forwarded to the follwowing functions}{
#'    \itemize{
#'		\item{\code{...} is currently not forwared.}
#'    }
#' }
#'
#' @keywords radians, polar-angle, polar, coordinates
#' @export
#' @return the angle as a value of class  \code{\link{numeric}}.
#' @author Dipl. Kfm. Felix Lindemann \email{felix.lindemann@@hs-neu-ulm.de}
#'
#' Wissenschaftlicher Mitarbeiter
#' Kompetenzzentrum Logistik
#' Buro ZWEI, 17
#'
#' Hochschule fur angewandte Wissenschaften
#' Fachhochschule Neu-Ulm | Neu-Ulm University
#' Wileystr. 1
#'
#' D-89231 Neu-Ulm
#'
#'
#' Phone   +49(0)731-9762-1437
#' Web      www.hs-neu-ulm.de
#'
#' @references
#'Bronstein 2008 Bronstein, I. N.: Taschenbuch der Mathematik.
#'[CD-ROM-Ausg. der 7., voll. ueberarb. und erg. gedr. Ausg.].
#'Frankfurt:  Harri Deutsch, 2008
setGeneric("getpolar", function(n0,n1,...) standardGeneric("getpolar"))

#' @title distance between two \code{\link{Node}s}
#' @description Calculates the euclidian distance between to nodes. Optional this distance can be multiplied by a  \code{costfactor} in order to convert the distance to cost-related value (such as time, costs, ...).
#' \deqn{ f(x) = \sqrt((x_0-x_1)^2 + (y_0-y_1)^2) \cdot costfactor }{ costfactor * ((x_0-x_1)^2 + (y_0-y_1)^2)^0.5  }
#' @param n0 an object of class \code{\link{numeric}} with a length of 2 (x/y-coordinates) or a class derived from \code{\link{Node}}. Used as origin.
#' @param n1 an object of class \code{\link{numeric}} with a length of 2 (x/y-coordinates) or a class derived from \code{\link{Node}}.
#' @param ... \emph{Optional Parameters} (See Below).
#'
#' @section Optional Parameters (\code{...}):
#' \subsection{used by \code{\link{getDistance}}}{
#'    \describe{
#'     \item{digits}{non negative Integer value for the number of digitis that has to be rounded to.}
#'      \item{costfactor}{ \code{\link{numeric}} Optional Parameter. Used to transform the distance by a factor into costs. Default is \code{1}.}
#'    }
#' }
#' \subsection{Forwarded to the follwowing functions}{
#'    You may want to check these functions for any other optional parameters.
#'    \itemize{
#'      \item{\code{\link{round}} called, if the parameter \code{digits} is provided.}
#'    }
#' }
#' @name getDistance
#' @docType methods
#' @rdname getDistance
#' @author Dipl. Kfm. Felix Lindemann \email{felix.lindemann@@hs-neu-ulm.de}
#'
#' Wissenschaftlicher Mitarbeiter
#' Kompetenzzentrum Logistik
#' Buro ZWEI, 17
#'
#' Hochschule fur angewandte Wissenschaften
#' Fachhochschule Neu-Ulm | Neu-Ulm University
#' Wileystr. 1
#'
#' D-89231 Neu-Ulm
#'
#'
#' Phone   +49(0)731-9762-1437
#' Web      \url{www.hs-neu-ulm.de/felix-lindemann/}
#'          \url{http://felixlindemann.blogspot.de}
setGeneric("getDistance", function(n0,n1,   ...) standardGeneric("getDistance"))


# http://stackoverflow.com/questions/6461209/how-to-round-up-to-the-nearest-10-or-100-or-x
# http://stackoverflow.com/questions/3502925/include-files-r
roundUp <- function(x) 10^ceiling(log10(x))
roundUpNice <- function(x, nice=c(1,2,4,5,6,8,10)) {
    if(length(x) != 1) stop("'x' must be of length 1")
    10^floor(log10(x)) * nice[[which(x <= 10^floor(log10(x)) * nice)[[1]]]]
}
round_up <- function(x, round=10) ceiling(max(x+10^-9)/round + 1/round)*round