#   __      _____             _              __        _
# <(o )___ |  _  |___ ___ ___| |_ ___ ___   |  |   ___| |_ ___
# ( ._> /  |   __|  _| -_|_ -|  _| -_|_ -|  |  |__| .'| . |_ -|
#  `---'   |__|  |_| |___|___|_| |___|___|  |_____|__,|___|___|
#==============================================================================
# Local Regression NonParametric LOESS
#==============================================================================
# Title          : Local Regression NP LOESS.r
# Description    : Local Regression - Fit a line with LOESS in R
# Author         : Isaias V. Prestes <isaias.prestes@gmail.com>
# Date           : 20180304
# Version        : 0.0.1
# Usage          : Run in R 3.4
# Notes          : Based on
# https://stackoverflow.com/questions/15337777/fit-a-line-with-loess-in-r
# http://ggplot2.tidyverse.org/reference/geom_smooth.html
# r-statistics.co by Selva Prabhakaran
# R version      : 3.4
#==============================================================================
# install.packages('ggplot2')

#==============================================================================
# LIBRARY DEPENDENCE
#==============================================================================
library(ggplot2)

# Loess short for Local Regression is a non-parametric approach that fits
# multiple regressions in local neighborhood. This can be particularly
# resourceful, if you know that your X variables are bound within a range.

#------------------------------------------------------------------------------
# Regular
#------------------------------------------------------------------------------
load(url('https://www.dropbox.com/s/ud32tbptyvjsnp4/data.R?dl=1'))
lw1 <- loess(y ~ x,data=data)
plot(y ~ x, data=data,pch=19,cex=0.1, main="Loess Smoothing and Prediction")
j <- order(data$x)
lines(data$x[j],lw1$fitted[j],col="red",lwd=3)

#------------------------------------------------------------------------------
# Scatter
#------------------------------------------------------------------------------
scatter.smooth(data$y ~ data$x, span = 2/3, degree = 2, main="Loess Smoothing and Prediction")

#------------------------------------------------------------------------------
# ggplot2
#------------------------------------------------------------------------------
# http://ggplot2.tidyverse.org/reference/geom_smooth.html
load(url("https://www.dropbox.com/s/ud32tbptyvjsnp4/data.R?dl=1"))
ggplot(data, aes(x, y), main="Loess Smoothing and Prediction") +
geom_point() +
geom_smooth(method = "loess", se = FALSE)

ggplot(data, aes(x, y)) +
geom_point() +
geom_smooth(method = "loess", se = TRUE)

# Second Example

data(economics, package="ggplot2")  # load data
economics$index <- 1:nrow(economics)  # create index variable
economics <- economics[1:80, ]  # retail 80rows for better graphical understanding
loessMod10 <- loess(uempmed ~ index, data=economics, span=0.10) # 10% smoothing span
loessMod25 <- loess(uempmed ~ index, data=economics, span=0.25) # 25% smoothing span
loessMod50 <- loess(uempmed ~ index, data=economics, span=0.50) # 50% smoothing span
# get smoothed output
smoothed10 <- predict(loessMod10)
smoothed25 <- predict(loessMod25)
smoothed50 <- predict(loessMod50)

# Plot it
plot(economics$uempmed, x=economics$date, type="l", main="Loess Smoothing and Prediction", xlab="Date", ylab="Unemployment (Median)")
lines(smoothed10, x=economics$date, col="red")
lines(smoothed25, x=economics$date, col="green")
lines(smoothed50, x=economics$date, col="blue")

#------------------------------------------------------------------------------
# Finding the optimal smoothing span
#------------------------------------------------------------------------------
# As the smoothing span changes, the accuracy of the fitted curve also changes.
# If your intent is to minimize the error, the optim() can be used to find that
# value of span, that minimizes the Sum of Squared Errors (SSE). For this case,
# it is graphically intuitive that lower SSE will likely be achieved at lower
# values of span, but for more challenging cases, optimizing span could help.
# To implement optim(), we define the function that computes the SSE. An error
# handling mechanism is needed to address very low values of span and cases where
# the non-numerics are produced. The simulated annealing method (SANN) is
# implemented here to find the span that gives minimal SSE. The par argument
# specifies the first value of the span at which optim() will begin the search.

# define function that returns the SSE
calcSSE <- function(x){
  loessMod <- try(loess(uempmed ~ index, data=economics, span=x), silent=T)
  res <- try(loessMod$residuals, silent=T)
  if(class(res)!="try-error"){
    if((sum(res, na.rm=T) > 0)){
      sse <- sum(res^2)
    }
  }else{
    sse <- 99999
  }
  return(sse)
}

# Run optim to find span that gives min SSE, starting at 0.5
optim(par=c(0.5), calcSSE, method="SANN")

# EOF

Local Regression MP LOESS/Local Regression MP LOESS.r


# confidence interval for indpendent sample

n1= 12
n2= 12
y1bar = 26.58
y2bar=39.67
s1=14.36
s2=13.86
# solving part c
# common standard deviation
sp=sqrt(((n1-1)*s1*s1+(n2-1)*s2*s2)/(n1+n2-2))

# the t-percentile based on df for 95% confidence interval
tstar=qt( .975, df=18)
margin=tstar*sp*sqrt((1/n1)+(1/n2))
left_i=(y1bar-y2bar)-margin
right_i=(y1bar-y2bar)+margin
print("confidence interval is")
print(left_i)
print(right_i)

# solving part  a and b
t=(y1bar-y2bar)/((sp)*sqrt((1/n1)+(1/n2)))
print(t)
# crtitical value
alpha= 0.05
df=n1+n2-2
t.alpha=qt(0.05, df=22)
if(t<=t.alpha){
  print(" We will reject H0")
}else{
  print("we will fail to reject H0 (no significant evidence")
}


sumSquare <- function(x) {
    sum <- 0
    for (l in 1:x) {
       sum <- sum+l
    }
    return (sum*sum)
}

squareSum <- function(x) {
    sum <- 0
    for (l in 1:x) {
       sum <- sum+(l*l)
    }
    return (sum)
}

sumSquareDifference <- function(x) {
    return (sumSquare(x) - squareSum(x))
}

sumSquareDifference(100)


# mean
mean_g <- function(x, gmean = "sqrtsin") {
    switch(
        gmean,
        "linear" = 0.2 + 0.4 * x,
        "log" = log(x),
        "sin" = sin(2 * pi * x),
        "lsin" =  0.5 + 2 * x + sin(2 * pi * x - 0.5),
        "sqrtsin" = sqrt(x * (1 - x)) * sin(2 * pi * (1 + 2 ^ (-7 / 5)) / (x + 2 ^ (-7 / 5)))
    )
}
# error
err_sig <- function(x, xsig = "quad", derr = "norm") {
    v_sig <- switch(
        xsig,
        "const" = 0.2,
        "linear" = 0.2 + 0.2 * x,
        "quad" = 0.5 + 0.5 * (x - 1) ^ 2
    )
    switch(
        derr,
        "norm" = rnorm(x, 0),
        "chisq3" = rchisq(x, 3),
        "t3" = rt(x, 3),
        "t1" = rt(x, 1)
        #"laplace" = rla
    ) * v_sig
}
# error quantile
err_qt <- function(x, tau = 0.5, xsig = "quad", derr = "norm") {
    v_sig <- switch(
        xsig,
        "const" = 0.2,
        "linear" = 0.2 + 0.2 * x,
        "quad" = 0.5 + 0.5 * (x - 1) ^ 2
    )
    switch(
        derr,
        "norm" = qnorm(tau, 0),
        "chisq3" = qchisq(tau, 3),
        "t3" = qt(tau, 3),
        "t1" = qt(tau, 1)
        #"laplace" = rla
    ) * v_sig
}
obs_f <- function(x, gmean = "sqrtsin", xsig = "quad", derr = "norm") {
    mean_g(x, gmean) + err_sig(x, xsig, derr)
}
truth_f <- function(x, tau, gmean = "sqrtsin", xsig = "quad", derr = "norm") {
    mean_g(x, gmean) + err_qt(x, tau, xsig, derr)
}

# x <- sort(x)
# plot(x, obs_f(x, derr = "chisq3"))
# for (tau in seq(0.001, 0.999, length.out = 10)) {
#     lines(comp[[3]][[1]]$x, truth_f(comp[[3]][[1]]$x, tau, gmean = "linear", xsig = "linear", derr = "t3"))
# }


rm(list=ls())

ps <- read.table("patch1968.dat",header=TRUE)

ps$r <- rank(-ps$pSize)

plot(r ~ pSize,data=ps)

plot(log(r)~log(pSize),data=ps)

lm0 <- lm(log(r)~log(pSize),data=ps)

summary(lm0)

abline(lm0)

slope0 <- -coef(lm0)[2]

2-2*slope0

require(car)

dwt(lm0)

grid()

require(segmented)

ps$logr <- log(ps$r)
ps$logpSize <- log(ps$pSize)

lm0 <- lm(logr~logpSize,data=ps)

seg <- segmented(lm0, seg.Z = ~logpSize, psi=4)

summary(seg)

slope(seg)

plot(seg)

calcH <- function(B) { 2-2*abs(B)}

calcH(.1550) # H = 1.69

calcH(.9036) # H = 0.19

calcBreak <- function(B) { 0.1*exp(B)*0.65 }

calcBreak(3.35) # 1.85 ha

# dados 1985

ps <- read.table("patch1985.dat",header=TRUE)

ps$r <- rank(-ps$pSize)

ps$logr <- log(ps$r)

ps$logpSize <- log(ps$pSize)

lm0 <- lm(logr~logpSize,data=ps)

seg <- segmented(lm0, seg.Z = ~logpSize, psi=4)

summary(seg)

slope(seg)

calcH(0.2676) # H = 1.46

calcH(1.2600) # H = -0.52

calcBreak(2.7080) # 0.97

plot(seg,col="blue",xlab="Log Patch Size",ylab="Acum Freq",lty=3)

points(log(r)~log(pSize),data=ps,pch=6,cex=.5)

# ggplot

ps <- read.table("patch1985.dat",header=T)
ps$r <- rank(-ps$pSize)
ps$Year <- "1985"

ps1 <- read.table("patch1968.dat",header=T)
ps1$r <- rank(-ps1$pSize)
ps1$Year <- "1968"

ps <- rbind(ps,ps1)

require(ggplot2)
ggplot(data=ps,aes(x=pSize,y=r,color=Year))+geom_point()

p <- ggplot(data=ps,aes(x=log(pSize),y=log(r),
          color=Year))+geom_point(aes(shape=Year))

p

ps$logpSize <- log(ps$pSize)

ps1 <- ps[ps$logpSize>3.35,]

p + geom_smooth(data=ps1,method="lm")

# Partition function

rm(list=ls())

p <- c(7,10,14,10)
tp <-sum(p)
u <- p/tp
q <-0

sum(u^q)

partition <- function(p,q)
{
  tp <-sum(p)
  u <- p/tp
  sum(u^q)
}

partition(p,-1)

partition(p,10)

partition(p,-10)


##########################
# Linear regression in R #
##########################

# Create some data
x <- c(1,3,4,5,4,3,6,4,8,9,10,11,4,6,2,4,9,12,4)
n = length(x)
y <- 3 + 1.6 * x + + 0.5 * x^2 + rnorm(n,mean=0,sd=4)
plot(x,y)      #scatterplot

# Fit a linear regression model
fit1 <- lm(y~x)       # intercept is included automatically
summary(fit1)

plot(fit1)      # Some standard diagnostics for checking model assumptions

# Alternatively can do this by hand
fitted1 <- fit1$fitted      # fitted values y_hat
rstd1 <- rstandard(fit1)    # standardized residuals

# Residuals against fitted. Always look at this plot. Goal: See no pattern whatsoever
plot(fitted1,rstd1)                 # See the U-shaped pattern?
                                    # Suggests including a quadratic term

# Normality
qqnorm(rstd1)
qqline(rstd1)               # Normality looks OK

# Try a new model
x.sq = x^2
fit2 <- lm(y ~ x + x.sq)
summary(fit2)

fitted2 <- fit2$fitted      # fitted values y_hat
rstd2 <- rstandard(fit2)    # standardized residuals

plot(fitted2,rstd2)         # Now it looks OK. => Use model fit2, not fit1.

qqnorm(rstd2)
qqline(rstd2)               # OK

?lm

fit2$model                  # It doesn't show the first column that is constant all 1's. But it is used nevertheless (intercept).

fit2$coefficients           # The OLS estimate beta_hat
vcov(fit2)                  # The variance/covariance matrix of beta_hat

# Illustrate Near-collinearity
x3 <- 2*x + 5*x.sq + rnorm(n,mean=0,sd=0.01)

fit3 <- lm(y ~ x + x.sq + x3)
summary(fit3)               # The standard errors became huge now. Hard to identify the beta's.
plot(fit3)

fitted3 <- fit3$fitted      # fitted values y_hat
rstd3 <- rstandard(fit3)    # standardized residuals

plot(fitted3,rstd3)         #

qqnorm(rstd3)
qqline(rstd3)               #

# How to detect near (multi-)collinearity?
# Check whether one of the Variance Inflation Factors (VIF) is > 10.  If yes => potential problem.

# install.packages("car")
library(car)                # need to install package 'car' first

vif(fit2)                   # Not great, but not tooo bad either
vif(fit3)                   # Catastrophic. Clearly, one of the variables has to go.

# Check numerical stability of calculations by hand

# Create model matrix X for model fit3
fit3$model                  # Doesn't include constant column with all ones. Have to add it by hand
const <- rep(1,n)
X3_ <- cbind(const,fit3$model[,2:4])
X3_                         # Can't do matrix opertions on this array. Have to convert to matrix.
X3 <- as.matrix(X3_)
X3                          # That's it

# Easier alternative: X3 <- model.matrix(fit3)

beta_hat3_naive <- solve(t(X3) %*% X3) %*% t(X3) %*% y
t(beta_hat3_naive)
fit3$coef                   # Here the naive method doesn't create problems yet.

summary(fit3)
names(summary(fit3))
sigma3 <- summary(fit3)$sigma

V3_naive <- sigma3^2 * solve(t(X3) %*% X3)
V3_naive
vcov(fit3)                  # Comparison shows that the naive method still works

# Let's make it worse
x4 <- 2*x + 5*x.sq + rnorm(n,mean=0,sd=0.00005)

fit4 <- lm(y ~ x + x.sq + x4)
summary(fit4)
vif(fit4)           # HUGE

X4 <- model.matrix(fit4)

beta_hat4_naive <- solve(t(X4) %*% X4) %*% t(X4) %*% y
t(beta_hat4_naive)
fit4$coef                   # Here the naive method gives a slightly different result. Numerical instability (rounding error).

sigma4 <- summary(fit4)$sigma
V4_naive <- sigma4^2 * solve(t(X4) %*% X4)
V4_naive
vcov(fit4)                  # Comparison shows that the naive method start's getting into trouble

# Even worse
x5 <- 2*x + 5*x.sq + rnorm(n,mean=0,sd=0.000005)

fit5 <- lm(y ~ x + x.sq + x5)
summary(fit5)                 # Even R's QR decomposition can't deal with it any more.


## Author: Sergio García Prado
## Title: Statistical Inference - Non parametric Tests - Exercise 13

rm(list = ls())

a <- c(0.41, 0.45, 0.36, 0.49, 0.39, 0.54, 0.38, 0.43)
b <- c(0.38, 0.40, 0.32, 0.50, 0.31, 0.52, 0.32, 0.36)

(s <- (a - b)[a != b])
# 0.03 0.05 0.04 -0.01 0.08 0.02 0.06 0.07

(n <- length(s))
# 8

(V <- sum((s > 0) * rank(abs(s))))
# 35

(V.mean <- n * (n + 1) / 4)
# 18

(V.var <- n * (n + 1) * (2 * n + 1) / 24)
# 51

### H0: A(x) == B(x)
### H1: A(x) != B(x)

## Asymptotic pvalue (with continuity correction)
2 * (1 - pnorm(abs(V + 0.5 * sign(V.mean - V) - V.mean) / sqrt(V.var)))
# 0.0208625823327655

## Exact pvalue
2 * (1 - psignrank(V - (V.mean < V), n, lower.tail = V.mean < V))
# 0.015625

wilcox.test(a, b, paired = TRUE, alternative = "two.sided")
# Wilcoxon signed rank test
#
# data:  a and b
# V = 35, p-value = 0.01563
# alternative hypothesis: true location shift is not equal to 0


### PART 1:
makeHailstone <- function(n){
  hseq <- n
  while (hseq[length(hseq)] > 1){
    current.value <- hseq[length(hseq)]
    if (current.value %% 2 == 0){
      next.value <- current.value / 2
    } else {
      next.value <- (3 * current.value) + 1
    }
    hseq <- append(hseq, next.value)
  }
  return(list(hseq=hseq, seq.length=length(hseq)))
}

### PART 2:
twenty.seven <- makeHailstone(27)
twenty.seven$hseq
twenty.seven$seq.length

### PART 3:
max.length <- 0;  lower.bound <- 1;  upper.bound <- 100000

for (index in lower.bound:upper.bound){
  current.hseq <- makeHailstone(index)
  if (current.hseq$seq.length > max.length){
    max.length <- current.hseq$seq.length
    max.index  <- index
  }
}

cat("Between ", lower.bound, " and ", upper.bound, ", the input of ",
    max.index, " gives the longest hailstone sequence, which has length ",
    max.length, ". \n", sep="")


##========================================================
##
##  Credits:
##  Theory by Paul Bourke http://local.wasp.uwa.edu.au/~pbourke/geometry/pointline/
##  Based in part on C code by Damian Coventry Tuesday, 16 July 2002
##  Based on VBA code by Brandon Crosby 9-6-05 (2 dimensions)
##  With grateful thanks for answering our needs!
##  This is an R (http://www.r-project.org) implementation by Gregoire Thomas 7/11/08
##
##========================================================

distancePointLine <- function(x, y, slope, intercept) {
  ## x, y is the point to test.
  ## slope, intercept is the line to check distance.
  ##
  ## Returns distance from the line.
  ##
  ## Returns 9999 on 0 denominator conditions.
  x1 <- x-10
  x2 <- x+10
  y1 <- x1*slope+intercept
  y2 <- x2*slope+intercept
  distancePointSegment(x,y, x1,y1, x2,y2)
}

distancePointSegment <- function(px, py, x1, y1, x2, y2) {
  ## px,py is the point to test.
  ## x1,y1,x2,y2 is the line to check distance.
  ##
  ## Returns distance from the line, or if the intersecting point on the line nearest
  ## the point tested is outside the endpoints of the line, the distance to the
  ## nearest endpoint.
  ##
  ## Returns 9999 on 0 denominator conditions.
  lineMagnitude <- function(x1, y1, x2, y2) sqrt((x2-x1)^2+(y2-y1)^2)
  ans <- NULL
  ix <- iy <- 0   # intersecting point
  lineMag <- lineMagnitude(x1, y1, x2, y2)
  if( lineMag < 0.00000001) {
    warning("short segment")
    return(9999)
  }
  u <- (((px - x1) * (x2 - x1)) + ((py - y1) * (y2 - y1)))
  u <- u / (lineMag * lineMag)
  if((u < 0.00001) || (u > 1)) {
    ## closest point does not fall within the line segment, take the shorter distance
    ## to an endpoint
    ix <- lineMagnitude(px, py, x1, y1)
    iy <- lineMagnitude(px, py, x2, y2)
    if(ix > iy)  ans <- iy
    else ans <- ix
  } else {
    ## Intersecting point is on the line, use the formula
    ix <- x1 + u * (x2 - x1)
    iy <- y1 + u * (y2 - y1)
    ans <- lineMagnitude(px, py, ix, iy)
  }
  ans
}

distancePointLineTest <- function() {
  if(abs(distancePointSegment(  5,   5,  10, 10, 20, 20) - 7.07106781186548)>.0001)
    stop("error 1")
  if(abs(distancePointSegment( 15,  15,  10, 10, 20, 20) - 0)>.0001)
    stop("error 2")
  if(abs(distancePointSegment( 15,  15,  20, 10, 20, 20) - 5)>.0001)
    stop("error 3")
  if(abs(distancePointSegment(  0,  15,  20, 10, 20, 20) - 20)>.0001)
    stop("error 4")
  if(abs(distancePointSegment(  0,  25,  20, 10, 20, 20) - 20.6155281280883)>.0001)
    stop("error 5")
  if(abs(distancePointSegment(-13, -25, -50, 10, 20, 20) - 39.8808224589213)>.0001)
    stop("error 6")
  if(abs(distancePointSegment(  0,   3,   0, -4,  5,  0) - 5.466082)>.0001)
    stop("error 7")
  if(abs(distancePointSegment(  0,   9,   0, -4,  0, 15) - 0)>.0001)
    stop("error 8")
  if(abs(distancePointSegment(  0,   0,   0, -2,  2,  0)^2 - 2)>.0001)
    stop("error 9")
  return(TRUE)
}


#!/usr/bin/Rscript

# Bhishan Poudel
# Jan 12, 2016

# Chapter. 2 Probability
################################################################################
# set the working directory
setwd ("~/Copy/2016Spring/RProgramming/presentation/")

# Start device driver to save output
postscript(file="figures/chap2.eps", height=14, width=8)

# Set up 6 panel figure
par(mfrow=c(3,2))  # par is parameter

# Expand right side of clipping rect to make room for the legend
#par(xpd=T, mar=par()$mar+c(0,0,0,4))

# Plot upper left panel with three illustrative
# exponential p.d.f. distributions (dexp)
xdens <- seq(0,5,0.02)
plot(xdens,dexp(xdens,rate=0.5), type='l', ylim=c(0,1.5), xlab='', ylab='Exponential p.d.f.',lty=1)

lines(xdens,dexp(xdens,rate=1), type='l', lty=2)
lines(xdens,dexp(xdens,rate=1.5), type='l', lty=3)
legend(2, 1.45, lty=1, substitute(lambda==0.5), box.lty=0)
legend(2, 1.30, lty=2, substitute(lambda==1.0), box.lty=0)
legend(2, 1.15, lty=3, substitute(lambda==1.5), box.lty=0)

# Help files to learn these function
# help(seq) ; help(plot); help(par) ; help(lines); help(legend)

# Plot upper right panel with three illustrative exponential c.d.f. distributions
plot(xdens, pexp(xdens,rate=0.5), type='l', ylim=c(0,1.0), xlab='', ylab='Exponential c.d.f.', lty=1)
lines(xdens, pexp(xdens,rate=1), type='l', lty=2)
lines(xdens, pexp(xdens,rate=1.5),type='l',lty=3)
legend(3, 0.50, lty=1, substitute(lambda==0.5), box.lty=0)
legend(3, 0.38, lty=2, substitute(lambda==1.0), box.lty=0)
legend(3, 0.26, lty=3, substitute(lambda==1.5), box.lty=0)

# Plot middle panels with illustrative normal p.d.f. and c.d.f.
xdens <- seq(-5, 5, 0.02)
ylabdnorm <- expression(phi[mu~sigma^2] (x))
plot(xdens, dnorm(xdens, sd=sqrt(0.2)), type='l', ylim=c(0,1.0), xlab='', ylab=ylabdnorm,lty=1)
lines(xdens,dnorm(xdens, sd=sqrt(1.0)), type='l', lty=2)
lines(xdens,dnorm(xdens, sd=sqrt(5.0)), type='l', lty=3)
lines(xdens,dnorm(xdens, mean=-2.0, sd=sqrt(0.5)), type='l', lty=4)
leg1 <- expression(mu^' '==0, mu^' '==0, mu^' '==0, mu^' '==-2)
leg2 <- expression(sigma^2==0.2, sigma^2==1.0, sigma^2==5.0, sigma^2==0.5,)
legend(0.5, 1.0, lty=1:4, leg1, lwd=2, box.lty=0)
legend(3.0, 1.01, leg2, box.lty=0)
ylabpnorm <- expression(Phi[mu~sigma^2] (x))
plot(xdens,pnorm(xdens,sd=sqrt(0.2)), type='l', ylim=c(0,1.0), xlab='',ylab=ylabpnorm,lty=1)
lines(xdens,pnorm(xdens, sd=sqrt(1.0)), type='l', lty=2)
lines(xdens,pnorm(xdens, sd=sqrt(5.0)), type='l', lty=3)
lines(xdens,pnorm(xdens, mean=-2.0, sd=sqrt(0.5)), type='l', lty=4)
leg1 <- expression(mu^' '==0, mu^' '==0, mu^' '==0, mu^' '==-2)
leg2 <- expression(sigma^2==0.2, sigma^2==1.0, sigma^2==5.0, sigma^2==0.5,)
legend(0.5, 0.6, lty=1:4, leg1, lwd=2, box.lty=0)
legend(3.0, 0.61, leg2, box.lty=0)

# Plot bottom panels with illustrative lognormal p.d.f. and c.d.f.
xdens <- seq(0,3, 0.02)
plot(xdens, dlnorm(xdens, meanlog=0, sdlog=5), type='l', ylim=c(0,2), xlab='', ylab='Lognormal density', lty=1)
lines(xdens, dlnorm(xdens, meanlog=0, sdlog=1), type='l', lty=2)
lines(xdens, dlnorm(xdens, meanlog=0, sdlog=1/2), type='l', lty=3)
lines(xdens, dlnorm(xdens, meanlog=0, sdlog=1/8), type='l', lty=4)
leg1 <- expression(sigma==5, sigma==1, sigma==1/2, sigma==1/8)
legend(1.8,1.8,lty=1:4,leg1,box.lty=0)
plot(xdens,plnorm(xdens,meanlog=0,sdlog=5),type='l',ylim=c(0,1),xlab='x', ylab='Lognormal distribution',lty=1)
lines(xdens,plnorm(xdens,meanlog=0,sdlog=1),type='l',lty=2)
lines(xdens,plnorm(xdens,meanlog=0,sdlog=1/2),type='l',lty=3)
lines(xdens,plnorm(xdens,meanlog=0,sdlog=1/8),type='l',lty=4)
leg1 <- expression(sigma==5,sigma==1,sigma==1/2,sigma==1/8)
legend(1.5,0.6,lty=1:4,leg1,box.lty=0)

# Turn off device driver (to flush output to png)
dev.off()

# Return plot to single-panel format
par(mfrow=c(1,1))

# Restore default clipping rect
par(mar=c(5, 4, 4, 2) + 0.1)

#‘mfcol, mfrow’ A vector of the form ‘c(nr, nc)’.  Subsequent
#          figures will be drawn in an ‘nr’-by-‘nc’ array on the device
#          by _columns_ (‘mfcol’), or _rows_ (‘mfrow’), respectively.

#          In a layout with exactly two rows and columns the base value
#          of ‘"cex"’ is reduced by a factor of 0.83: if there are three
#          or more of either rows or columns, the reduction factor is
#          0.66.

#          Setting a layout resets the base value of ‘cex’ and that of
#          ‘mex’ to ‘1’.

#          If either of these is queried it will give the current
#          layout, so querying cannot tell you the order in which the
#          array will be filled.


##### Chapter 6: Regression Methods -------------------

#### Part 1: Linear Regression -------------------

## Understanding regression ----
## Example: Space Shuttle Launch Data ----
launch <- read.csv("challenger.csv")

# estimate beta manually
b <- cov(launch$temperature, launch$distress_ct) / var(launch$temperature)
b

# estimate alpha manually
a <- mean(launch$distress_ct) - b * mean(launch$temperature)
a

# calculate the correlation of launch data
r <- cov(launch$temperature, launch$distress_ct) /
       (sd(launch$temperature) * sd(launch$distress_ct))
r
cor(launch$temperature, launch$distress_ct)

# computing the slope using correlation
r * (sd(launch$distress_ct) / sd(launch$temperature))

# confirming the regression line using the lm function (not in text)
model <- lm(distress_ct ~ temperature, data = launch)
model
summary(model)

# creating a simple multiple regression function
reg <- function(y, x) {
  x <- as.matrix(x)
  x <- cbind(Intercept = 1, x)
  b <- solve(t(x) %*% x) %*% t(x) %*% y
  colnames(b) <- "estimate"
  print(b)
}

# examine the launch data
str(launch)

# test regression model with simple linear regression
reg(y = launch$distress_ct, x = launch[2])

# use regression model with multiple regression
reg(y = launch$distress_ct, x = launch[2:4])

# confirming the multiple regression result using the lm function (not in text)
model <- lm(distress_ct ~ temperature + field_check_pressure + flight_num, data = launch)
model

## Example: Predicting Medical Expenses ----
## Step 2: Exploring and preparing the data ----
insurance <- read.csv("insurance.csv", stringsAsFactors = TRUE)
str(insurance)

# summarize the charges variable
summary(insurance$expenses)

# histogram of insurance charges
hist(insurance$expenses)

# table of region
table(insurance$region)

# exploring relationships among features: correlation matrix
cor(insurance[c("age", "bmi", "children", "expenses")])

# visualing relationships among features: scatterplot matrix
pairs(insurance[c("age", "bmi", "children", "expenses")])

# more informative scatterplot matrix
library(psych)
pairs.panels(insurance[c("age", "bmi", "children", "expenses")])

## Step 3: Training a model on the data ----
ins_model <- lm(expenses ~ age + children + bmi + sex + smoker + region,
                data = insurance)
ins_model <- lm(expenses ~ ., data = insurance) # this is equivalent to above

# see the estimated beta coefficients
ins_model

## Step 4: Evaluating model performance ----
# see more detail about the estimated beta coefficients
summary(ins_model)

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

# add a higher-order "age" term
insurance$age2 <- insurance$age^2

# add an indicator for BMI >= 30
insurance$bmi30 <- ifelse(insurance$bmi >= 30, 1, 0)

# create final model
ins_model2 <- lm(expenses ~ age + age2 + children + bmi + sex +
                   bmi30*smoker + region, data = insurance)

summary(ins_model2)

# making predictions with the regression model
insurance$pred <- predict(ins_model2, insurance)
cor(insurance$pred, insurance$expenses)

plot(insurance$pred, insurance$expenses)
abline(a = 0, b = 1, col = "red", lwd = 3, lty = 2)

predict(ins_model2,
        data.frame(age = 30, age2 = 30^2, children = 2,
                   bmi = 30, sex = "male", bmi30 = 1,
                   smoker = "no", region = "northeast"))

predict(ins_model2,
        data.frame(age = 30, age2 = 30^2, children = 2,
                   bmi = 30, sex = "female", bmi30 = 1,
                   smoker = "no", region = "northeast"))

predict(ins_model2,
        data.frame(age = 30, age2 = 30^2, children = 0,
                   bmi = 30, sex = "female", bmi30 = 1,
                   smoker = "no", region = "northeast"))

#### Part 2: Regression Trees and Model Trees -------------------

## Understanding regression trees and model trees ----
## Example: Calculating SDR ----
# set up the data
tee <- c(1, 1, 1, 2, 2, 3, 4, 5, 5, 6, 6, 7, 7, 7, 7)
at1 <- c(1, 1, 1, 2, 2, 3, 4, 5, 5)
at2 <- c(6, 6, 7, 7, 7, 7)
bt1 <- c(1, 1, 1, 2, 2, 3, 4)
bt2 <- c(5, 5, 6, 6, 7, 7, 7, 7)

# compute the SDR
sdr_a <- sd(tee) - (length(at1) / length(tee) * sd(at1) + length(at2) / length(tee) * sd(at2))
sdr_b <- sd(tee) - (length(bt1) / length(tee) * sd(bt1) + length(bt2) / length(tee) * sd(bt2))

# compare the SDR for each split
sdr_a
sdr_b

## Example: Estimating Wine Quality ----
## Step 2: Exploring and preparing the data ----
wine <- read.csv("whitewines.csv")

# examine the wine data
str(wine)

# the distribution of quality ratings
hist(wine$quality)

# summary statistics of the wine data
summary(wine)

wine_train <- wine[1:3750, ]
wine_test <- wine[3751:4898, ]

## Step 3: Training a model on the data ----
# regression tree using rpart
library(rpart)
m.rpart <- rpart(quality ~ ., data = wine_train)

# get basic information about the tree
m.rpart

# get more detailed information about the tree
summary(m.rpart)

# use the rpart.plot package to create a visualization
library(rpart.plot)

# a basic decision tree diagram
rpart.plot(m.rpart, digits = 3)

# a few adjustments to the diagram
rpart.plot(m.rpart, digits = 4, fallen.leaves = TRUE, type = 3, extra = 101)

## Step 4: Evaluate model performance ----

# generate predictions for the testing dataset
p.rpart <- predict(m.rpart, wine_test)

# compare the distribution of predicted values vs. actual values
summary(p.rpart)
summary(wine_test$quality)

# compare the correlation
cor(p.rpart, wine_test$quality)

# function to calculate the mean absolute error
MAE <- function(actual, predicted) {
  mean(abs(actual - predicted))
}

# mean absolute error between predicted and actual values
MAE(p.rpart, wine_test$quality)

# mean absolute error between actual values and mean value
mean(wine_train$quality) # result = 5.87
MAE(5.87, wine_test$quality)

## Step 5: Improving model performance ----
# train a Cubist Model Tree
library(Cubist)
m.cubist <- cubist(x = wine_train[-12], y = wine_train$quality)

# display basic information about the model tree
m.cubist

# display the tree itself
summary(m.cubist)

# generate predictions for the model
p.cubist <- predict(m.cubist, wine_test)

# summary statistics about the predictions
summary(p.cubist)

# correlation between the predicted and true values
cor(p.cubist, wine_test$quality)

# mean absolute error of predicted and true values
# (uses a custom function defined above)
MAE(wine_test$quality, p.cubist)


ybar = 178.2           # sample mean
mu0 = 190           # hypothesized value
sigma = 45.3       # population standard deviation
n = 100               # sample size
z = (ybar- mu0)/(sigma/sqrt(n))
print(z)
k=abs(z)
# test statistic
 # formula based on level of significance
p_value=2*(1-pnorm(k))
print(p_value)
# mentioned p value in book is wrong
alpha=0.01
if(p_value>alpha){
  print("we fail to reject H0")
  print(" data do not support the research hypothesis(insufficient evidence).")
}else{
  print("  there is very little evidence in the data to support the research hypothesis  hence we will reject H0")
}


truemu <- -.5
truesd <- 200

n <- 10
M <- 10000
gama <- .90
cc <- qt(p = (1  + gama)/2, df = n-1)

computa_D <- function(x) {
  n <- length(x)
  Delta.sq <- sum((x - mean(x))^2)
  sigma.prime <- sqrt(Delta.sq/(n-1))
  d <- cc * sigma.prime/sqrt(n)
  return(d)
}

ta_no_intervalo <- function(intervalo){
  (intervalo[1] <= truemu) * (truemu <= intervalo[2])
}
#######

data.sets <- matrix(rnorm(n = n*M, mean = truemu, sd = truesd),
                    ncol = n, nrow = M)

Xbars <- apply(data.sets, 1, mean)
Ds <- apply(data.sets, 1, computa_D)
As <- Xbars - Ds
Bs <- Xbars + Ds

Intervalos <- data.frame(lwr = As, upr = Bs)
Intervalos$contem <- apply(Intervalos, 1, ta_no_intervalo)

mean(Intervalos$contem) ## cobertura dos intervalos

########### Figura
praplotar <- data.frame(lwr = As, media = Xbars, upr = Bs,
                        inclui = as.factor(Intervalos$contem), replicata = 1:M)
library(ggplot2)

p0 <- ggplot(data = praplotar, aes(x = replicata, y = media, colour = inclui)) +
  geom_point() +
  geom_errorbar(aes(ymin = lwr, ymax = upr)) +
  geom_hline(yintercept = truemu, linetype = "longdash", size = 1.5) +
  scale_y_continuous(expression(bar(X[n]) %+-%  D), expand = c(0, 0)) +
  theme_bw(base_size = 16)

p0


# Intervalos de confianza, error estándar y variance-covariance matrix.
#################################################################
cat("\014")
rm(list=ls())
graphics.off()

# Cargar paquete para cargar bases que no son de R.
# install.packages("foreign")
library(foreign) # significa "foraneo"
options(scipen = 1000000) # apagar notacion cientifica.
dat = read.dta("https://github.com/hbahamonde/OLS/raw/master/Datasets/cow.dta")

# Estimar modelo lineal: relacion entre crecimiento economico y democracia, controlando por poblacion
modelo.1 = lm(rgdpch ~ democracy + pop, dat)
summary(modelo.1)

# (1) Que significa "controlando por"?

# Obtener intervalos de confianza
## Estos valores representan la incertidumbre de nuestra estimacion al promedio de cada variable,
## manteniendo las otras variables independientes "constantes en sus medias".
confint(modelo.1, level = 0.95) # 95% de confianza
confint(modelo.1, level = 0.99) # 99% de confianza

# DIBUJAR EN EL PIZARRON LA REPRESENTACION DE QUE _SIGNIFICA_
# "EL 95%", Y DE POR QUE VEMOS LOS NUMEROS "2.5%" Y "97.5%"
# EN NUESTRA TABLA DE "CONFINT".

# Fijate que el intervalo de confianza de "democracia" va de ~1179 a ~2097
## "~" significa "aproximadamente". Esos valores representan, nuevamente,
## valores de nuestra "y" (es decir, "crecimiento economico", segun lo
## estimamos en nuestro "modelo.1".)

# Tambien podemos ver los coeficientes y su incertidumbre
# en forma grafica tambien.

# plotear CI
# install.packages("coefplot", "ggplot2")
library(coefplot, ggplot2)
coefplot(modelo.1)

# (1) Compara los numeros de la tabla "confint" y lo que ves en el grafico.
# (2) Que es lo que vemos en este grafico?
# (3) Que podemos decir de los distintos coeficientes?
# (4) Que podemos decir respecto al ancho de los intervalos de confianza?
# (5) Que es mejor? Intervalos de confianza "angostos" o "anchos"?

# Sin embargo, hay algunas veces que queremos observar como esta incertidumbre
# varia a medida que recorremos la distribucion entera (no solo el promedio).
## Atencion: "coefplot" y la tabla de coeficientes ("summary(modelo.1)")
## solo muestra la incertidumbre respecto al PROMEDIO ("el centro") de la distribucion.
## Lo que quiero decir, es que hay veces en que queremos ver como es que
## la incertidumbre (es decir, los intervalos de confianza) VARIAN
## segun nos movemos a lo LARGO de la distribucion, es decir, cuando
## vemos mas que el solo PROMEDIO.

### ESTE PUNTO ES IMPORTANTE, y ASEGURATE DE ENTENDERLO BIEN.

# Veamos como se ve esta incertidumbre a lo LARGO de la distribucion.

# install.packages("effects")
library(effects)
plot(allEffects(modelo.1))

# (1) Que vemos en este grafico?
# * DIBUJAR EN LA PIZARRA: CUANDO AVANZO UNA UNIDAD EN X, AVANZO 1179.9 EN DEMOCRACIA.
# (2) Que notan respecto al grado de incertidumbre?

# OK. Ya sabemos lo que los intervalos de confianza significan, y para que estan.
# Ahora calculemos intervalos de confianza a mano, y veamos de donde vienen
# estos numeros.

########################################################
# Como estimar manualmente los intervalos de confianza
########################################################

# Todo empieza estimando la Varianza del Error (sigma^2).

# Primero, obtengamos el error
e = as.vector(modelo.1$residuals)
e # es simplemente un vector con todos los errores (diferencia entre observado
# y predicho)

# Segundo, veamos cuantos parametros estimamos. Sera importante para la formula.
k = 3 # numero de variables a estimar (incluyendo intercepto).
# Tenemos "democracy", "pop", "Intercept". Entonces, tenemos 3 parametros.

# sigma.2 (varianza del error)
# Varianza es una medida de la variabilidad o dispersion de un vector. En este caso, del vector "e", que es nuestro error. Matematicamente, es la suma de los elementos diagonales que resultan de la multiplicacion entre el vector del error y el vector del error traspuesto, dividido por la cantidad de observaciones menos el numero de parametros que estaremos estimando (3 en este ejemplo).
sigma.2 = (1/(nrow(dat)-k))*sum(diag(e %*% t(e)))

# Tercero, obtengamos la matriz "x". La matriz "x" representa lo que observamos.
## Recuerda que para calcular el intercepto, debemos poner una columna de 1's del mismo largo que la dimension de el resto de las variables.
unos = rep(1, nrow(dat)) # repetir "1" 112 veces, que es el largo de la base de datos
# que lo acabo de calcular con "nrow(dat)".

## OK, ahora creemos la matrix "x".
x = matrix(c(unos, dat$democracy, dat$pop), ncol=3)
x # Ve como quedo.

# Cuarto, estimemos los errores estandard.
# Es importante sacar los errores estandard porque necesitamos eso para calcular los intervalos de confianza.

# Los errores estandard de hecho, salen en nuestra tabla de regresion.

summary(modelo.1) # "Std. Error"

# Para calcular los errores estandard, usaremos una vieja tecnica de matrices.

# Esta matriz es famosa, y se llama Matriz de Varianza-Covarianza.
# Las varianzas aparecen en la diagonal, y las covarianzas fuera de la diagonal.

library(matlib) # paquete para hacer operaciones con matrices.

# Calculemos la Matriz de Varianza-Covarianza
# Multiplicar sigma^2 por (x'x)^-1
options(scipen=999)
sigma.2 * inv(t(x) %*% x)

# Pero habia un camino mas corto...
vcov(modelo.1)

# Recapitulemos, esta matriz de Varianzas y Covarianzas tiene elementos importantes para calcular el error estandard, que sera necesario para calcular el intervalo de confianza.

# Lo interesante es que la raiz cuadrada de la diagonal, son los errores estandard.
sqrt(diag(sigma.2 * inv(t(x) %*% x)))

# Comprobemos. Los errores std. del "summary" debieran ser los mismos
# que los que estimamos nosotros manualmente.
summary(modelo.1)

# OK. Una manera de anotar esto, es extraer elemento por elemento de lo que acabamos de calcular.
sqrt(diag(sigma.2 * inv(t(x) %*% x)))[1] # error std. del intercepto
sqrt(diag(sigma.2 * inv(t(x) %*% x)))[2] # error std. de democracy
sqrt(diag(sigma.2 * inv(t(x) %*% x)))[3] # error std. de pop.

## Hablemos del error estandar
### La manera en la que debemos entender el error estandard (SE) asociado al
### coeficiente (lo que vemos en "summary(modelo.1)") es como un ESTIMATIVO de
### la desviacion estandard de la POBLACION.

### ATENCION: Poblacion es distinto a MUESTRA. Pensemos mas en esto...

### Pensemos en esto por un segundo. La razon por la que ESTIMAMOS, MODELAMOS, y
### tenemos INCERTIDUMBRE, es precisamente porque NO PODEMOS acceder a la poblacion.
### Es decir, dado que es imposible tener TODOS LOS DATOS, nosotros trabajamos
### con MUESTRAS. Un ejemplo de esto, es una encuesta para conocer preferencias
### politicas. Dado que no podemos entrevistar a todo el pais (POBLACION), entrevistamos
### a una MUESTRA, generalmente, aleatoria.

### Entonces, el error estandard del coeficiente hace referencia a algo que no conocemos

### En ese sentido, es precisamente la informacion que necesitamos para calcular los Intervalos de Confianza (nuestro tema de hoy).

### Antes de seguir, definamos los "grados de libertad"
### Se define como el numero de observaciones - 2.
grados.de.libertad = nrow(dat)-2

grados.de.libertad # ...veamos.

### La manera en que calculamos el intervalo de confianza,
### es la siguiente:

### Formula del intervalo de confianza
### coeficiente +/- t * SE del coeficiente.

# Es un calculo "doble":
### coeficiente + t * SE del coeficiente.
### coeficiente - t * SE del coeficiente.

### Hasta el momento, sabemos como derivar el coeficiente ( o "beta").
### Solo recuerda nuestros ej's en matrices:
### beta = (x'x)^-1x'y

### En la clase de hoy, aprendimos tambien a sacar el error estandard
### y entendimos lo que significa.
### Recuerda, el SE se saca asi:
### sqrt(diag(sigma.2 * inv(t(x) %*% x)))
### Es decir, la raiz cuadrada del los elementos diagonales de la
### multiplicacion entre sigma^2 y x'x (que es el "variance-covariance matrix").

### Para completar nuestra formula de los intervalos de confianza,
### necesitamos un ultimo elemento, "t".
### T es un valor critico que sacamos de una distribicion
### llamada "t".

#### Ocupemos una funcion para conseguir estos valores criticos.
t = qt(1-.05/2, grados.de.libertad) # valores criticos de t, a un 95% de confianza.

# "1-.05" porque queremos el 95% de la distribucion.
# Piensa en "la distribucion" como al area bajo la curva
# que representa "confianza". Es por eso que decimos
# que "estamos 95% seguros/confiados que nuestra estimacion
# es cierta"
# Y es dividido por dos ("/2") porque queremos repartir esa
# confianza a ambos lados de la distribucion.

#
10631.611789 - t * sqrt(diag(sigma.2 * inv(t(x) %*% x)))[1]  # (Intercept)  #  9136.09240230
10631.611789 + t * sqrt(diag(sigma.2 * inv(t(x) %*% x)))[1]  # (Intercept)  #  12127.13117506

#
1638.874546  - t * sqrt(diag(sigma.2 * inv(t(x) %*% x)))[2]  # democracy  # 1179.996
1638.874546  + t * sqrt(diag(sigma.2 * inv(t(x) %*% x)))[2]  # democracy  # 2097.753

#
0.002947     - t * sqrt(diag(sigma.2 * inv(t(x) %*% x)))[3]  # pop
0.002947     + t * sqrt(diag(sigma.2 * inv(t(x) %*% x)))[3]  # pop

# Pero nuevamente, siempre hay un camino mas corto.
confint(modelo.1, level = 0.95) # 95% de confianza

# Discutir
## (1) Por que 95 vs. 99?
## (2) Logica frecuentista: limites del "supuesto asintotico". Es posible?


# ------------------------------------------Questão01----------------------------------------------------
# 01) Utilize uma Distribuição Uniforme para criar uma base de dados aleatória.
# A base deve ser composta por 50 elementos entre os valores 6 e 18.
# Em seguida, calcule o que se pede.

database <- seq(from = 6, to = 18, by = 0.244)
length(database)
database

mean(database) # Média
var(database) # Variância
sd(database) # Desvio padrão
median(database) # Mediana
quantile(database) # Quartis
100*sd(database)/mean(database) # Coeficiente de variação

# ------------------------------------------Questão02--------------------------------------------------------------
# 02) Realize o download da base de dados localizada no link http://archive.ics.uci.edu/ml/datasets/Wine+Quality.
# Dois arquivos devem ser baixados, o que avalia a qualidade dos vinhos tintose outro sobre a qualidade dos vinhos
# brancos (winequality-red.csve winequality-white.csvrespectivamente). Faça o que se pedepara ambas basesde dados.

wine_red <- read.csv("../datasets/winequality-red.csv", sep = ";")
wine_white <- read.csv("../datasets/winequality-white.csv", sep = ";")

head(wine_red, n = 10)

head(wine_white)

# a) Obtenha os parâmetros estatísticos com a função summary.

summary(wine_red)

summary(wine_white)

# b) Plote umgráfico de pontos dos parâmetros de qualidade por pH.

plot(wine_red[,12],wine_red[,9],type="p", main = "Vinho vermelho", xlab = "Qualidade", ylab = "pH", col="blue")

plot(wine_white[,12],wine_white[,9],type="p", main = "Vinho branco", xlab = "Qualidade", ylab = "pH", col="green")

# c) Plote gráficos de barras para os parâmetros pH, qualidade e álcool.

wine_red_aux <- data.frame(pH=wine_red[,9], qualidade=wine_red[,12], alcool=wine_red[,11])
barplot(colSums(wine_red_aux), main = "Vinho vermelho")

wine_white_aux <- data.frame(pH=wine_white[,9], qualidade=wine_white[,12], alcool=wine_white[,11])
barplot(colSums(wine_white_aux), main = "Vinho branco")

# d) Plote histogramas para os parâmetros açúcar residual e volatilidade ácida com 10 intervalos.

hist(wine_red[,2], main = "Vinho vermelho", xlab = "Volatilidade acida")

hist(wine_red[,4], main = "Vinho vermelho", xlab = "Açúcar residual")

hist(wine_white[,2], main = "Vinho branco", xlab = "Volatilidade acida")

hist(wine_white[,4], main = "Vinho branco", xlab = "Açucar residual")

library("ISwR")

# e) Calcule a correlação entre os parâmetros qualidade e pH;densidade e álcool;
# açúcar residual e qualidade. Interprete cada resultado com um breve comentário.

print("Vinho vermelho --BEGIN--")
# qualidade e pH
cor(wine_red[,12], wine_red[,9])
cor.test(wine_red[,12], wine_red[,9])

# densidade e álcool
cor(wine_red[,8], wine_red[,11])
cor.test(wine_red[,8], wine_red[,11])

# açúcar residual e qualidade
cor(wine_red[,4], wine_red[,12])
cor.test(wine_red[,4], wine_red[,12])

print("Vinho vermelho --END--")

print("Vinho branco --BEGIN--")
# qualidade e pH
cor(wine_white[,12], wine_white[,9])
cor.test(wine_white[,12], wine_white[,9])

# densidade e álcool
cor(wine_white[,8], wine_white[,11])
cor.test(wine_white[,8], wine_white[,11])

# açúcar residual e qualidade
cor(wine_white[,4], wine_white[,12])
cor.test(wine_white[,4], wine_white[,12])

print("Vinho branco --END--")

# ------------------------------------------Questão03--------------------------------------------------------------
# 03)Implemente uma função em R que calcule a moda de vetoresde dados criados pelo usuário. Cada vetor deve conter 15 elementos,
# contendo apenas números inteiros positivos e/ou negativos. Crie três vetores para simulação, sendo um amodal,
# um modal e um bimodal para teste do seu programa.

# Função que calcula a moda
calc_moda <- function(vec){
 if(length(vec) != 15){
     print("Vetor inválido! O vetor deve conter 15 elementos.")
     return(FALSE)
 }

 if(typeof(vec[0]) == 'character'){
     print("Vetor inválido! O vetor deve conter apenas inteiros.")
     return(FALSE)
 }

 z <- table(as.vector(vec))
 names(z)[z == max(z)]

 return(z)
}

# Vetores de exemplo
amodal<-c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15)
modal<-c(1,1,3,4,5,6,7,8,9,10,11,12,13,14,15)
bimodal<-c(1,1,3,3,5,6,7,8,9,10,11,12,13,14,15)

calc_moda(amodal)
calc_moda(modal)
calc_moda(bimodal)

# ------------------------------------------Questão04--------------------------------------------------------------
# A tabela a seguir apresenta a quantidade de itens vendidos em um restaurante por um período
# de tempo. Devido às rasuras alguns dados estão faltantes. Importe os dados no formato XLSX
# para o RStudio®. Calcule média, mediana, variância e desvio padrão da Variável Quantidade.
# Obs.: ao criar a planilha no editor utilize apenas DUAS colunas para inserir os dados.

# PS está em CSV pq nao consegui instalar a LIB de xls do R 3.4

df <- data.frame(read.csv("questao_04.csv", sep = ";"))
head(df)
qtd <- na.omit(df[,2])
qtd

mean(qtd) # Média
var(qtd) # Variância
sd(qtd) # Desvio padrão
median(qtd) # Mediana

# ------------------------------------------Questão05--------------------------------------------------------------
# Calcule as probabilidades dos seguintes eventos. Para cada letra crie o espaço amostral e o
# evento desejado.

# a) Obter três caras no lançamento de 6 vezes de uma moeda justa.

S1 <- tosscoin(6, makespace = TRUE)
head(S1)
E1 <- subset(S1, isrep(S1, vals = "H", nrep = 3))
head(E1)
Prob(E1)

# b) Obter quatro coroas no lançamento de 7 vezes de uma moeda com p_cara = 0.65 e
# p_coroa= 0.35.

S2 <- probspace(tosscoin(7),probs = c(0.65,0.35)) #cara 65% e coroa 35%
head(S2)

E2 <- subset(S2, isrep(S2, vals = "T", nrep = 4))
head(E2)
Prob(E2)

# c) Obter a soma do resultado do lançamento de 4 vezes de um dado com 8 faces maior que
# 22.
S3 <-rolldie(4, nsides = 8, makespace = TRUE)
head(S3)

E3 <- subset(S3, X1+X2+X3+X4 > 22)
head(E3)
Prob(E3) #resultado

# d) Considere uma urna com 04 bolas verdes, 06 bolas azuis, 02 bolas pretas e 03 bolas
# vermelhas. Determine a probabilidade de se retirada a sequencia nesta ordem (preta,
# azul, verde, vermelha e azul) após cinco retiradas sem reposição dessa urna

Balls <- rep(c("verde","azul","preta", "vermelha"),times = c(4,6,2,3))
S4 <- urnsamples(Balls, size = 5, replace = FALSE, ordered = TRUE)
E4 <- probspace(S4)
R4 <- Prob(E4, isin(E4, c("preta","azul","verde","vermelha","azul"), ordered =
TRUE))

R4

# ------------------------------------------Questão06--------------------------------------------------------------
# 06) Para a base de dados beaver1 presente no R faça o que se pede

beav <- beaver1
head(beav)

# a) Plote um gráfico entre as variáveis tempo (eixo X) e temperatura (eixo Y).

plot(beav[,2], beav[,3], type = "b", main = "Beaver1", xlab = "Tempo", ylab = "Temperatura", col=c("red", "blue"))

# b) Faça uma regressão linear considerando Y=f(X)

time<-beav[,2]
temp<-beav[,3]
x1<-time
y1<-temp

beav.lm <- lm(y1 ~ x1, data=beav)
coef1<- coef(beav.lm)
coef1
plot(x1,y1,type="p",xlab = "Tempo", ylab = "Temperatura", col=c("red", "blue"))
abline(coef1)

# c) Com base na regressão preveja o valor da temperatura para o tempo 960 e 1680.

# d) Calcule o vetor de predições

prev1<- fitted(beav.lm)
head(prev1, 10)

# e) Calcule o vetor de resíduos

res1 <- residuals(beav.lm)
head(res1, 10)

# f) Intervalo de confiança para os níveis de 95% e 70%.
conf1 <- confint(beav.lm, level = 0.95) #intervalo de confiança de 95%
conf2 <- confint(beav.lm, level = 0.70) #intervalo de confiança de 70%

conf1 # 95
conf2 # 70

# g) Utilizando a função ci.plot() plote os gráficos dos intervalos junto com os dados.

plot(beav.lm, conf.level = 0.70)

plot(beav.lm, conf.level = 0.95)


library(wavelets)
k <- c(1,2,3,4)
w <- dwt(k, filter="haar")
w@V[[1]]
# http://www.bearcave.com/misl/misl_tech/wavelets/matrix/index.html
a <- c(1,1,0,0,
       1,-1,0,0,
       0,0,1,1,
       0,0,1,-1)
a <- matrix(a, nrow = 4, ncol = 4)
b <- matrix(k,nrow=4, ncol = 1)
x <- (1/sqrt(2)) * a %*% b
y <- c(x)
ai <- y[seq(1, 3, 2)]

#library(wavelets)
# https://stackoverflow.com/questions/19677229/r-haar-wavelet-transform
k <- c(4,6,10,12,8,6,5,5)
w <- dwt(k, filter="haar")
w@V[[1]]
# http://www.bearcave.com/misl/misl_tech/wavelets/matrix/index.html
a <- c(1,1,0,0,0,0,0,0,
       1,-1,0,0,0,0,0,0,
       0,0,1,1,0,0,0,0,
       0,0,1,-1,0,0,0,0,
       0,0,0,0,1,1,0,0,
       0,0,0,0,1,-1,0,0,
       0,0,0,0,0,0,1,1,
       0,0,0,0,0,0,1,-1)
a <- matrix(a, nrow = 8, ncol = 8)
b <- matrix(k,nrow=8, ncol = 1)
x <- (1/sqrt(2)) * a %*% b
y <- c(x)
ai <- y[seq(1, 7, 2)]

#library(wavelets)
# https://stackoverflow.com/questions/19677229/r-haar-wavelet-transform
# 40 muestras haar vs jorge
k <- rep(c(4,6,10,12,8,6,5,8),4)
w <- dwt(k, filter="haar")
bi <- c(w@V[[1]])
# http://www.bearcave.com/misl/misl_tech/wavelets/matrix/index.html
a <- c(1,1,0,0,0,0,0,0,
       1,-1,0,0,0,0,0,0,
       0,0,1,1,0,0,0,0,
       0,0,1,-1,0,0,0,0,
       0,0,0,0,1,1,0,0,
       0,0,0,0,1,-1,0,0,
       0,0,0,0,0,0,1,1,
       0,0,0,0,0,0,1,-1)
a <- matrix(a, nrow = 8, ncol = 8)
b <- matrix(k,nrow=8, ncol = length(k)/8)
x <- (1/sqrt(2)) * a %*% b
y <- c(x)
ai <- y[seq(1, length(y)-1, 2)]

# para 80 muestras
nivel = 80
k <- rep(c(4,6,10,12,8,6,5,5,23,1),8) # length 80
a <- c()
estado = FALSE
for (index in c(1:nivel)){
  estado = !estado
  arreglo = rep(0,nivel)
  myIndice = 0
  if (index %% 2 == 0){# par
    myIndice = index -1
  } else {
    myIndice = index
  }
  par = c()
  if (estado) {
    par = c(1,1)
  } else {
    par = c(1,-1)
  }
  iInf = myIndice-1
  iSup = myIndice+2
  #print(paste("Indice", iInf, iSup))
  #print(arreglo[0:iInf])
  #print(arreglo[iSup:length(arreglo)])
  if (iInf == 0){
    arreglo = c(par, arreglo[iSup:length(arreglo)])
  } else if (iSup == length(arreglo)+1){
    arreglo=c(arreglo[1:iInf], par)
  } else {
    arreglo=c(arreglo[1:iInf], par, arreglo[iSup:length(arreglo)])
  }
  #print(paste("Estado", estado))
  #print(paste("Par", par))
  #print(arreglo)
  #print(paste("Indice", index))
  a <- c(a,arreglo)
}
a <- matrix(a, nrow=nivel, ncol=nivel)
b <- matrix(k, nrow=nivel, ncol=1)
x <- (1/sqrt(2)) * a %*% b
y <- c(x)
ai <- y[seq(1, nivel, 2)]

Transformada Wavelet Haar Y Arbol de Decisiones/wavelets.r


### 線形回帰分析(単回帰)の例
### - Brain and Body Weights for 28 Species

## パッケージの読み込み
require(MASS)
require(tidyverse)
require(ggfortify)

## データの読み込み ("MASS::Animals"を用いる)
data(Animals)

## データの内容を確認
help(Animals)  # 内容の詳細を表示
print(Animals) # データの表示

## データのプロット (normal plot)
ggplot(Animals, aes(body, brain, label=rownames(Animals))) +
    geom_point(colour="royalblue") +
    labs(title="Brain and Body Weights (normal plot)",
         x="body [kg]", y="brain [g]")

ggplot(Animals, aes(body, brain)) +
    scale_x_log10() + scale_y_log10() +
    geom_point(colour="royalblue") +
    labs(title="Brain and Body Weights (log-log plot)",
         x="body [kg]", y="brain [g]")

## 回帰分析 (単回帰)
model <- lm(log(brain) ~ log(body), data=Animals)
summary(model) # 分析結果のまとめを表示

## 区間推定
yc <- exp(predict(model, newdata=Animals, interval="confidence"))
colnames(yc) <- paste("c",colnames(yc),sep=".")
yp <- exp(predict(model, newdata=Animals, interval="prediction"))
colnames(yp) <- paste("p",colnames(yp),sep=".")
mydat <- cbind(Animals, yc, yp)

## 回帰式および信頼区間・予測区間の表示
ggplot(mydat, aes(body, brain, label=rownames(mydat))) +
    scale_x_log10() + scale_y_log10() + # log-log plot
    geom_line(aes(y=c.fit), color="dodgerblue", lwd=1.2) +
    geom_ribbon(aes(ymin=c.lwr,ymax=c.upr), fill="blue", alpha=0.2)+
    geom_ribbon(aes(ymin=p.lwr,ymax=p.upr), fill="blue", alpha=0.1)+
    geom_text(size=3) +
    labs(title="Brain and Body Weights", x="body [kg]", y="brain [g]")

## 診断プロット
autoplot(model, colour="royalblue",
         smooth.colour="gray50", smooth.linetype="dashed",
         ad.colour="blue",
         label.size=3, label.n=5, label.colour="red")

## 外れ値を除いた回帰分析
idx <- c(6,16,26) # 外れ値のindex
model <- lm(log(brain) ~ log(body), data=Animals, subset=-idx)
summary(model)

## 区間推定
yc <- exp(predict(model, newdata=Animals, interval="confidence"))
colnames(yc) <- paste("c",colnames(yc),sep=".")
yp <- exp(predict(model, newdata=Animals, interval="prediction"))
colnames(yp) <- paste("p",colnames(yp),sep=".")
mydat <- cbind(Animals, yc, yp)

## 回帰式および信頼区間・予測区間の表示
ggplot(mydat, aes(body, brain, label=rownames(mydat))) +
    scale_x_log10() + scale_y_log10() +
    geom_line(aes(y=c.fit), color="royalblue", lwd=1.2) +
    geom_ribbon(aes(ymin=c.lwr,ymax=c.upr), fill="blue", alpha=0.2)+
    geom_ribbon(aes(ymin=p.lwr,ymax=p.upr), fill="blue", alpha=0.1)+
    geom_text(size=3) +
    labs(title="Brain and Body Weights", x="body [kg]", y="brain [g]")

## 診断プロット
autoplot(model, colour="royalblue",
         smooth.colour="gray50", smooth.linetype="dashed",
         ad.colour="blue",
         label.size=3, label.n=5, label.colour="red")


# See
# http://what-when-how.com/artificial-intelligence/a-comparison-of-cooling-schedules-for-simulated-annealing-artificial-intelligence/

exp_cool <- function(i, ntot, a, b) {
  (1-b)*exp(-a*i/ntot)+b
}

pow_cool <- function(i, ntot, a, b) {
  (1-b)*(a^(i/ntot))+b
}

lin_cool <- function(i, ntot, a, b) {
  (1-b)*(1/(1+a*i))+b
}

quad_cool <- function(i, ntot, a, b) {
  (1-b)*(1/(1+a*(i^2)))+b
}

log_cool <- function(i, ntot, a, b) {
  (1-b)*(1/(1+a*log(1+i)))+b
}

ntot <- 10000
x <- seq(0, ntot, by=1)

# plot(
#   x,
#   pow_cool(x, ntot, 0.001, 0),
#   type="l"
# )

plot(
  x,
  exp_cool(x, ntot, 3, 0),
  type="l"
)

lines(
  x,
  pow_cool(x, ntot, 1e-10, 0),
  col="red"
)

lines(
  x,
  lin_cool(x, ntot, 0.01, 0.01),
  col="green"
)

lines(
  x,
  quad_cool(x, ntot, 0.0000002, 0.05),
  col="blue"
)

lines(
  x,
  log_cool(x, ntot, 3, 0),
  col="purple"
)

# plot(
#   x,
#   0.2*cos(100*x*pi/ntot)+0.3,
#   type="l",
#   ylim=c(0, 1)
# )
#
plot(
  x,
  ((exp(-5*x/ntot)+0.05*cos(100*x*pi/ntot))+0.05)/1.1,
  type="l"
)
#
# plot(
#   seq(-1, 1, by=0.01),
#   seq(-1, 1, by=0.01)^2,
#   type="l"
# )

# 1) Lift the map
# 2) Lift-decay the map
# 3) Discussion: adaptive
# 4) Discussion: partial (parts) of metric
# 5) Discussion: scale with data and parameters


set.seed(102)

#Saving plots
pdf(file = "task3.pdf")

#prior sd is 4 prior
#hyperparameters h_mean=0 h_sd=2
h_mean = 4
h_sd = 2

par(mfrow=c(3,3),xpd=FALSE)
N=1;
x=rnorm(n=N,m=7,sd=4)
#finding observed values
	x<-rnorm(n=N,m=7,sd=4) #creation of observed data
	sampleMean=mean(x);

	x1 <- seq(-30, 30, 0.1)

	#Finding posterior
	posterior_mean = (N*(h_sd^2)*sampleMean + 16*0 )  /  ( N*(h_sd^2) + 16)
	posterior_var = (h_sd^2*16) / N*( h_sd^2 + 16 )
	post.norm<-rnorm(n=N,m=posterior_mean,sd=sqrt(posterior_var)) #creation of observed data

	#finding posterior, observed, prior
	plot(x1, dnorm(x1, 0, 2), type = "l",xlim=c(-20, 20), xlab=N,col="blue")
	lines(x1,dnorm(x1, posterior_mean, sqrt(posterior_var)),col="gold")
	lines(x,dnorm(x1, x, sqrt(0)),col="red")

	legend("topleft",
       inset=.05,
       cex = 1,
       c("data","post","prior"),
       horiz=FALSE,
       lty=c(1,1),
       lwd=c(2,2),
       col=c("red","gold","blue"),
       box.lty=0)

for (N in c(5,10,20,50,100,1000)){
	print(paste("The number of observed values is", N))

	#finding observed values
	x<-rnorm(n=N,m=7,sd=4) #creation of observed data
	sampleMean=mean(x);

	x1 <- seq(-30, 30, 0.1)

	#Finding posterior
	posterior_mean = (N*(h_sd^2)*sampleMean + 16*0 )  /  ( N*(h_sd^2) + 16)
	posterior_var = (h_sd^2*16) / N*( h_sd^2 + 16 )
	post.norm<-rnorm(n=N,m=posterior_mean,sd=sqrt(posterior_var)) #creation of observed data

	#finding posterior, observed, prior
	plot(x1, dnorm(x1, 0, 2), type = "l",xlim=c(-20, 20), xlab=N,col="blue",ylim=c(0, 0.35))
	lines(x1,dnorm(x1, posterior_mean, sqrt(posterior_var)),col="darkgoldenrod1")
	lines(density(x),col="red")

  legend("topleft",
       inset=.05,
       cex = 1,
       c("data","post","prior"),
       horiz=FALSE,
       lty=c(1,1),
       lwd=c(2,2),
       col=c("red","gold","blue"),
       box.lty=0)
}

dev.off()

#Παρατηρήσεις: Η εκ των προτέρων (prior) κατανομή(με εξαιρεση Ν=1) παραμένει σταθερή,
#η κατανομή των παρατηρήσεων παραμένει σχεδόν σταθερή με αβεβαιότητα
#λόγω της μικρής κορυφής και η posterior, όσο αυξάνονται τα δείγματα
# μικραίνει η διακύμανση και αποκτά μεγάλη κορυφή. Λογικό, όπως
#αναφέρεται στη βιβλιογραφία όσο το Ν αυξάνεται η αβεβαιότητα στη posterior
# μειώνεται αφού μειώνεται η επίδραση της σ.


## Basics in R

## Generate a vector with seq()
?seq

# Generate a sequence from 3.1 to 8.9, with gap between adjacent unit being 0.8
seq(from = 3.1, to= 8.9, by=0.8)
seq(from=3.1, to =8.9, length.out=10)
#seq(from=3.1, to =8.9, by=1, length.out=10)

a=1:3
(a= 1:3)
(b=c(1,2,3))

a == b

?identical
identical(a,b)

typeof(a)
typeof(b)

(u=c(TRUE,T,FALSE,F,T))
typeof(u)

(w=c("a", 'b', "c", "d"))
typeof(w)
paste(w[1],w[2],sep="")

y=c(1:3,w)
typeof(y[1])

z=as.numeric(y)

?NA
is.na(y[4])
is.na(z[4])

length(y)
k= 3;
y[k]

x = c(1,3,4,6.7,-4,NA,-2.9)
x

x == 1
x>1
x<1
x>=1

x[which(x>=1)]
x[x>=1]

x[  x>0 ]

x[  x<2 ]

x[(x>0) & (x<2)] # &: and
x[(x>0) | (x<2)] # |: or

(x<0)
!(x<0)
x[ which(!(x>0) & (x<2)) ]

##
x

length(x)
sum(x)
?sum
sum(x,na.rm=TRUE)
sd(x,na.rm=TRUE)
mean(x,na.rm=TRUE)

0/0
?NaN
1/0
-1/0

is.na()
is.nan(0/0)
y=NULL
is.null(y)
y

?sum # <- find the help file for the function sum.
args(sum)
example(sum)

## Strings:
wrd = c("a","new","sentence")
u = c("_","!","?")
wrd
typeof(wrd)

print("this is a sentence")
length("this is a sentence")
length(wrd)

paste(wrd,u,sep="")

split.str=strsplit("this is a sentence", split=" ")
typeof(split.str)
length(split.str)
split.str[[1]]

## Data frame

name =c("Bob","Jane")
age = c(19,21)
GPA = c(3.2,3.6)

students = data.frame(name,age,GPA,stringsAsFactors=F)
students
str(students)

?rbind
students = rbind(students,c("Ashley",20,3.4))
students

students = cbind(students,resident=c(T,F,T))
students

## Functions
?rbind
?seq

x = seq(0,1,0.05)
x.check=seq(from = 0, to= 1, by=0.05)

identical(x,x.check)

y = sin(2*pi*x)*exp(-4*x^2) #<- reproduce this function on our own!

sinexp = function(z){
  out=sin(2*pi*z)*exp(-4*z^2);
  return(out)
}

y.new=sinexp(z=x)
identical(y.new,y)

plot(y~x, type='l')
lines(x=x,y=y.new,col='red')

lm() #<- This is what we will reproduce in this quarter


library(repr) ; options(repr.plot.res = 100, repr.plot.width=4, repr.plot.height= 4) # Change plot sizes (in cm) - this bit of code is only relevant if you are using a jupyter notebook - ignore otherwise

MySample <- rnorm(10, m=0, sd=1)

MySample

hist(MySample)

dnorm(1, m=0, sd=1)

dnorm(-1, m=0, sd=1)

dnorm(10, m=0, sd=1)

dnorm(100, m=0, sd=1)

MySample5 <- rnorm(5, m=0, sd=1) # Draw 5 normal random nos w/ mean 0 and s.d. 1:
MySample10 <- rnorm(10, m=0, sd=1)
MySample20 <- rnorm(20, m=0, sd=1)
MySample40 <- rnorm(40, m=0, sd=1)
MySample80 <- rnorm(80, m=0, sd=1)
MySample160 <- rnorm(160, m=0, sd=1)

par(mfcol = c(2,3)) #initialize multi-paneled plot
par(mfg = c(1,1)); hist(MySample5, col = rgb(1,1,0), main = 'n = 5')
par(mfg = c(1,2)); hist(MySample10, col = rgb(1,1,0), main = 'n = 10')
par(mfg = c(1,3)); hist(MySample20, col = rgb(1,1,0), main = 'n = 20')
par(mfg = c(2,1)); hist(MySample40, col = rgb(1,1,0), main = 'n = 40')
par(mfg = c(2,2)); hist(MySample80, col = rgb(1,1,0), main = 'n = 80')
par(mfg = c(2,3)); hist(MySample160, col = rgb(1,1,0), main = 'n = 160')

genome <- read.csv('../data/GenomeSize.csv')

head(genome) # this won't look so nice on your computer!

str(genome) # Check what the data columns contain

summary(genome)

hist(genome$GenomeSize, breaks=10)

plot(density(genome$GenomeSize, bw=0.1))

plot(GenomeSize ~ Suborder, data=genome)

Anisoptera <- subset(genome, Suborder=='Anisoptera') #The dragonflies
Zygoptera <- subset(genome, Suborder=='Zygoptera') #The damselflies

head(Anisoptera)

plot(density(Zygoptera$GenomeSize), xlim=c(0.1, 2.7), ylim=c(0,1.7))
lines(density(Anisoptera$GenomeSize), col='red')

plot(GenomeSize ~ BodyWeight, data = genome)

str(genome$Suborder) #Confirm that there are two levels under suborders

myColours <- c('red', 'blue') # So choose two colours
mySymbols <- c(1,3) # And two different markers

plot(GenomeSize ~ TotalLength , data = genome, #Now plot again
col = myColours[Suborder], pch = mySymbols[Suborder],
xlab='Total length (mm)', ylab='Genome size (pg)')

legend("topleft", legend=levels(genome$Suborder), #Add legend at top left corner
       col= myColours, pch = mySymbols, cex = 1)


# linear regression model : y= 0.15085 - 0.00288x1 - 0.00759x2 + 0.26528x3
SStotal=3.328
SSresidual=0.674
n=21
R2=(SStotal-SSresidual)/SStotal
print(R2)

#test statistic
F=(R2/3)/((1-R2)/(n-4))
print(F)
alpha=0.05
fvalue=qf(1-alpha,df1=3,df2 = 17)
print(fvalue)
# Because the computed F statistic, , is greater than fvalue, we reject H0 and
#conclude that one or more of the x values has some predictive power


### car package を用いた回帰分析の診断の例
### 詳しい解説は以下を参照
###  An R Companion to Applied Regression, Second Edition
###     John Fox and Sanford Weisberg
###        Sage Publications, 2011

## パッケージの読み込み
require(car)
require(tidyverse)
require(ggfortify)
require(GGally)

## データの読み込み ("datasets::mtcars"を用いる)
data(mtcars)  # データの読み込み

## データの内容を確認
help(mtcars)  # 内容の詳細を表示
str(mtcars)   # データの構造を表示
## print(mtcars) # 全データの表示
head(mtcars)  # データの一部を表示

## カテゴリカルな変数を因子に変換してデータを整理
mydata <- mtcars
mydata[,c(2,8:11)] <- lapply(mydata[,c(2,8:11)],
                             factor)
with(mydata,table(cyl)) # clyカテゴリ毎のデータ数を表示
## str(mydata) # データの構造を表示

## 量的変数の散布図: 図(a)
ggscatmat(mydata, columns=c(1,3:7),
          color="cyl", alpha=.8)

## ## その他の散布図の書き方
## ggpairs(mydata) +
##     theme(axis.title.x=element_text(size=10),
##           axis.title.y=element_text(size=10))

## 気筒数(cyl)毎の燃費(mpg)と排気量(disp)の関係: 図(b)
coplot(mpg ~ disp | cyl,
       data=mydata, panel=panel.smooth, rows=1)

### 線形回帰モデルの作成
### モデル例: 量的変数のみを用いたモデル
## 目的変数: 燃費(mpg)
## 説明変数: 排気量(disp)，馬力(hp)，
##         重さ(wt)，ギア比(drat)
## 馬力と重さが有意
## 排気量は不合理な結果で有意性も低い悪いモデル
model <- lm(mpg ~ disp + hp + wt + drat,
            data=mydata)
summary(model)
## 推定された係数と信頼区間: 図(c)
ggcoef(model)

## 診断プロット: 図(d)
autoplot(model)

## car packageによる診断
## *residual plots*
## モデルが正しければ残差は予測値や説明変数とは独立になるはず
## 出力は lack-of-fit test (2乗項を含むかどうかのt検定)
## 各変数と残差の関係: 図(e)
##  (drat 以外は残差に偏りが見られる)
residualPlots(model)
## ## optionの例 (terms の与え方でいろいろな図が作成できる)
## residualPlots(model, terms= ~ 1)  # 予測値との関係のみ
## residualPlots(model, terms= ~ wt, fitted=FALSE)
## residualPlots(model, terms= ~ 1 | cyl) # cylごと
## residualPlots(model, terms= ~ . | cyl)
##  (残差の偏りとcylの間に何らかの関係が見られる)

## *marginal-model plots*
## residualPlotsの変種
## 残差の代わりに目的変数を縦軸に用いて
## 予測値や説明変数での条件付周辺分布を視覚化する
## モデルが正しければデータとモデルの条件付平均は一致するはず
## 各変数と目的変数の関係: 図(f)
##  (hpやwtは2つの平均が明瞭に交差している)
marginalModelPlots(model)
## # optionの例
## marginalModelPlots(model, id.n=3) # 外れ値を3つ表示
## marginalModelPlots(model, sd=TRUE) # 標準偏差を付加

## *added-variable plots*
##  偏回帰 (以下の2つの回帰)
##   y  ~ x2 + ... + xp
##   x1 ~ x2 + ... + xp
##  の残差の散布図を用いて，説明変数と目的変数の関係を視覚化する
## 偏回帰の残差の関係: 図(g)
##  (hpは反比例(双曲線)の関係が示唆される)
avPlots(model)
## ## optionの例
## avPlots(model, id.n=2) # それぞれの軸で外れ値を2つ

## *QQ plot*
## 正規分布から逸脱する残差を調べて
## モデルに合致しないデータを洗い出す
## 残差の正規性の検討: 図(h)
qqPlot(model)
## ## optionの例
## qqPlot(model, envelope=.99) # 信頼区間を変更
## qqPlot(model, id.n=3) # 外れ値を3つ表示

## 残差
residuals(model) %>% head() # headで最初の部分のみ表示
## 標準化誤差
rstandard(model) %>% head() # standardized residual
rstudent(model) %>% head()  # Studentized residual
## テコ比
hatvalues(model) %>% head()
## Cook's dist
cooks.distance(model) %>% head()
## 最大正規化誤差のt-検定 (Bonferroniの補正)
outlierTest(model)

## *influence index plot*
## 各データの Cook's dist., Studentized residual,
## Bonferroni p-value, hat-value (テコ比)を表示
## 外れ値の診断プロット: 図(i)
influenceIndexPlot(model, id.n=3)

## *influence plot*
## Cook's dist., Studentized residual, hat-valueを表示
## 外れ値の診断プロット: 図(j)
influencePlot(model, id.n=3)

## *component+residual plots*
## 説明変数と残差+説明変数による成分(偏回帰の残差)の関係から
## 非線形性の確認を行う
## 非線形性の検討: 図(k)
crPlots(model)
## ## optionの例
## crPlots(model, order=2) # 2次の関係を仮定
## crPlots(model, order=3) # 3次の関係を仮定

## *spread-level plot*
## 予測値と残差の絶対値の関係から残差の分散の一様性の確認を行う
## 分散の一様性の検討: 図(l)
spreadLevelPlot(model)

## non-constant variance score test
## 残差の分散の一様性の検定
ncvTest(model)

## variance inflation factor
## 多重共線性の確認
vif(model)

### モデル例: 量的変数のみを用いたモデル
## 目的変数: 燃費(mpg)
## 説明変数: AICを用いたstepwise法により選択されたモデル
model <- step(lm(mpg ~ ., data=mydata), trace=0)
summary(model)
## ggcoef(model)

## 各種診断: 図(m)(n)
residualPlots(model)
## marginalModelPlots(model, id.n=3)
## avPlots(model, id.n=2)
qqPlot(model)
## crPlots(model)
## spreadLevelPlot(model)
vif(model)

### モデル例: 変数を変換して作成したモデル
## 目的変数: 燃費の逆数(gpm)
## 説明変数: power-weight ratio(hp/wt)を加えAICで選択
mydata2 <- dplyr::select(mutate(mydata,
                                gpm=1/mpg,pwr=hp/wt),drat:pwr)
rownames(mydata2) <- rownames(mtcars) # 行名を付ける
model <- step(lm(gpm ~ ., data=mydata2), trace=0)
summary(model)
## ggcoef(model)

## 各種診断: 図(o)(p)
residualPlots(model)
## marginalModelPlots(model, id.n=3)
## avPlots(model, id.n=2)
qqPlot(model)
## crPlots(model)
## spreadLevelPlot(model)
vif(model)

## 主成分分析による変数間の関係の視覚化: 図(q)
autoplot(princomp(~ disp + hp + wt + drat,
                  data=mydata, cor=TRUE),
         data=mydata,
         colour="cyl", shape=FALSE, label=TRUE,
         loadings=TRUE, loadings.label=TRUE,
         loadings.label.size=6)
## ## optionの例
## autoplot(princomp(~ disp + hp + wt + drat,
##          data=mydata, cor=TRUE),
##          data=mydata, label=FALSE,
##          colour="cyl", shape="am", size="carb",
##          loadings=TRUE, loadings.label=TRUE,
##          loadings.label.size=6)


filesSize<-read.table("xn.txt"， header = T)
mydata = filesSize$Byte
cat("Nombre de fichier："，nrow(filesSize))

h = hist(log(mydata), breaks = 15, probability= TRUE, xlab = "log(file size)",
      main="Histogramme de la taille des fichiers en échelle logarithmique")

x <- seq(min(log(mydata)), max(log(mydata)), length = 100)
y <- dnorm( x, mean = mean(log(mydata)), sd = sd(log(mydata)))
lines(x, y, col = "blue", lwd = 2)

400/399 * sd(log(mydata))^2 - sd(log(mydata))^2

h = hist(log(mydata), breaks = 50, probability= TRUE,
      main="Histogramme de la taille des fichiers en échelle logarithmique")

log_x <- seq(-2, max(log(mydata)), length = 1000)
y_normal <- dnorm( log_x, mean = mean(log(mydata)), sd = sd(log(mydata)))
lines(log_x, y_normal, col = "blue", lwd = 2)

densité_lnorm <- function(x, mean, sd){
    return (1.0/(x*sqrt(2*pi*sd^2)) * exp(-(log(x)-mean)^2/(2*sd^2)))
}

#yfit_2 <- densité_lnorm(exp(xfit_2), mean(log(x)), sd(log(x)))
y_dlnorme <- dlnorm(exp(log_x), meanlog = mean(log(mydata)), sdlog = sd(log(mydata)))

par(new = TRUE)
plot(log_x, y_dlnorme, type = "l", axes = FALSE, bty = "n", xlab = "", ylab = "", col='red')
axis(4, ylim=c(0,max(y_dlnorme)), col="red",col.axis="red")

## Add Legend
legend("topright",legend=c("Densité de ln(x) suivant lois normal","Densité de X suivant loi log-Nromal"),
  text.col=c("black","red"),pch=c(16,15),col=c("black","red"))

median(mydata)

exp(mean(log(mydata)))

qlnorm(p=0.95, mean=mean(log(mydata)),sd=sd(log(mydata)))

exp(sqrt(399/400)*sd(log(mydata))*qnorm(p=0.95, mean=0, sd=1)+mean(log(mydata)))

mean(log(mydata))

print(0.1+400/2)

mu = mean(log(mydata))
0.1 + 0.5 * sum((log(mydata) - mu)^2)

margin = seq(0,1,length=5000)
apriori = dgamma(margin, shape=0.1, scale=10)

plot(x=margin,y=apriori,col="red",type="l",ylim=c(0,40),main="Densité de loi",xlab="Valeur",ylab="Densité")

posteriori = dgamma(margin, shape=200.1, scale=1/1708.3)
lines(x=margin,y=posteriori,col="orange",type="l")

abline(v=200.1/1708.3, col="green", lwd = "4")
abline(v=400/399/var(log(mydata)), col="blue", lwd = "2", lty = 2)

legend("topright",legend=c("Densité à priori","Densité à posteriori","Espérance à posteriori","Espérance MV"),col=c("red","orange","green","blue"),lty=c(1,1,1,2), cex=0.8)

L = 8 * qchisq(p=0.95, df = 399)
Accepte = sd(log(mydata))^2*400 <= L
Accepte

seuil = sqrt(sd(log(mydata))^2 * 400 / qchisq(p=0.95,df = 399))
seuil


# Example : 5.3A   Chapter : 5.3     Page No: 277
# Nullspace of matrix as transpose of Cofactor matrix
nullspacebasis<-function(A){
  C<-matrix(c(1:9),ncol=3)
  for(i in 1:3){
    for(j in 1:3){
      if((i+j)%%2==0){
        x<-1
      }
      else{
        x<--1
      }
      C[i,j]<-x*det(A[-i,-j])
    }
  }
  C<-t(C)
  return(C)
}

A1<-matrix(c(1,2,2,4,3,2,7,9,8),ncol=3)
N1<-nullspacebasis(A1)
print("The null space basis are given by columns of transpose of cofactor matrix")
print("Null space of A1 is")
print(N1)
A2<-matrix(c(1,1,1,1,1,1,2,1,1),ncol=3)
N2<-nullspacebasis(A2)
print("Null space of A2 is ")
print(N2)


# Program to display the Fibonacci sequence up to n-th term using recursive functions
recurse_fibonacci <- function(n) {
if(n <= 1) {
return(n)
} else {
return(recurse_fibonacci(n-1) + recurse_fibonacci(n-2))
}
}
# take input from the user
nterms = as.integer(readline(prompt="How many terms? "))
# check if the number of terms is valid
if(nterms <= 0) {
print("Plese enter a positive integer")
} else {
print("Fibonacci sequence:")
for(i in 0:(nterms-1)) {
print(recurse_fibonacci(i))
}
}


rm(list = ls()) #cleaning up
library(tidyverse)

df5=data.frame()
for (i in 1:10000){
  df5<-rbind(df5,rexp(5,2))
}
df5$mean<-rowMeans(df5,na.rm=TRUE,dims=1)

ggplot(df5, aes(mean))+
  geom_histogram(data=df5, aes(mean, ..density..), binwidth = 0.01)

mean(df5$mean)

##############1###################
df1=data.frame()
for (i in 1:10000){
  df1<-rbind(df1,rexp(1,2))
}
df1$mean<-rowMeans(df1,na.rm=TRUE,dims=1)

ggplot(df1, aes(mean))+
  geom_histogram(data=df1, aes(mean, ..density..), binwidth = 0.01)

mean(df1$mean)

##############10###################
df10=data.frame()
for (i in 1:10000){
  df10<-rbind(df10,rexp(10,2))
}
df10$mean<-rowMeans(df10,na.rm=TRUE,dims=1)

ggplot(df10, aes(mean))+
  geom_histogram(data=df10, aes(mean, ..density..), binwidth = 0.01)

mean(df10$mean)

##############30###################
df30=data.frame()
for (i in 1:10000){
  df30<-rbind(df30,rexp(30,2))
}
df30$mean<-rowMeans(df30,na.rm=TRUE,dims=1)

ggplot(df30, aes(mean))+
  geom_histogram(data=df30, aes(mean, ..density..), binwidth = 0.01)

mean(df30$mean)

##### same graph #####
df = data.frame("X1"  = df1$mean,
                "X5"  = df5$mean,
                "X10" = df10$mean,
                "X30" = df30$mean)
mean(df1$mean)
mean(df5$mean)
mean(df10$mean)
mean(df30$mean)

ggplot(df)+
  geom_histogram(data=df1, aes(mean, ..density..), color="red", binwidth = 0.01)+
  geom_histogram(data=df5, aes(mean, ..density..), color="orange", binwidth = 0.01)+
  geom_histogram(data=df10, aes(mean, ..density..), color="yellow", binwidth = 0.01)+
  geom_histogram(data=df30, aes(mean, ..density..), color="green", binwidth = 0.01)

##### Comparing the ratio of how decrease the starndard error ###
sd(df30$mean)
sd(df5$mean)/sqrt(6)


lesmis <- read.delim("lesmis.dat",header = F,sep = ",")
polbooks <- read.delim("polbooks.dat", header = F, sep = ",")
#d <- data.frame((lesmis[,1] + 1), (lesmis[,2] + 1))
d <- data.frame((polbooks[,1] + 1), (polbooks[,2] + 1))
n <- max(d) #No. of vertices
a <- matrix(0,n,n,dimnames = list(c(seq(1:n)),c(seq(1:n))))

#Creating adjacency matrix from given list
for (i in 1:nrow(d)){
      x <- d[i,1]
      y <- d[i,2]
      a[x,y] <- 1
      a[y,x] <- 1
}
degree <- rowSums(a)
vertex <- seq(1,n)
show(data.frame(vertex,degree))

avg_degree <- sum(degree)/n
cat(sprintf("\nAverage degree is :"),avg_degree)
cat(sprintf("\nDensity is :"),avg_degree/n)

#Local Clustering coeff (LCC)
LCC <- NULL #LCC of each vertex
id <- NULL  #index of neighbours
kC2 <- NULL  #Possible connections between neighbours
for(i in 1:n){
  k <- 0
  kC2 <- 0
  nd <- sum(a[i,])  #degree of each vertex
  if(nd > 1){
    id <- which(a[i,] == 1)
    for(j in 1:(nd-1)){
      for(l in (j+1):nd){
        if(a[id[j],id[l]] == 1){k <- k + 1}
      }
    }
    kC2 <- nd * (nd - 1) / 2
  }
  lc <- 0
  if(kC2 != 0) {lc <- k/kC2}
  LCC = c(LCC, lc)
}

#Degree Distribution
dm <- max(degree)
dist <- NULL
for (i in 0:dm) {
  dist1 <- length(which(degree==i))/n
  dist <- c(dist,dist1)
}
cat(sprintf("\n"))
deg <- seq(0,dm)
show(data.frame(deg,dist))

#Matrix for cosine similarities
m <- a %*% a  #Matrix for common neighbors between vertices
sig <- matrix(0,n,n,byrow = T,dimnames = list(c(seq(1:n)),c(seq(1:n)))) #Cosine similarity mat
for (i in 1:n) {
  for (j in 1:n) {
    if (i != j) {
      sig[i,j] <- m[i,j]/(sqrt(rowSums(a)[i])*sqrt(rowSums(a)[j]))
    }
    if(i == j){
      sig[i,j] <- 1
    }
  }
}

#Matrix  for Katz similarities
I <- diag(1,n)
e <- eigen(a)
alpha <- (1/max(e$values))* 0.7   #alpha < 1/k1 where k1 is largerst eigen value of a
ks <- solve(I - (alpha*a)) #Matrix of Katz Similarity


## Dale W.R. Rosenthal, 2018
## You are free to distribute and use this code so long as you attribute
## it to me or cite the text.
## The legal disclaimer in _A Quantitative Primer on Investments with R_
## applies to this code.  Use or distribution without these comment lines
## is forbidden.

## B = Bloomberg Barclays Aggregate Bond index ETF (AGG), from Yahoo Finance
expret.bonds <- 0.0269
vol.bonds <- 0.0292
## E = S&P 500 index ETF (SPY), from Yahoo Finance
vol.stocks <- 0.1027
expret.stocks <- 0.1076
rf <- 0.01  ## F = risk-free rate (approximately)

wt.bonds <- seq(-0.5,1.5,0.005)  ## explore bond weights: short 50% to long 150%
## create expected portfolio returns for weights
expret.port <- wt.bonds*expret.bonds + (1-wt.bonds)*expret.stocks

## plot and set up axes
plot.default(NULL, type='l', xlim=c(0,0.15), ylim=c(-0.01, 0.15))
abline(h=0, lty=2, col="gray80")
lines(c(0,0), c(0.08,-0.025), lty=2, col="gray80")

## iterate through correlations from 1 to -1 in steps of -0.25
## find the portfolio volatility and then plot the curve
## RAINBOW-y for visibility and fabulous pride
line.colors <- c("purple","magenta", "red", "orange", "yellow",
                 "chartreuse", "aquamarine", "cyan", "blue")
corrs.bonds.stocks <- seq(1, -1, -0.25)
legend.keys <-  c()
for (i in 1:length(corrs.bonds.stocks)) {
    corr.bs <- corrs.bonds.stocks[i]
    var.port.tmp <- wt.bonds^2*vol.bonds^2 + (1-wt.bonds)^2*vol.stocks^2 +
        2*wt.bonds*(1-wt.bonds)*corr.bs*vol.bonds*vol.stocks
    vol.port.tmp <- sqrt(var.port.tmp)
    lines(vol.port.tmp, expret.port, lty=i, lwd=2, col=line.colors[i])
    legend.keys <- c(legend.keys, bquote(rho==~.(corr.bs)))
}
## Add a legend so we know which curves are for which correlations
legend.text <- as.expression(legend.keys)
legend("topleft", legend.text, lty=1:length(legend.text), cex=0.8, lwd=2, col=line.colors)

## show where F, B, and E are
points(0,0.01,lwd=2)
text(0.005, 0.01, "F")
points(vol.bonds, expret.bonds,lwd=2)
text(vol.bonds+0.005, expret.bonds, "B")
points(vol.stocks, expret.stocks,lwd=2)
text(vol.stocks, expret.stocks-0.01, "E")


library(ISLR)
names(Smarket)
dim(Smarket)

cor(Smarket[,-9])

plot(Smarket$Volume)

glm.fit=glm(Direction ~ Lag1+Lag2+Lag3+Lag4+Lag5+Volume, data=Smarket, family=binomial)
summary(glm.fit)

glm.probs=predict(glm.fit,type="response")
glm.pred=rep("Down",1250)
glm.pred[glm.probs >.5]="Up"
table(glm.pred,Smarket$Direction)
#in training error rate
mean(glm.pred==Smarket$Direction )

train=(Smarket$Year <2005)
Smarket.2005 = Smarket[!train ,]
dim(Smarket.2005)
Direction.2005= Smarket$Direction[!train]

glm.fit=glm(Direction~Lag1+Lag2+Lag3+Lag4+Lag5+Volume, data=Smarket, family=binomial, subset=train)
glm.probs=predict(glm.fit,Smarket.2005,type="response")

glm.pred=rep("Down",252)
glm.pred[glm.probs >.5]="Up"
table(glm.pred,Direction.2005)

mean(glm.pred==Direction.2005)

library(MASS)
lda.fit=lda(Direction~Lag1+Lag2,data=Smarket ,subset=train)
lda.fit
plot(lda.fit)

lda.pred=predict(lda.fit , Smarket.2005)
lda.class=lda.pred$class
table(lda.class, Direction.2005)

qda.fit=qda(Direction ~ Lag1+Lag2,data=Smarket ,subset=train)
qda.fit
qda.class=predict(qda.fit,Smarket.2005)$class
table(qda.class, Direction.2005)
mean(qda.class==Direction.2005)

library(class)
train.X=cbind(Smarket$Lag1, Smarket$Lag2)[train ,]
test.X=cbind(Smarket$Lag1,Smarket$Lag2)[!train ,]
train.Direction = Smarket$Direction [train]

set.seed(1)
knn.pred=knn(train.X,test.X,train.Direction, k=1)
table(knn.pred,Direction.2005)

knn.pred=knn(train.X,test.X,train.Direction, k=3)
table(knn.pred,Direction.2005)

dim(Caravan)
standardized.X=scale(Caravan [,-86])
var(Caravan [,1])
var(standardized.X[,1])
test=1:1000
train.X=standardized.X[-test ,]
test.X=standardized.X[test ,]
train.Y=Caravan$Purchase [-test]
test.Y=Caravan$Purchase [test]
set.seed(1)
knn.pred=knn(train.X,test.X,train.Y,k=1)
mean(test.Y!=knn.pred)
mean(test.Y!="No")

table(knn.pred,test.Y)

glm.fit=glm(Purchase~.,data=Caravan ,family=binomial, subset=-test)
glm.probs=predict(glm.fit,Caravan[test ,],type="response")
glm.pred=rep("No",1000)
glm.pred[glm.probs >.5]="Yes"
table(glm.pred,test.Y)

glm.pred=rep("No",1000)
glm.pred[glm.probs >.25]="Yes"
table(glm.pred,test.Y)


library(plotly)
library(htmlwidgets)

gaussPdf <- function (x, mu, E) {
  k <- length(x)
  ans <- exp(-0.5 * t(x - mu) %*% solve(E) %*% (x - mu)) /
    sqrt((2 * pi) ^ k * det(E))
  return (ans)
}

drawPlot <- function () {
  mu = c(0, 0)
  # E <- matrix(c(1, 3/5, 3/5, 2), nrow = 2)
  # E <- matrix(c(0.5, 0, 0, 2), nrow = 2)
  E <- matrix(c(2, 0.9, 0.9, 2), nrow = 2)

  xs <- seq(from = -5, to = 5, by = 0.1)
  ys <- seq(from = -5, to = 5, by = 0.1)
  z <- c()

  for (y in ys) {
    curr <- c()
    for (x in xs) {
      arg <- c(x, y)
      value <- gaussPdf(arg, mu, E)

      curr <- c(curr, value)
    }
    z <- rbind(z, curr)
  }

  fig <- plot_ly(
    type = 'surface',
    x = ~xs,
    y = ~ys,
    z = ~z) %>% add_surface(
      contours = list(
        z = list(
          show=TRUE,
          usecolormap=TRUE,
          highlightcolor="#ff0000",
          project=list(z=TRUE)
        )
      )
    )
  fig <- fig %>% layout(
    scene = list(
      camera=list(
        eye = list(x=1.87, y=0.88, z=-0.64)
      )
    )
  )
  #saveWidget(fig, file="widget.html")
  return (fig)
}

drawHeatmap <- function() {
  mu = c(0, 0)
  # E <- matrix(c(1, 3/5, 3/5, 2), nrow = 2)
  # E <- matrix(c(0.5, 0, 0, 2), nrow = 2)
  E <- matrix(c(2, 0.9, 0.9, 2), nrow = 2)

  xs <- seq(from = -5, to = 5, by = 0.1)
  ys <- seq(from = -5, to = 5, by = 0.1)
  z <- c()

  for (y in ys) {
    curr <- c()
    for (x in xs) {
      arg <- c(x, y)
      value <- gaussPdf(arg, mu, E)

      curr <- c(curr, value)
    }
    z <- rbind(z, curr)
  }

  fig <- plot_ly(
    type = 'heatmap',
    x = ~xs,
    y = ~ys,
    z = ~z)
  #saveWidget(fig, file="widget.html")
  return (fig)
}

# drawPlot()
drawHeatmap()

# plotly 3D plotting tests:
# x = c(1,2,3,4,5)
# y = c(1,2,3,4,5)
# z <- c()
# z = rbind(z,
#   c(2, 1, 2.2, 1, 0),
#   c(1, 0, 1, 0, 1))
#
# z <- rbind(z,   c(0, 1, 0, 1, 0),
#            c(1, 0, 1, 0, 1),
#            c(0, 1, 0, 1, 0))
#
# fig <- plot_ly(
#   type = 'surface',
#   x = ~x,
#   y = ~y,
#   z = ~z)
#
# fig

5 - Contour lines of the Gaussian distribution PDF/contour-lines.r


# Assignment: ASSIGNMENT 1
# Name: Lastname, Firstname
# Date: 2010-02-14

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

> num_vector <- c(3,2,1)
> print(num_vector)
[1] 3 2 1

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

> char_vector <- c("three", "two", "one")
> print(char_vector)
[1] "three" "two"   "one"

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

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

## Create a vector called `week1_sleep_weekdays`
## Assign the weekday values using indice slicing

> week1_sleep_weekdays<- week1_sleep[1:7]
> week1_sleep_weekdays
[1] 6.1 8.8 7.7 6.4 6.2 6.9 6.6
>

## Add the total hours slept in week one using the `sum` function
## Assign the value to variable `total_sleep_week1`

> total_sleep_week1=sum(week1_sleep)
> total_sleep_week1
[1] 48.7

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

week2_sleep <- c(7.1, 7.4, 7.9, 6.5, 8.1, 8.2, 8.9)

## Add the total hours slept in week two using the sum function
## Assign the value to variable `total_sleep_week2`

> week2_sleep <- c(7.1, 7.4, 7.9, 6.5, 8.1, 8.2, 8.9)
> total_sleep_week2 <- sum(week2_sleep)
> total_sleep_week2
[1] 54.1

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

> total_sleep_week1 < total_sleep_week2
[1] TRUE
>

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

> mean(week1_sleep)
[1] 6.957143
>

## Create a vector called `days` containing the days of the week.
## Start with Sunday and end with Saturday

> days <- c("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday", "Saturday")
> days
[1] "Sunday"    "Monday"    "Tuesday"   "Wednesday" "Thursday"  "Friday"    "Saturday"
>

## Assign the names of each day to `week1_sleep` and `week2_sleep` using the `names` function and `days` vector
> names(week1_sleep) = days
> week1_sleep
   Sunday    Monday   Tuesday Wednesday  Thursday    Friday  Saturday
      6.1       8.8       7.7       6.4       6.2       6.9       6.6

> names(week2_sleep) = days
> week2_sleep
   Sunday    Monday   Tuesday Wednesday  Thursday    Friday  Saturday
      7.1       7.4       7.9       6.5       8.1       8.2       8.9
>

## Display the amount of sleep on Tuesday of week 1 by selecting the variable name

> week1_sleep["Tuesday"]
Tuesday
    7.7
>

## Create vector called weekdays from the days vector

> weekdays =days[1:7]
> weekdays
[1] "Sunday"    "Monday"    "Tuesday"   "Wednesday" "Thursday"  "Friday"    "Saturday"

## Create vector called weekends containing Sunday and Saturday
> weekends <- c(days[7],days[1])
> weekends
[1] "Saturday" "Sunday"
>

## Calculate the mean about sleep on weekdays for each week
## Assign the values to weekdays1_mean and weekdays2_mean
> weekdays1_mean <- mean(week1_sleep[2:6])
> weekdays1_mean
[1] 7.2

> weekdays2_mean <- mean(week2_sleep[2:6])
> weekdays2_mean
[1] 7.62

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

> weekdays1_mean > weekdays2_mean
[1] FALSE
>
## Determine how many days in week 1 had over 8 hours of sleep using the `>` operator

> length(week1_sleep[week1_sleep > 8])
[1] 1
>
> week1_sleep > 8
   Sunday    Monday   Tuesday Wednesday  Thursday    Friday  Saturday
    FALSE      TRUE     FALSE     FALSE     FALSE     FALSE     FALSE
>

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

> grades <- matrix(students_combined, byrow = TRUE, nrow = 3)
> grades
      [,1] [,2]
[1,] 100.0 87.1
[2,]  77.2 88.9
[3,]  66.3 87.9

## Add a new student row with `rbind()`
> student04 <- c(95.2, 94.1)
> grades <- rbind(student04 ,grades)
> grades
           [,1] [,2]
student04  95.2 94.1
          100.0 87.1
           77.2 88.9
           66.3 87.9

## Add a new assignment column with `cbind()`

> assignment04 <- c(92.1, 84.3, 75.1, 97.8)
> grades <- cbind(assignment04, grades)
> grades
          assignment04
student04         92.1  95.2 94.1
                  84.3 100.0 87.1
                  75.1  77.2 88.9
                  97.8  66.3 87.9

## Add the following names to columns and rows using `rownames()` and `colnames()`

> assignments <- c("Assignment 1", "Assignment 2", "Assignment 3")
> students <- c("Florinda Baird", "Jinny Foss", "Lou Purvis", "Nola Maloney")
> rownames(grades) <- students
> colnames(grades) <- assignments
> grades
               Assignment 1 Assignment 2 Assignment 3
Florinda Baird         92.1         95.2         94.1
Jinny Foss             84.3        100.0         87.1
Lou Purvis             75.1         77.2         88.9
Nola Maloney           97.8         66.3         87.9
>

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

> colSums(grades)
Assignment 1 Assignment 2 Assignment 3
       349.3        338.7        358.0

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

> colSums(grades)
Assignment 1 Assignment 2 Assignment 3
       349.3        338.7        358.0

## Matrix with 10% and add it to grades

> weighted_grades <- grades * 0.1 + grades
> weighted_grades
               Assignment 1 Assignment 2 Assignment 3
Florinda Baird       101.31       104.72       103.51
Jinny Foss            92.73       110.00        95.81
Lou Purvis            82.61        84.92        97.79
Nola Maloney         107.58        72.93        96.69

## Create a factor of book genres using the genres_vector
## Assign the factor vector to factor_genre_vector

> genres_vector <- c("Fantasy", "Sci-Fi", "Sci-Fi", "Mystery", "Sci-Fi", "Fantasy")
> factor_genre_vector <- genres_vector
> factor_genre_vector

## Use the `summary()` function to print a summary of `factor_genre_vector`
> summary(factor_genre_vector)
   Length     Class      Mode
        6 character character

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

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

> summary(factor_recommendations_vector)
     no neutral     yes
      2       2       1

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

> head(mtcars)
                   mpg cyl disp  hp drat    wt  qsec vs am gear carb
Mazda RX4         21.0   6  160 110 3.90 2.620 16.46  0  1    4    4
Mazda RX4 Wag     21.0   6  160 110 3.90 2.875 17.02  0  1    4    4
Datsun 710        22.8   4  108  93 3.85 2.320 18.61  1  1    4    1
Hornet 4 Drive    21.4   6  258 110 3.08 3.215 19.44  1  0    3    1
Hornet Sportabout 18.7   8  360 175 3.15 3.440 17.02  0  0    3    2
Valiant           18.1   6  225 105 2.76 3.460 20.22  1  0    3    1

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

> tail(mtcars)
                mpg cyl  disp  hp drat    wt qsec vs am gear carb
Porsche 914-2  26.0   4 120.3  91 4.43 2.140 16.7  0  1    5    2
Lotus Europa   30.4   4  95.1 113 3.77 1.513 16.9  1  1    5    2
Ford Pantera L 15.8   8 351.0 264 4.22 3.170 14.5  0  1    5    4
Ferrari Dino   19.7   6 145.0 175 3.62 2.770 15.5  0  1    5    6
Maserati Bora  15.0   8 301.0 335 3.54 3.570 14.6  0  1    5    8
Volvo 142E     21.4   4 121.0 109 4.11 2.780 18.6  1  1    4    2

## Create a dataframe called characters_df using the following information from LOTR
> name <- c("Aragon", "Bilbo", "Frodo", "Galadriel", "Sam", "Gandalf", "Legolas", "Sauron", "Gollum")
> race <- c("Men", "Hobbit", "Hobbit", "Elf", "Hobbit", "Maia", "Elf", "Maia", "Hobbit")
> in_fellowship <- c(TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE)
> ring_bearer <- c(FALSE, TRUE, TRUE, FALSE, TRUE, TRUE, FALSE, TRUE, TRUE)
> age <- c(88, 129, 51, 7000, 36, 2019, 2931, 7052, 589)
> characters_df <- data.frame(race ,in_fellowship ,ring_bearer ,age )
> characters_df
    race in_fellowship ring_bearer  age
1    Men          TRUE       FALSE   88
2 Hobbit         FALSE        TRUE  129
3 Hobbit          TRUE        TRUE   51
4    Elf         FALSE       FALSE 7000
5 Hobbit          TRUE        TRUE   36
6   Maia          TRUE        TRUE 2019
7    Elf          TRUE       FALSE 2931
8   Maia         FALSE        TRUE 7052
9 Hobbit         FALSE        TRUE  589

## Sorting the characters_df by age using the order function and assign the result to the sorted_characters_df
> sorted_characters_df <- characters_df[order(age),]
> sorted_characters_df
    race in_fellowship ring_bearer  age
5 Hobbit          TRUE        TRUE   36
3 Hobbit          TRUE        TRUE   51
1    Men          TRUE       FALSE   88
2 Hobbit         FALSE        TRUE  129
9 Hobbit         FALSE        TRUE  589
6   Maia          TRUE        TRUE 2019
7    Elf          TRUE       FALSE 2931
4    Elf         FALSE       FALSE 7000
8   Maia         FALSE        TRUE 7052
## Use `head()` to output the first few rows of `sorted_characters_df`
> head(sorted_characters_df)
    race in_fellowship ring_bearer  age
5 Hobbit          TRUE        TRUE   36
3 Hobbit          TRUE        TRUE   51
1    Men          TRUE       FALSE   88
2 Hobbit         FALSE        TRUE  129
9 Hobbit         FALSE        TRUE  589
6   Maia          TRUE        TRUE 2019

## Select all of the ring bearers from the dataframe and assign it to ringbearers_df
> ringbearers_df <- characters_df[characters_df$ring_bearer   == TRUE,]
> ringbearers_df
    race in_fellowship ring_bearer  age
2 Hobbit         FALSE        TRUE  129
3 Hobbit          TRUE        TRUE   51
5 Hobbit          TRUE        TRUE   36
6   Maia          TRUE        TRUE 2019
8   Maia         FALSE        TRUE 7052
9 Hobbit         FALSE        TRUE  589
## Use `head()` to output the first few rows of `ringbearers_df`
> head(ringbearers_df)
    race in_fellowship ring_bearer  age
2 Hobbit         FALSE        TRUE  129
3 Hobbit          TRUE        TRUE   51
5 Hobbit          TRUE        TRUE   36
6   Maia          TRUE        TRUE 2019
8   Maia         FALSE        TRUE 7052
9 Hobbit         FALSE        TRUE  589


B <- matrix(c(7,9,3,5),2,2)
C <- matrix(c(3,2,3,2,8,1,4,-2,8),3,3)
determinant_B=det(B)
determinant_C=det(C)
determinant_B
determinant_C
solve(B)
solve(C)
# B* inverse B
x=zapsmall(solve(B)%*%B)
x
# C* inverse C
y=zapsmall(solve(C)%*%C)
y


add2 <- function(x, y) {
  x + y
}

above10 <- function(x) {
  use <- x > 10
  x[use] # Return the sub set of x which is greater than 10
}

columnmean <- function(y, removedNA = TRUE) {
  nc <- ncol(y)
  means <- numeric(nc)
  for(i in 1:nc) {
    means[i] <- mean(y[, i], na.rm = removedNA)
  }
  means
}

make.power <- function(n) {
        pow <- function(x) {
                x^n
        }
        pow
}
cube <- make.power(3)
square <- make.power(2)

ls(enviroment(cube))

get("n", environment(cube))

########## Dynamic scoping #####
y <- 10

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

g <- function(x) {
        x*y
}

## what is the value of

f(3) ## it should be 2^2 + g(3) = 2^10 (g is function and it will take global variable value of y) + (3*2) = 4+6 = 10 y local value

############# End of Dynamic scoping#######

#### Vectorized Operations####
x<-1:5
y<-1:10
x+y

x <- matrix(1:4, 2, 2);
y <- matrix(rep(10, 4), 2, 2)
x*y ## element-wise multiplication
x/y ## element-wise /

x %*% y ## true matrix multiplication