MGRAST_plot_pco <- function(
                            file_in,
                            input_dir = "./",
                            input_type = "file",
                            output_PCoA_dir = "./",
                            print_dist = 1,
                            output_DIST_dir = "./",
                            dist_method = "euclidean",
                            headers = 1,
                            debug=FALSE
                            )

{
  # load packages
  suppressPackageStartupMessages(library(matlab))
  suppressPackageStartupMessages(library(ecodist))
  #suppressPackageStartupMessages(library(Cairo))
  #suppressPackageStartupMessages(library(gplots))

  # define sub functions
  func_usage <- function() {
    writeLines("
     You supplied no arguments

     DESCRIPTION: (MGRAST_plot_pco.r):
     This script will perform a PCoA analysis on the inputdata
     using the selected distance metric.  Output always produces a
     *.PCoA file that has the normalized eigenvalues (top n lines)
     and eigenvectors (bottom n x m matris, n lines) where n is the
     number of variables (e.g.subsystems), and m the number of
     samples. You can also choose to produce *.DIST files that contain
     the distance matrix used to generate the PCoA.

     USAGE: MGRAST_plot_pca(
                            file_in = no default arg                               # (string)  input data file
                            input_type = \"file\"                                   # (string) file or r_matrix
                            input_dir = \"./\"                                       # (string)  directory(path) of input
                            output_PCoA_dir = \"./\"                                 # (string)  directory(path) for output PCoA file
                            print_dist = 0                                         # (boolean) print the DIST file (distance matrix)
                            output_DIST_dir = \"./\"                                 # (string)  directory(path) for output DIST file
                            dist_method = \"bray-curtis\"                            # (string)  distance/dissimilarity metric,
                                          (choose from one of the following options)
                                          \"euclidean\" | \"maximum\"     | \"canberra\"    |
                                          \"binary\"    | \"minkowski\"   | \"bray-curtis\" |
                                          \"jacccard\"  | \"mahalanobis\" | \"sorensen\"    |
                                          \"difference\"| \"manhattan\"
                            headers = 0                                            # (booealan) print headers in output PCoA file
                            )\n"
               )
    stop("MGRAST_plot_pco stopped\n\n")
  }

  find_dist <- function(my_data, dist_method)
    {
      switch(dist_method,
             "euclidean" = dist(my_data, method = "euclidean"),
             "maximum" = dist(my_data, method = "maximum"),
             "manhattan" = dist(my_data, method = "manhattan"),
             "canberra" = dist(my_data, method = "canberra"),
             "binary" = dist(my_data, method = "binary"),
             "minkowski" = dist(my_data, method = "minkowski"),

             #"bray-curtis" = distance(my_data, method = "bray-curtis"), # could not handle large data 1-12-12

             "bray-curtis" = bcdist(my_data), # 1-12-12
             #"bray-curtis" = vegdist(my_data, method="bray"), # 1-12-12
             #"bray-curtis" = designdist(my_data, method = "(A+B-2*J)/(A+B)") # 1-12-12

             "jaccard" = distance(my_data, method = "jaccard"),
             "mahalanobis" = distance(my_data, method = "mahalanobis"),
             "sorensen" = distance(my_data, method = "sorensen"),
             "difference" = distance(my_data, method = "difference")
             # unifrac
             # weighted_unifrac

             # distance methods with {stats}dist: dist(x, method = "euclidean", diag = FALSE, upper = FALSE, p = 2)
             #      euclidean maximum manhattan canberra binary minkowski

             # distance methods with {ecodist}distance: distance(x, method = "euclidean")
             #      euclidean bray-curtis manhattan mahalanobis jaccard "simple difference" sorensen

             )
    }

  # stop and give the usage if the proper number of arguments is not given
  if ( nargs() == 0 ){
    func_usage()
  }

  # load data

  #writeLines("FILE-IN")
  #writeLines(file_in)
  #input_data_path = gsub(" ", "", paste(input_dir, file_in))
  #writeLines("INPUT-DATA-PATH")
  #writeLines(input_data_path)
  #my_data <<- flipud(rot90(data.matrix(read.table(input_data_path, row.names=1, header=TRUE, sep="\t", comment.char="", quote="")))) # edited on 12-14-12, stop character conversions in column names

  if( debug==TRUE ){print("MADE IT HERE 1")}

  if ( identical(input_type, "file") ){
    if( debug==TRUE ){print("MADE IT HERE 2a")}
    input_data_path = gsub(" ", "", paste(input_dir, file_in))
    my_data <<- flipud(rot90(data.matrix(read.table(input_data_path, row.names=1, check.names=FALSE, header=TRUE, sep="\t", comment.char="", quote=""))))
  } else if ( identical(input_type, "r_matrix") ) {
    if( debug==TRUE ){print("MADE IT HERE 2.b")}
    my_data <<- flipud(rot90(file_in))
  } else {
    if( debug==TRUE ){print("MADE IT HERE 2.c")}
    stop("input_type value is not valid, must be file or r_matrix")
  }

  if( debug==TRUE ){print("MADE IT HERE 3")}

  num_data_rows = dim(my_data)[1] # substitute 0 for NA's if they exist in the data
  num_data_cols = dim(my_data)[2]
  for (row_num in (1:num_data_rows)){
    for (col_num in (1:num_data_cols)){
      #my_data[row_num, col_num] = as.integer(my_data[row_num, col_num]) # added 1-12-12 to fix "Error in vector("double", length) : vector size cannot be NA ...
      if (is.na(my_data[row_num, col_num])){
        my_data[row_num, col_num] <<- 0
      }
    }
  }

  if( debug==TRUE ){print("MADE IT HERE 4")}

  # a bit for naming outputs
  if( identical(input_type, "r_matrix") ){
    file_in.name <- deparse(substitute(file_in))
  } else {
    file_in.name <- file_in
  }

  # calculate distance matrix
  dist_matrix <<- find_dist(my_data, dist_method)
  DIST_file_out <- gsub(" ", "", paste(output_DIST_dir, file_in.name, ".", dist_method, ".DIST"))
  if (print_dist > 0) { write_file(file_name = DIST_file_out, data = data.matrix(dist_matrix)) }

  if( debug==TRUE ){print("MADE IT HERE 5")}

  # perform the pco
  my_pco <<- pco(dist_matrix)

  if( debug==TRUE ){print("MADE IT HERE 6")}

  # scale eigen values from 0 to 1, and label them
  eigen_values <<- my_pco$values
  scaled_eigen_values <<- (eigen_values/sum(eigen_values))
  for (i in (1:dim(as.matrix(scaled_eigen_values))[1])) {names(scaled_eigen_values)[i]<<-gsub(" ", "", paste("PCO", i))}
  scaled_eigen_values <<- data.matrix(scaled_eigen_values)
  #for (i in (1:dim(as.matrix(scaled_ev))[1])) dimnames(scaled_ev)[i]<<-gsub(" ", "", paste("PCO", i))

  if( debug==TRUE ){print("MADE IT HERE 7")}

  # label the eigen vectors
  eigen_vectors <<- data.matrix(my_pco$vectors)
  dimnames(eigen_vectors)[[1]] <<- dimnames(my_data)[[1]]

  if( debug==TRUE ){print("MADE IT HERE 8")}

  # write eigen values and then eigen vectors to file_out
  PCoA_file_out = gsub(" ", "", paste(output_PCoA_dir, file_in.name, ".", dist_method, ".PCoA"))

  if ( headers == 1 ){
    write(file = PCoA_file_out, paste("# file_in    :", file_in.name,
            "\n# dist_method:", dist_method,
            "\n#________________________________",
            "\n# EIGEN VALUES (scaled 0 to 1) >",
            "\n#________________________________"),
          append=FALSE)
    write.table(scaled_eigen_values, file=PCoA_file_out, col.names=FALSE, row.names=TRUE, append = TRUE, sep="\t", eol="\n")
  }else{
    write.table(scaled_eigen_values, file=PCoA_file_out, col.names=FALSE, row.names=TRUE, append = FALSE, sep="\t", eol="\n")
  }

  if( debug==TRUE ){print("MADE IT HERE 9")}

  if ( headers == 1 ){
    write(file = PCoA_file_out, paste("#________________________________",
            "\n# EIGEN VECTORS >",
            "\n#________________________________"),
          append=TRUE)
  }

  if( debug==TRUE ){print("MADE IT HERE 10")}

  #write.table(eigen_vectors, file=PCoA_file_out, col.names=FALSE, row.names=TRUE, append = TRUE, sep="\t")
  write.table(eigen_vectors, file=PCoA_file_out, col.names=FALSE, row.names=TRUE, append = TRUE, sep="\t", eol="\n")

  if( debug==TRUE ){print("MADE IT HERE 11")}

}

write_file <- function(file_name, data) {
  write.table(data, file=file_name, col.names=NA, row.names=TRUE, append = FALSE, sep="\t", quote = FALSE, eol="\n")
}


tb_lech_saiso <- function(x) {
    cat("tb: ", mean(x), "\n")
    # tinh do lech tieu chuan
    cat("lech tieu chuan: ", sd(x), "\n")
    # tinh
    cat("sai so chuan: ", sd(x)/sqrt(length(x)), "\n")
}

func_6_1 <- function() {
    x <- c(1, 2, 5, 7, -3, 0, 5, 1, 5, 6)
    y <- c(2, 2, 0, -5, 7, 8, 11, 9, 3, 2)
    cat("x + y: ", x + y, "\n")
    cat("x * y: ", x * y, "\n")
    cat("x - y: ", x - y, "\n")
    # z phan chan cua x
    z <- c()
    for (i in x) {
        if (i%%2 == 0) {
            z <- c(z, i)
        }
    }
    cat("z: ", z, "\n")
    # t phan le cua y
    t <- c()
    for (i in y) {
        if (i%%2 == 0) {
            t <- c(t, i)
        }
    }
    cat("t: ", t, "\n")
    # w lon hon 0
    w <- c()
    for (i in x) {
        if (i > 0) {
            w <- c(w, i)
        }
    }
    for (i in y) {
        if (i > 0) {
            w <- c(w, i)
        }
    }
    cat("w: ", w, "\n")
    # tb, lech, sai so
    cat("x: \n")
    tb_lech_saiso(x)
    cat("min: ", min(x), " max: ", max(x), "\n")
    cat("tang dan: ", sort(x), "\n")
    cat("y: \n")
    tb_lech_saiso(y)
    cat("min: ", min(y), " max: ", max(y), "\n")
    cat("giam dan", sort(y, decreasing = T), "\n")
}


# K-Nearest Neighbor classification model for machine learning.
#
# The idea of K Nearest Neighbors classification is to best divide and separate
# the data based on clustering the data and classifying based on the proximity
# to it's K closest neighbors and their classifications.

# Importing the data set
dataset = read.csv('Social_Network_Ads.csv')
dataset = dataset[, 3:5]

# Splitting the Dataset into a Training set and a Test set
# install.packages('caTools')
# library(caTools)
set.seed(123) # choose random number, only same number for debugging
split = sample.split(dataset$Purchased, SplitRatio = 0.75)
training_set = subset(dataset, split==TRUE)
test_set = subset(dataset, split==FALSE)

# Feature scaling, normalize scale is important. Especially on algorithms
# involving euclidian distance. Two main feature scaling formulas are:
# Standardisation: x_stand = (x-mean(x))/(standard_deviation(x))
# Normalisation: x_norm = (x-min(x))/(max(x)-min(x))
training_set[, 1:2] = scale(training_set[, 1:2])
test_set[, 1:2] = scale(test_set[, 1:2])

# Fitting the K-Nearest Neighbor classification model to the training_set
# and predicting the Test set results
# library(class)
y_pred = knn(train = training_set[, -3],
             test = test_set[, -3],
             cl = training_set[, 3],
             k = 5)

# Making the Confusion Matrix
cm = table(test_set[, 3], y_pred)

# Plot the training_set results
# install.packages('ElemStatLearn')
# library(ElemStatLearn)
set = training_set
X1 = seq(min(set[, 1]) - 1, max(set[, 1]) + 1, by = 0.01)
X2 = seq(min(set[, 2]) - 1, max(set[, 2]) + 1, by = 0.01)
grid_set = expand.grid(X1, X2)
colnames(grid_set) = c('Age', 'EstimatedSalary')
y_grid = knn(train = training_set[, -3],
             test = grid_set,
             cl = training_set[, 3],
             k = 5)
plot(set[, -3],
     main = 'K-Nearest Neighbor classification model (Training set)',
     xlab = 'Age', ylab = 'Estimated Salary',
     xlim = range(X1), ylim = range(X2))
contour(X1, X2, matrix(as.numeric(y_grid), length(X1), length(X2)), add = TRUE)
points(grid_set, pch = '.', col = ifelse(y_grid == 1, 'springgreen3', 'tomato'))
points(set, pch = 21, bg = ifelse(set[, 3] == 1, 'green4', 'red3'))

# Plot the test_set results
# install.packages('ElemStatLearn')
# library(ElemStatLearn)
set = test_set
X1 = seq(min(set[, 1]) - 1, max(set[, 1]) + 1, by = 0.01)
X2 = seq(min(set[, 2]) - 1, max(set[, 2]) + 1, by = 0.01)
grid_set = expand.grid(X1, X2)
colnames(grid_set) = c('Age', 'EstimatedSalary')
y_grid = knn(train = training_set[, -3],
             test = grid_set,
             cl = training_set[, 3],
             k = 5)
plot(set[, -3],
     main = 'K-Nearest Neighbor classification model (testing set)',
     xlab = 'Age', ylab = 'Estimated Salary',
     xlim = range(X1), ylim = range(X2))
contour(X1, X2, matrix(as.numeric(y_grid), length(X1), length(X2)), add = TRUE)
points(grid_set, pch = '.', col = ifelse(y_grid == 1, 'springgreen3', 'tomato'))
points(set, pch = 21, bg = ifelse(set[, 3] == 1, 'green4', 'red3'))


# Clase 2022-03-15
# Listas
rm(list = ls())
A <- matrix(1:6, 3, 2)
m1 <- rowMeans(A)
m2 <- colMeans(A)
minA <- min(A)
maxA <- max(A)
nomb <- c("col1", "col2", "col3")
cond <- A > mean(A) + sd(A)
cond
A
lista <- list(A, m1, m2, minA, maxA, nomb, cond)
lista

lista <- list(
    matriz = A, med_fil = m1, med_col = m2, minimo = minA, maximo = maxA,
    nombres = nomb, cond = cond
)
lista[["matriz"]]
lista$matriz

class(lista)
lapply(lista, class)
lapply(lista, mean)

sapply(lista, class)
sapply(lista, mean)

unlist(lista)

class(lista[1])
class(lista[[1]])

x <- rnorm(100)
res <- hist(x)
res
sum(diff(res$breaks) * res$density)

#
# --- DATA FRAMES ----------------------------------------------------------------
#
rm(list = ls())
dni <- c("22456715A", "22456716B", "22456717C", "22456718D", "22456719E")
edad <- c(45, 35, 52, 60, 25)
sexo <- factor(c("Hombre", "Mujer", "Hombre", "Mujer", "Hombre"))
estudios <- factor(c("superior", "superior", "profesional", "medio", "profesional"))
salario <- c(2500, 1500, 2000, 1200, 1800)

datos <- data.frame(dni, edad, sexo, estudios, salario)
datos
class(datos)
names(datos)
str(datos)

summary(datos)

datos[3] # Tratar como lista
datos[3, ] # Tratar como matriz
datos[, 3]

datos[1:2, c("edad", "salario")]
datos[, c(-1, -3, -4)]

model <- lm(datos$salario ~ datos$edad)
model
plot(model)

sample(datos, size = 2) # same as
datos[sample(seq_len(length(datos)), 2)]

mtcars
head(mtcars)
tail(mtcars)

subset(mtcars, vs == 0 & hp > 90)

subset(mtcars, vs == 0 & hp > 90, select = c(-vs))

# Transformar la masa de libras a kg:
transform(mtcars, wt = wt / 2.2046)
transform(mtcars, wtkg = wt / 2.2046)
# --------------------------------------------------------------------------------
# within:
mtcars2 <- within(mtcars, {
    vs <- factor(vs, labels = c("V", "S"))
    am <- factor(am, labels = c("automatic", "manual"))
    cyl <- ordered(cyl)
    gear <- ordered(gear)
    carb <- ordered(carb)
})
mtcars2

with(mtcars2, boxplot(mpg ~ vs))
with(subset(mtcars2, vs == "V"), hist(mpg, main = "vs=V"))
with(subset(mtcars2, vs == "S"), hist(mpg, main = "vs=S"))

# --------------------------------------------------------------------------------
# Comprobación de tipo y casteo

x <- c(1, 2, 2, 1, 2, 1, 1, 1)
is.numeric(x)
is.factor(x)
x <- as.factor(x)
x
class(x)
as.matrix(1:2)
as.complex(1:2)
A <- matrix(1:4, 2, 2)
is.numeric(A)
as.numeric(A)
D <- as.data.frame(A)
is.data.frame(D[1])
is.data.frame(D[1, ])
is.data.frame(D[, 1])
is.vector(D[, 1])
as.numeric(factor(c("H", "M")))
hh <- hist(runif(100), plot = FALSE)
is.list(hh)


"
Последовательно выполнить операции:
3/7
3/7 – 0.4285714
Объяснить полученный результат
."
print(3/7)
result <- 3/7 - 0.4285714
print(result)


## Set up and plot hypothetical paths of productivity process

## Set up scenarios
# Each scenario has ID, theta, lambda, phi, gR, R0, A0
scenario <- c('A','B','C','D','E')
theta <- c(.01,.01,.01,.01,.01)
lambda <- c(1,1,1,1,.8)
phi <- c(0,.8,-.8,0,0)
gR <- c(.02,.02,.01,.04,.02)
R0 <- c(1,1,2,1,1)
A0 <- c(1,10,1,.9,10)
label <- c('C','B','D','E','A') # allows different label for test purposes

# Year vector gives total periods to run over
year <- c(0:400)
s <- 0 # initializes vector

# Merge year and scenario data to create scenario/year dataframe
all_scenario <- data.frame(scenario,theta,lambda,phi,gR,R0,A0,label) # combine scenario parameters
year_scenario <- expand.grid(year,scenario) # create year/scenario combinations
names(year_scenario) <- c("year","scenario")
s <- merge(year_scenario,all_scenario,by="scenario") # add parameters to year/scenario combos

# Make calculations of various values using theory
# z is A^1-phi/R^lambda state variable, solved for first, then extract info
s$conv <- 1-s$lambda*s$gR
s$z <- (s$conv^s$year)*(s$A0^(1-s$phi))/(s$R0^(s$lambda)) + (1-s$conv^s$year)*(1-s$phi)*s$theta/(s$lambda*s$gR)
s$RA <- 1/s$z # put this in R/A form
s$gA <- s$theta/s$z # growth rate of A follows directly
s$R <- s$R0*(1+s$gR)^(s$year) # constant growth of R
s$lnA <- log(s$z)/(1-s$phi) + s$lambda*log(s$R)/(1-s$phi) # actual log of productivity

# Plot figure of scenarios and their BGP's
fig <- plot_ly(s, x = ~year, y = ~lnA, linetype = ~scenario, type = 'scatter', mode = 'lines')
#fig <- add_trace(fig, x = ~year, y = ~lnystar, linetype = ~scenario, type = 'scatter', mode = 'lines')
fig <- layout(fig, title = list(text = 'Log productivity', x=0),
              xaxis = list(title = 'Year'),
              yaxis = list (title = 'Log of productivity (A)'),
              hovermode="x unified")
#api_create(fig, filename = "sim-prod-lnA")

fig <- plot_ly(s, x = ~year, y = ~gA, linetype = ~scenario, type = 'scatter', mode = 'lines')
fig <- layout(fig, title = list(text = 'Growth rate of productivity', x=0),
              xaxis = list(title = 'Year'),
              yaxis = list (title = 'Growth rate of productivity'),
              hovermode="x unified")
#api_create(fig, filename = "sim-prod-gA")

fig <- plot_ly(s, x = ~year, y = ~z, linetype = ~scenario, type = 'scatter', mode = 'lines')
fig <- layout(fig, title = list(text = 'R/A ratio', x=0),
              xaxis = list(title = 'Year'),
              yaxis = list (title = 'R/A ratio'),
              hovermode="x unified")
#api_create(fig, filename = "sim-prod-RA")


library(tidyverse)

# Step 1: Call the pdf command to start the plot
pdf(file = "/Users/ishasharma/Desktop/plot.pdf",   # The directory you want to save the file in
    width = 40, # The width of the plot in inches
    height = 40) # The height of the plot in inches

# This function creates the segments of the original polygon
polygon <- function(n) {
  tibble(
    x    = accumulate(x+cos(.y*2*pi/n)),
    y    = accumulate(x+sin(.y*2*pi/n)),
    xend = accumulate(2:n,     ~.x+cos(.y*2*pi/n), .init = cos(2*pi/n)),
    yend = accumulate(2:n,     ~.x+sin(.y*2*pi/n), .init = sin(2*pi/n)))
}

# This function creates segments from some mid-point of the edges
mid_points <- function(d, p, a, i, FUN = ratio_f) {
  d %>% mutate(
    angle=atan2(yend-y, xend-x) + a,
    radius=FUN(i*80),
    x=p*xend,
    y=p*yend,
    xend=x+radius*cos(angle),
    yend=y+radius*sin(angle)) %>%
    select(x, y, xend, yend)
}

# This function connect the ending points of mid-segments
con_points <- function(d) {
  d %>% mutate(
    x=xend,
    y=yend,
    xend=lead(x, default=first(x)),
    yend=lead(y, default=first(y))) %>%
    select(x, y, xend, yend)
}

edges <- 30   # Number of edges of the original polygon
niter <- 250 # Number of iterations
pond <- 0.24  # Weight to calculate the point on the middle of each edge
step  <- 130  # Number of times to draw mid-segments before connect ending points
alph  <- 0.25 # transparency of curves in geom_curve
angle <- 2.6 # angle of mid-segment with the edge
curv <- 90   # Curvature of curves
line_color <- "gray98" # Color of curves in geom_curve
back_color <- "indianred1" # Background of the ggplot
ratio_f <- function(x) {sin(cos(900)/5660)} # To calculate the longitude of mid-segments

# Generation on the fly of the dataset
accumulate(.f = function(old, y) {
  if (y%%step!=0) mid_points(old, pond, angle, y) else con_points(old)
}, 1:niter,
.init=polygon(edges)) %>% bind_rows() -> df

# Plot
ggplot(df)+
  geom_curve(aes(x=x, y=y, xend=xend, yend=yend),
             curvature = curv,
             color=line_color,
             alpha=alph)+
  coord_equal()+
  theme(legend.position  = "none",
        panel.background = element_rect(fill=back_color),
        plot.background  = element_rect(fill=back_color),
        axis.ticks       = element_blank(),
        panel.grid       = element_blank(),
        axis.title       = element_blank(),
        axis.text        = element_blank())

# Step 3: Run dev.off() to create the file!
dev.off()


#number of trials
n<-1000
#  the probability of success of single event  is
z<-0.001
Mean<-n*z
print(Mean)
 # Applying the Poisson probability distribution with U= 1

U<-1
# probability that none of a  patients administered the drug experiences a particular side effect

y<-0
probability_nopatientsideeffect<-((U^y)*(exp(1)^-U))/factorial(y)
print(probability_nopatientsideeffect)


# Graph chance of exceedance for a parameter -----------------------------------------

require(NADA)

  Param_ROS <- cenros(ParamData$new_Result_Value, ParamData$nonDetect_Flag)
  plot(Param_ROS)

  cor_value <- sqrt(summary(Param_ROS)$r.squared)
  nDetects  <- Case.list$num.Detects[i]

###  probability plot coefficient test - See Helsel and Hirsch 2002, the following is from table B3.
###  alpha = 0.05
###  Ho is that data come from log-normal distribution

  k_PPCC <- c(3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20,
              21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36,
             37, 38, 39, 40, 41, 42, 43, 46, 47, 50, 55, 60, 65, 70, 75, 80, 90, 100)
  r_star <- c(0.879, 0.868, 0.88, 0.888, 0.898, 0.906, 0.912, 0.918, 0.923, 0.928,
              0.932, 0.935, 0.939, 0.941, 0.944, 0.946, 0.949, 0.951, 0.952, 0.954,
              0.956, 0.957, 0.959, 0.96, 0.961, 0.962, 0.963, 0.964, 0.965, 0.966,
              0.967, 0.968, 0.969, 0.969, 0.97, 0.971, 0.971, 0.972, 0.973, 0.973,
              0.974, 0.975, 0.976, 0.977, 0.979, 0.98, 0.981, 0.983, 0.984, 0.985,
              0.986, 0.987)
  r_star_selected <- r_star[max(which(k_PPCC <= nDetects))]

  if (cor_value < r_star_selected) {
    PPCC <- "reject Ho"
  } else {
    PPCC <- "do not reject Ho"
  }

  Case.list[i,"ROS_correlation"] <- cor_value
  Case.list[i,"PPCC_test"] <- PPCC


max.subseq <- function(x) {
  cumulative <- cumsum(x)
  min.cumulative.so.far <- Reduce(min, cumulative, accumulate=TRUE)
  end <- which.max(cumulative-min.cumulative.so.far)
  begin <- which.min(c(0, cumulative[1:end]))
  if (end >= begin) x[begin:end] else x[c()]
}


pred_regression <- function(df.thread_cluster){
  X <- t(as.matrix(df.thread_cluster[,1:6]))
  X <- rbind(rep(1, dim(X)[2]),X)
  y <- as.matrix(df.thread_cluster[,7])

  par(mfrow=c(1,1))
  alphaI <- diag(dim(X)[1])*0.01
  b_mle <- (solve(X%*%t(X)+alphaI)%*%X)%*%y
  preds <- t(X)%*%b_mle
  plot(preds, ylim=c(0,max(y)))
  lines(y, col='red')
  title(paste("Predictions with linear regression. SSE:", (1/length(y))*sqrt(sum((preds-y)^2))))
}


setwd(dirname(rstudioapi::getActiveDocumentContext()$path))

df    <- read.table("../data/workshops.csv", h = T, sep = ";")
score <- tapply(df$Overall, df$ID, mean)
size  <- tapply(df$Overall, df$ID, length)
df    <- data.frame(score, size)

#### ordinary least squares ----------------------------------------------------
summary(lm(score ~ size))

#### bootstrap -----------------------------------------------------------------
library(boot)
m <- 500

stat_fn <- function(data, idx) {
  lm(data[idx, 1] ~ data[idx, 2])$coeff
}

df <- rbind(df, df) # pretending that we have more data
res <- boot(df, stat_fn, R = m)
boot.ci(res, index = 1, type = "perc")
boot.ci(res, index = 2, type = "perc")

#### update plot ---------------------------------------------------------------
library(ggplot2)

g1 <- ggplot(df, aes(size, score)) +
  geom_point() +
  geom_smooth(formula = y ~ x, method = "lm", se = FALSE) +
  xlab("number of participants") +
  ylab("average overall score") +
  geom_abline(slope = res$t[,2], intercept = res$t[,1], alpha = 0.1, colour = "red")
g1


 DSBGVX Example Program Results

 Number of eigenvalues found =    1

 Eigenvalues
     0.0992
 Selected eigenvectors
          1
 1   0.6729
 2  -0.1009
 3   0.0155
 4  -0.3806


rm(list=ls())

A <- 1

A
A+6
B = 2
B
A <- B
A   #Ahora A toma el valor de B, y B continua conservando el mismo valor
B
## R base

#Redefinimos los valores A y B
A <-  10
B  <-  20
#Realizamos comparaciones lógicas

A >  B
A >= B
A <  B
A <= B
A == B
A != B

C <- A != B
C
## Operadores aritméticos:

#suma
A <- 5+6
A
#Resta
B <- 6-8
B
#cociente
C <- 6/2.5
C
#multiplicacion
D <- 6*2.5
D

## Funciones:
paste("Pega","estas",4,"palabras", sep = " ")

#Puedo concatenar caracteres almacenados en objetos
paste(A,B,C,sep = "**")

# Paste0 pega los caracteres sin separador
paste0(A,B,C)

1:5

sum(1:5)
mean(1:5,na.rm = TRUE)

A <-  1
class(A)

A <-  paste('Soy', 'una', 'concatenación', 'de', 'caracteres', sep = " ")
A
class(A)

A <- factor("Soy un factor, con niveles fijos")
class(A)

### Vectores

C <- c(1, 3, 4)
C

C <- C + 2
C

D <- C + 1:3 #esto es equivalente a hacer 3+1, 5+2, 6+9
D

E <- c("Carlos","Federico","Pedro")
E

E[2]

elemento2 <-  E[2]
elemento2
rm(elemento2)
elemento2
E[2] <- "Pablo"
E

### Data Frames

INDICE  <- c(100,   100,   100,
             101.8, 101.2, 100.73,
             102.9, 102.4, 103.2)

FECHA  <-  c("Oct-16", "Oct-16", "Oct-16",
             "Nov-16", "Nov-16", "Nov-16",
             "Dic-16", "Dic-16", "Dic-16")

GRUPO  <-  c("Privado_Registrado","Público","Privado_No_Registrado",
             "Privado_Registrado","Público","Privado_No_Registrado",
             "Privado_Registrado","Público","Privado_No_Registrado")

Datos <- data.frame(INDICE, FECHA, GRUPO)
Datos

Datos$FECHA
Datos[3,2]
Datos$FECHA[3]

Datos$FECHA[3,2]

Datos[Datos$FECHA=="Dic-16",]

###Por separado
Indices_Dic <- Datos$INDICE[Datos$FECHA=="Dic-16"]
Indices_Dic

mean(Indices_Dic)

### Todo junto
mean(Datos$INDICE[Datos$FECHA=="Dic-16"])

### Listas
superlista <- list(A,B,C,D,E,FECHA, DF = Datos, INDICE, GRUPO)
superlista

superlista$DF$FECHA[2]

# Lectura y escritura de archivos

## .csv  y  .txt
individual_t117 <- read.table(file = 'Fuentes/usu_individual_t117.txt',sep=";", dec=",", header = TRUE, fill = TRUE)

#View(individual_t117)
names(individual_t117)
summary(individual_t117)[,c(8,10,31,133)]
head(individual_t117)[,1:5]

## Excel
# install.packages("openxlsx") # por única vez
library(openxlsx) #activamos la librería

#creamos una tabla cualquiera de prueba
x <- 1:10
y <- 11:20
tabla_de_R <- data.frame(x,y)

# escribimos el archivo
write.xlsx( x = tabla_de_R, file = "archivo.xlsx",row.names = FALSE)
#Donde lo guardó? Hay un directorio por default en caso de que no hayamos definido alguno.
getwd()

#Si queremos exportar multiples dataframes a un Excel, debemos armar previamente una lista de ellos. Cada dataframe, se guardará en una pestaña de excel, cuyo nombre correspondera al que definamos para cada Dataframe a la hora de crear la lista.
Lista_a_exportar <- list("Indices Salarios" = Datos,
                         "Tabla Numeros" = tabla_de_R)

write.xlsx( x = Lista_a_exportar, file = "archivo_2_hojas.xlsx",row.names = FALSE)

#leemos el archivo especificando la ruta (o el directorio por default) y el nombre de la hoja que contiene los datos
Indices_Salario <- read.xlsx(xlsxFile = "archivo_2_hojas.xlsx",sheet = "Indices Salarios")
#alternativamente podemos especificar el número de orden de la hoja que deseamos levantar
Indices_Salario <- read.xlsx(xlsxFile = "archivo_2_hojas.xlsx",sheet = 1)
Indices_Salario

Clase 2 - R Base/Clase 1- Introduccion.r


a = 91:100
class(a)
is.vector(a)
a[1]
a[1:4]
a+1
a[1]-3
a/2
a%%2
a%/%2
a[a<95]
a[a==92]
a[a==101]
a=c("M","F","M")
a
a[a=="F"]
b=a[a=="F"]
b = a[a!="F"]
b
a = 1:10
b = 11:20
c = 1:10
a[a > 5 & a < 8]
a[a > 5 & a < 8]
a = 1:10
b = 1:5
a+b
x = a()
b = c(b,rep(0,5))
b
a+b
a = c()
a
class(a)
a = c(1,0,0,0,1,1,1,1)
class(a)
a = as.factor(a)
a
class(a)
# convert from any form to another with as.
levels(a)
table(a) #use table function to check whether they are equal or not
b = c("E","W","E","E","N","S","W")
b
class(b)
as.factor(b)
table(b)
a = matrix(1:6, 3)
a
a[1,1]
a
a[2,2]
a[,2] # this is used almost everywhere. very important
a[1,]
a = matrix(0,3,3)
a
b = matrix(rep(0,9),3,3)
b
b = rbind(b,1:3)
b
cbind(b, 7:9)
b[1,1] = 10
b
fix(b)
a * b
a
a = matrix(1:6,3)
a
a = cbind(a, 7:9)
a
a = matrix(1:6,4)
a
b
a = matrix(rep(1:16),4,4)
a
b
a*b
a%*%b
a = t(a)
a
fact(5)
factorial(5)
a = list("Teachers",3,c("Radha", "Krishna", "Rama"))
a
class(a)
b = LETTERS[1:3]
b
class(b)
b = LETTERS[3]
b
c = list(a,b)
c
d = c(a,b)
d
x = 10
x
c[[1]]
a[[3]][2:3]
library(readxl)
sample <- read_excel("C:/users/vijaykumar/desktop/sample.xlsx")
class(sample)
a
b
b = LETTERS[1:5]
c = data.frame(a,b)
c$a
c$b
str(c)
c$b = as.character(c$b)
str(c)
student = data.frame(srn = c(1,5,7),name = c("Radha", "Krishna", "Rama"))
student
student$srn
student$name
student$srn == 5
k = student[student$srn == 5,]
k = student[student$srn == 5, student$name == "Krishna"]
k
class(k)
table(k$srn)
k = student[1:2,]
k
emp.data <- data.frame(emp_id = c(1:5), emp_name = c("Ricky", "Danish", "Mini", "Ryan", "Gary"), salary = c(600,500,671,729,943))
emp.data
dim(student)
nrow(student)
result = data.frame(emp.data$emp_name)
result
emp.data[1:2,]
emp.data[c(3,5),c(2,4)]
emp.data
student$marks = c(90,60,50)
student
fix(student)


fruits <- c("apple","orange","banana")
lenght(fruits)

dim(iris)
iris_rows <- nrow(iris)

#What code would you use to determine the column names of the `iris` dataset?

> names(iris)
[1] "Sepal.Length" "Sepal.Width"  "Petal.Length" "Petal.Width"  "Species"
> colnames(iris)
[1] "Sepal.Length" "Sepal.Width"  "Petal.Length" "Petal.Width"  "Species"

Write code that will use a function to display the first 6 rows of the `iris` data frame.

> head(iris)
  Sepal.Length Sepal.Width Petal.Length Petal.Width Species
1          5.1         3.5          1.4         0.2  setosa
2          4.9         3.0          1.4         0.2  setosa
3          4.7         3.2          1.3         0.2  setosa
4          4.6         3.1          1.5         0.2  setosa
5          5.0         3.6          1.4         0.2  setosa
6          5.4         3.9          1.7         0.4  setosa

> tail(iris)

> ozone_levels <- c(1,2,1,3,1,1)
> ozone_factor <- factor(ozone_levels, levels = 1:3, labels = c("low", "medium", "hi\
gh"))
> ozone_factor
[1] low    medium low    high   low    low
Levels: low medium high
> ozone_factor2 <- factor(ozone_levels, levels = c(2,1,3), labels = c("medium", "low\
", "high"))
> ozone_factor2
[1] low    medium low    high   low    low
Levels: medium low high

str(df)
>


#!/usr/bin/env Rscript

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

suppressMessages(library(quantreg))

nlQuantileRegression <- function(model,data,alpha=0.05)
{
	nlqrmodels <- vector(mode="list",length=2)
	func  <- y ~ a * X ^ b
	a <- coefficients(model)[1]
	b <- coefficients(model)[2]
	lmodel <- nlrq(func,data=data,start=list(a=a,b=b),tau=alpha/2)
	umodel <- nlrq(func,data=data,start=list(a=a,b=b),tau=1-(alpha/2))
	nlqrmodels[[1]] <- lmodel
	nlqrmodels[[2]] <- umodel
	return(nlqrmodels)
}

getPredictionIntervals <- function(nlqrmodels,data)
{
	intervals <- matrix(0,nrow(data),ncol=2)
	intervals[,1] <- yhat(nlqrmodels[[1]],data)
	intervals[,2] <- yhat(nlqrmodels[[2]],data)
	return(intervals)
}


x = (0:10)
> x^2
 [1]   0   1   4   9  16  25  36  49  64  81 100
> Reduce(function(y,z){return (y+z)},x)
[1] 55
> x[x[(0:length(x))] %% 2==0]
[1]  0  2  4  6  8 10


library(cubature)

is_pdf <- function(func){

  rez <- cubintegrate(func, lower = -Inf, upper = Inf, method = "pcubature")

  ifelse( round(rez$integral) == 1, return("Functia este densitate de probabilitate"), return ("Functia nu este densitate de probabilitate"))

}

f <- function(x) {
  if(x >= 0 && x <= 1)
    (exp(1)*(exp(-x)+exp(x)))/(exp(2)-1)
  else 0
}

g <- function(x) {
  if((x >= 0) && (x <= pi)) {sin(x)/2} else {0}
}

h <- function(x) {
  if((x >= 0) && (x <= pi)) {
    sin(x)/2
  } else {0}
}

div <- function(x){
  x+1
}

is_pdf(f)


# Compare means with Kruskal-Wallis test (nonparametric, because non-normal distribution)

data <- read.csv('../../results/skip_bgp_heuristic/data_all.csv', sep = ';')

# Means
aggregate(data$time, list(data$combination), median)
# None: 1232.0
# Always: 601.5
# 1000: 569.0
# 2000: 539.5
# 3000: 603.5
# 4000: 566.5
# 5000: 577.5
# 10000: 609.5

#boxplot(time ~ combination, data = data, ylab="Exec (ms)", xlab="Combination")

# H0: BGPCombined == BGPCombined1000
kruskal.test(time ~ combination, data = data[which(data$combination=='combination_1' | data$combination=='combination_2'),])
# p: 0.284
# => Accept H0, equal means => BGPCombined == BGPCombined1000

# H0: BGPCombined == BGPCombined2000
kruskal.test(time ~ combination, data = data[which(data$combination=='combination_1' | data$combination=='combination_3'),])
# p: 0.1842
# => Accept H0, equal means => BGPCombined == BGPCombined2000


setwd("C:/Users/lukaszbinden/git/jmcs-pattern-recognition/Exercise_4")

data = read.csv("stats-214950.290.csv", header = TRUE)

result=lm(data$acc~data$k+data$c_n+data$c_e)
summary(result)

plot(data$acc ~ data$k, main="Accuracy explained by k", ylab="Accuracy %", xlab="k", col="blue", pch=20)

plot(data$acc ~ data$c_n, main="Accuracy explained by c_n", ylab="Accuracy %", xlab="c_n", col="blue", pch=20)

plot(data$acc ~ data$c_e, main="Accuracy explained by c_e", ylab="Accuracy %", xlab="c_e", col="blue", pch=20)

# plot(data$acc ~ data$k+data$c_n+data$c_e, main="Accuracy explained by k,c_n+c_e", ylab="Accuracy %", xlab="k+c_n+c_e", col="blue", pch=20)


#!/usr/bin/Rscript
# simulate the binary circuit for estimating n and epsilon

args <- commandArgs(TRUE)

# Input two shares for X
x1 <- as.integer(args[1])
x2 <- as.integer(args[2])

# to customize inputs
maxN <- 80
bitLength <- 80
# input randomization parameters
randa <- 0
randb <- 0

## init
est <- 1
n <- 0
x <- x1 + x2
print(paste("Input x:  ", x))

# Estimate n and est
for (i in 1:maxN) {
  if (est < x) {
    est = 2*est
    n = n+1
  }
}

print(paste("[Rough estimate] est:  ", est))
print(paste("[Rough estimate] n:    ", n))

## scale epsilon
jEnd <- maxN - n
est <- x - est

for (i in 1:maxN) {
  if (i <= jEnd) {
    est <- 2 * est
  }

}

print(paste("Scaled epsilon:  ", est))

print("-- Server: ---")
print(paste("est - randa:  ", est - randa))
print(paste("   or (est + fieldSize):  ", est - randa + 2^bitLength))
print(paste("n - randb:  ", n - randb))

print("")
print("-- Client: ---")
print(paste("- randa:  ", randa))
print(paste("- randb:  ", randb))


# set the working directory (where the files are, so no paths are needed when loading/saving data)
# change this to your directory
# if you've already set it, no need to set it again
setwd('E:teaching/2015_acg5075_r/introR')

# read csv file with columns: month,orders,costs
# if already loaded, no need to load it again
myData = read.csv("chapter14/dataset.csv")

# regression
# dependent variable costs, independent variable orders
fit <- lm(costs ~ orders, data=myData)
summary(fit)

# Other useful functions
coefficients(fit) # model coefficients
confint(fit, level=0.95) # CIs for model parameters
fitted(fit) # predicted values
residuals(fit) # residuals
anova(fit) # anova table
vcov(fit) # covariance matrix for model parameters
influence(fit) # regression diagnostics

#diagnostics
layout(matrix(c(1,2,3,4),2,2))
plot(fit)


library(rbi)

sir.bi <- "
model sir {
  const N = 403
  const timestep = 0.1
  state S, I, R, Y
  param bet, gamm, iota
  noise infection, recovery
  sub parameter {
    bet <- 2.62110617498984
    gamm <- 0.5384615384615384
    iota <- 0.5
  }
  sub initial {
    S <- 60
    I <- 1
    R <- 342
    Y <- 0
  }
  sub transition (delta=timestep) {
    inline lambd = bet*(I+iota)/N
    inline ifrac = 1.0-exp(-lambd*timestep)
    inline rfrac = 1.0-exp(-gamm*timestep)
    infection ~ binomial(S,ifrac)
    recovery ~ binomial(I,rfrac)
    S <- S - infection
    I <- I + infection - recovery
    R <- R + recovery
    Y <- Y + infection
  }
}
"

sir.bi.model <- bi_model(lines=sir.bi)
sir.bi.obj <- libbi(model=sir.bi.model)
sir.bi.sample <- sample(sir.bi.obj,
                        target="joint",
                        end_time=54.0,
                        nsamples=1000,
                        seed=1)
sir.bi.results <- bi_read(sir.bi.sample$output_file_name)

sir.bi.results


## See Paul T von Hippel, The American Statistician 58:160-164, 2004

mvector <- c(0,0)
msigma <- matrix(c(1,0.5,0.5,1), nrow=2)
library(mvtnorm)
library(Hmisc)

# XZ <- rmvnorm(1000, mvector, msigma)
mvrnorm <- function(n, p = 1, u = rep(0, p), S = diag(p)) {
  Z <- matrix(rnorm(n * p), p, n)
  t(u + t(chol(S)) %*% Z)
}

XZ <- mvrnorm(1000, 2, mvector, msigma)

U <- rnorm(1000)
Y <- XZ[,1]+XZ[,2]+U
summary(lm(Y ~ XZ))
X <- XZ[,1]
Z <- XZ[,2]
Z.ni <- Z

type <- c('random','X<0','Y<0','Z<0')[3]
i <- switch(type,
            random= runif(1000) < .5,
            'X<0' = X<0,
            'Y<0' = Y<0,
            'Z<0' = Z<0)

Zna <- Z
Zna[i] <- NA
summary(lm(Y ~ X + Zna))

#w <- aregImpute(~monotone(Y)+monotone(X)+monotone(Zna))
#w <- aregImpute(~I(Y)+I(X)+I(Zna),fweight=.75)
w <- aregImpute(~monotone(Y)+monotone(X)+monotone(Zna), n.impute=5,
                type='regression')

plot(w)
Ecdf(Zna, add=T, col='red')
Ecdf(Z, add=T, col='green')
# plot(w$imputed$Zna, Z[is.na(Zna)])  # use if n.impute=1
# abline(a=0,b=1,lty=2)
# lm(Z[is.na(Zna)] ~ w$imputed$Zna)

coef(fit.mult.impute(Y~X+Zna, lm, w, data=data.frame(X,Zna,Y),pr=F))

#--------------------------------------------------------------------
## From Ewout Steyerberg
# Missing values: illustrate MCAR, MAR, MNAR mechanism
# linear models
library(rms)

## 1. x1 and x2 with y1 outcome
## A) X only
## B) X+Y

#########################
### Test Imputation ###
### use aregImpute in default settings
#########################

n <- 20000                                      # arbitrary sample size
x2  <- rnorm(n=n, mean=0, sd=1)               # x2 standard normal
x1   <- sqrt(.5) * x2 + rnorm(n=n, mean=0, sd=sqrt(1-.5))  # x2 correlated with x1
y1   <- 1 * x1 + 1 * x2 + rnorm(n=n, mean=0, sd=sqrt(1-0)) # generate y
# var of y1 larger with correlated x1 - x2

x1MCAR   <- ifelse(runif(n) < .5, x1, NA)          # MCAR mechanism for 50% of x1
x1MARx   <- ifelse(rnorm(n=n,sd=.8) < x2, x1, NA)  # MAR on x2, R2 50%, 50% missing (since mean x2==0)
x1MARy   <- ifelse(rnorm(n=n,sd=(sqrt(3)*.8)) >y1, x1, NA) # MAR on y, R2 50%, 50% missing (since mean y1==0)
# x1MNAR   <- ifelse(rnorm(n=n,sd=.8) < x1, x1, NA)  # MNAR on x1, R2 50%, 50% missing (since mean x1==0)
x1MNAR   <- ifelse(rnorm(n=n,sd=.8) < x1, x1, NA)  # MNAR on x1, R2 50%, 50% missing (since mean x1==0)

plot(x2, x1MARx)
plsmo(x2, is.na(x1MARx), datadensity=TRUE)
dd <- datadist(x2,x1MARx)
options(datadist='dd')
f <- lrm(is.na(x1MARx) ~ rcs(x2,4))
plot(Predict(f, x2, fun=plogis))

d <- data.frame(y1,x1,x2,x1MCAR, x1MARx,x1MARy,x1MNAR)
ols(y1~x1+x2)
ols(y1 ~ x1MARx + x2)

# MAR on x: 3 approaches; CC, MI with X, MI with X+Y

g <- aregImpute(~I(y1) + I(x1MARx) + I(x2), n.impute=5, data=d, pr=F,
    type=c('pmm','regression')[1], match='closest', plotTrans=TRUE)
plot(g)
Ecdf(x1,     add=TRUE, col='red',q=.5)
Ecdf(x1MARx, add=TRUE, col='blue',q=.5)

f <- fit.mult.impute(y1 ~ x1MARx + x2, ols, xtrans=g, data=d, pr=F)
g <- aregImpute(~y1 + x1MARx + x2, n.impute=5, data=d, pr=F, type='regression', plotTrans=TRUE)
f <- fit.mult.impute(y1 ~ x1MARx + x2, ols, xtrans=g, data=d, pr=F)

# MAR on y: 3 approaches; CC, MI with X, MI with X+Y
f  <- ols(y1~x1MARy+x2)
if(FALSE) {
Mat.imputation[i,29:32] <- c(coef(f)[2:3], sqrt(diag(vcov(f)))[2:3])
g <- aregImpute(~x1MARy + x2, n.impute=5, data=d, pr=F, type='regression')
f <- fit.mult.impute(y1 ~ x1MARy + x2, ols, xtrans=g, data=d, pr=F)
Mat.imputation[i,33:36] <- c(coef(f)[2:3], sqrt(diag(vcov(f)))[2:3])
g <- aregImpute(~y1 + x1MARy + x2, n.impute=5, data=d, pr=F, type='regression')
f <- fit.mult.impute(y1 ~ x1MARy + x2, ols, xtrans=g, data=d, pr=F)
Mat.imputation[i,37:40] <- c(coef(f)[2:3], sqrt(diag(vcov(f)))[2:3])
}


rm(list = ls())

D     = 4         # neuron diameter
sigma = D/4       # profile
td    = seq(-D/2, D/2,by=0.01)
w     = exp(-(td*td) / (2*sigma*sigma))

#pdf(file="~/filter-cs.pdf", width = 5, height = 4)

par(mar=c(4.2, 4.2, 1.0, 1.0))

plot(td, w,
     type="l",
     ylim=range(w),
     #axes=T,
     #ann=T,
     xlab="d [pixels]",
     #ylab="weight",
     las=1,
     cex.axis=1.8,
     cex.lab=2.5,
     lwd=3
     )
box()
grid()
#dev.off()


#######################################################################################################
#   MARSSFisherI function
#   Compute the observed Fisher Information Matrix at the values in the MLEobj

#   Compute the Fisher Information Matrix via Harvey (1989) and Cavanaugh & Shumway (1996) methods
#   Louis (1982) is nicely related to the derivatives used by the EM algorithm, but the
#   temporally correlation must be dealt with, e.g. Duan & Fulop (2011) A stable estimator of the information matrix
#   under EM for dependent data. Statistics and Computing 21: 83-91
#   Oakes (1999) has an approach that only involves derivatives of E(LL(theta)|data,theta') but one of the derivatives
#   will be the derivative of the E(X|data,theta') with respect to theta'.  It's not clear how to do that derivative.
#   Ho, Shumway and Ombao (2006) The state-space approach to modeling dynamic processes in Models for Intensive Longitudinal Data
#   page 157 suggest that this derivative is hard to compute.
#######################################################################################################
MARSSFisherI <- function(MLEobj, method = c("Harvey1989", "fdHess", "optim")) {
  # optim is here for debugging.  fdHess is the numerical method used for users
  method <- match.arg(method)
  if (method == "fdHess" || method == "optim") {
    obsFI <- MARSShessian.numerical(MLEobj, fun = method)
  }
  if (method == "Harvey1989") {
    obsFI <- MARSSharveyobsFI(MLEobj)
  }
  return(obsFI)
}