#EDAMI 2020l Lab1
#autor: Grzegorz Protaziuk, Robert Bembenik
library(arules)
#setwd("/home/users/chojnar1/Desktop/STUD/data_mining/labs/1")
#getwd()

#####################################
#data preprocessing
#####################################
#data imputation
#example vector with pseudorandom numbers  - "runif" function
?runif
wRand <- runif(100,1,10)
wRand
#pseudorandom selection of  10 natural numbers - "sample" function
#setting generator seed
set.seed(1234)
?sample
wek2 = sample(100,10)
wek2
#assigning the spacial value NA to selected positions in a vector
wRand[wek2] <- NA
wRand
#a list of numbers indicating vector fields with the special value NA -"which" and "is.na" functions
#?which
#?is.na
which(is.na(wRand) == TRUE)

#which(wRand == NA) # it doesn't give the expected result

#data copy
wRand2 <- wRand
mean(wRand)
?mean

#mean caluculation based on valid values
average = mean(na.omit(wRand))
average

#replacement of the special value NA by the mean
wRand2[is.na(wRand2)==TRUE] = mean(na.omit(wRand))

is.na(wRand2)
is.na(wRand)
#checking
which(is.na(wRand2))
wRand2
wRand2 == wRand

?complete.cases

################################################3
#preliminary  data analysis
?AdultUCI
data("AdultUCI")

#?summary
summary(AdultUCI)

str(AdultUCI)
#numeric attribute
summary(AdultUCI$workclass)
#standard deviation
sd(AdultUCI$age)
#quantiles
quantile(AdultUCI$age)
#deciles
quantile(AdultUCI$age, prob = seq(0, 1, length = 11), type = 5)
#histogram
hist(AdultUCI$age)

#nominal attribute
#number of occurences of values
table(AdultUCI$education)
#visualization of values distribution
pie(table(AdultUCI$"education"))
barplot(table(AdultUCI$"education"), cex.names=0.7)
plot(table(AdultUCI$"education"),ylab = "number of occurences")

#saving picture into file with the high resolution
#?png
#png("file_name.png", res=80, height=800, width=2400)
#pie(table(AdultUCI$"education"))
#dev.off();

#####################################
#discretization  - "cut" function
?cut

age = sample(130, 300, replace = TRUE)
age

#division into ranges based on the given borders
age_p = cut(age, c(0,15,25,67,200))
age_p
#ladding labels
age_p = cut(age, c(0,15,25,67,200), labels = c("child", "pupil", "working", "pensioner"))
age_p
age_p[1] > age_p[3]
#adding the order relation
age_p = cut(age, c(0,15,25,67,200), labels = c("child", "pupil", "working", "pensioner"), ordered_result = TRUE)
age_p[1] > age_p[3]

#division into ranges based on the mean and the standard deviation values
?sd
age_p1 = cut(age, c(-Inf,mean(age)-sd(age), mean(age), mean(age)+sd(age), +Inf), labels=c('p1','p2','p3','p4'))
age_p1

#division into ranges based on the given borders
AdultUCI$age.d  <- ordered(cut(AdultUCI[["age"]], c(15,25,45,65,100)), labels = c("Young", "Middle-aged", "Senior", "Old"))

summary(AdultUCI["age.d"])

#division into ranges based on the median
AdultUCI$"capital_gain.d" <- ordered(cut(AdultUCI[[ "capital-gain"]], c(-Inf, 0, median(AdultUCI[[ "capital-gain"]][AdultUCI["capital-gain"] > 0 ]),Inf)), labels = c("None", "Low", "High"))
#cross table
xtabs(formula = ~ age.d + capital_gain.d , data = AdultUCI)
#####################################
#removing attributes with only one values
delOneValued <- function(inputData11)
{
  res <- c(which(sapply(inputData11, function(x) {length(unique(x))}) == 1));
  if(length(res) > 0)
  {
    data11 <- inputData11[,-res];
  }
  else
  {
    data11 <-inputData11;
  }
  data11
}

#testing

which(sapply(AdultUCI, function(x) {length(unique(x))}) == 1);
dim(AdultUCI)
AdultUCI <- delOneValued(AdultUCI)

#adding two new attributes
AdultUCI$Att1 = 0
AdultUCI$Att2.Cat = 'cat1'
colnames(AdultUCI)

which(sapply(AdultUCI, function(x) {length(unique(x))}) == 1);
AdultUCI <- delOneValued(AdultUCI)
colnames(AdultUCI)

###########################################################
#removing attributes with unique values
delUniqueValueAtt<- function(inputData11)
{
  res <- c(which(sapply(inputData11, function(x) {length(unique(x))}) == nrow(inputData11)));
  if(length(res) >0)
  {
    data11 <- inputData11[,-res];
  }
  else
  {
    data11 <-inputData11;
  }

  data11
}

#testing
which(sapply(AdultUCI, function(x) {length(unique(x))}) == nrow(AdultUCI))

AdultUCI <- delUniqueValueAtt(AdultUCI)
dim(AdultUCI)
#adding two new attributes
AdultUCI$Att1 = sample(nrow(AdultUCI),nrow(AdultUCI));
AdultUCI$Att2.Cat = sample.int(nrow(AdultUCI))

which(sapply(AdultUCI, function(x) {length(unique(x))}) == nrow(AdultUCI))

AdultUCI <- delUniqueValueAtt(AdultUCI)
colnames(AdultUCI)

###########################################################
#removing duplicates
#?duplicated
#?anyDuplicated

which(duplicated(AdultUCI) == TRUE)
length(which(duplicated(AdultUCI) == TRUE))

AdultUCI.U <- unique(AdultUCI)
dim(AdultUCI)
dim(AdultUCI.U)

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

#replacement of nominal attribute by numeric attributes

#setting working directory

#download data
download.file('http://archive.ics.uci.edu/ml/machine-learning-databases/car/car.data', 'car.data')

#read data
cars = read.csv("car.data", header = FALSE,
                col.names = c('buying', 'maint', 'doors', 'persons', 'lug_boot','safety', "category") )

#variable internal structure
str(cars)
# data view
View(cars)

#creation of additional attribute for each value of a given nominal attribute in a given dataframe
genNumericAttrsForFactor = function(dataF, attName)
{
  #validation of input data
  if(is.data.frame(dataF) == FALSE)
  {
    print("A given object is not a dataFrame");
    return(dataF);
  }

  if(is.character(attName) == FALSE)
  {
    print("The name of an attribute is not a text value");
    return(dataF);
  }

  if(is.factor(dataF[[attName]]) == FALSE)
  {
    print("The indicated attribute is not a nominal one.");
    return(dataF);
  }

  #names for new attributes
  attsName = levels(dataF[[attName]]);

  #creation of new attributes
  for(name1 in attsName)
  {
    dataF[paste0(attName,'_',name1)] = 0;
  }
  #data updating
  for( id in 1:nrow(dataF))
  {
    dataF[id,paste0(attName,'_',as.character(dataF[id,attName]))] = 1
  }

  dataF
}

#function checking
cars2 = genNumericAttrsForFactor(cars,'maint')
View(cars)
View(cars2)


Please read the source of NAGComplexExample.java for a better understanding of how to use NAGComplex

*****BASICS*****

Constructing z1 and z2;
z1 = (0.0, 0.0)
z2 = (2.0, 3.0)

Changing z1 values using NAGComplex.setRe() and NAGComplex.setIm();
z1 = (3.0, 4.0)

Copying z2 to z3 using NAGComplex.clone();
z3 = (2.0, 3.0)
Copying z1 to z4 using static method NAGComplex.clone(NAGComplex z)
z4 = (3.0, 4.0)

Array created using NAGComplex.createArray(5);
(0.0, 0.0) (0.0, 0.0) (0.0, 0.0) (0.0, 0.0) (0.0, 0.0)

The same array updated using NAGComplex[i].setRe() and NAGComplex[i].setIm();
(1.0, 9.0) (2.0, 8.0) (3.0, 7.0) (4.0, 6.0) (5.0, 5.0)

*****ARITHMETIC*****

z1 = (3.0, 4.0)
z2 = (2.0, 3.0)
z3 = (6.0, -2.0)
z4 = (4.0, -5.0)

z1 + z2 = (5.0, 7.0)
z3 + z4 = (10.0, -7.0)

z1 - z2 = (1.0, 1.0)
z3 - z4 = (2.0, 3.0)

z1 * z2 = (-6.0, 17.0)
z3 * z4 = (14.0, -38.0)

z1 / z2 = (1.3846153846153846, -0.07692307692307696)
z3 / z4 = (0.829268292682927, 0.5365853658536587)

-(z1) = (-3.0, -4.0)
-(z2) = (-2.0, -3.0)

conjugate(z1) = (3.0, -4.0)
conjugate(z2) = (2.0, -3.0)

z3 == z4? - false
z4 = (6.0, -2.0)
z3 == z4? - true
|z1| = 5.0
|z2| = 3.6055512754639896

arg(z1) = 0.9272952180016122
arg(z2) = 0.982793723247329

z5 = (-5.0, 12.0)
z6 = (-9.0, 40.0)
Sqrt(z5) = (2.0, 3.0)
Sqrt(z6) = (4.0, 5.0)


zigzag <- function(size)
{
   digits <- seq_len(size^2) - 1
   mat <- matrix(0, nrow = size, ncol=size)
   i <- 1
   j <- 1
   for(element in digits)
   {
      mat[i,j] <- element
      if((i + j) %% 2 == 0)
      {
         # Even stripes
         if(j < size) j <- j + 1 else i <- i + 2
         if(i > 1) i <- i - 1
      } else
      {
         # Odd stripes
         if(i < size) i <- i + 1 else j <- j + 2
         if(j > 1) j <- j - 1
      }
   }
   mat
}

zigzag(5)


# Loading Libraries used
library(tidyverse)
library(PCAtools)
library(patchwork)

# reading the data, no non-numeric columns should be added.
metabolites <- read.csv("metabolites.csv", row.names = "compound")

metabolites <- t(metabolites)

# carrying out analysis, remove lower 10% variables
pca_analysis <- pca(metabolites ,
                    removeVar = 0.1)

# screeplot
p1 <- screeplot(pca_analysis,
                getComponents(pca_analysis, 1:10))

# biplot
p2 <- biplot(pca_analysis,
             showLoadings = TRUE, lab = NULL)

# pairsplot
p3 <- pairsplot(pca_analysis,
                getComponents(pca_analysis, c(1:3)))

# loadings plot
p4 <- plotloadings(pca_analysis, labSize = 3)

# looking at the data at a glance.
pca_analysis$rotated[1:5, 1:5]

# combining all plots together
p_final <- (p1 + p2) / (p3 + p4)
p_final

# save as png
ggsave("p_final.png",
       width = 25,
       height = 25,
       dpi = 200)


X <- t(as.matrix(expand.grid(0:4, 0:4)))
X <- X[, colSums(X) <= 4]
X <- rbind(X, 4 - colSums(X))
dimnames(X) <- list(letters[1:3])

fun <- (function(x){y = x^2})
Y <- apply(X, 2, fun)
print(Y)


qmix <- function (p, params, pro = c(.5, .5), expand=.1, dist = "binorm") {
  nr <- 1000000
  XX <- rbinom(n=nr, size=1, prob=pro)
  if(dist == "binorm") {
    sd.s <- 1
    x = rnorm(n=nr, params[1], sd.s)*XX + rnorm(n=nr, params[2], sd.s)*(1-XX)
  } else if(dist == "bibeta") {
    x = rbeta(n=nr, params[[1]][1], params[[1]][2])*XX + rbeta(n=nr, params[[2]][1], params[[2]][2])*(1-XX)
  }
  span <- seq(min(x) - expand * diff(range(x)), max(x) + expand * diff(range(x)), length = nr)
  cdf <- vector(mode = "numeric", length = nr)
  if(dist == "binorm") {
    sd.s <- 1
    cdf = pnorm(span, params[1], sd.s)*pro[1] + pnorm(span, params[2], sd.s)*(1-pro[1])
  } else if(dist == "bibeta") {
    cdf = pbeta(span, params[[1]][1], params[[1]][2])*pro[1] + pbeta(span, params[[2]][1], params[[2]][2])*(1-pro[1])
  }
  quants <- stats::spline(cdf, span, method = "hyman", xout = p)$y
  quants[which(p < 0L | p > 1L)] <- NaN
  quants[which(p == 0L)] <- -Inf
  quants[which(p == 1L)] <- Inf
  if (any(is.nan(quants)))
    warning("Some quantile values could not be calculated. If all 'p's are within [0,1], try reducing the value of 'expand' and try again.")
  return(as.vector(quants))
}

add.alpha <- function(col, alpha=1){
  if(missing(col))
    stop("Please provide a vector of colours.")
  apply(sapply(col, col2rgb)/255, 2,
        function(x)
          rgb(x[1], x[2], x[3], alpha=alpha))
}

computeTrueKDiff <- function(){

  if(dist == "binorm" | dist == "bibeta") {
    c1 <- qmix(1-r, params[[1]], c(pi.0.true, 1-pi.0.true), expand=.1, dist = dist)
    c2 <- qmix(1-r, params[[2]], c(pi.0.true, 1-pi.0.true), expand=.1, dist = dist)
  } else {
    stop("Wrong dist")
  }

  if (dist == "binorm") {
    sd.s = 1
    F.plus1 <- pnorm(c1, mean = params[[1]][1], sd.s)
    F.plus2 <- pnorm(c2, mean = params[[2]][1], sd.s)
  } else if (dist == "bibeta") {
    F.plus1 <- pbeta(c1, params[[1]][[1]][1], params[[1]][[1]][2])
    F.plus2 <- pbeta(c2, params[[2]][[1]][1], params[[2]][[1]][2])
  }

  k.true1 <- vector(length = length(F.plus1))
  pi.true1 <- vector(length = length(F.plus1))
  k.true2 <- vector(length = length(F.plus2))
  pi.true2 <- vector(length = length(F.plus2))

  for (i in 1:length(k.true1)) {
    k.true1[i] <- 1 - F.plus1[i]
    pi.true1[i] <- k.true1[i]*pi.0.true/r[i]
    k.true2[i] <- 1 - F.plus2[i]
    pi.true2[i] <- k.true2[i]*pi.0.true/r[i]
  }

  # if k or pi is above 1, then they should actually be slightly below 1
  k.true1 <- ifelse(k.true1 > 1, 1 - 1E-10, k.true1)
  pi.true1 <- ifelse(pi.true1 > 1, 1 - 1E-10, pi.true1)
  k.true2 <- ifelse(k.true2 > 1, 1 - 1E-10, k.true2)
  pi.true2 <- ifelse(pi.true2 > 1, 1 - 1E-10, pi.true2)

  return(k.true1 - k.true2)
}

fig_label <- function(text, region="figure", pos="topleft", cex=NULL, ...) {

  region <- match.arg(region, c("figure", "plot", "device"))
  pos <- match.arg(pos, c("topleft", "top", "topright",
                          "left", "center", "right",
                          "bottomleft", "bottom", "bottomright"))

  if(region %in% c("figure", "device")) {
    ds <- dev.size("in")
    # xy coordinates of device corners in user coordinates
    x <- grconvertX(c(0, ds[1]), from="in", to="user")
    y <- grconvertY(c(0, ds[2]), from="in", to="user")

    # fragment of the device we use to plot
    if(region == "figure") {
      # account for the fragment of the device that
      # the figure is using
      fig <- par("fig")
      dx <- (x[2] - x[1])
      dy <- (y[2] - y[1])
      x <- x[1] + dx * fig[1:2]
      y <- y[1] + dy * fig[3:4]
    }
  }

  # much simpler if in plotting region
  if(region == "plot") {
    u <- par("usr")
    x <- u[1:2]
    y <- u[3:4]
  }

  sw <- strwidth(text, cex=cex) * 60/100
  sh <- strheight(text, cex=cex) * 60/100

  x1 <- switch(pos,
               topleft     =x[1] + sw,
               left        =x[1] + sw,
               bottomleft  =x[1] + sw,
               top         =(x[1] + x[2])/2,
               center      =(x[1] + x[2])/2,
               bottom      =(x[1] + x[2])/2,
               topright    =x[2] - sw,
               right       =x[2] - sw,
               bottomright =x[2] - sw)

  y1 <- switch(pos,
               topleft     =y[2] - sh,
               top         =y[2] - sh,
               topright    =y[2] - sh,
               left        =(y[1] + y[2])/2,
               center      =(y[1] + y[2])/2,
               right       =(y[1] + y[2])/2,
               bottomleft  =y[1] + sh,
               bottom      =y[1] + sh,
               bottomright =y[1] + sh)

  old.par <- par(xpd=NA)
  on.exit(par(old.par))

  text(x1, y1, text, cex=cex, ...)
  return(invisible(c(x,y)))
}


suppressPackageStartupMessages(library(kazaam))

if (comm.rank() == 0){
  x = matrix(rnorm(30), 10)
  n_o = norm(x, "O")
  n_i = norm(x, "F")
  n_f = norm(x, "I")
  n_m = norm(x, "M")
  n_2 = norm(x, "2")
} else {
  x = NULL
}

dx = expand(x)

n_o_t = norm(dx, "O")
n_i_t = norm(dx, "F")
n_f_t = norm(dx, "I")
n_m_t = norm(dx, "M")
n_2_t = norm(dx, "2")

comm.print(all.equal(n_o, n_o_t))
comm.print(all.equal(n_i, n_i_t))
comm.print(all.equal(n_f, n_f_t))
comm.print(all.equal(n_m, n_m_t))
comm.print(all.equal(n_2, n_2_t))

finalize()


#!/usr/bin/env Rscript

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

measSigma <- function(model,data,sigmad=0.05,sigmah=0.1,sigmar=0.1,runs=10000)
{
	sigma_m <- matrix(0,nrow=nrow(data),ncol=1)
	for(i in 1:nrow(data))
	{
		ddist <- rnorm(runs,data[i,'d'],data[i,'d']*sigmad)
		hdist <- rnorm(runs,data[i,'h'],data[i,'h']*sigmah)
		rdist <- rnorm(runs,data[i,'rho'],data[i,'rho']*sigmar)
		regressor <- data.frame(ddist*ddist*hdist*rdist)
		colnames(regressor) <- c("X")
		ystar <- yhat(model,regressor)
		tmp <- data.frame(data[i,'d']*data[i,'d']*data[i,'h']*data[i,'rho'])
		colnames(tmp) <- c("X")
		yhat <- yhat(model,tmp)
		residuals <- (ystar-yhat)^2
		sigma <- sqrt(sum(residuals)/runs)
		sigma_m[[i]] <- sigma
	}
	return(sigma_m)
}


library(effsize)
 dataA <- c(8.0,10.0,3.0,2.0,9.0,3.0,8.0,9.0,3.0,6.0,6.0,10.0,9.0,8.0,10.0,9.0,9.0,9.0,7.0,10.0,9.0,9.0,9.0,7.0,7.0,10.0,10.0,6.0,10.0)
dataB <- c(10.0,5.0,8.0,8.0,3.0,5.0,8.0,10.0,3.0,3.0,8.0,7.0,7.0,10.0,7.0,9.0,3.0,4.0,5.0,8.0,1.0,7.0,8.0,8.0,7.0)
ks.test(dataA,dataB)
cohen.d(dataA,dataB)
cohen.d(dataA,dataB,hedges.correction=TRUE)


# simple example of data cloning taken from their web pages (with slight modification)

# Copyright 2017 Province of British Columbia
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and limitations under the License.

set.seed(23423423)
n <- 25
p <- .3
y <- rbinom(n=1, size=n, p=p)

library(dclone)
library(rjags)

model <- dclone::custommodel("
model {
   y ~ dbin(p, n)  # likelihood

   p ~ dunif(.001, .999)  # prior

   # compute the likelihood
   loglik <- log( pbin(y, p, n))
}
")

data.list <- list(y=y, n=n)
data.list

monitor.list <- c("p","loglik")

fit <- jags.fit(data   =data.list,
                params =monitor.list,
                model  = model)

summary(fit)
plot(fit)

#---------------------------------------------------
# Now for the data cloning

model.clone <- dclone::custommodel("
model {
  for(k in 1:K){  # cloning loop
    y[1,k]   ~ dbin(p, n)  # likelihood
    loglikc[1,k] <- log( dbin(y[1,k], p, n))
  }

  loglik <- mean(loglikc[1,1:K])  # the mean loglikelihood?
  p ~ dunif(.001, .999)  # prior
 }
")

data.list.clone <- list( y=dcdim(data.matrix(y)), n=n, K=1)
data.list.clone

monitor.list <- c("p", "loglik")

fit.clone <- dc.fit(data  =data.list.clone,
                    params=monitor.list,
                    model =model.clone,
                    n.clones=c(1,2,4,8,16),
                    unchanged="n",
                    multiply="K")

summary(fit.clone)
phat <- summary(fit.clone)$statistics["p","Mean"]
phat
# actual log likelihood
dbinom(y, n, phat, log=TRUE )

coef(fit.clone)
phat <- y/n
cat("MLE ", phat, "\n" )
dcsd(fit.clone)
cat('Theoretical SE ', sqrt(p*(1-p)/n), "\n")
cat("Empirical   SE ", sqrt(phat*(1-phat)/n), "\n")

vcov(fit.clone)
confint(fit.clone)


#### SimulationFunctions
CorrMatrixNegFixed <- function(blocks, a, corr, off) {
    Corr <- NULL
    for (i in 1:blocks) {
        Corr[[i]] <- matrix(NA, ncol = a, nrow = a)
        diag= rep(1,a)
        offdiag = corr
        Corr[[i]][lower.tri(Corr[[i]])] <- offdiag
        Corr[[i]][upper.tri(Corr[[i]])] <- t(Corr[[i]])[upper.tri(t(Corr[[i]]))]
        diag(Corr[[i]]) <- diag
        for ( k in ((ncol(Corr[[i]])/2)+1):(ncol(Corr[[i]])) ) {
            for( j in 1:(nrow(Corr[[i]])/2) ) {
                Corr[[i]][j,k] <- -1*Corr[[i]][j,k]
            }
        }

        for ( k in ((nrow(Corr[[i]])/2)+1):(nrow(Corr[[i]])) ) {
            for( j in 1:(ncol(Corr[[i]])/2) ) {
                Corr[[i]][k,j] <- -1*Corr[[i]][k,j]
            }
        }

    }
    res <- as.matrix(bdiag(Corr))
    res[which(res == 0, arr.ind = TRUE)] <- off
    return(res)
}

##################################################################################
## This function Simulates complete data sets.
## We are creating a dataset of size N (samples) by p (Metabolites)
##################################################################################

SimulatedData <- function(n, p, covar, low, high)  {
	## No of Samples == N
	## No of Metabolites = p
        Means <- runif(p, min = low, max = high)
        data <- rmvnorm(n, mean = Means, sigma = covar)
	return(data)
}

##################################################################################
###### Create MissingValues Datasets
##################################################################################

MissingData <- function(data, totalmiss, mar, perc) {
	missdata <- data

      ## First create Missing Not At Random (MNAR)
        belowthresh <- which(data < quantile(data, probs = c(totalmiss-mar)/100), arr.ind = TRUE)
        missdata[belowthresh] <- NA

	## Next create Missing At Random (MAR)
        dataVector <- c(1:length(data))
        randommiss <- sample(dataVector[-which(is.na(missdata))], (mar/100)*length(data) )
        missdata[randommiss] <- NA

	## Next exclude metabolites with more that 'perc' missing
        NumberMissing <- apply(missdata, 2, function(x) length(which(is.na(x))))

        ind  <- which(NumberMissing >= (nrow(data)*perc))
        if(length(ind) > 0 ){
            missdata <- missdata[,-ind]
            data <- data[,-ind]
        }

	return(list(missdata, data, NumberMissing))
}


### TITLE: Full Matching Effect Ratio Code ###
### MAINTAINER: Hyunseung Kang (hskang at stanford dot edu)
### LAST UPDATE: Nov. 29, 2015
### SUMMARY: The code implements the full matching IV method
###          described in the paper Kang, Kreuels, May,
###          and Small (2015+). Specifically, the main
###          function, estLambda(), estimates the
###          effect ratio parameter described in the
###          said paper.
### REQUIRES: MASS, optmatch, AER (R packages, install them
###           from CRAN)
### USAGE: Copy-paste the R code below. At the end of
###        the code is a simple running example of
###        the code from simulated data.

### Libraries to Load ####
library(optmatch)
library(AER)

### Functions ###
##### smahal: Obtain rank-based Mahalanobis distance
### FUNCTION: Creates a rank-based Mahalanobis distance.
### INPUT: 1) Z: instruments (n by 1 vector), Z =1 (treated) and Z = 0 (not treated)
###        2) X: covariates  (n by p matrix}
### OUTPUT: 1) n by n rank-based Mahalanobis distance matrix
smahal= function(Z,X){
  X<-as.matrix(X)
  n<-dim(X)[1]
  rownames(X)<-1:n
  k<-dim(X)[2]
  m<-sum(Z)
  for (j in 1:k) X[,j]<-rank(X[,j])
  cv<-cov(X)
  vuntied<-var(1:n)
  rat<-sqrt(vuntied/diag(cv))
  cv<-diag(rat)%*%cv%*%diag(rat)
  out<-matrix(NA,m,n-m)
  Xc<-X[Z==0,]
  Xt<-X[Z==1,]
  rownames(out)<-rownames(X)[Z==1]
  colnames(out)<-rownames(X)[Z==0]
  icov<-ginv(cv)
  for (i in 1:m) out[i,]<-mahalanobis(Xc,Xt[i,],icov,inverted=T)
  out
}

##### addcaliper: adds caliper to the matching matrix
### FUNCTION: Creates a calipered rank-based Mahalanobis distance from a distance matrix.
### INPUT: 1) dmat: distance matrix.
###        2) Z: instruments (n by 1 vector), Z =1 (treated) and Z = 0 (not treated)
###        3) logitp: logit propensity scores from logistic regression (n by 1 vector)
###        4) calipersd, indicator on when to caliper
###        5) penalty, how much penalty for exceeding caliper bounds
### OUTPUT: 1) n by n with caliper added
addcaliper=function(dmat,Z,logitp,calipersd=.2,penalty=1000){
  sd.logitp=sd(logitp)
  adif=abs(outer(logitp[Z==1],logitp[Z==0],"-"))
  adif=(adif-(calipersd*sd.logitp))*(adif>(calipersd*sd.logitp))
  dmat=dmat+adif*penalty
  dmat
}

##### matching: does full matching
### FUNCTION: creates a vector that matches treatment to control
### INPUT: 1) Z: a n-length vector that lists treatment (as 1) and control (as 0)
###        2) X: a n-by-p matrix of covariates
###        3) type: type of matching, defaults to full matching
###        4) ratio: if full matching or 1:m matching, checks to see the control/treatment ratio
###        5) matchInfo: should the function print out the matching information?
### OUTPUT: 1) a n-vector vector containing match numbers.
### NOTE: The matching function (smahal, prop.score, caliper, and fullmatch) are
###       very sensitive to how the observations are ordered. Currentyl, smahal
###       orders the observations by how Z is ordered.
matching = function(Z,X,type=c("full","pair","1:m"),ratio,matchInfo=FALSE) {
  type = match.arg(type)

  # Pre-processing
  Z = as.logical(Z);

  # Rank-based distance matrix
  rank.mat = smahal(Z,X)

  # Propensity scores
  model = glm(Z ~ X,family="binomial"); prop.score = predict(model);

  # Fix rank-based distance matrix by propensity score calipers
  rank.mat.caliper = addcaliper(rank.mat,Z,prop.score)

  # Actual matching
  if(type == "pair") pairmatchvec = pairmatch(rank.mat.caliper,data=1:length(Z))
  if(type == "full") {
  	  if(missing(ratio)) pairmatchvec = fullmatch(rank.mat.caliper,data=1:length(Z))
  	  else pairmatchvec = fullmatch(rank.mat.caliper,data=1:length(Z),min.controls=1/ratio,max.controls=ratio)
  }
  if(type == "1:m") pairmatchvec = pairmatch(rank.mat.caliper,data=1:length(Z),controls=ratio)
  if(matchInfo) print(summary(pairmatchvec))

  # Post-processing
  pairmatchvec = as.numeric(substr(pairmatchvec,start=3,stop=20))
  return(pairmatchvec)
}

##### estLambda: estimates Lambda, provide confidence interval, and p-value
### FUNCTION: provides point est, confidence interval, and p-value
### INPUT: Z: instrument (n by 1 vector)
###        R: response (n by 1 vector)
###        D: dose (n by 1 vector)
###        X: covariate matrix (n by p)
###        matchedNumber: matching vector from matching() function
###        null: the lambda_0 value in H0: lambda = lambda_0
###        alphaLevel: alpha level for the confidence interval
### OUTPUT: point Est, confidence interval, and p-value
estLambda = function(Z,R,D,X,matchedNumber,null = 0,alphaLevel = 0.05) {
  if(alphaLevel >= 0.5) stop("alphaLevel is improperly set")

  X.factorize = model.matrix(~X)
  if(missing(matchedNumber)) matchedNumber = matching(Z,X,"full")

  # Deal with non-matched individuals #
  R.matchedIndiv = R[!is.na(matchedNumber)]
  D.matchedIndiv = D[!is.na(matchedNumber)]
  Z.matchedIndiv = Z[!is.na(matchedNumber)]
  matchedNumber.matchedIndiv = matchedNumber[!is.na(matchedNumber)]

  # Sort individuals in ascending matching order
  matchedNumber.sortedIndex = sort(matchedNumber.matchedIndiv,index.return=TRUE)$ix
  R.sorted = R.matchedIndiv[matchedNumber.sortedIndex]
  D.sorted = D.matchedIndiv[matchedNumber.sortedIndex]
  Z.sorted = Z.matchedIndiv[matchedNumber.sortedIndex]
  matchedNumber.sorted = matchedNumber.matchedIndiv[matchedNumber.sortedIndex]

  # Calculate the size of each matched set and the corresponding weights
  ni = tabulate(matchedNumber.sorted);
  ni = ni[!(ni == 0)] #this cleans up a flaw with matching algorithm
                      #where some matched numbers (e.g. 1:I) are not used between
		      	     	  	  	    #1 to I
  I = length(ni)
  wi = ni^2 / (ni - 1)  #Actual formula: ni^2 /(mi * (ni - mi))

  # Calculate Vi, Gi, and Hi
  # Formula
  # Vi = Gi - lambda * Hi
  # Gi = wi*(Zij - Zimean)(Rij - Rimean) = wi*(ZijRij - ni*Zmean.*Rmean.)
  # Hi = wi*(Zij - Zimean)(Dij - Dimean) = wi*(ZijDij - ni*Zmean.*Dmean.)

  # This requires some thought. Basically, because R,D,Z are all ordered based on matchedset number,
  # we use cumsum to obtain means of R, D, and Z within each group as well as means of RZ and DZ.
  # The key here is using the cumsum(ni), which keeps track of the indices in all the ordered vectors
  ni.cumsum = cumsum(ni)
  RZ.cumsum = cumsum(R.sorted*Z.sorted); DZ.cumsum = cumsum(D.sorted*Z.sorted)
  R.cumsum = cumsum(R.sorted); D.cumsum = cumsum(D.sorted); Z.cumsum = cumsum(Z.sorted)
  R.means = (R.cumsum[ni.cumsum] - c(0,R.cumsum[ni.cumsum[-length(ni.cumsum)]]))/ni
  Z.means = (Z.cumsum[ni.cumsum] - c(0,Z.cumsum[ni.cumsum[-length(ni.cumsum)]]))/ni
  D.means = (D.cumsum[ni.cumsum] - c(0,D.cumsum[ni.cumsum[-length(ni.cumsum)]]))/ni

  RZ.group = RZ.cumsum[ni.cumsum] - c(0,RZ.cumsum[ni.cumsum[-length(ni.cumsum)]])
  DZ.group = DZ.cumsum[ni.cumsum] - c(0,DZ.cumsum[ni.cumsum[-length(ni.cumsum)]])

  Gi = wi * RZ.group - wi * ni * R.means * Z.means
  Hi = wi * DZ.group - wi * ni * D.means * Z.means

  # Compute the point estimate
  pointEst = sum(Gi) / sum(Hi)

  # Compute the p-value under the null
  ViNull = Gi - null * Hi
  testStatNull = mean(ViNull) / sqrt(1/(I *(I-1)) * sum( (ViNull - mean(ViNull))^2) )
  pvalue = 2* (1 - pnorm(abs(testStatNull)))

  # Compute the quadratic terms for CI
  # A*lambda^2 + B*lambda + C = 0 (technically, it's A*lambda^2 + B*lambda + C <= 0)
  q = qnorm(1 - alphaLevel/2)
  A = sum(Hi)^2/I^2 - q^2 /(I * (I-1)) * sum( (Hi - mean(Hi))^2)
  B = -2 * (sum(Hi) * sum(Gi) / I^2 - q^2 / (I * (I-1)) * sum( (Hi - mean(Hi)) * (Gi - mean(Gi))))
  C = sum(Gi)^2/I^2 - q^2/(I * (I-1)) * sum( (Gi - mean(Gi))^2)

  detQuad = round(B^2 - 4*A*C,9) #6 is set for numerical accuracy
  if( detQuad <= 0) {
    if(A < 0) {
      cis = matrix(c(-Inf,Inf),1,2)
      } else {
        cis = matrix(c(NA,NA),1,2)
	}
  }
  if(detQuad > 0) {
    if(A < 0) {
      up.ci = (-B - sqrt(detQuad))/ (2*A)
      low.ci = (-B + sqrt(detQuad)) / (2*A)
        cis = matrix(c(-Inf,low.ci,up.ci,Inf),2,2,byrow=TRUE)
	} else {
	  low.ci = (-B - sqrt(detQuad))/ (2*A)
      up.ci = (-B + sqrt(detQuad)) / (2*A)
        cis = matrix(c(low.ci,up.ci),1,2)
	}
  }
  return(list(pointEst = pointEst,cis = cis,pvalue = pvalue))
}
###### est2SLS
### FUNCTION: computes the 2SLS estimate using the AER package
### INPUT: Z: instrument (n by 1 vector)
###        R: response (n by 1 vector)
###        D: dose (n by 1 vector)
###        X: covariate matrix (n by p)
###        null: null Value under H_0:
### OUTPUT: point Est, confidence interval, and p-value
est2SLS <- function(Z,R,D,X,null=0) {
  library(AER)
  model = ivreg(R ~ D + X | Z + X)
  model.summary = summary(model)
  coefficientTable = model.summary$coefficients
  dfTest = model.summary$df[2]
  estValue = as.numeric(coefficientTable[2,1])
  stdError = as.numeric(coefficientTable[2,2])
  tValue = abs( (estValue - null) / stdError)
  pvalue = 2*(1 - pt(tValue,dfTest))
  confInt = matrix(as.numeric(confint(model)[2,]),1,2)
  return(list(pointEst = estValue,cis = confInt,pvalue = pvalue))
}

###### estOLS
### FUNCTION: computes the OLS estimate
### INPUT: Z: instrument (n by 1 vector), note this is not used in OLS
###        R: response (n by 1 vector)
###        D: dose (n by 1 vector)
###        X: covariate matrix (n by p)
### OUTPUT: point Est, confidence interval, and p-value
estOLS <- function(Z,R,D,X) {
  model = lm(R ~ D + X)
  estValue = as.numeric(coefficients(model))[2]
  pvalue = as.numeric(summary(model)$coefficients[2,4])
  confInt = matrix(as.numeric(confint(model)[2,]),1,2)
  return(list(pointEst = estValue,cis = confInt,pvalue=pvalue))
}

##### sensInt
### FUNCTION: does sensitivity analysis
### INPUT: Gamma: a scalar value
###        Z: binary treatment/control vector (n time 1)
###        R: binary response (n * 1)
###        pairmatchvec: vector of matches (handles no matches)
### OUTPUT: lower and upper bounds for sensitivity analysis
### NOTE: Can only handle sensitivity analysis if there are multiple controls
###      (but not if there are multiple treatments) AND if the response is binary
sensInt <- function(Gamma,Z,R,pairmatchvec) {
  matchedSets = unique(pairmatchvec[!is.na(pairmatchvec)]);
  cs.plus = rep(0,length(I))
  ps.plus = rep(0,length(I))
  ps.minus = rep(0,length(I))
  testStat = rep(0,length(I))
  ds= rep(0,length(I))
  for(i in 1:length(matchedSets)) {
    index = matchedSets[i]
    matchedSetID = which(pairmatchvec == index)
    ni = length(matchedSetID); mi = sum(Z[matchedSetID])
    cs.plus[i] = sum(R[matchedSetID])
    ps.plus[i] = Gamma * cs.plus[i]/(Gamma*cs.plus[i] + ni - cs.plus[i])
    ps.minus[i] = cs.plus[i]/(cs.plus[i] + (ni - cs.plus[i])*Gamma)
    ds[i] = ni/(mi*(ni - mi))
    testStat[i] = ds[i] * sum(Z[matchedSetID] * R[matchedSetID])
  }
  T = sum(testStat)
  lowerBound = (T - sum(ds * ps.plus)) /(sqrt(sum(ds^2 * ps.plus * (1 - ps.plus))))
  upperBound = (T - sum(ds * ps.minus)) /(sqrt(sum(ds^2 * ps.minus * (1 - ps.minus))))
  return(c(lowerBound,upperBound))
}

##### balanceCheck
### FUNCTION: checks the balance of covariates before and after matching
### INPUT: Z: treatment/control vector (n time 1)
###        X: covariates (n * p)
###        pairmatchvec: vector of matches (handles no matches)
### OUTPUT: a table of standardized differences
balanceCheck <- function(Z,X,pairmatchvec) {
   # Before Matching #
   X.C.BeforeMatch = X[Z == 0,]; X.T.BeforeMatch = X[Z == 1,];
   overallSD = sqrt(apply(X.C.BeforeMatch,2,var) + apply(X.T.BeforeMatch,2,var)/2)
   stdDiff.Before = abs((colMeans(X.T.BeforeMatch) - colMeans(X.C.BeforeMatch))/overallSD)
   # After Matching #
   matchedSets = unique(pairmatchvec[!is.na(pairmatchvec)]);
   X.C.AfterMatch = matrix(0,length(matchedSets),ncol(X)); X.T.AfterMatch = matrix(0,length(matchedSets),ncol(X));
   nTreatedAfterMatch = rep(0,length(matchedSets))
   for(i in 1:length(matchedSets)) {
      treatedZ = which(pairmatchvec == matchedSets[i] & Z == 1)
     controlZ = which(pairmatchvec == matchedSets[i] & Z == 0)
     X.C.AfterMatch[i,] = colMeans(X[controlZ,,drop=FALSE]); X.T.AfterMatch[i,] = colMeans(X[treatedZ,,drop=FALSE])
     nTreatedAfterMatch[i] = length(treatedZ)
   }
   stdDiff.After = apply( X.T.AfterMatch - X.C.AfterMatch,2,function(x){ sum(x * nTreatedAfterMatch) / sum(nTreatedAfterMatch)}) / overallSD
   stdDiff.After = abs(stdDiff.After)
   output = cbind(stdDiff.Before,stdDiff.After)
   colnames(output) = c("Standardized differences before matching","Standardized differences after matching")
   return(output)
}

##### effectSampleSize
### FUNCTION: computes the asymptotic variance of effectRatio estimator and the maximum strata size for effectratio estimator
### INPUT: Z: treatment/control vector (n time 1)
###        matchedNumber: vector of matches
### OUTPUT: a two-dimensional vector, the first dimension being the effective sample size and the second dimension being the maximum strata size.
effectSampleSize <- function(Z,matchedNumber) {
  # Deal with non-matched individuals #
  Z.matchedIndiv = Z[!is.na(matchedNumber)]
  matchedNumber.matchedIndiv = matchedNumber[!is.na(matchedNumber)]

  # Sort individuals in ascending matching order
  matchedNumber.sortedIndex = sort(matchedNumber.matchedIndiv,index.return=TRUE)$ix
  Z.sorted = Z.matchedIndiv[matchedNumber.sortedIndex]
  matchedNumber.sorted = matchedNumber.matchedIndiv[matchedNumber.sortedIndex]

  # Calculate the size of each matched set and the corresponding weights
  ni = tabulate(matchedNumber.sorted); I = length(ni)
  ni.max = max(ni)
  asympVarEffectRatio = (sum(ni^3 / (ni - 1)) * 1/I) / (sum(ni) / I)^2
  print(paste("Asymptotic variance of effect ratio estimator is",asympVarEffectRatio))
  print(paste("Maximmum strata size is",ni.max))
  return(c(asympVarEffectRatio,ni.max))
}

##### matchSizeAnalysis
### FUNCTION: analyzes the size of matched Sets as a function of the covariates
### INPUT: pairmatchvec: vector of of matches
###        Z: treatment/control vector
###        X: covariates
### OUTPUT: a two-dimensional vector, the first dimension being the effective sample size and the second dimension being the maximum strata size.
matchSizeAnalysis <- function(pairmatchvec,Z,X) {
  matchedSets = unique(pairmatchvec[!is.na(pairmatchvec)]); I = length(matchedSets)
  Y.sizeMatch = rep(0,I)
  Y.controlMatch = rep(0,I)
  X.covAvg = matrix(0,I,ncol(X))

  for(i in 1:I) {
    set.i = which(matchedSets[i] == pairmatchvec)
    Y.controlMatch[i] = sum(Z[set.i])
    Y.sizeMatch[i] = length(set.i)
    for(j in 1:ncol(X.covAvg)) {
      X.covAvg[i,j] = mean(X[set.i,j])
      }
  }
  colnames(X.covAvg) = colnames(X)
  return(data.frame(Y.sizeMatch = Y.sizeMatch,Y.controlMatch=Y.controlMatch,X.covAvg))
}


# Estadiistica descriptiva (I): Teoría de probabilidades: distribuciones, varianza.

#################################################################
# Limpiemos todo primero.
cat("\014")
rm(list=ls())
graphics.off()

## Este truco instala el paquete si es que no esta instalado, y lo llama usando "library".
## Si NO está instalado, lo instala, y despues lo llama usando "library".
## Es, básicamente, un instalador y cargador CONDICIONAL de paquetes.
## Este paquete que ejecuta esta accion condicional, se llama "pacman".

# Usuarios MAC: asegurarse de tener XQuartz instalado
# https://dl.bintray.com/xquartz/downloads/XQuartz-2.7.11.dmg

install.packages("cem")
library(cem)

if (!require("pacman")) install.packages("pacman"); library(pacman) # Ahora cargaremos "pacman"
p_load(cem) # y aqui le decimos a pacman que revise si tienes el paquete "cem" que utilizaremos para el sgte. ej. Si no lo tienes, lo instalará, y lo llamará.
# En resumen, p_load() reemplaza install.packages("paquete") y "library(paquete)".

# En la libreria "cem" vive una base de datos muy famosa, conocida como LaLonde. Carguemosla para la sgte. actividad.
data(LL)

# Veamos en que consiste.
head(LL)

## Variables

# treated: Indicator variable for whether the participant received the treatment.
# age: Measured in years.
# education: Years of education.
# black: Indicator variable for whether the participant is African-American.
# married: Indicator variable for whether the participant is married.
# nodegree: Indicator variable for not possessing a high school diploma
# re74: Real earnings in 1974. re75:
# Real earnings in 1975.
# re78: Real earnings in 1978.
# hispanic: Indicator variable for whether the participant is Hispanic.
# u74: Indicator variable for unemployed in 1974.
# u75: Indicator variable for unemployed in 1975.

#################################################################
# Estadistica Descriptiva
#################################################################

# En esta seccion revisaremos los estadisticos descriptivos mas usados.

#################################################################
# Promedio (o media) (o "mean" en ingles).
#################################################################

# 1) Es la medida mas usada para medir la centralidad de la distribucion.
# 2) Todos los datos, como vimos, siguen una distribucion. Por ej., veamos la distribucion
# etarea de los sujetos entrevistados en esta base de datos.

## Un histograma
histogram(LL$age) # El promedio debiera ser cercano a 20 años.

## Veamos ahora el promedio de esta variable usando el comando "mean()"
mean(LL$age)

## Redondear numeros usando el comando "round"
round(mean(LL$age), 1) # con un decimal.
round(mean(LL$age), 0) # con 0 decimales.

#################################################################
# Mediana (o "median" en ingles).
#################################################################

# Muestra el valor que vive al medio de la distribucion.
# Ventaja: es mas robusta (o resistente) a los valores extremos, si la comparamos con el promedio.
# Recuerda. Para calcular el promedio, debemos incorporar los valores extremos (los muy altos, y los muy bajos).
# Y esto afecta el promedio. No asi con la mediana: no cambia si agregamos valores extremos.
# En la distribucion normal: mediana = media = moda.

### Primero, ordenemos los numeros de mayor a menor.
LL$age
ll.age.ordenado = sort(LL$age)
ll.age.ordenado

# Calculemos la mediana
median(LL$age)

### OK. Los valores estan ordenados de menor a mayor. Segundo, veamos que largo tiene este vector (usando el comando "lenght", que significa "largo").
length(ll.age.ordenado)

length(ll.age.ordenado)/2 # OK. Ahora, veamos el elemento que vive al medio de esta lista de numeros.
# 361.

## 1) OK. Es un numero impar. Que significa eso?
## 2) Qué pasa con los numeros pares?

## OK. Ahora llamemos al elemento 361
ll.age.ordenado[361]

## Comprobemos que nuestro calculo esta correcto.
median(LL$age) == ll.age.ordenado[361] # OK.

##  Conclusion preliminar # 1
round(mean(LL$age), 0) > median(LL$age)
## Que significa eso?
## "Skewness" positiva. Hay ciertos valores "extremos" que estan inflando el promedio (hacia arriba).

#################################################################
# Un resumen un poco mas completo
#################################################################

summary(LL) # de toda la base
summary(LL$age) # de la variable "age" ("edad")

# 1) Voluntari@ para dibujar un _________ en la pizarra? Usando esta informacioón, cómo se vería este gráfico?

#################################################################
# Tablas de Frecuencia
#################################################################

# Por ej., cuantos estan casados ("married") en nuestra base de datos?
table(LL$married)

# Otro ejemplo, cuantos Afro-Americanos estan casados?
table(LL$married, LL$black) # Siempre es table(FILA, COLUMNA). Ese orden (FILA, COLUMNA) siempre es asi en R.
## En ese sentido, los casados van en la fila, y los Afroamericanos en las columnas.

#################################################################
# Medidas de Dispersion
#################################################################

# Ademas de ver cuan centrada esta nuestra distrubucion, tambien queremos ver
# cuan dispersas estan las observaciones del promedio.
var(LL$age)

# 1) Que significa eso?
# Como lo solucionamos?

# Solucion: desviacion estandard.
sd(LL$age)

## redondear
round(sd(LL$age),0) # 7

# La DS es la raiz cuadrada ("square root", comando "sqrt") de la varianza (comando "var"), que esta en escala cuadrada.
sqrt(var(LL$age)) == sd(LL$age) # Comprobando.

# Qué significa todo esto?
## Existe la regla "68-95-99.7" que aplica sólo a distribuciones normales (nuestra variable de edad NO es normal...).

## 68% de los datos caen dentro del rango de +/- 1 DS  de la media. Es decir:
mean(LL$age) - round(sd(LL$age),0) # rango minimo
mean(LL$age) + round(sd(LL$age),0) # rango maximo

## 95% de los datos caen dentro del rango de +/- 2 DS's  de la media.
mean(LL$age) - 2*(round(sd(LL$age),0)) # rango minimo
mean(LL$age) + 2*(round(sd(LL$age),0)) # rango maximo

## 99.7% de los datos caen dentro del rango de +/- 3 DS's  de la media.
mean(LL$age) - 3*(round(sd(LL$age),0)) # rango minimo
mean(LL$age) + 3*(round(sd(LL$age),0)) # rango maximo


# ----------------------------------------
#  App Title: Benford's Law and Sequences
#     Author: Jimmy Doi
# ----------------------------------------

library(RColorBrewer)
library(shinyIncubator)

########################################
seq.gen <- function(length,val.1,val.2){

  seq <- numeric(length)
  seq[1] <- val.1
  seq[2] <- val.2

  for (i in 3:length) {
    seq[i] <- seq[i-1]+seq[i-2]
  }
  return(seq)
}

########################################
pow.gen <- function(base,length){

  seq <- base**(1:length)

  return(seq)
}

########################################
prime.gen <- function(n){
  n <- as.integer(n)
  if(n > 1e8) stop("n too large")
  primes <- rep(TRUE, n)
  primes[1] <- FALSE
  last.prime <- 2L
  fsqr <- floor(sqrt(n))
  while (last.prime <= fsqr)
  {
    primes[seq.int(2L*last.prime, n, last.prime)] <- FALSE
    sel <- which(primes[(last.prime+1):(fsqr+1)])
    if(any(sel)){
      last.prime <- last.prime + min(sel)
    }else last.prime <- fsqr+1
  }
  which(primes)
}

########################################
string.1st <- function(sequence,max){
  string1 <- substr(as.character(sequence[1:max]),1,1)
  #  string1<-paste(" ",string1,sep="")
  return(string1)
}

########################################
string.2nd <- function(sequence,max){
  string2 <- substr(as.character(sequence[1:max]),2,1000000L)
  string2.a<-paste(string2,", ",sep="")
  string2.a[max]<-string2[max]
  return(string2.a)
}

########################################
print.string <- function(string,num){
  #names(string)<-""
  return(string[num])
}

########################################
goodness.test <- function(sequence){

  string <- substr(as.character(sequence),1,1)

  first.digits <- as.integer(string)

  # In the event any of the 9 possible digits is not observed in the string,
  # table(first.digits) will not display all digits 1, 2, ..., 9. An example is
  #
  # NAME     1  2  3  4  5  6  7  9
  # FREQ    12 11  9  8  6  5  4  2
  #
  # Here, obs <- as.integer(table(first.digits)) would only contain 8 elements.
  # To correct for this, initialize obs to a zero vector, loop through NAME,
  # find FREQ corresponding to NAME,then paste that FREQ in obs[NAME].
  # This will also work for the case when all 9 possible digits are observed.

  Obs <- seq(0,0,,9)

  for (i in as.numeric(names(table(first.digits))))  {
    pos <- which(as.numeric(names(table(first.digits)))==i)
    Obs[i]<- as.numeric(table(first.digits))[pos]
  }
  i <- seq(1,9)

  Exp <- length(sequence)*log10(1+1/i)

  Digit <- seq(1,9)

  #print(info)

  chisq <- sum(((Obs-Exp)**2)/Exp)

  Exp <- round(Exp,3)
  info <- cbind(Digit,Obs,Exp)
  rownames(info)<-rep("",nrow(info))

  #print(chisq)

  p.value <- 1-pchisq(chisq,8)

  text.chi <- paste("Chi Square = ",format(round(chisq,3),nsmall=3),sep="")
  names(text.chi)<-""

  text.pval <- paste("P Value = ",format(round(p.value,3),nsmall=3),sep="")
  names(text.pval)<-""

  print(info)
  print(text.chi,quote=F)
  print(text.pval,quote=F)

}

########################################
pr.goodness.test <- function(sequence,big.n){

  string <- substr(as.character(sequence),1,1)

  first.digits <- as.integer(string)

  # In the event any of the 9 possible digits is not observed in the string,
  # table(first.digits) will not display all digits 1, 2, ..., 9. An example is
  #
  # NAME     1  2  3  4  5  6  7  9
  # FREQ    12 11  9  8  6  5  4  2
  #
  # Here, obs <- as.integer(table(first.digits)) would only contain 8 elements.
  # To correct for this, initialize obs to a zero vector, loop through NAME,
  # find FREQ corresponding to NAME,then paste that FREQ in obs[NAME].
  # This will also work for the case when all 9 possible digits are observed.

  Obs <- seq(0,0,,9)

  for (i in as.numeric(names(table(first.digits))))  {
    pos <- which(as.numeric(names(table(first.digits)))==i)
    Obs[i]<- as.numeric(table(first.digits))[pos]
  }

  i <- seq(1,9)

  alpha <- 1/(log(big.n)-1.10)

  gbl <- 1/(10**(1-alpha)-1)*((i+1)**(1-alpha)-i**(1-alpha))

  Exp <- length(sequence)*gbl

  Digit <- seq(1,9)

  chisq <- sum(((Obs-Exp)**2)/Exp)

  Exp <- round(Exp,3)
  info <- cbind(Digit,Obs,Exp)
  rownames(info)<-rep("",nrow(info))

  p.value <- 1-pchisq(chisq,8)

  text.chi <- paste("Chi Square = ",format(round(chisq,3),nsmall=3),sep="")
  names(text.chi)<-""

  text.pval <- paste("P Value = ",format(round(p.value,3),nsmall=3),sep="")
  names(text.pval)<-""

  print(info)
  print(text.chi,quote=F)
  print(text.pval,quote=F)

}

############################################
pmf.compare<-function(sequence){

  string <- substr(as.character(sequence),1,1)

  first.digits <- as.integer(string)

  # In the event any of the 9 possible digits is not observed in the string,
  # table(first.digits) will not display all digits 1, 2, ..., 9. An example is
  #
  # NAME     1  2  3  4  5  6  7  9
  # FREQ    12 11  9  8  6  5  4  2
  #
  # Here, obs <- as.integer(table(first.digits)) would only contain 8 elements.
  # To correct for this, initialize obs to a zero vector, loop through NAME,
  # find FREQ corresponding to NAME,then paste that FREQ in obs[NAME].
  # This will also work for the case when all 9 possible digits are observed.

  Obs <- seq(0,0,,9)

  for (i in as.numeric(names(table(first.digits))))  {
    pos <- which(as.numeric(names(table(first.digits)))==i)
    Obs[i]<- as.numeric(table(first.digits))[pos]
  }
  i <- seq(1,9)

  pmf.Exp <- cbind(seq(1,9)+0.065,log10(1+1/i))
  pmf.Obs <- cbind(seq(1,9)-0.065,Obs/sum(Obs))

  col1 <- brewer.pal(n = 12, name = "Paired")[8]
  col2 <- brewer.pal(n = 12, name = "Paired")[2]

  par(mar=c(3.5,4.5,2,0))

  my.lwd <- 3.75

  if (max(pmf.Obs[,2])>=max(pmf.Exp[,2])){
    plot(pmf.Obs[,1],pmf.Obs[,2],type="n",col=col1,xlim=c(0.75,9.25), xlab="",ylab="Proportion", xaxt="n", main="Proportion of First Digits")
    axis(1, at=seq(1,9), labels=c("1","2","3","4","5","6","7","8","9"))
    mtext("First Digit",1,line=2.5)
    for (i in 1:nrow(pmf.Obs)){
      lines(c(pmf.Obs[i,1],pmf.Obs[i,1]),c(0,pmf.Obs[i,2]),col=col1,lwd=my.lwd)
    }
    for (i in 1:nrow(pmf.Exp)){
      lines(c(pmf.Exp[i,1],pmf.Exp[i,1]),c(0,pmf.Exp[i,2]),col=col2,lwd=my.lwd)
      legend("topright", inset=.02,
             c("Observed Proportion","Benford's Law"), fill=c(col1,col2), horiz=F)
    }
  }

  if (max(pmf.Obs[,2])<max(pmf.Exp[,2])){
    plot(pmf.Exp[,1],pmf.Exp[,2],type="n",col=col2,xlim=c(0.75,9.25), xlab="", ylab="Proportion", xaxt="n", main="Proportion of First Digits")
    axis(1, at=seq(1,9), labels=c("1","2","3","4","5","6","7","8","9"))
    mtext("First Digit",1,line=2.5)
    for (i in 1:nrow(pmf.Obs)){
      lines(c(pmf.Exp[i,1],pmf.Exp[i,1]),c(0,pmf.Exp[i,2]),col=col2,lwd=my.lwd)
    }
    for (i in 1:nrow(pmf.Obs)){
      lines(c(pmf.Obs[i,1],pmf.Obs[i,1]),c(0,pmf.Obs[i,2]),col=col1,lwd=my.lwd)
    }
    legend("topright", inset=.02,
           c("Observed Proportion","Benford's Law"), fill=c(col1,col2), horiz=F)
  }
}

############################################
pr.pmf.compare<-function(sequence,big.n){

  string <- substr(as.character(sequence),1,1)

  first.digits <- as.integer(string)

  # In the event any of the 9 possible digits is not observed in the string,
  # table(first.digits) will not display all digits 1, 2, ..., 9. An example is
  #
  # NAME     1  2  3  4  5  6  7  9
  # FREQ    12 11  9  8  6  5  4  2
  #
  # Here, obs <- as.integer(table(first.digits)) would only contain 8 elements.
  # To correct for this, initialize obs to a zero vector, loop through NAME,
  # find FREQ corresponding to NAME,then paste that FREQ in obs[NAME].
  # This will also work for the case when all 9 possible digits are observed.

  Obs <- seq(0,0,,9)

  for (i in as.numeric(names(table(first.digits))))  {
    pos <- which(as.numeric(names(table(first.digits)))==i)
    Obs[i]<- as.numeric(table(first.digits))[pos]
  }
  i <- seq(1,9)

  alpha <- 1/(log(big.n)-1.10)

  gbl <- 1/(10**(1-alpha)-1)*((i+1)**(1-alpha)-i**(1-alpha))

  pmf.Exp <- cbind(seq(1,9)+0.065,gbl)

  pmf.Obs <- cbind(seq(1,9)-0.065,Obs/sum(Obs))

  col1 <- brewer.pal(n = 12, name = "Paired")[8]
  col2 <- brewer.pal(n = 12, name = "Paired")[2]

  par(mar=c(3.5,4.5,2,0))

  my.lwd <- 3.75

  if (max(pmf.Obs[,2])>=max(pmf.Exp[,2])){
    plot(pmf.Obs[,1],pmf.Obs[,2],type="n",col=col1,xlim=c(0.75,9.25), xlab="",ylab="Proportion", xaxt="n", main="Proportion of First Digits",
         ylim=c(0.06,
         max(1.05*max(pmf.Obs[,2]),1.05*max(pmf.Exp[,2])))
      )
    axis(1, at=seq(1,9), labels=c("1","2","3","4","5","6","7","8","9"))
    mtext("First Digit",1,line=2.5)
    for (i in 1:nrow(pmf.Obs)){
      lines(c(pmf.Obs[i,1],pmf.Obs[i,1]),c(0,pmf.Obs[i,2]),col=col1,lwd=my.lwd)
    }
    for (i in 1:nrow(pmf.Exp)){
      lines(c(pmf.Exp[i,1],pmf.Exp[i,1]),c(0,pmf.Exp[i,2]),col=col2,lwd=my.lwd)
      legend("topright", inset=.02,
             c("Observed Proportion","Generalized Benford's Law"), fill=c(col1,col2), horiz=F)
    }
  }

  if (max(pmf.Obs[,2])<max(pmf.Exp[,2])){
    plot(pmf.Exp[,1],pmf.Exp[,2],type="n",col=col2,xlim=c(0.75,9.25), xlab="", ylab="Proportion", xaxt="n", main="Proportion of First Digits",
         ylim=c(0.06,
      max(1.05*max(pmf.Obs[,2]),1.05*max(pmf.Exp[,2]))))
    axis(1, at=seq(1,9), labels=c("1","2","3","4","5","6","7","8","9"))
    mtext("First Digit",1,line=2.5)
    for (i in 1:nrow(pmf.Obs)){
      lines(c(pmf.Exp[i,1],pmf.Exp[i,1]),c(0,pmf.Exp[i,2]),col=col2,lwd=my.lwd)
    }
    for (i in 1:nrow(pmf.Obs)){
      lines(c(pmf.Obs[i,1],pmf.Obs[i,1]),c(0,pmf.Obs[i,2]),col=col1,lwd=my.lwd)
    }
    legend("topright", inset=.02,
           c("Observed Proportion","Generalized Benford's Law"), fill=c(col1,col2), horiz=F)
  }
}

##############################################################################
# Shiny Server Contents
##############################################################################

shinyServer(function(input, output, session) {

  #########################################################################
  ## Additive Sequence
  #########################################################################

    withProgress(session, {
      setProgress(message = "Calculating, please wait.",
                  detail = " ", value=1)

  output$val.1st <- renderText({input$seq1})

  output$val.2nd <- renderText({input$seq2})

  output$textlength <- renderText({input$length})

  seqInput <- reactive({
    seq.gen(input$length,input$seq1,input$seq2)
  })

  output$goodness <- renderPrint({
    goodness.test(seqInput())
  })

  firstDigit <- reactive({
    string.1st(seqInput(),50)
  })

  restDigit <- reactive({
    string.2nd(seqInput(),50)
  })

  output$num.1a <- renderText({print.string(firstDigit(),  1)})
  output$num.1b <- renderText({print.string(restDigit(),   1)})
  output$num.2a <- renderText({print.string(firstDigit(),  2)})
  output$num.2b <- renderText({print.string(restDigit(),   2)})
  output$num.3a <- renderText({print.string(firstDigit(),  3)})
  output$num.3b <- renderText({print.string(restDigit(),   3)})
  output$num.4a <- renderText({print.string(firstDigit(),  4)})
  output$num.4b <- renderText({print.string(restDigit(),   4)})
  output$num.5a <- renderText({print.string(firstDigit(),  5)})
  output$num.5b <- renderText({print.string(restDigit(),   5)})
  output$num.6a <- renderText({print.string(firstDigit(),  6)})
  output$num.6b <- renderText({print.string(restDigit(),   6)})
  output$num.7a <- renderText({print.string(firstDigit(),  7)})
  output$num.7b <- renderText({print.string(restDigit(),   7)})
  output$num.8a <- renderText({print.string(firstDigit(),  8)})
  output$num.8b <- renderText({print.string(restDigit(),   8)})
  output$num.9a <- renderText({print.string(firstDigit(),  9)})
  output$num.9b <- renderText({print.string(restDigit(),   9)})
  output$num.10a <- renderText({print.string(firstDigit(),10)})
  output$num.10b <- renderText({print.string(restDigit(), 10)})
  output$num.11a <- renderText({print.string(firstDigit(),11)})
  output$num.11b <- renderText({print.string(restDigit(), 11)})
  output$num.12a <- renderText({print.string(firstDigit(),12)})
  output$num.12b <- renderText({print.string(restDigit(), 12)})
  output$num.13a <- renderText({print.string(firstDigit(),13)})
  output$num.13b <- renderText({print.string(restDigit(), 13)})
  output$num.14a <- renderText({print.string(firstDigit(),14)})
  output$num.14b <- renderText({print.string(restDigit(), 14)})
  output$num.15a <- renderText({print.string(firstDigit(),15)})
  output$num.15b <- renderText({print.string(restDigit(), 15)})
  output$num.16a <- renderText({print.string(firstDigit(),16)})
  output$num.16b <- renderText({print.string(restDigit(), 16)})
  output$num.17a <- renderText({print.string(firstDigit(),17)})
  output$num.17b <- renderText({print.string(restDigit(), 17)})
  output$num.18a <- renderText({print.string(firstDigit(),18)})
  output$num.18b <- renderText({print.string(restDigit(), 18)})
  output$num.19a <- renderText({print.string(firstDigit(),19)})
  output$num.19b <- renderText({print.string(restDigit(), 19)})
  output$num.20a <- renderText({print.string(firstDigit(),20)})
  output$num.20b <- renderText({print.string(restDigit(), 20)})
  output$num.21a <- renderText({print.string(firstDigit(), 21)})
  output$num.21b <- renderText({print.string(restDigit(),  21)})
  output$num.22a <- renderText({print.string(firstDigit(), 22)})
  output$num.22b <- renderText({print.string(restDigit(),  22)})
  output$num.23a <- renderText({print.string(firstDigit(), 23)})
  output$num.23b <- renderText({print.string(restDigit(),  23)})
  output$num.24a <- renderText({print.string(firstDigit(), 24)})
  output$num.24b <- renderText({print.string(restDigit(),  24)})
  output$num.25a <- renderText({print.string(firstDigit(), 25)})
  output$num.25b <- renderText({print.string(restDigit(),  25)})
  output$num.26a <- renderText({print.string(firstDigit(), 26)})
  output$num.26b <- renderText({print.string(restDigit(),  26)})
  output$num.27a <- renderText({print.string(firstDigit(), 27)})
  output$num.27b <- renderText({print.string(restDigit(),  27)})
  output$num.28a <- renderText({print.string(firstDigit(), 28)})
  output$num.28b <- renderText({print.string(restDigit(),  28)})
  output$num.29a <- renderText({print.string(firstDigit(), 29)})
  output$num.29b <- renderText({print.string(restDigit(),  29)})
  output$num.30a <- renderText({print.string(firstDigit(),30)})
  output$num.30b <- renderText({print.string(restDigit(), 30)})
  output$num.31a <- renderText({print.string(firstDigit(), 31)})
  output$num.31b <- renderText({print.string(restDigit(),  31)})
  output$num.32a <- renderText({print.string(firstDigit(), 32)})
  output$num.32b <- renderText({print.string(restDigit(),  32)})
  output$num.33a <- renderText({print.string(firstDigit(), 33)})
  output$num.33b <- renderText({print.string(restDigit(),  33)})
  output$num.34a <- renderText({print.string(firstDigit(), 34)})
  output$num.34b <- renderText({print.string(restDigit(),  34)})
  output$num.35a <- renderText({print.string(firstDigit(), 35)})
  output$num.35b <- renderText({print.string(restDigit(),  35)})
  output$num.36a <- renderText({print.string(firstDigit(), 36)})
  output$num.36b <- renderText({print.string(restDigit(),  36)})
  output$num.37a <- renderText({print.string(firstDigit(), 37)})
  output$num.37b <- renderText({print.string(restDigit(),  37)})
  output$num.38a <- renderText({print.string(firstDigit(), 38)})
  output$num.38b <- renderText({print.string(restDigit(),  38)})
  output$num.39a <- renderText({print.string(firstDigit(), 39)})
  output$num.39b <- renderText({print.string(restDigit(),  39)})
  output$num.40a <- renderText({print.string(firstDigit(),40)})
  output$num.40b <- renderText({print.string(restDigit(), 40)})
  output$num.41a <- renderText({print.string(firstDigit(), 41)})
  output$num.41b <- renderText({print.string(restDigit(),  41)})
  output$num.42a <- renderText({print.string(firstDigit(), 42)})
  output$num.42b <- renderText({print.string(restDigit(),  42)})
  output$num.43a <- renderText({print.string(firstDigit(), 43)})
  output$num.43b <- renderText({print.string(restDigit(),  43)})
  output$num.44a <- renderText({print.string(firstDigit(), 44)})
  output$num.44b <- renderText({print.string(restDigit(),  44)})
  output$num.45a <- renderText({print.string(firstDigit(), 45)})
  output$num.45b <- renderText({print.string(restDigit(),  45)})
  output$num.46a <- renderText({print.string(firstDigit(), 46)})
  output$num.46b <- renderText({print.string(restDigit(),  46)})
  output$num.47a <- renderText({print.string(firstDigit(), 47)})
  output$num.47b <- renderText({print.string(restDigit(),  47)})
  output$num.48a <- renderText({print.string(firstDigit(), 48)})
  output$num.48b <- renderText({print.string(restDigit(),  48)})
  output$num.49a <- renderText({print.string(firstDigit(), 49)})
  output$num.49b <- renderText({print.string(restDigit(),  49)})
  output$num.50a <- renderText({print.string(firstDigit(),50)})
  output$num.50b <- renderText({print.string(restDigit(), 50)})

  output$pmf <- renderPlot({
    pmf.compare(seqInput())
    })

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

  output$powlength <- renderText({input$pow.length})

  e.seqInput <- reactive({
    pow.gen(input$pow.base,input$pow.length)
  })

  output$e.goodness <- renderPrint({
    goodness.test(e.seqInput())
  })

  e.firstDigit <- reactive({
    string.1st(e.seqInput(),20)
  })

  e.restDigit <- reactive({
    string.2nd(e.seqInput(),20)
  })

  output$e.num.1a <- renderText({print.string(e.firstDigit(),  1)})
  output$e.num.1b <- renderText({print.string(e.restDigit(),   1)})
  output$e.num.2a <- renderText({print.string(e.firstDigit(),  2)})
  output$e.num.2b <- renderText({print.string(e.restDigit(),   2)})
  output$e.num.3a <- renderText({print.string(e.firstDigit(),  3)})
  output$e.num.3b <- renderText({print.string(e.restDigit(),   3)})
  output$e.num.4a <- renderText({print.string(e.firstDigit(),  4)})
  output$e.num.4b <- renderText({print.string(e.restDigit(),   4)})
  output$e.num.5a <- renderText({print.string(e.firstDigit(),  5)})
  output$e.num.5b <- renderText({print.string(e.restDigit(),   5)})
  output$e.num.6a <- renderText({print.string(e.firstDigit(),  6)})
  output$e.num.6b <- renderText({print.string(e.restDigit(),   6)})
  output$e.num.7a <- renderText({print.string(e.firstDigit(),  7)})
  output$e.num.7b <- renderText({print.string(e.restDigit(),   7)})
  output$e.num.8a <- renderText({print.string(e.firstDigit(),  8)})
  output$e.num.8b <- renderText({print.string(e.restDigit(),   8)})
  output$e.num.9a <- renderText({print.string(e.firstDigit(),  9)})
  output$e.num.9b <- renderText({print.string(e.restDigit(),   9)})
  output$e.num.10a <- renderText({print.string(e.firstDigit(),10)})
  output$e.num.10b <- renderText({print.string(e.restDigit(), 10)})
  output$e.num.11a <- renderText({print.string(e.firstDigit(),11)})
  output$e.num.11b <- renderText({print.string(e.restDigit(), 11)})
  output$e.num.12a <- renderText({print.string(e.firstDigit(),12)})
  output$e.num.12b <- renderText({print.string(e.restDigit(), 12)})
  output$e.num.13a <- renderText({print.string(e.firstDigit(),13)})
  output$e.num.13b <- renderText({print.string(e.restDigit(), 13)})
  output$e.num.14a <- renderText({print.string(e.firstDigit(),14)})
  output$e.num.14b <- renderText({print.string(e.restDigit(), 14)})
  output$e.num.15a <- renderText({print.string(e.firstDigit(),15)})
  output$e.num.15b <- renderText({print.string(e.restDigit(), 15)})
  output$e.num.16a <- renderText({print.string(e.firstDigit(),16)})
  output$e.num.16b <- renderText({print.string(e.restDigit(), 16)})
  output$e.num.17a <- renderText({print.string(e.firstDigit(),17)})
  output$e.num.17b <- renderText({print.string(e.restDigit(), 17)})
  output$e.num.18a <- renderText({print.string(e.firstDigit(),18)})
  output$e.num.18b <- renderText({print.string(e.restDigit(), 18)})
  output$e.num.19a <- renderText({print.string(e.firstDigit(),19)})
  output$e.num.19b <- renderText({print.string(e.restDigit(), 19)})
  output$e.num.20a <- renderText({print.string(e.firstDigit(),20)})
  output$e.num.20b <- renderText({print.string(e.restDigit(), 20)})

  output$e.pmf <- renderPlot({pmf.compare(e.seqInput())})

  #########################################################################
  ## Power Sequence
  #########################################################################

  pr.seqInput <- reactive({

    pr.big.n <-as.integer(input$my.n)

    prime.gen(pr.big.n)
  })

  output$num.primes <- reactive({length(pr.seqInput())})

  output$pr.goodness <- renderPrint({
    pr.big.n <-as.integer(input$my.n)

    pr.goodness.test(pr.seqInput(),pr.big.n)
  })

  pr.firstDigit <- reactive({
    string.1st(pr.seqInput(),80)
  })

  pr.restDigit <- reactive({
    string.2nd(pr.seqInput(),80)
  })

  output$pr.num.1a <- renderText({print.string(pr.firstDigit(),  1)})
  output$pr.num.1b <- renderText({print.string(pr.restDigit(),   1)})
  output$pr.num.2a <- renderText({print.string(pr.firstDigit(),  2)})
  output$pr.num.2b <- renderText({print.string(pr.restDigit(),   2)})
  output$pr.num.3a <- renderText({print.string(pr.firstDigit(),  3)})
  output$pr.num.3b <- renderText({print.string(pr.restDigit(),   3)})
  output$pr.num.4a <- renderText({print.string(pr.firstDigit(),  4)})
  output$pr.num.4b <- renderText({print.string(pr.restDigit(),   4)})
  output$pr.num.5a <- renderText({print.string(pr.firstDigit(),  5)})
  output$pr.num.5b <- renderText({print.string(pr.restDigit(),   5)})
  output$pr.num.6a <- renderText({print.string(pr.firstDigit(),  6)})
  output$pr.num.6b <- renderText({print.string(pr.restDigit(),   6)})
  output$pr.num.7a <- renderText({print.string(pr.firstDigit(),  7)})
  output$pr.num.7b <- renderText({print.string(pr.restDigit(),   7)})
  output$pr.num.8a <- renderText({print.string(pr.firstDigit(),  8)})
  output$pr.num.8b <- renderText({print.string(pr.restDigit(),   8)})
  output$pr.num.9a <- renderText({print.string(pr.firstDigit(),  9)})
  output$pr.num.9b <- renderText({print.string(pr.restDigit(),   9)})
  output$pr.num.10a <- renderText({print.string(pr.firstDigit(),10)})
  output$pr.num.10b <- renderText({print.string(pr.restDigit(), 10)})
  output$pr.num.11a <- renderText({print.string(pr.firstDigit(),11)})
  output$pr.num.11b <- renderText({print.string(pr.restDigit(), 11)})
  output$pr.num.12a <- renderText({print.string(pr.firstDigit(),12)})
  output$pr.num.12b <- renderText({print.string(pr.restDigit(), 12)})
  output$pr.num.13a <- renderText({print.string(pr.firstDigit(),13)})
  output$pr.num.13b <- renderText({print.string(pr.restDigit(), 13)})
  output$pr.num.14a <- renderText({print.string(pr.firstDigit(),14)})
  output$pr.num.14b <- renderText({print.string(pr.restDigit(), 14)})
  output$pr.num.15a <- renderText({print.string(pr.firstDigit(),15)})
  output$pr.num.15b <- renderText({print.string(pr.restDigit(), 15)})
  output$pr.num.16a <- renderText({print.string(pr.firstDigit(),16)})
  output$pr.num.16b <- renderText({print.string(pr.restDigit(), 16)})
  output$pr.num.17a <- renderText({print.string(pr.firstDigit(),17)})
  output$pr.num.17b <- renderText({print.string(pr.restDigit(), 17)})
  output$pr.num.18a <- renderText({print.string(pr.firstDigit(),18)})
  output$pr.num.18b <- renderText({print.string(pr.restDigit(), 18)})
  output$pr.num.19a <- renderText({print.string(pr.firstDigit(),19)})
  output$pr.num.19b <- renderText({print.string(pr.restDigit(), 19)})
  output$pr.num.20a <- renderText({print.string(pr.firstDigit(),20)})
  output$pr.num.20b <- renderText({print.string(pr.restDigit(), 20)})
  output$pr.num.21a <- renderText({print.string(pr.firstDigit(), 21)})
  output$pr.num.21b <- renderText({print.string(pr.restDigit(),  21)})
  output$pr.num.22a <- renderText({print.string(pr.firstDigit(), 22)})
  output$pr.num.22b <- renderText({print.string(pr.restDigit(),  22)})
  output$pr.num.23a <- renderText({print.string(pr.firstDigit(), 23)})
  output$pr.num.23b <- renderText({print.string(pr.restDigit(),  23)})
  output$pr.num.24a <- renderText({print.string(pr.firstDigit(), 24)})
  output$pr.num.24b <- renderText({print.string(pr.restDigit(),  24)})
  output$pr.num.25a <- renderText({print.string(pr.firstDigit(), 25)})
  output$pr.num.25b <- renderText({print.string(pr.restDigit(),  25)})
  output$pr.num.26a <- renderText({print.string(pr.firstDigit(), 26)})
  output$pr.num.26b <- renderText({print.string(pr.restDigit(),  26)})
  output$pr.num.27a <- renderText({print.string(pr.firstDigit(), 27)})
  output$pr.num.27b <- renderText({print.string(pr.restDigit(),  27)})
  output$pr.num.28a <- renderText({print.string(pr.firstDigit(), 28)})
  output$pr.num.28b <- renderText({print.string(pr.restDigit(),  28)})
  output$pr.num.29a <- renderText({print.string(pr.firstDigit(), 29)})
  output$pr.num.29b <- renderText({print.string(pr.restDigit(),  29)})
  output$pr.num.30a <- renderText({print.string(pr.firstDigit(),30)})
  output$pr.num.30b <- renderText({print.string(pr.restDigit(), 30)})
  output$pr.num.31a <- renderText({print.string(pr.firstDigit(), 31)})
  output$pr.num.31b <- renderText({print.string(pr.restDigit(),  31)})
  output$pr.num.32a <- renderText({print.string(pr.firstDigit(), 32)})
  output$pr.num.32b <- renderText({print.string(pr.restDigit(),  32)})
  output$pr.num.33a <- renderText({print.string(pr.firstDigit(), 33)})
  output$pr.num.33b <- renderText({print.string(pr.restDigit(),  33)})
  output$pr.num.34a <- renderText({print.string(pr.firstDigit(), 34)})
  output$pr.num.34b <- renderText({print.string(pr.restDigit(),  34)})
  output$pr.num.35a <- renderText({print.string(pr.firstDigit(), 35)})
  output$pr.num.35b <- renderText({print.string(pr.restDigit(),  35)})
  output$pr.num.36a <- renderText({print.string(pr.firstDigit(), 36)})
  output$pr.num.36b <- renderText({print.string(pr.restDigit(),  36)})
  output$pr.num.37a <- renderText({print.string(pr.firstDigit(), 37)})
  output$pr.num.37b <- renderText({print.string(pr.restDigit(),  37)})
  output$pr.num.38a <- renderText({print.string(pr.firstDigit(), 38)})
  output$pr.num.38b <- renderText({print.string(pr.restDigit(),  38)})
  output$pr.num.39a <- renderText({print.string(pr.firstDigit(), 39)})
  output$pr.num.39b <- renderText({print.string(pr.restDigit(),  39)})
  output$pr.num.40a <- renderText({print.string(pr.firstDigit(),40)})
  output$pr.num.40b <- renderText({print.string(pr.restDigit(), 40)})
  output$pr.num.41a <- renderText({print.string(pr.firstDigit(), 41)})
  output$pr.num.41b <- renderText({print.string(pr.restDigit(),  41)})
  output$pr.num.42a <- renderText({print.string(pr.firstDigit(), 42)})
  output$pr.num.42b <- renderText({print.string(pr.restDigit(),  42)})
  output$pr.num.43a <- renderText({print.string(pr.firstDigit(), 43)})
  output$pr.num.43b <- renderText({print.string(pr.restDigit(),  43)})
  output$pr.num.44a <- renderText({print.string(pr.firstDigit(), 44)})
  output$pr.num.44b <- renderText({print.string(pr.restDigit(),  44)})
  output$pr.num.45a <- renderText({print.string(pr.firstDigit(), 45)})
  output$pr.num.45b <- renderText({print.string(pr.restDigit(),  45)})
  output$pr.num.46a <- renderText({print.string(pr.firstDigit(), 46)})
  output$pr.num.46b <- renderText({print.string(pr.restDigit(),  46)})
  output$pr.num.47a <- renderText({print.string(pr.firstDigit(), 47)})
  output$pr.num.47b <- renderText({print.string(pr.restDigit(),  47)})
  output$pr.num.48a <- renderText({print.string(pr.firstDigit(), 48)})
  output$pr.num.48b <- renderText({print.string(pr.restDigit(),  48)})
  output$pr.num.49a <- renderText({print.string(pr.firstDigit(), 49)})
  output$pr.num.49b <- renderText({print.string(pr.restDigit(),  49)})
  output$pr.num.50a <- renderText({print.string(pr.firstDigit(),50)})
  output$pr.num.50b <- renderText({print.string(pr.restDigit(), 50)})
  output$pr.num.51a <- renderText({print.string(pr.firstDigit(), 51)})
  output$pr.num.51b <- renderText({print.string(pr.restDigit(),  51)})
  output$pr.num.52a <- renderText({print.string(pr.firstDigit(), 52)})
  output$pr.num.52b <- renderText({print.string(pr.restDigit(),  52)})
  output$pr.num.53a <- renderText({print.string(pr.firstDigit(), 53)})
  output$pr.num.53b <- renderText({print.string(pr.restDigit(),  53)})
  output$pr.num.54a <- renderText({print.string(pr.firstDigit(), 54)})
  output$pr.num.54b <- renderText({print.string(pr.restDigit(),  54)})
  output$pr.num.55a <- renderText({print.string(pr.firstDigit(), 55)})
  output$pr.num.55b <- renderText({print.string(pr.restDigit(),  55)})
  output$pr.num.56a <- renderText({print.string(pr.firstDigit(), 56)})
  output$pr.num.56b <- renderText({print.string(pr.restDigit(),  56)})
  output$pr.num.57a <- renderText({print.string(pr.firstDigit(), 57)})
  output$pr.num.57b <- renderText({print.string(pr.restDigit(),  57)})
  output$pr.num.58a <- renderText({print.string(pr.firstDigit(), 58)})
  output$pr.num.58b <- renderText({print.string(pr.restDigit(),  58)})
  output$pr.num.59a <- renderText({print.string(pr.firstDigit(), 59)})
  output$pr.num.59b <- renderText({print.string(pr.restDigit(),  59)})
  output$pr.num.60a <- renderText({print.string(pr.firstDigit(),60)})
  output$pr.num.60b <- renderText({print.string(pr.restDigit(), 60)})
  output$pr.num.61a <- renderText({print.string(pr.firstDigit(), 61)})
  output$pr.num.61b <- renderText({print.string(pr.restDigit(),  61)})
  output$pr.num.62a <- renderText({print.string(pr.firstDigit(), 62)})
  output$pr.num.62b <- renderText({print.string(pr.restDigit(),  62)})
  output$pr.num.63a <- renderText({print.string(pr.firstDigit(), 63)})
  output$pr.num.63b <- renderText({print.string(pr.restDigit(),  63)})
  output$pr.num.64a <- renderText({print.string(pr.firstDigit(), 64)})
  output$pr.num.64b <- renderText({print.string(pr.restDigit(),  64)})
  output$pr.num.65a <- renderText({print.string(pr.firstDigit(), 65)})
  output$pr.num.65b <- renderText({print.string(pr.restDigit(),  65)})
  output$pr.num.66a <- renderText({print.string(pr.firstDigit(), 66)})
  output$pr.num.66b <- renderText({print.string(pr.restDigit(),  66)})
  output$pr.num.67a <- renderText({print.string(pr.firstDigit(), 67)})
  output$pr.num.67b <- renderText({print.string(pr.restDigit(),  67)})
  output$pr.num.68a <- renderText({print.string(pr.firstDigit(), 68)})
  output$pr.num.68b <- renderText({print.string(pr.restDigit(),  68)})
  output$pr.num.69a <- renderText({print.string(pr.firstDigit(), 69)})
  output$pr.num.69b <- renderText({print.string(pr.restDigit(),  69)})
  output$pr.num.70a <- renderText({print.string(pr.firstDigit(),70)})
  output$pr.num.70b <- renderText({print.string(pr.restDigit(), 70)})
  output$pr.num.71a <- renderText({print.string(pr.firstDigit(), 71)})
  output$pr.num.71b <- renderText({print.string(pr.restDigit(),  71)})
  output$pr.num.72a <- renderText({print.string(pr.firstDigit(), 72)})
  output$pr.num.72b <- renderText({print.string(pr.restDigit(),  72)})
  output$pr.num.73a <- renderText({print.string(pr.firstDigit(), 73)})
  output$pr.num.73b <- renderText({print.string(pr.restDigit(),  73)})
  output$pr.num.74a <- renderText({print.string(pr.firstDigit(), 74)})
  output$pr.num.74b <- renderText({print.string(pr.restDigit(),  74)})
  output$pr.num.75a <- renderText({print.string(pr.firstDigit(), 75)})
  output$pr.num.75b <- renderText({print.string(pr.restDigit(),  75)})
  output$pr.num.76a <- renderText({print.string(pr.firstDigit(), 76)})
  output$pr.num.76b <- renderText({print.string(pr.restDigit(),  76)})
  output$pr.num.77a <- renderText({print.string(pr.firstDigit(), 77)})
  output$pr.num.77b <- renderText({print.string(pr.restDigit(),  77)})
  output$pr.num.78a <- renderText({print.string(pr.firstDigit(), 78)})
  output$pr.num.78b <- renderText({print.string(pr.restDigit(),  78)})
  output$pr.num.79a <- renderText({print.string(pr.firstDigit(), 79)})
  output$pr.num.79b <- renderText({print.string(pr.restDigit(),  79)})
  output$pr.num.80a <- renderText({print.string(pr.firstDigit(),80)})
  output$pr.num.80b <- renderText({print.string(pr.restDigit(), 80)})

  output$pr.pmf <- renderPlot({
    pr.big.n <-as.integer(input$my.n)
        pr.pmf.compare(pr.seqInput(),pr.big.n)
    })

  })#close withProgress

})#close shinyServer


logMessage <- function(m) {
	cat (as.character.Date(Sys.time()), m, '\n')
}

resampleBase <- function(X, Y, size = 0.1, cl = c()) {
	logMessage("Sampling data")
	ret = list()
	ret$X = c()
	ret$Y = c()
	classes = unique(Y)
	if(length(cl) > 0)
		classes = cl
	for(c in classes) {
		indices = which(Y == c)
		cat(length(indices), " instances of class ", c, "\n")
		samples = sample(indices, min(length(indices), round(length(indices) * size)))
		ret$X = matrix(c(ret$X, X[samples, ]), ncol = ncol(X))
    ret$Y = c(ret$Y, Y[samples])
	}
	cat("From ", nrow(X), " samples to ")
	cat(nrow(ret$X), " samples.\n")
	ret
}

reducePCA <- function(X, info = 0.85) {
	logMessage("Reducting via PCA")
	print(ncol(X))
	pca = prcomp(X)
	cuminfo = cumsum(pca$sdev/sum(pca$sdev))
	plot(cuminfo)
	i = max(length(which(cuminfo <= info)), 2)
	print(i)
	print(cuminfo)
	ret = list()
	ret$i = i
  ret$x = pca$x[,1:i]
	ret$pca = pca
	print(ncol(ret$x))
	ret
}

computeRadius <- function(points) {
	radius = 0.0
	for (i in 1:nrow(points))
    for (j in 1:nrow (points))
			radius = max(radius, sqrt(t(points[i, ]) %*% points[j, ]))
	radius
}

run.experiment <- function(samples, tune.degree = c(1,2,3), tune.coef0 = c(0,1),
													 tune.cost = c(10, 100), tune.gamma = 1,
													 tune.kernel = "polynomial") {
	logMessage("Tunning svm")
	set.seed(1)
	tuned.svm = tune.svm(x = samples$X, y = as.factor(samples$Y),
		                          degree = tune.degree,
															coef0 = tune.coef0,
															cost = tune.cost,
															gamma = tune.gamma,
															kernel = tune.kernel)
	logMessage("Trainning svm")
	svm.model = svm(x = samples$X, y = as.factor(samples$Y),
										scale = FALSE, kernel = tune.kernel,
	                  degree = tuned.svm$best.parameters["degree"],
	                  cost = tuned.svm$best.parameters["cost"],
	                  gamma = tuned.svm$best.parameters["gamma"],
	                  coef0 = tuned.svm$best.parameters["coef0"])
	print('performance')
	print(tuned.svm$best.performance)
	print(tuned.svm$performance)
	logMessage("Computing rho")
	w = t(svm.model$coefs) %*% svm.model$SV
	w.norm = sqrt(sum(w^2))
	rho = 1 / w.norm
	print(rho)
	logMessage("Computing r")
	degree = tuned.svm$best.parameters["degree"]
	gamma = tuned.svm$best.parameters["gamma"]
	coef0 = tuned.svm$best.parameters["coef0"]
	points = gamma * (samples$X %*% t(samples$X) + coef0)^degree
	if(tune.kernel == 'radial') {
		X = as.matrix(sample$X)
 		ids = 1:nrow(X)
    points = outer(ids,ids, function(id1,id2) {
                        exp(-gamma*rowSums((X[id1,] - X[id2,])^2)) } )
		print(dim(points))
	}
	radius = computeRadius(points) / 2
	print(degree)
	print(coef0)
	print(radius)
	logMessage("Computing nu")
	prediction = predict(svm.model, samples$X, decision.value=T)
	xis = attr(prediction, "decision.values")
	n = length(xis)
	nu = length(which(abs(xis) / w.norm < 1)) / n
	print(nu)
	print(n)
	logMessage("finished!")
	ret = list()
	ret$radius = radius
	ret$n = as.numeric(n)
	ret$rho = rho
	ret$nu = nu
	ret$performance = tuned.svm$best.performance
	ret
}

gb.analyze <- function(n, nu, radius, rho) {
	ret = list()
	ret$gb = nu + sqrt((4 / n) * ((radius / (rho^2)) * log(n*n) + log(1 / 0.01)))
	ret$n = 0
	new.n = n
	gb = ret$gb
 	while(gb > 0.01 && new.n < 10^30) {
 		new.n = new.n * 10
 		gb = nu + sqrt((4 / new.n) * ((radius / (rho^2)) * log(new.n*new.n) + log(1 / 0.01)))
 	}
 	ret$n = new.n
 	ret
}


library(pastecs) #For creating descriptive statistic summaries
library(ggplot2) #For creating histograms with more detail than plot
library(psych) # Some useful descriptive functions
library(semTools) #For skewness and kurtosis
library(FSA) #For percentage
library(car) # For Levene's test for homogeneity of variance
library(effectsize) #To calculate effect size for t-test

setwd("~/GitHub/Data/mlsp-2014-mri")
getwd()

labels_train = read.csv(file='Train/train_labels.csv', head=TRUE, sep=",")
labels_train
# Convert 'Class' into an unordered categorical variable, and assign labels
# to each level.
labels_train$Class = factor(labels_train$Class,labels=c('Healthy Control','Schizophrenic Patient'))
summary(labels_train$Class)
# 46 control # 40 patient

## Load FNC features
# These are correlation values.

FNC_train = read.csv(file='Train/train_FNC.csv',head=TRUE,sep=",")

# Generate five number summary
summary(FNC_train[,-1])
# Group means and standard deviations
by(FNC_train[,-1], labels_train$Class, colMeans)
by(FNC_train[,-1], labels_train$Class, apply, 2, sd)

FNC_test = read.csv(file='Test/test_FNC.csv',head=TRUE,sep=",")

## Load SBM features
# These are ICA weights.

SBM_train = read.csv(file='Train/train_SBM.csv',head=TRUE,sep=",")

# Generate five number summary
summary(SBM_train[,-1])
# Group means and standard deviations
by(SBM_train[,-1], labels_train$Class, colMeans)
by(SBM_train[,-1], labels_train$Class, apply, 2, sd)


sum_mul <- function(n, m) {
  if( n > 0 && m > 0 ) {
    count <- (m-1) %/% n
    n * count * (count+1) / 2
  } else
    "INVALID"
}


=begin
  # sample-quotientfield01.rb

  require "algebra"
  Q = LocalizedRing(Integer)
  a = Q.new(3, 5)
  b = Q.new(5, 3)
  p [a + b, a - b, a * b, a / b, a + 3, 1 + a]
    #=> [34/15, -16/15, 15/15, 9/25, 18/5, 8/5]
((<_|CONTENTS>))
=end


# ......................................................................................
# .........................Cvičení 4 - Spojitá náhodná veličina.........................
# ..................Martina Litschmannová, Adéla Vrtková, Michal Béreš..................
# ......................................................................................

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

# **Obsah tohoto skriptu je pouze jako doplňující ilustrace k cvičení, není nutno znát
# ke zkoušce. Důležité je to umět spočítat ručně.**
# * Numerická integrace v Rku ####
# Rkovská funkce **integrate**
# integrate(f, a, b) = $\int_{a}^{b}f(x)dx$
# - **f** je Rková funkce (námi definovaná) která má jeden vstupní argument - vektor
# hodnot ve kterém má vrátit své hodnoty
# - **a** dolní integrační mez
# - **b** horní integrační mez

f = function(x){return(x*x)} # x^2
a = -1
b = 2
integrate(f, a, b)

#  Příklady ####
# * Příklad 1. ####
# Náhodná veličina X má distribuční funkci
# $F(x)=\begin{cases}
# 0    &      x \leq 0 \\
# cx^2 &  0 < x \leq 1 \\
# 1    &  1 < x
# \end{cases}$
# Jaké hodnoty může nabývat konstanta c?

# derovací F(x) získáme hustotu pravd. f(x)
# příslušná hustota pravděpodobnosti na intrvalu <0,1>
f = function(x){return(2*x)} # f(x) = 2x
a = 0
b = 1
integrate(f, a, b)$value

# c = 1, proto distribuční funkce vypadá takto:
F.dist = function(x){
    res = x*x     # x^2
    res[x<=0] = 0 # 0 pro x<=0
    res[x>1] = 1  # 1 pro x>1
    return(res)
}

x = seq(from = -1, to = 2, by = 0.01) # body na ose x
FX = F.dist(x) # hodnoty F(x)
plot(x, FX, type = 'l') # vykreslit jako čáru

# * Příklad 2. ####
# Rozdělení náhodné veličiny X je dáno hustotou
# $f(x)=\begin{cases}
# 2x+2 & x \in <-1;0> \\
# 0    & x \notin <-1;0>
# \end{cases}$
# Určete:
# ** 2. a) ####
# $F(x)$,

f.dens = function(x){
    res = 2*x + 2
    # pozor na x<-1 protože '<-' je v rku přiřazení
    res[x < -1] = 0 # 0 pro x<=0
    res[x > 0] = 0  # 1 pro x>1
    return(res)
}

x = seq(from = -2, to = 1, by = 0.01) # body na ose x
fx = f.dens(x) # hodnoty f(x)
plot(x, fx, cex=0.2) # vykreslit tečky (cex je velikost)

F.dist = function(x){
    res = x*x+2*x+1     # x^2+2x+1
    res[x < -1] = 0 # 0 pro x<=0
    res[x > 0] = 1  # 1 pro x>1
    return(res)
}

x = seq(from = -2, to = 1, by = 0.01) # body na ose x
FX = F.dist(x) # hodnoty f(x)
plot(x, FX, type='l') # vykreslit tečky (cex je velikost)

# ** 2. b) ####
# P(−2 ≤ X ≤ −0.5), P(−2 ≤ X ≤ −1), P(X > 0.5), P(X = 0.3)

# P(−2 ≤ X ≤ −0.5)
integrate(f.dens, -2, -0.5)$value
integrate(f.dens, -1, -0.5)$value

# P(−2 ≤ X ≤ −1)
integrate(f.dens, -2, -1)$value

# P(X > 0.5)
integrate(f.dens, 0.5, 1e16)$value # tohle nebude vždy fungovat

# P(X = 0.3)
integrate(f.dens, 0.3, 0.3)$value
# je jasné že tato pravděpodobnost je 0
# odpovídá integrálu s a=b tedy s nulovou velikostí na ose x

# ** 2. c) ####
# střední hodnotu, rozptyl a směrodatnou odchylku náhodné veličiny X.

# E(X)
x_fx = function(x){
    fx = f.dens(x)
    return(x*fx)
}
# integrujeme jen tam kde víme, že je f(x) nenulová
E_X = integrate(x_fx, -1, 0)$value
E_X
-1/3

# E(X^2)
xx_fx = function(x){
    fx = f.dens(x)
    return(x*x*fx)
}
# integrujeme jen tam kde víme, že je f(x) nenulová
E_XX = integrate(xx_fx, -1, 0)$value
E_XX
1/6

# D(X)
D_X = E_XX - E_X^2
D_X
1/18

# sigma(x)
std_X = sqrt(D_X)
std_X
sqrt(2)/6

# ** 2. d) ####
# modus $\hat{x}$

# modus = 0

# ** 2. e) ####
# medián $x_{0,5}$

x = seq(from = -2, to = 1, by = 0.001) # body na ose x
FX = F.dist(x)
plot(x, FX, type='l')
lines(c(-2, 1),c(0.5, 0.5))

x[FX >= 0.5][1] # první prvek z x pro který F(x)>=0.5
(-2+sqrt(2))/2

# * Příklad 3. ####
# Náhodná veličina Y je definována jako: Y = 3X+1, kde X je náhodná veličina z
# předcházejícího
# příkladu. Určete:
# ** 3. a) ####
# $F_Y(y)$

FY.dist = function(y){
    # spočteno ze vztahu FY(y) = P(Y < y) = P(3X + 1 < y) = ...
    x = (y-1)/3
    FY = F.dist(x)
    return(FY)
}
y = seq(from = -3, to = 2, by = 0.001) # body na ose x
FY = FY.dist(y)
plot(y, FY, type='l')

# ** 3. b) ####
# $f_Y(y)$

# derivace F_Y
fY.dens = function(y){
    res = 2/9*(y + 2)
    res[y < -2] = 0 # 0 pro x<-2
    res[y > 1] = 0  # 1 pro x>1
    return(res)
}
integrate(fY.dens,-2,1)$value # kontrola celkového integrálu
y = seq(from = -3, to = 2, by = 0.001) # body na ose x
fY = fY.dens(y)
plot(y, fY, cex=0.2)

# ** 3. c) ####
# E(Y), D(Y), σ(Y)

# E(Y)
y_fy = function(y){
    fy = fY.dens(y)
    return(y*fy)
}
# integrujeme jen tam kde víme, že je f(y) nenulová
E_Y = integrate(y_fy, -2, 1)$value
E_Y
0

# alternativně
E_Y = 3*E_X + 1
E_Y

# E(Y^2)
yy_fy = function(y){
    fy = fY.dens(y)
    return(y*y*fy)
}
# integrujeme jen tam kde víme, že je f(y) nenulová
E_YY = integrate(yy_fy, -2, 1)$value
E_YY
1/2

# D(Y)
D_Y = E_YY - E_Y^2
D_Y
1/2

# alternativně
D_Y = 3^2*D_X
D_Y

# sigma(Y)
sqrt(D_Y)
sqrt(2)/2

# * Příklad 4. (není ze sbírky) ####
# Spočtěte $\omega$ takové, aby náhodná veličina X s hustotou pravděpodobnosti:
# $f(x)=\begin{cases}
# 0 & x < 0 \\
# 3e^{-3x}    & x \geq 0
# \end{cases}$
# byla s pravděpodobností 0.3 větší než $\omega$

F.dist = function(x){
    res = 1 - exp(-3*x)
    res[x < 0] = 0 # 0 pro x<=0
    return(res)
}

x = seq(from = -1, to = 3, by = 0.001) # body na ose x
FX = F.dist(x)
plot(x, FX, type='l')
lines(c(-1, 3),c(0.7, 0.7))

x[FX >= 0.7][1]

-1/3*log(0.3)


# compute the smooth estimate of f(x) in y=f(x) + error
#        lambda is the smoothing parameter
#        npar   is the number of equispaced points of x
#        d      is degree of differencing
# output is a list of  x, fhat(x) at gridded locations of x

msmooth<- function(x,y,npar=21,lambda=10,d=2)
{
  xx<- seq(min(x)-.0001,max(x),len=npar)
  cutx<- cut(x,breaks=xx)
  xx1<- xx[-1] - (xx[2]-xx[1])/2
  midx<- exp(xx1[cutx])

# bin statistics
w <- as.numeric(table(cutx))
ybar<- as.numeric(tapply(y,cutx,mean))
  ybar[is.na(ybar)]<- 0.

delta<- matrix(0,ncol=(npar-1),nrow=(npar-2))
for (i in 1:(npar-2)){
  delta[i,i]<- -1
  delta[i,i+1]<- 1
 }
if (d==1) {R1 <- t(delta) %*% delta}

if (d==2) {
  delta2<- delta[-1,-1]%*% delta
  R1 <- t(delta2) %*% delta2
  }

fhat<- solve((diag(w) + lambda*R1),w*ybar)
return(list(x=xx1,y=fhat))
}


# Figure to simulate the growth rate of productivity

# Fixed parameters
theta <- .01
lambda <- 1
gR <- .02
phi <- 0

# Initialize dynamic process
Rcurr <- 10 # this stays the same for both
Abase <- 2 # baseline scenario
Aalt  <- 10 # alternative scenario

dfbase = NULL # initialize a dataframe
dfalt = NULL # initialize a dataframe
name = "A" # name of base case is "A"
namealt = "B" # name of alt case is "B"

# This will simulate the process for gA and A period by period
for (t in 1:250) # do for this many periods
{
  # Base case
  gA <- theta*(Rcurr^lambda)/(Abase^(1-phi)) # calculate growth rate of A given current A and R
  dfbase = rbind(dfbase, data.frame(t,Abase,gA,name)) # add this new row to base dataframe
  Abase <- (1+gA)*(Abase) # Update the value of A

  # Alternative case
  gA <- theta*(Rcurr^lambda)/(Aalt^(1-phi)) # calculate growth rate of A given current A and R
  dfalt = rbind(dfalt, data.frame(t,Aalt,gA,namealt)) # add this new row to alt dataframe
  Aalt <- (1+gA)*(Aalt) # Update the value of A

  # Update the value of R for both cases
  Rcurr <- (1+gR)*Rcurr
}

colnames(dfalt) <- c("t","Abase","gA","name") # rename cols of alt DF to match base DF
dfgraph = rbind(dfbase,dfalt) # bind these two for graphing
dfgraph$ratio <- dfgraph$gA/theta # solve for ratio of R/A

# Create animated figure
fig <- plot_ly(dfgraph,
    x = ~ratio,
    y = ~gA,
    color = ~name,
    frame = ~t,
    text = ~t,
    hoverinfo = "text",
    type = 'scatter',
    mode = 'markers',
    marker = list(size = 15)
  ) %>% animation_opts(frame=0, transition=0)
fig <- fig %>% animation_slider(
  hide = T
)
fig <- fig %>% animation_button(
  x = 1, xanchor = "right", y = 0.4, yanchor = "bottom"
)
fig <- layout(fig, title = list(text = 'Dynamics of productivity growth', x=0),
              xaxis = list(title = 'Ratio of R/A'),
              yaxis = list (title = 'Growth rate',range=c(0,.06))
)

api_create(fig, filename = "me-gA-dynamics")


#Library
library(caret)
library(mlbench)

#Data
data(BostonHousing)
set.seed(71)
Index <- createDataPartition(BostonHousing$medv, p = .7,
                                  list = FALSE,
                                  times = 1)

Train <- BostonHousing[ Index,]
Test  <- BostonHousing[-Index,]

#Training
set.seed(71)
con<-trainControl(method = "repeatedcv",
                  number = 10,
                  preProc = c("center", "scale"))

train_grid = expand.grid(mtry = 1:10)

rf_fit = train(Train[ , 1:13], Train$medv,
                 method = "rf",
                 tuneGrid = train_grid,
                 trControl=con)

rf_fit

#Result
pred <- predict(rf_fit, Test[ , 1:13])
pred2 <- predict(rf_fit, Train[ , 1:13])

sqrt(mean((pred - Test$medv)^2))
cor(pred, Test$medv)^2
cor(pred2, Train$medv)^2

#Validation
#Tropsha's R^2: (Acceptable: Tropha's R^2 > 0.5)
R2_tr <- 1 -  sum((Test$medv - (pred))^2)/sum((Test$medv - mean(pred2))^2)
R2_tr

# K:(Acceptable: 0.85 < k < 1.15)
k <- (sum(pred * Test$medv))/(sum((pred)^2))
k

#R^20 (Acceptable: (R2_tr-R_20)/R2_tr < 0.1)
R_20 <- 1 - (sum((pred - k*(pred))^2)/sum((pred - mean(pred))^2))
(R2_tr-R_20)/R2_tr


 ZGGSVD Example Program Results

 Number of infinite generalized singular values (K)
     2
 Number of finite generalized singular values (L)
     2
 Numerical rank of (A**H B**H)**H (K+L)
     4

 Finite generalized singular values
       2.0720E+00   1.1058E+00

 Unitary matrix U
                              1                           2
 1  ( -1.3038E-02, -3.2595E-01) ( -1.4039E-01, -2.6167E-01)
 2  (  4.2764E-01, -6.2582E-01) (  8.6298E-02, -3.8174E-02)
 3  ( -3.2595E-01,  1.6428E-01) (  3.8163E-01, -1.8219E-01)
 4  (  1.5906E-01, -5.2151E-03) ( -2.8207E-01,  1.9732E-01)
 5  ( -1.7210E-01, -1.3038E-02) ( -5.0942E-01, -5.0319E-01)
 6  ( -2.6336E-01, -2.4772E-01) ( -1.0861E-01,  2.8474E-01)

                              3                           4
 1  (  2.5177E-01, -7.9789E-01) ( -5.0956E-02, -2.1750E-01)
 2  ( -3.2188E-01,  1.6112E-01) (  1.1979E-01,  1.6319E-01)
 3  (  1.3231E-01, -1.4565E-02) ( -5.0671E-01,  1.8615E-01)
 4  (  2.1598E-01,  1.8813E-01) ( -4.0163E-01,  2.6787E-01)
 5  (  3.6488E-02,  2.0316E-01) (  1.9271E-01,  1.5574E-01)
 6  (  1.0906E-01, -1.2712E-01) ( -8.8159E-02,  5.6169E-01)

                              5                           6
 1  ( -4.5947E-02,  1.4052E-04) ( -5.2773E-02, -2.2492E-01)
 2  ( -8.0311E-02, -4.3605E-01) ( -3.8117E-02, -2.1907E-01)
 3  (  5.9714E-02, -5.8974E-01) ( -1.3850E-01, -9.0941E-02)
 4  ( -4.6443E-02,  3.0864E-01) ( -3.7354E-01, -5.5148E-01)
 5  (  5.7843E-01, -1.2439E-01) ( -1.8815E-02, -5.5686E-02)
 6  (  1.5763E-02,  4.7130E-02) (  6.5007E-01,  4.9173E-03)

 Unitary matrix V
                              1                           2
 1  (  9.8930E-01,  1.9041E-19) ( -1.1461E-01,  9.0250E-02)
 2  ( -1.1461E-01, -9.0250E-02) ( -9.8930E-01,  1.9041E-19)

 Unitary matrix Q
                              1                           2
 1  (  7.0711E-01,  0.0000E+00) (  0.0000E+00,  0.0000E+00)
 2  (  0.0000E+00,  0.0000E+00) (  7.0711E-01,  0.0000E+00)
 3  (  7.0711E-01,  0.0000E+00) (  0.0000E+00,  0.0000E+00)
 4  (  0.0000E+00,  0.0000E+00) (  7.0711E-01,  0.0000E+00)

                              3                           4
 1  (  6.9954E-01,  4.7274E-19) (  8.1044E-02, -6.3817E-02)
 2  ( -8.1044E-02, -6.3817E-02) (  6.9954E-01, -4.7274E-19)
 3  ( -6.9954E-01, -4.7274E-19) ( -8.1044E-02,  6.3817E-02)
 4  (  8.1044E-02,  6.3817E-02) ( -6.9954E-01,  4.7274E-19)

 Nonsingular upper triangular matrix R
                              1                           2
 1  ( -2.7118E+00,  0.0000E+00) ( -1.4390E+00, -1.0315E+00)
 2                              ( -1.8583E+00,  0.0000E+00)
 3
 4

                              3                           4
 1  ( -7.6930E-02,  1.3613E+00) ( -2.8137E-01, -3.2425E-02)
 2  ( -1.0760E+00,  3.1016E-02) (  1.3292E+00,  3.6772E-01)
 3  (  3.2537E+00,  0.0000E+00) ( -6.3858E-17,  6.3858E-17)
 4                              ( -2.1084E+00,  0.0000E+00)

 Estimate of reciprocal condition number for R
       1.3E-01

 Error estimate for the generalized singular values
       1.7E-15


library("rgl")

# ####################
# PREPARE CLUSTER DATA
# input file
file = "/tmp/KDD-Cup-1999/out/kmeans_1E-10_050_0050_03_L2NormV1_test.R_sample"
# read the entire data set
all_clusters_data <- read.csv(file)
# filter some of the clusters or not
clusters_data = subset(all_clusters_data, X0 >=0)
# clusters labels
clusters <- clusters_data[1]
# unique clusters
unique_clusters <- unique(clusters)
# unique cluster number
num_clusters <- nrow(unique_clusters)
#unlabeled data
data <- data.matrix(clusters_data[-c(1)])
random_projection <- matrix(data = rnorm(3*ncol(data)), ncol=3)
random_projection_norm <- random_projection / sqrt(rowSums(random_projection*random_projection))
projected_data <- data.frame(data %*% random_projection_norm)

# #################
# PLOT CLUSTER DATA
# open 3d window
open3d()
# resize window
par3d(windowRect = c(100, 100, 1200, 800))
# labels and points colors
colors = sapply(clusters, function(c) rainbow(num_clusters)[c])
# add legend
legend3d("topright", legend = paste('Cluster', as.matrix(unique_clusters)), pch = 16, col = colors, cex=1, inset=c(0.02))
# plot data
plot3d(projected_data, col = colors, size = 10)
# save snapshot
# snapshot3d(filename = '/tmp/3dplot.png', fmt = 'png')


#   __      _____             _              __        _
# <(o )___ |  _  |___ ___ ___| |_ ___ ___   |  |   ___| |_ ___
# ( ._> /  |   __|  _| -_|_ -|  _| -_|_ -|  |  |__| .'| . |_ -|
#  `---'   |__|  |_| |___|___|_| |___|___|  |_____|__,|___|___|
#==============================================================================
# Surface fitting
#==============================================================================
# Title          : Plotting Survival Curves.r
# Description    : Vector fitting is popular, and it provides a compact way
#                  of simultaneously displaying a large number of environmental
#                  variables. However, it implies a linear relationship between
#                  ordination and environment: direction and strength are all
#                  you need to know.
# Author         : Isaias V. Prestes <isaias.prestes@gmail.com>
# Date           : 20170324
# Version        : 0.0.1
# Usage          : Run in R 3.4
# Notes          : Original on Vegan package documentation.
# R version      : 3.4
#==============================================================================

#==============================================================================
# LIBRARY DEPENDENCE
#==============================================================================
library(vegan)

#==============================================================================
# Surfacing
#==============================================================================
data(varespec)
data(varechem)
vare.dist <- vegdist(varespec)
vare.mds <- monoMDS(vare.dist)
ordisurf(vare.mds ~ Baresoil, varechem, bubble = 5)

ef <- envfit(vare.mds, varechem, permu = 999)
ef
ef <- envfit(vare.mds ~ Al + Ca, varechem)
plot(vare.mds, display = "sites")
plot(ef)
tmp <- with(varechem, ordisurf(vare.mds, Al, add = TRUE))
with(varechem, ordisurf(vare.mds, Ca, add = TRUE, col = "green4"))


source("M:\\josef_new\\eclipse_ws\\statsmodels\\statsmodels_py34_pr\\tools\\R2nparray\\R\\R2nparray.R")
library('mgcv')
library('gamair')
d = data(mpg)

#gam_a = gam(city.mpg ~ fuel + drive + s(weight,bs="cc",k=7) + s(hp,bs="cc",k=6), data = mpg,
#            sp = c(6.46225497484073, 0.81532465890585))

#gam_a = gam(city.mpg ~ fuel + drive + s(weight,bs="bs",k=7) + s(hp,bs="bs",k=6), data = mpg)

sm_knots_w = c(1488., 1488., 1488., 1488., 1953.22222222, 2118.77777778, 2275., 2383.88888889, 2515.55555556, 2757.33333333, 3016.44444444, 3208.11111111, 4066., 4066., 4066., 4066.)
sm_knots_hp = c(48.0, 48.0, 48.0, 48.0, 68.0, 73.0, 88.0, 101.0, 116.0, 152.28571428571428, 288.0, 288.0, 288.0, 288.0)

knots_w <- data.frame(weight=sm_knots_w)
knots_h <- data.frame(hp=sm_knots_hp)
gam_a = gam(city.mpg ~ fuel + drive + s(weight,bs="bs",k=12) + s(hp,bs="bs",k=10), data = mpg, knots=c(knots_w, knots_h), family=poisson)

pls = gam_a

fname = "results_mpg_bs_poisson.py"
append = FALSE #TRUE

#redirect output to file
sink(file=fname, append=append)
write_header()
mod_name = "mpg_bs_poisson."
cat("\nmpg_bs_poisson = Bunch()\n")
cat(paste("\n", mod_name, "smooth0 = Bunch()\n", sep=""))

sm1 <- gam_a$smooth[[1]]
cat_items(sm1, prefix=paste(mod_name, "smooth0.", sep=""))
#, blacklist=c())
cat("\n")
cat(convert.numeric(pls$smooth[[1]]$S[[1]], name=paste(mod_name, "smooth0.S", sep="")))
cat("\n")
cat_items(pls, prefix=mod_name, blacklist=c("eq", "control"))
cat("\n")
pls_summ = summary(pls)
cat_items(pls_summ, prefix=mod_name, blacklist=c("eq", "control"))

params = coef(pls)
cat("\n")
cat(convert.numeric(params, name=paste(mod_name, "params", sep="")))

# stop redirecting output
sink()


#the upper .025 percentile for the F distribution with df1 = 10 and df2 =7 is

upper_percentile=qf(1-0.025,10,7)
lower_percentile=1/upper_percentile
print(lower_percentile)