## Helper function to evaluate a string formula -------------------------------
EvalFormula <- function(k, expr_str) {
  .env <- new.env()
  sapply(c(k), function(k) {
    .env$k <- k
    eval(expr = parse(text = expr_str),
         envir = .env)
  })
}

## PARAMS ---------------------------------------------------------------------
MAX_TERMS <- 10
r_PTS <- c(1, 7/8, 3/4, 1/2)
color_palette <- RColorBrewer::brewer.pal(n = 3 + length(r_PTS), name = "Set3")

## INPUTS ---------------------------------------------------------------------

# example 1
pattern <- "(-1)^(k)"
abel_series_sum <- "1/(1+r)"

# # example 2
# pattern <- "(-1)^(k+1)"
# abel_series_sum <- "-1/(1+r)"

# # example 3
# pattern <- "(-1)^(k)*(k+1)"
# abel_series_sum <- "1/(1+r)^2"

## Comparison and Demonstration of Summation Methods --------------------------

# construct terms of the sequence
indices <- seq(from = 0, to = MAX_TERMS - 1, by = 1) # starting from 0
series <- EvalFormula(indices, pattern)

# compute Cauchy partial sum
partial_sum <- cumsum(series)

# compute Cesaro partial mean
cesaro_mean <- cumsum(partial_sum) / ( indices + 1 )

# compute Abel mean at a few points
abel_mean_func <- function(r)
  EvalFormula(r, gsub(pattern = "r", replacement = "k", x = abel_series_sum))
abel_mean <- abel_mean_func(r_PTS)
abel_weights <- t(sapply(r_PTS, function(r) r^indices))
abel_weights <- abel_weights[2:nrow(abel_weights),]

# plot

p <- plotly::plot_ly()

p <- plotly::add_trace(
  p, type = "scatter", mode = "lines",
  x = as.ordered(indices), y = abel_mean[1], yaxis = "y",
  name = "Limit --> Sum", hoverlabel = list(namelength = -1),
  line = list(color = "#000000", width = 2) )

for ( idx in seq(from = 2, to = length(r_PTS)) ) {
  p <- plotly::add_trace(
    p, type = "bar", alpha = 0.5, yaxis = "y2",
    x = as.ordered(indices), y = abel_weights[idx-1,],
    name = paste0("Abel Weights with r = ", sprintf("%.4f", r_PTS[idx])),
    hoverlabel = list(namelength = -1),
    color = color_palette[idx] )
  p <- plotly::add_trace(
    p, type = "scatter", mode = "lines",
    x = as.ordered(indices), y = abel_mean[idx], yaxis = "y",
    name = paste0("Abel Sum with r = ", sprintf("%.4f", r_PTS[idx])),
    hoverlabel = list(namelength = -1),
    color = color_palette[idx], alpha = 0.5 )
}

p <- plotly::add_trace(
  p, type = "scatter", mode = "lines+markers",
  x = as.ordered(indices), y = series, yaxis = "y",
  name = "Sequence a_k", hoverlabel = list(namelength = -1),
  color = color_palette[length(r_PTS) + 1], alpha = 0.7 )
p <- plotly::add_trace(
  p, type = "scatter", mode = "lines+markers",
  x = as.ordered(indices), y = partial_sum, yaxis = "y",
  name = "Cauchy Partial Sum s_k", hoverlabel = list(namelength = -1),
  color = color_palette[length(r_PTS) + 2] )
p <- plotly::add_trace(
  p, type = "scatter", mode = "lines+markers",
  x = as.ordered(indices), y = cesaro_mean, yaxis = "y",
  name = "Cesaro Partial Mean sigma_k", hoverlabel = list(namelength = -1),
  color = color_palette[length(r_PTS) + 3] )

p <- plotly::layout(
  p, hovermode = "compare", legend = list(orientation = "h", yanchor = "top"),
  barmode = "overlay",  # bargap = 0,
  yaxis  = list(title = "Value", side = "left", automargin = TRUE,
                showgrid = TRUE, zeroline = FALSE, overlaying = "y2"),
  yaxis2 = list(title = "Abel Weight", side = "right", automargin = TRUE, tickformat = ".2%",
                showgrid = FALSE, zeroline = FALSE),
  xaxis  = list(title = "Index", dtick = "L1",
                showgrid = TRUE, automargin = TRUE)
)

p


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

kNN <- function(dset, labels, point, k, dist = euclidean) {
  distance <- array(dim=dim(dset)[1])
  for (j in 1:dim(dset)[1]) {
    distance[j] <- dist(dset[j,], point)
  }
  sortedDataset <- dset[order(distance),]
  sortedLabels <- labels[order(distance)]

  classScores <- array(0L, dim = length(unique(labels)))
  names(classScores) = unique(labels)
  for (j in 1:k) {
    classScores[sortedLabels[j]] <- classScores[sortedLabels[j]] + 1
  }
  classScores <- classScores / k

  return (classScores)
}

gaussKernel <- function(dist, h) exp(sqrt(h / pi * 0.5) * -0.5 * (dist * h) ^ 2)

parzen <- function(dset, labels, point, h, kernel, dist = euclidean) {
  dsetLength <- length(dset[,1])
  distances <- array(dim = c(dsetLength))

  uLabels <- unique(labels)
  classScores <- array(0L, dim = c(length(uLabels)))
  names(classScores) = uLabels;
  # classScores["undefined"] <- 0.000001

  for (i in 1:dsetLength) {
    classScores[labels[i]] <- classScores[labels[i]] + kernel(dist(point, dset[i,]), h)
  }

  return(classScores)
}

computeMargins <- function(dset, labels) {
  dsetLen <- dim(dset)[1]
  margins <- array(0L, dim = dsetLen)
  for (i in 1:dsetLen) {
    cat("\rProcessing", i, "of", dsetLen)
    # classScores <- kNN(dset[-i,], labels[-i], dset[i,], 6)
    classScores <- parzen(dset[-i,], labels[-i], dset[i,], 1.6, gaussKernel)
    # cat(paste(labels[i]), names(classScores[which.max(classScores)]), "\n")

    margins[i] <- classScores[labels[i]] - max(classScores[-as.integer(labels[i])])

    if (paste(labels[i]) != names(classScores[which.max(classScores)])) {
      #cat(classScores, labels[i], classScores[labels[i]], max(classScores[-which.max(classScores)]), classScores[-labels[i]], margins[i], "\n")
    }
  }
  cat("\n")

  return (margins)
}

# tt <- kNN(iris[3:4], iris$Species, c(2.5, 1.1), 6)
# tt <- parzen(iris[3:4], iris$Species, c(2.5, 1.1), 1.6, kernel = gaussKernel)

margins <- computeMargins(iris[3:4], iris$Species)

margins <- margins / max(abs(margins))
colors <- array(dim = length(margins))

for (i in 1:length(margins)) {
  colors[i] <- if (margins[i] > 0) rgb(1 - margins[i], 1, 0) else rgb(1, 1 - abs(margins[i]), 0)
}

par(mfcol = c(1,1))
plot(iris[,3], iris[,4], col = colors, pch = 16)

# 1 => rgb(0, 1, 0)
# 0.5 => rgb()
# 0 => rgb(1, 1, 0)
# -1 => rgb(1, 0, 0)

4 - Selection of reference objects/margin-plot.r


library(readr)
Autompg <- read.csv("auto-mpg.csv")

View(Autompg)

library(dplyr)
library(tidyr)

summary(Autompg)

head(Autompg)

tail(Autompg)

names(Autompg)[9]<-"CarName"
View(Autompg)

Autompg$cylinders = Autompg$cylinders %>%
+     factor(labels = sort(unique(Autompg$cylinders)))
Autompg$horsepower = as.numeric(levels(Autompg$horsepower))[Autompg$horsepower]

View(Autompg)

class(Autompg)

dim(Autompg)

colnames(Autompg)

str(Autompg)

glimpse(Autompg)

plot(Autompg$displacement, Autompg$acceleration, main = "Rate of acceleration", xlab = "Displacement", ylab = "Acceleration")

t.test(Autompg$displacement, Autompg$weight)

t.test(Autompg$displacement, mu = 5, alternative = 'greater')

t.test(Autompg$displacement, mu = 5, alternative = 'greater')

outlierKD <- function(dt, var) {
+ var_name <- eval(substitute(var),eval(dt))
+ na1 <- sum(is.na(var_name))
+ m1 <- mean(var_name, na.rm = T)
+ par(mfrow=c(2, 2), oma=c(0,0,3,0))
+ boxplot(var_name, main="With outliers")
+ hist(var_name, main="With outliers", xlab=NA, ylab=NA)
+ outlier <- boxplot.stats(var_name)$out
+ mo <- mean(outlier)
+ var_name <- ifelse(var_name %in% outlier, NA, var_name)
+ boxplot(var_name, main="Without outliers")
+ hist(var_name, main="Without outliers", xlab=NA, ylab=NA)
+ title("Outlier Check", outer=TRUE)
+ na2 <- sum(is.na(var_name))
+ cat("Outliers identified:", na2 - na1, "n")
+ cat("Propotion (%) of outliers:", round((na2 - na1) / sum(!is.na(var_name))*100, 1), "n")
+ cat("Mean of the outliers:", round(mo, 2), "n")
+ m2 <- mean(var_name, na.rm = T)
+ cat("Mean without removing outliers:", round(m1, 2), "n")
+ cat("Mean if we remove outliers:", round(m2, 2), "n")
+ response <- readline(prompt="Do you want to remove outliers and to replace with NA? [yes/no]: ")
+ if(response == "y" | response == "yes"){
+ dt[as.character(substitute(var))] <- invisible(var_name)
+ assign(as.character(as.list(match.call())$dt), dt, envir = .GlobalEnv)
+ cat("Outliers successfully removed", "n")
+  return(invisible(dt))
+ } else{
+ cat("Nothing changed", "n")
+ return(invisible(var_name))
+ }}

outlierKD(Autompg,displacement)

install.packages("outliers")

library(outliers)

grubbs.flag <- function(x) {
+     outliers <- NULL
+     test <- x
+     grubbs.result <- grubbs.test(test)
+     pv <- grubbs.result$p.value
+     while(pv < 0.05) {
+         outliers <- c(outliers,as.numeric(strsplit(grubbs.result$alternative," ")[[1]][3]))
+         test <- x[!x %in% outliers]
+         grubbs.result <- grubbs.test(test)
+         pv <- grubbs.result$p.value
+     }
+     return(data.frame(X=x,Outlier=(x %in% outliers)))
+ }

grubbs.flag(AirQualityUCI$AH)
grubbs.flag(Autompg$displacement)

ggplot(grubbs.flag(Autompg$displacement),aes(x=Autompg$displacement,color=Outlier,fill=Outlier))+
+  geom_histogram(binwidth=diff(range(Autompg$displacement))/30)+ theme_bw()

library(MoEClust)

View(Autompg)
mpg <- Autompg[,1]
displacement <- Autompg[,3]
Acceleration <- Autompg[,6]
dim(Autompg)

m1    <- MoE_clust(displacement, G=0:2, verbose=FALSE)

m2    <- MoE_clust(displacement, G=2:16, verbose=FALSE)

comp <- MoE_compare(m1, m2)

(mod <- as.Mclust(comp$optimal))

plot(mod, what="classification")
plot(mod, what="uncertainty")

#Multi-factor Variance Analysis

d <- aggregate(mpg ~ displacement, data = Autompg, FUN = mean)
print(abs(d[[2]][1]-d[[2]][2]))

fit0 <- lm(mpg ~ displacement, data = Autompg)

lm(formula = mpg ~ displacement, data = Autompg)

fit0 <- lm(mpg ~ displacement, data = Autompg)
fit1 <- lm(mpg ~ ., data = Autompg)
fit2 <- lm(mpg ~ Acceleration + weight, Autompg)
View(Autompg)
fit3 <- lm(mpg ~ displacement + horsepower + Acceleration + weight, Autompg)
fit0

anova(fit0, fit1, fit2, fit3)

#Graphical exploration of dataset
plot(Autompg$weight , Autompg$mpg, xlab = 'Weight of Cars', ylab = 'Miles per Gallon', main = 'Scatter Plot for MTCars Weight Vs MPG')

library(ggplot2)
ggplot(data=Autompg,aes(x=weight, y=mpg)) + geom_point() + theme_minimal()

library(gplots)

plotmeans(model.year ~ origin, data = Autompg, frame = FALSE)

rate_of_activity = Autompg$displacement

sd(rate_of_activity)
ggplot(Autompg, aes(x=mpg, y=displacement)) +
+     geom_bar(stat="identity", color="black", position=position_dodge())

p <- ggplot(Autompg, aes(x = weight, y = displacement))
p + geom_point() + stat_density2d()
p + stat_density2d(aes(colour = ..level..))
p + stat_density2d(aes(fill = ..density..), geom = "raster", contour = FALSE)


estimate_y = function(y, x)
{
	coeffs = coefficients(lm(y~x))

	x %*% coeffs[-1] + coeffs[1]
}

estimate_s = function(y, x)
{
	m = nrow(x)
	n = ncol(x)
	y_estimate = estimate_y(y, x)

	s = sum( (y - y_estimate)^2 ) / (m - n - 1)
	s
}

get_measures = function(y, x, s)
{
	x = as.matrix(x)
	y = as.matrix(y)

	m = nrow(x)
	n = ncol(x)

	y_estimate = estimate_y(y, x)
	y_mean = mean(y)

	rss = sum( (y - y_estimate)^2 )
	tss = sum( (y - y_mean)^2 )

	r = 1 - rss/tss
	ra = 1 - (1 - r) * ( (m - 1) / (m - n - 1) )
	cp = rss/s - (m - 2*(n+1))

	rbind(rss, r, ra, cp)
}

best_subset = function(y, x)
{
	s = estimate_s(y, x)
	all_preds = 1:ncol(x)

	best_rss = best_r = best_ra = best_cp = c()

	for(pred in all_preds)
	{
		combs = combn(all_preds, pred)
		combs_v = if(ncol(combs) > 1) 2:ncol(combs) else 1

		best_comb_measures = get_measures(y, x[, combs[,1]], s)
		best_rss_comb = best_r_comb = best_ra_comb = best_cp_comb = combs[,1]

		for(comb in combs_v)
		{
			local_measures = get_measures(y, x[, combs[, comb]], s)

			if(local_measures[1] < best_comb_measures[1])
			{
				best_comb_measures[1] = local_measures[1]
				best_rss_comb = combs[, comb]
			}
			if(local_measures[2] > best_comb_measures[2])
			{
				best_comb_measures[2] = local_measures[2]
				best_r_comb =  combs[, comb]
			}
			if(local_measures[3] > best_comb_measures[3])
			{
				best_comb_measures[3] = local_measures[3]
				best_ra_comb = combs[, comb]
			}
			if(abs(local_measures[4] - (pred+1)) < best_comb_measures[4])
			{
				best_comb_measures[4] = abs(local_measures[4] - (pred+1))
				best_cp_comb = combs[, comb]
			}
		}

		best_rss = rbind(best_rss, cbind(best_comb_measures[1], list(best_rss_comb)))
		best_r = rbind(best_r, cbind(best_comb_measures[2], list(best_r_comb)))
		best_ra = rbind(best_ra, cbind(best_comb_measures[3], list(best_ra_comb)))
		best_cp = rbind(best_cp, cbind(best_comb_measures[4], list(best_cp_comb)))
	}

	rbind(list(best_rss), list(best_r), list(best_ra), list(best_cp))
}

get_p_values = function(y, x)
{
	coefficients(summary(lm(y~x)))[-1, 4]
}

forward_selection = function(y, x, significance)
{
	remaining_preds = 1:ncol(x)
	significant_preds = c()

	while(length(remaining_preds) != 0)
	{
		most_significant = NULL
		most_significance = 2

		for(pred in remaining_preds)
		{
			s = get_p_values(y, x[,c(significant_preds, pred)])
			pred_significance = s[length(s)]

			if(pred_significance <= significance &&
				pred_significance < most_significance)
			{
				most_significant = pred
				most_significance = pred_significance
			}
		}

		if(is.null(most_significant))
			break

		remaining_preds = remaining_preds[
			remaining_preds != most_significant]
		significant_preds = c(significant_preds, most_significant)
	}

	significant_preds
}

backward_selection = function(y, x, significance)
{
	significant_preds = 1:ncol(x)

	while(length(significant_preds) != 0)
	{
		most_insignificant = NULL
		most_insignificance = -1
		s = get_p_values(y, x[,significant_preds])
		current_pred = 0

		for(si in s)
		{
			current_pred = current_pred + 1

			if(si > significance &&
				si > most_insignificance)
			{
				most_insignificant =
					significant_preds[current_pred]
				most_insignificance = si
			}
		}

		if(is.null(most_insignificant))
			break

		significant_preds = significant_preds[
			significant_preds != most_insignificant]
	}

	significant_preds
}

stepwise_selection = function(y, x, significance)
{
	remaining_preds = 1:ncol(x)
	significant_preds = c()

	while(length(remaining_preds) != 0)
	{
		most_significant = NULL
		most_significance = 2

		for(pred in remaining_preds)
		{
			s = get_p_values(y, x[,c(significant_preds, pred)])
			pred_significance = s[length(s)]

			if(pred_significance <= significance &&
				pred_significance < most_significance)
			{
				most_significant = pred
				most_significance = pred_significance
			}
		}

		if(is.null(most_significant))
			break

		remaining_preds = remaining_preds[
			remaining_preds != most_significant]
		significant_preds = c(significant_preds, most_significant)

		most_insignificant = NULL
		most_insignificance = -1
		s = get_p_values(y, x[,significant_preds])
		current_pred = 0

		for(si in s)
		{
			current_pred = current_pred + 1

			if(si > significance &&
				si > most_insignificance)
			{
				most_insignificant =
					significant_preds[current_pred]
				most_insignificance = si
			}
		}

		if(!is.null(most_insignificant))
		{
			significant_preds = significant_preds[
				significant_preds != most_insignificant]
			remaining_preds = c(remaining_preds,
				most_insignificant)
		}
	}

	significant_preds
}

get_all = function(y, x, cp_index)
{
	data = best_subset(y, x)
	preds = data[[4]][cp_index,][[2]]

	estimate_y(y, x[, preds])
}

get_forward_selection = function(y, x, significance)
{
	preds = forward_selection(y, x, significance)

	estimate_y(y, x[, preds])
}

get_backward_selection = function(y, x, significance)
{
	preds = backward_selection(y, x , significance)

	estimate_y(y, x[, preds])
}

get_stepwise_selection = function(y, x, significance)
{
	preds = stepwise_selection(y, x, significance)

	estimate_y(y, x[, preds])
}

plot_and_save = function(y, all, forward, backward, stepwise)
{
	pdf(file=paste0(
		"D:\\Facultate\\",
		"Capitole Speciale de Inteligenta Artificiala\\",
		"homework5\\graphs\\",
		"Methods Comparison", ".pdf"),
		width=8, height=8)

	pmin = min(rbind(all, forward, backward, stepwise))
	pmax = max(rbind(all, forward, backward, stepwise))

	plot(pmin:pmax, pmin:pmax, type='n',
		main="Methods Comparison",
		xlab="y",
		ylab="y predicted")

	legend('topleft',
		legend=c('All', 'Forward', 'Backward', 'Stepwise'),
		col=c('red', 'blue', 'green', 'coral'),
		pch=c(19, 19, 19, 19),
		bty='n')

	abline(0,1, lwd=3)
	points(y, all, pch=19, lwd=1, col='red', cex=2)
	points(y, forward, pch=19, lwd=1, col='blue', cex=1.6)
	points(y, backward, pch=19, lwd=1, col='green', cex=1.2)
	points(y, stepwise, pch=19, lwd=1, col='coral', cex=0.8)

	dev.off()
}

ex1 = function()
{
	data = read.table(
			paste0(
				"D:\\Facultate\\",
				"Capitole Speciale de Inteligenta Artificiala\\",
				"homework5\\data\\house.dat"),
			header=T, sep="", dec=".")
	y = data[,1]
	x = data.matrix(data[,-1])

	all = get_all(y, x, 6)
	forward = get_forward_selection(y, x, 0.05)
	backward = get_backward_selection(y, x, 0.05)
	stepwise = get_stepwise_selection(y, x, 0.05)

	plot_and_save(y, all, forward, backward, stepwise)
}


#!/usr/bin/env Rscript

# file: grade class standardized
w = read.table("res/grade.txt", header=T)
par(mfrow=c(1,3))

c1 = w[w$class ==1, ]
c2 = w[w$class ==2, ]

m1 = mean(c1$grade)
m2 = mean(c2$grade)

s1 = sqrt(var(c1$grade))
s2 = sqrt(var(c2$grade))

# round: 控制精度, stand1, stand2 应该和文件中一样
stand1 = round((c1$grade - m1) / s1, 2)
stand2 = round((c2$grade - m2) / s2, 2)

# nrow <---> summary(stand1 == c1$standardized)[2]
nr1 = nrow(c1)
nr2 = nrow(c2)
summary(stand1 == c1$standardized)[2]
summary(stand2 == c2$standardized)[2]

boxplot(grade~class, w, main="Original Grades")
boxplot(standardized~class, w, main="Standardized Grades")
boxplot(standardized~class, rbind(c1, c2), main="My-Standardized Grades")


=begin
[((<index|URL:index.html>))]
((<Polynomial>))
/
((<PolynomialFactorization>))
/
((<Algebra::SplittingField>))
/
((<Algebra::Galois>))

= Polynomial
((*(Class of Polynomial Ring)*))

This class expresses the polynomial ring over arbitrary ring.
For creating the actual class, use the class method ((<::create>))
or ((<Algebra.Polynomial>)), giving the coefficient ring.

== File Name:
* ((|polynomial.rb|))

== SuperClass:

* ((|Object|))

== Included Modules

* ((|Enumerable|))
* ((|Comparable|))
* ((<Algebra::EuclidianRing>))
#* ((<PolynomialFactorization>))

== Associated Functions:

--- Algebra.Polynomial(ring [, obj0 , obj1 [, ...]])
    Same as ((<::create>))(ring, obj0[, obj1 [, ...]]).

== Class Methods:

--- ::create(ring, obj0[, obj1[, ...]])
    Creates a polynomial ring class over the coefficient ring
    expressed by the class: ((|ring|)).

    The objects designated in (({obj0, obj1, ...})) express the variables,
    and the polynomial ring on the polynomial ring is recursively created,
    if this is multiple.

    The value of this method is the subclass of Polynomial class.
    This subclass has the class methods: ((|ground|)), ((|var|)),
    and ((|vars|)), which return the coefficient ring ((|ring|)),
    the primary variable object(the latest one) and all variables,
    respectively.

    The objects (({obj0, obj1, ...})) are to utilize for the name
    (the value of ((|to_s|)) ) of the variable.

    Example: Polynomial ring over Integer
      require "polynomial"
      P = Algebra::Polynomial.create(Integer, "x")
      x = P.var
      p((x + 1)**100) #=> x^100 + 100x^99 + ... + 100x + 1
      p P.ground #=> integer

    Example: Multi variate Polynomial ring over Integer
      require "polynomial"
      P = Algebra::Polynomial.create(Integer, "x", "y", "z")
      x, y, z = P.vars
      p((-x + y + z)*(x + y - z)*(x - y + z))
      #=> -z^3 + (y + x)z^2 + (y^2 - 2xy + x^2)z - y^3 + xy^2 + x^2y - x^3
      p P.var #=> z

    This (({P})) is equal to

      Algebra::Polynomial.create(
        Algebra::Polynomial.create(
          Algebra::Polynomial.create(
            Integer,
          "x"),
        "y"),
      "z")

    and the last variable ((|z|)) is the primary variable.

--- ::var
    Returns the (primary) variable of the polynomial ring.

--- ::vars
    Returns the array of the variables of the polynomial rings,
    collecting recursively.

--- ::mvar
    Same as ((<::vars>)).

--- ::to_ary
    Returns (({[self, *vars]})).

    Example: Define Polynomial ring and variables simulteniously
      P, x, y, z = Algebra::Polynomial.create(Integer, "x", "y", "z")

--- ::variable
    Returns the object which expresses the (primary) variable of
    the polynomial ring.

--- ::variables
    Returns the array of the objects which express the variables of
    the polynomial rings, collecting recursively.

--- ::indeterminate(obj)
    Returns the variable expressed by ((|obj|)).

--- ::monomial([n])
    Returns the monomial of degree ((|n|)).

    Example:
      P = Polynomial(Integer, "x")
      P.monomial(3) #=> x^3

--- ::const(c)
    Returns the constant value ((|c|)).

    Example:
      P = Polynomial(Integer, "x")
      P.const(3)      #=> 3
      P.const(3).type #=> P

--- ::zero
    Returns the zero.

--- ::unity
    Returns the unity.

#--- ::euclidian?

== Methods:

--- var
    Same as ((<::var>)).

--- variable
    Same as ((<::variable>)).

--- each(&b)
    Iterates of coefficients in the ascendant power series.

    Example:
      P = Polynomial(Integer, "x")
      x = P.var
      (x**3 + 2*x**2 + 4).each do |c|
        p c #=> 4, 0, 2, 1
      end

--- reverse_each(&b)
    Iterates of coefficients in the descendent power series.

    Example:
      P = Polynomial(Integer, "x")
      x = P.var
      (x**3 + 2*x**2 + 4).reverse_each do |c|
        p c #=> 1, 2, 0, 4
      end

--- [](n)
    Returns the coefficient of degree ((|n|)).

--- []=(n, v)
    Sets the coefficient of degree ((|n|)) into ((|v|)).

--- monomial
    Same as ((<::monomial>)).

--- monomial?
    Returns true if self is a monomial.

--- zero?
    Returns true if self is the zero.

--- zero
    Returns the zero.

--- unity
    Returns the unity.

#--- variable=(bf)
#--- size
#--- compact!
#--- ground_div(n, d)

--- ==(other)
    Returns true if ((|self|)) is equal to ((|other|)).

--- <=>(other)
    Returns positive if ((|self|)) is greater than ((|other|)).

--- +(other)
    Returns the sum of ((|self|)) and ((|other|)).

--- -(other)
    Returns the difference of ((|self|)) from ((|other|)).

--- *(other)
    Returns the product of ((|self|)) and ((|other|)).

--- **(n)
    Returns the ((|n|))-th power of ((|self|)).

--- /(other)
    Returns the quotient of ((|self|)) by ((|other|)).
    Same as ((<div>)).

--- divmod(other)
    Returns the array [quotient, remainder] by ((|other|)).

--- div(other)
    Returns the quotient of ((|self|)) by ((|other|)).
    Same as (({divmod(other).first})).

--- %(other)
    Returns the remainder of ((|self|)) by ((|other|)).
    Same as (({divmod(other).last})).

--- divide?(other)
    Returns true if ((|self|)) is divisible by ((|other|)).
    Same as (({divmod(other).last == zero?})).

--- deg
    Returns the degree.

    Example:
      P = Polynomial(Integer, "x")
      x = P.var
      (5*x**3 + 2*x + 1).deg #=> 3

--- lc
    Returns the leading coefficient.

    Example:
      (5*x**3 + 2*x + 1).lc #=> 5

--- lm
    Returns the leading monomial.

    Example:
      (5*x**3 + 2*x + 1).lm #=> x**3

--- lt
    Returns the leading term).
    Same as (({lc * lm})).

    Example:
      (5*x**3 + 2*x + 1).lt #=> 5*x**3

--- rt
    Returns the rest term, which has the same value as (({self - lt})).

    Example:
      (5*x**3 + 2*x + 1).rt #=> 2*x + 1

--- monic
    Returns the polynomial, which corrected the maximum order coefficient in 1.
    Same as (({self / lc})) .

--- cont
    Returns the content (i.e. L.C.M of coefficients).

--- pp
    Returns the primitive part.
    Same as(({self / cont})).

--- to_s
    Returns the expression in strings.
    Use ((|display_type|)) in order to change the display format.
    The possible value of ((|display_type|)) is
    ((|:norm|))(default) and  ((|:code|)).

    Example:
      P = Polynomial(Integer, "x")
      x = P.var
      p 5*x**3 + 2*x + 1 #=>5x^3 + 2x + 1
      P.display_type = :code
      p 5*x**3 + 2*x + 1 #=> 5*x**3 + 2*x + 1

--- derivate
    Return the derivative.

    Example:
      (5*x**3 + 2*x + 1).derivate #=> 15*x**2 + 2

--- sylvester_matrix(other)
    Return the Sylvester matrix of ((|self|)) and ((|other|)).

--- resultant(other)
    Return the resultant of ((|self|)) with ((|other|))

--- project(ring[, obj]){|c, n| ... }
    Returns the sum of the evaluations
    of ... for each monomial of coefficient ((|c|)) and degree ((|n|)).
    If ((|obj|)) is omitted, it is assumed to be (({ring.var})).

    Example:
      require "polynomial"
      require "rational"
      P = Algebra::Polynomial(Integer, "x")
      PQ = Algebra::Polynomial(Rational, "y")
      x = P.var
      f = 5*x**3 + 2*x + 1
      p f.convert_to(PQ) #=> 5y^3 + 2y + 1
      p f.project(PQ) {|c, n| Rational(c) / (n + 1)} #=> 5/4y^3 + y + 1

--- evaluate(obj)
    Returns the value of ((|self|)) at ((|obj|)).
    This is equivalent to (({ project(ground, obj){|c, n| c} })).

    Example:
      require "polynomial"
      P = Algebra::Polynomial(Integer, "x")
      x = P.var
      f = x**3 - 3*x**2 + 1
      p f.evaluate(-1)    #=> -3 (in Integer)
      p f.evaluate(x + 1) #=> x^3 - 3x - 1 (in P)

--- call(obj)
    Same as ((<evaluate>)).

--- sub(var, value)
    Returns the value of substitution of a variable ((|var|)) by ((|value|)).

    Example:
      require "polynomial"
      P = Algebra::Polynomial(Integer, "x", "y", "z")
      x, y, z = P.vars
      f = (x - y)*(y - z - 1)
      p f.sub(y, z+1)    #=> 0

--- convert_to(ring)
    Returns the polynomial the one converted on ((|ring|)).
    This is equivalent to (({ project(ring){|c, n| c} })).

= PolynomialFactorization
((*(Module of Factorization)*))

The module of factorization of polynomials.

== File Name:
((|polynomial-factor.rb|))

== Methods:

--- sqfree
    Returns the square free parts.

--- sqfree?
    Returns true if square free.

--- irreducible?
    Returns true if irreducible

--- factorize
    Returns the factorization.

    The following type can be factorized:
    * Integer
    * Rational
    * prime field
    * Algebraic Field

= Algebra::SplittingField
((*(Module of Splitting Field)*))

The module of the minimal splitting field of polynomials.

== File Name:
* ((|splitting-field.rb|))

== Methods:

--- decompose([fac0])
    Returns

      [field, modulus, facts, roots, addelems]

    Here the elements are:
    ((|field|)) the mimimal splitting field of ((|poly|)),
    ((|def_polys|)) the irreducible polynomial needed for the splitting,
    ((|facts|)) the linear factors of ((|poly|)) over ((|field|)),
    ((|roots|)) the roots of ((|poly|)) and
    ((|proots|)) the sorted array of ((|roots|)) in order that
    the added elements to the base field first.

    ((|fac0|)) makes the factorization fast. (((|facts|)) and ((|fact0|))
    are the instance of ((|Algebra::Factors|))).
    Generally, ((|field|)) is the object of
    ((<AlgebraicExtensionField|algebraic-extension-field.html>)).
    If ((|self|)) is splitted linearlly,
    that is the ((<ground>)) ring own.

    Example:
      require "algebra"
      PQ = Polynomial(Rational, "x")
      x = PQ.var
      f = x**5 - x**4 + 2*x - 2
      field, def_polys, facts, roots, proots = f.decompose
      p def_polys #=> [a^4 + 2, b^2 + a^2]
      p facts    #=> (x - 1)(x - a)(x + a)(x - b)(x + b)
      p roots    #=> [1, a, -a, b, -b]
      p proots   #=> [a, b, 1, -a, -b]
      fp = Polynomial(field, "x")
      x = fp.var
      facts1 = Factors.new(facts.collect{|g, n| [g.call(x), n]})
      p facts1.pi == f.convert_to(fp) #=> true

--- splitting_field([fac0]))
    Returns the infomation of the splitting field of ((|self|)).
    Each field corresponds to the return value of ((<decompose>)):

    poly, field, roots, proots, def_polys

    The values of ((|roots|)) and ((|proots|)) are transrated in
    the elements of ((|fields|)).

    Example:
      require "algebra"
      PQ = Polynomial(Rational, "x")
      x = PQ.var
      f = x**5 - x**4 + 2*x - 2
      sf = f.splitting_field
      p sf.roots     #=> [1, a, -a, b, -b]
      p sf.proots     #=> [a, b, 1, -a, -b]
      p sf.def_polys #=> [a^4 + 2, b^2 + a^2]

= Algebra::Galois
((*(Module of Galois Group)*))

The module of Galois Group of polynomials

== File Name:
* ((|galois-group.rb|))

== Included Module:
(none)

== Associated Method

--- GaloisGroup.galois_group(poly)
    Same as ((<galois_group>)).

== Method:

--- galois_group
    Retuns the galois group of ((|self|)).
    Each elements of this is the object of
    ((<FiniteGroup|finite-group.html>)) of which elements are
    in ((<PermutationGroup|permutation-group.html>)).

    Example:
      require "rational"
      require "polynomial"

      P = Algebra.Polynomial(Rational, "x")
      x = P.var
      p( (x**3 - 3*x + 1).galois_group.to_a )
      #=>[[0, 1, 2], [1, 2, 0], [2, 0, 1]]

      (x**3 - x + 1).galois_group.each do |g|
        p g
      end
      #=> [0, 1, 2]
      #   [1, 0, 2]
      #   [2, 0, 1]
      #   [0, 2, 1]
      #   [1, 2, 0]
      #   [2, 1, 0]

=end


Java 2

Домашнее задание 5

1. Необходимо написать два метода, которые делают следующее:
1) Создают одномерный длинный массив, например:
static final int size = 10 000 000;
static final int h = size / 2;
float[] arr = new float[size].
2) Заполняют этот массив единицами.
3) Засекают время выполнения: long a = System.currentTimeMillis().
4) Проходят по всему массиву и для каждой ячейки считают новое значение по формуле:
arr[i] = (float)(arr[i] * Math.sin(0.2f + i / 5) * Math.cos(0.2f + i / 5) *
Math.cos(0.4f + i / 2)).
5) Проверяется время окончания метода System.currentTimeMillis().
6) В консоль выводится время работы: System.out.println(System.currentTimeMillis() - a).
Отличие первого метода от второго:
● Первый просто бежит по массиву и вычисляет значения.
● Второй разбивает массив на два массива, в двух потоках высчитывает новые значения и
потом склеивает эти массивы обратно в один.
Пример деления одного массива на два:
● System.arraycopy(arr, 0, a1, 0, h);
● System.arraycopy(arr, h, a2, 0, h).
Пример обратной склейки:
● System.arraycopy(a1, 0, arr, 0, h);
● System.arraycopy(a2, 0, arr, h, h).
Примечание:
System.arraycopy() — копирует данные из одного массива в другой:
System.arraycopy(массив-источник, откуда начинаем брать данные из массива-источника,
массив-назначение, откуда начинаем записывать данные в массив-назначение, сколько ячеек
копируем)
По замерам времени:
Для первого метода надо считать время только на цикл расчета:
for (int i = 0; i < size; i++) {
arr[i] = (float)(arr[i] * Math.sin(0.2f + i / 5) * Math.cos(0.2f + i / 5) *
Math.cos(0.4f + i / 2));
}
Для второго метода замеряете время разбивки массива на 2, просчета каждого из двух массивов и
склейки.

Сборка и компиляция проекта (сборка jar-файла) :
```
mvn package
```
Запуск
```
java -jar Lesson5.jar
```


## 2. Components Of A Function ##

first_vec <- c(1, 5, 4, 2, 3, 7, 6)
second_vec <- c(9, 2, 1, 8, 3, 4, 5, 6, 10, 7, 12, 11)
third_vec <- c(8, 3, 5, 1, 7, 1, 10)
find_longer_vector <- function(vec_one, vec_two) {

  if (length(vec_one) > length(vec_two)) {
      return("First")
  } else if (length(vec_one) < length(vec_two)) {
      return("Second")
  } else {
      return("Equal Length")
  }
}

first_vs_second <- find_longer_vector(first_vec, second_vec)
first_vs_third <- find_longer_vector(first_vec, third_vec)

## 4. Using Multiple Inputs ##

is_divisible <- function(divisor, dividend) {
  whole <- floor(divisor / dividend)
  rem <- divisor - (whole * dividend)

  if (rem == 0) {
      return(TRUE)
  } else {
      return(FALSE)
  }
}
div_5731_by_11 <- is_divisible(5731, 11)

## 6. Handling Variable Numbers of Arguments ##

subtract_all <- function(start, ...) {
  current_num <- start

  for (num in list(...)) {
    current_num <- current_num - num
  }

  return(current_num)
}

first_subtraction <- subtract_all(10, 1, 2, 3)
second_subtraction <- subtract_all(100, 71, 22)

Data Analyst in R/Step 1 - Introduction to R/3. Control Flow, Iteration and Functions in R/3. Functions in R.r


# Goals: Do bootstrap inference, as an example, for a sample median.

library(boot)

samplemedian <- function(x, d) {        # d is a vector of integer indexes
  return(median(x[d]))                  # The genius is in the x[d] notation
}

data <- rnorm(50)                          # Generate a dataset with 50 obs
b  <-  boot(data, samplemedian, R=2000)    # 2000 bootstrap replications
cat("Sample median has a sigma of ", sd(b$t[,1]), "\n")
plot(b)

# Make a 99% confidence interval
boot.ci(b, conf=0.99, type="basic")

RFrontEndSolution/Tests Repo/Rscripts All (163 files)/p2.r


probability_light=0.50
probability_medium=0.30
probability_heavy=0.20
# probability that member is light , medium and heavy  and no books borrow
probability_0_light=0.60
probability_0_medium=0.15
probability_0_heavy=0.05
#  the probability that the member is a light purchaser and purchases no books in 3 months
p=(probability_light*probability_0_light)/((probability_light*probability_0_light)+(probability_medium*probability_0_medium)+(probability_heavy*probability_0_heavy))
print(p)


pbenford <- function(d){
  return(log10(1+(1/d)))
}

get_lead_digit <- function(number){
  return(as.numeric(substr(number,1,1)))
}

fib_iter <- function(n){
  first <- 1
  second <- 0
  for(i in 1:n){
    sum <- first + second
    first <- second
    second <- sum
  }
  return(sum)
}

fib_sequence <- mapply(fib_iter,c(1:1000))
lead_digits <- mapply(get_lead_digit,fib_sequence)

observed_frequencies <- table(lead_digits)/1000
expected_frequencies <- mapply(pbenford,c(1:9))

data <- data.frame(observed_frequencies,expected_frequencies)
colnames(data) <- c("digit","obs.frequency","exp.frequency")
dev_percentage <- abs((data$obs.frequency-data$exp.frequency)*100)
data <- data.frame(data,dev_percentage)

print(data)


# correlation statistics

# matrix of correlations (or just the correlation if 2 variables)
cor(meat)

# same using Spearman rank correlation
cor(meat,method='spearman')

# t-test of correlation = 0 and Fisher confidence interval
cor.test(meat$time,meat$ph)

RFrontEndSolution/Tests Repo/Rscripts All (163 files)/corr.r


SUV<-read.csv('monthly-sales-for-a-souvenir-sho.csv')
suv<-ts(SUV$Sales)

library(astsa)
library(forecast)

par(mfrow=c(2,2))

plot(suv, main='Monthly sales for a souvenir shop', ylab='', col='blue', lwd=3)
plot(log(suv), main='Log-transorm of sales', ylab='', col='red', lwd=3)
plot(diff(log(suv)), main='Differenced Log-transorm of sales', ylab='', col='brown', lwd=3)
plot(diff(diff(log(suv)),12), main='Log-transorm without trend and seasonaliy', ylab='', col='green', lwd=3)

data<-diff(diff((log(suv)),12))
acf2(data, 50)

d=1
DD=1
per=12
for(p in 1:2){
  for(q in 1:2){
    for(i in 1:2){
      for(j in 1:4){
        if(p+d+q+i+DD+j<=10){
          model<-arima(x=log(suv), order = c((p-1),d,(q-1)), seasonal = list(order=c((i-1),DD,(j-1)), period=per))
          pval<-Box.test(model$residuals, lag=log(length(model$residuals)))
          sse<-sum(model$residuals^2)
          cat(p-1,d,q-1,i-1,DD,j-1,per, 'AIC=', model$aic, ' SSE=',sse,' p-VALUE=', pval$p.value,'\n')
        }
      }
    }
  }
}

model<- arima(x=log(suv), order = c(1,1,0), seasonal = list(order=c(0,1,1), period=12))

plot(forecast(model))

forecast(model)

a<-sarima.for(log(suv),12,1,1,0,0,1,1,12)

plot.ts(c(suv,exp(a$pred)), main='Monthly sales + Forecast', ylab='', col='blue', lwd=3)


## Author: Sergio García Prado
## Title: Exercises with Solutions 4

rm(list = ls())

Q <- matrix(c(-4/10, 4/10,      0,      0,    0,
                1/2, -4/5,   3/10,      0,    0,
                  0,  3/4, -19/20,   2/10,    0,
                  0,    0,      1, -11/10, 1/10,
                  0 ,   0,      0,      1,    -1),
              5, 5, byrow = TRUE)

A <- cbind(Q[, 1:(nrow(Q) - 1)], rep(1, nrow(Q)))

## Should be solved via detailed balance equations...
(stationary <- solve(A)[nrow(Q), ])
# 0.456537618699781 0.365230094959825 0.14609203798393 0.029218407596786 0.00292184075967864

(machines.mean <- sum(4:0 * stationary))
# 3.24324324324324

(all.busy.ratio <- sum(stationary[3] / 2, stationary[4:5]))
# 0.10518626734843


library(stats)
library(float, quietly=TRUE)
library(rbenchmark)
set.seed(1234)

reps = 5
cols <- c("test", "replications", "elapsed", "relative")

m = 7500
n = 500
x = matrix(rnorm(m*n), m, n)
y = rnorm(m)
s = fl(x)
t = fl(y)

### m >= n only
lmfit_spm <- function(x, y)
{
  QR = qr(x, LAPACK=TRUE)
  Q = qr.Q(QR)
  R = qr.R(QR)
  coef = solve(R, crossprod(Q,  y))

  resid <- y - x %*% coef
  eff <- crossprod(Q, y)

  list(coefficients=coef, residuals=resid, effects=eff)
}

benchmark(lmfit_spm(x, y), lmfit_spm(s, t), lm.fit(x, y), replications=reps, columns=cols)


#autor:      Joao Sollari Lopes
#local:      INE, Lisboa
#Rversion:   3.6.1
#criado:     17.10.2019
#modificado: 05.11.2019

setwd("2019/2019.08.13_formacao_RCD2019/bin/")
library("tidyverse")
library("modelr")

## 1. Modelling example
library("hexbin")

#diamonds data
?diamonds

fnam <- "../results/modelling/diamonds1.tiff"
tiff(file=fnam,units="in",width=3,height=3,res=300,compression="lzw")
diamonds %>%
  ggplot() +
   geom_boxplot(aes(cut,price))
dev.off()

fnam <- "../results/modelling/diamonds2.tiff"
tiff(file=fnam,units="in",width=3,height=3,res=300,compression="lzw")
diamonds %>%
  ggplot() +
   geom_boxplot(aes(clarity,price))
dev.off()

fnam <- "../results/modelling/diamonds3.tiff"
tiff(file=fnam,units="in",width=4,height=3,res=300,compression="lzw")
diamonds %>%
  ggplot() +
   geom_hex(aes(carat,price),bins=50)
dev.off()

diamonds2 <- diamonds %>%
  filter((x > 0) & (y > 0 & y < 20) & (z > 0 & z < 10)) %>%
  filter(carat <= 2.5) %>%
  select(carat,cut,color,clarity,price) %>%
  mutate(lprice = log(price), lcarat = log(carat))

fnam <- "../results/modelling/diamonds4.tiff"
tiff(file=fnam,units="in",width=5,height=4,res=300,compression="lzw")
diamonds2 %>%
  ggplot() +
    geom_hex(aes(lcarat,lprice),bins=50)
dev.off()

#model 1
diamonds_mod <- lm(lprice ~ lcarat,data=diamonds2)
summary(diamonds_mod)

diamonds2 <- diamonds2 %>%
  add_predictions(diamonds_mod,"lpred") %>%
  add_residuals(diamonds_mod,"lresid") %>%
  mutate(pred = exp(lpred))

fnam <- "../results/modelling/diamonds5.tiff"
tiff(file=fnam,units="in",width=5,height=4,res=300,compression="lzw")
diamonds2 %>%
  ggplot() +
    geom_hex(aes(carat,price),bins=50) +
    geom_line(aes(carat,pred),color="red")
dev.off()

fnam <- "../results/modelling/diamonds6.tiff"
tiff(file=fnam,units="in",width=4,height=4,res=300,compression="lzw")
diamonds2 %>%
  ggplot() +
    geom_boxplot(aes(cut,lresid))
dev.off()

fnam <- "../results/modelling/diamonds7.tiff"
tiff(file=fnam,units="in",width=4,height=4,res=300,compression="lzw")
diamonds2 %>%
  ggplot() +
    geom_boxplot(aes(clarity,lresid))
dev.off()

fnam <- "../results/modelling/diamonds8.tiff"
tiff(file=fnam,units="in",width=5,height=4,res=300,compression="lzw")
diamonds2 %>%
  ggplot() +
    geom_hex(aes(lcarat,lresid),bins=50)
dev.off()

fnam <- "../results/modelling/diamonds9.tiff"
tiff(file=fnam,units="in",width=4,height=4,res=300,compression="lzw")
diamonds2 %>%
  ggplot() +
    geom_point(aes(pred,price)) +
    geom_abline(aes(intercept=0,slope=1),size=1,color="white")
dev.off()

#model 2
diamonds_mod2 <- lm(lprice ~ lcarat + clarity + cut,data=diamonds2)
summary(diamonds_mod2)

diamonds2 <- diamonds2 %>%
  add_predictions(diamonds_mod2,"lpred2") %>%
  add_residuals(diamonds_mod2,"lresid2") %>%
  mutate(pred2 = exp(lpred2))

fnam <- "../results/modelling/diamonds10.tiff"
tiff(file=fnam,units="in",width=9,height=4.5,res=300,compression="lzw")
diamonds2 %>%
  ggplot() +
    geom_hex(aes(carat,price),bins=50) +
    geom_line(aes(carat,pred2),color="red") +
    facet_grid(cut ~ clarity)
dev.off()

fnam <- "../results/modelling/diamonds11.tiff"
tiff(file=fnam,units="in",width=5,height=4,res=300,compression="lzw")
diamonds2 %>%
  ggplot() +
    geom_hex(aes(lcarat,lresid2),bins=50)
dev.off()

fnam <- "../results/modelling/diamonds12.tiff"
tiff(file=fnam,units="in",width=4,height=4,res=300,compression="lzw")
diamonds2 %>%
  ggplot() +
    geom_point(aes(pred2,price)) +
    geom_abline(aes(intercept=0,slope=1),size=1,color="white")
dev.off()

## 2. Model Fitting
set.seed(12345)

#synthetic data
real_a1 <- 4.22
real_a2 <- 2.05
x <- round(runif(n=30,min=0,max=10),digits=2)
y <- real_a1*x + real_a2 + rnorm(n=30,mean=0,sd=1)
sim1 <- tibble(x,y)

#plot synthetic data
fnam <- "../results/modelling/synthetic1.tiff"
tiff(file=fnam,units="in",width=4,height=4,res=300,compression="lzw")
sim1 %>%
  ggplot() +
    geom_point(aes(x,y))
dev.off()

#### 2.1. fit model (random search)
models <- tibble(
  a1 = runif(250,-20,40),
  a2 = runif(250,-5,5))

fnam <- "../results/modelling/synthetic2.tiff"
tiff(file=fnam,units="in",width=4,height=4,res=300,compression="lzw")
sim1 %>%
  ggplot() +
    geom_abline(data=models,aes(intercept=a1,slope=a2),alpha=0.24) +
    geom_point(aes(x,y))
dev.off()

#Linear regression model
model1 <- function(a,dat){
  res <- a[1] + dat$x*a[2]
  return(res)
}

#Calculate Root-mean-squared-deviation
measure_distance <- function(params,dat){
  diff <- dat$y - model1(params,dat)
  res <- sqrt(mean(diff^2))
  return(res)
}

#Helper function to calculate RMSD for synthetic data "sim1"
sim1_dist <- function(a1,a2){
  res <- measure_distance(c(a1,a2),dat=sim1)
  return(res)
}

models <- models %>%
  mutate(RMSD = map2_dbl(a1,a2,sim1_dist))
print(models)

best_models <- models %>%
  filter(rank(RMSD) <= 10)

fnam <- "../results/modelling/synthetic3.tiff"
tiff(file=fnam,units="in",width=5,height=4,res=300,compression="lzw")
sim1 %>%
  ggplot() +
    geom_point(aes(x,y),size=2,color="grey30") +
    geom_abline(data=best_models,aes(intercept=a1,slope=a2,color=-RMSD))
dev.off()

fnam <- "../results/modelling/synthetic4.tiff"
tiff(file=fnam,units="in",width=5,height=4,res=300,compression="lzw")
models %>%
  ggplot() +
    geom_point(data=best_models,aes(a1,a2),size=4,color="red") +
    geom_point(aes(a1,a2,color=-RMSD))
dev.off()

#### 2.2. fit model (grid search)
models_grid <- expand.grid(
  a1 = seq(0,15,length=25),
  a2 = seq(2,5,length=25)) %>%
    mutate(RMSD=map2_dbl(a1,a2,sim1_dist))
head(models_grid,n=15)

best_grid <- models_grid %>%
  filter(rank(RMSD) <= 10)

fnam <- "../results/modelling/synthetic5.tiff"
tiff(file=fnam,units="in",width=5,height=4,res=300,compression="lzw")
sim1 %>%
  ggplot() +
    geom_point(aes(x,y),size=2,color="grey30") +
    geom_abline(data=best_grid,aes(intercept=a1,slope=a2,color=-RMSD))
dev.off()

fnam <- "../results/modelling/synthetic6.tiff"
tiff(file=fnam,units="in",width=5,height=4,res=300,compression="lzw")
models_grid %>%
  ggplot() +
    geom_point(data=best_grid,aes(a1,a2),size=4,color="red") +
    geom_point(aes(a1,a2,color=-RMSD))
dev.off()

#### 2.3. fit model (Newton-Raphson optimization)
best_optim <- optim(c(0,0),measure_distance,dat=sim1)
best_a1 <- best_optim$par[1]
best_a2 <- best_optim$par[2]

fnam <- "../results/modelling/synthetic7.tiff"
tiff(file=fnam,units="in",width=4,height=4,res=300,compression="lzw")
sim1 %>%
  ggplot() +
    geom_point(aes(x,y),size=2,color="grey30") +
    geom_abline(aes(intercept=best_a1,slope=best_a2))
dev.off()

#### 2.4. fit model (Least-Squares method)
best_lm <- lm(y ~ x,data=sim1)
best_a1 <- best_lm$coef[1]
best_a2 <- best_lm$coef[2]

fnam <- "../results/modelling/synthetic8.tiff"
tiff(file=fnam,units="in",width=4,height=4,res=300,compression="lzw")
sim1 %>%
  ggplot() +
    geom_point(aes(x,y),size=2,color="grey30") +
    geom_abline(aes(intercept=best_a1,slope=best_a2))
dev.off()

#### 2.5. summary
res1 <- models %>%
  filter(rank(RMSD) == 1)

res2 <- models_grid %>%
  filter(rank(RMSD) == 1)

res3 <- tibble(
  a1 = best_optim$par[1],
  a2 = best_optim$par[2],
  RMSD = best_optim$value)

res4 <- tibble(
  a1 = best_lm$coef[1],
  a2 = best_lm$coef[2],
  RMSD = sqrt(mean(best_lm$residuals^2)))

tab1 = round(data.frame(rbind(res1,res2,res3,res4)),digits=2)
rownames(tab1) = c("random","grid","NR","LS")
fnam = "../results/modelling/fitting1.txt"
write.table(tab1,fnam,sep=",",row.names=TRUE,col.names=NA)

## 3. Model Diagnostic
set.seed(12345)

#synthetic data
real_a1 <- 4.22
real_a2 <- 2.05
x <- round(runif(n=30,min=0,max=10),digits=2)
y <- real_a1*x + real_a2 + rnorm(n=30,mean=0,sd=1)
sim1 <- tibble(x,y)

#fit model
sim1_mod <- lm(y ~ x,data=sim1)

sim1 <- sim1 %>%
  add_predictions(sim1_mod) %>%
  add_residuals(sim1_mod)
print(sim1)

#scatterplot y~x
fnam <- "../results/modelling/visualization1.tiff"
tiff(file=fnam,units="in",width=3,height=2.4,res=300,compression="lzw")
sim1 %>%
  ggplot() +
    geom_point(aes(x,y),size=2,color="grey30") +
    geom_line(aes(x,pred)) +
	geom_segment(aes(x=x,xend=x,y=y,yend=pred),alpha=0.2)
dev.off()

#scatterplot y~pred
fnam <- "../results/modelling/visualization2.tiff"
tiff(file=fnam,units="in",width=3,height=2.4,res=300,compression="lzw")
sim1 %>%
  ggplot() +
    geom_abline(aes(intercept=0,slope=1),size=2,color="white") +
    geom_point(aes(pred,y),size=2,color="grey30")
dev.off()

#density(residuals)
fnam <- "../results/modelling/visualization3.tiff"
tiff(file=fnam,units="in",width=3,height=2.4,res=300,compression="lzw")
sim1 %>%
  ggplot() +
    geom_density(aes(resid)) +
    stat_function(fun=dnorm,color="red",args=list(mean=0,sd=1))
dev.off()

#scatterplot res~x
fnam <- "../results/modelling/visualization4.tiff"
tiff(file=fnam,units="in",width=3,height=2.4,res=300,compression="lzw")
sim1 %>%
  ggplot() +
    geom_hline(aes(yintercept=0),size=2,color="white") +
    geom_point(aes(x,resid))
dev.off()

#qqplot(residuals)
fnam <- "../results/modelling/visualization5.tiff"
tiff(file=fnam,units="in",width=3,height=2.4,res=300,compression="lzw")
sim1 %>%
  ggplot() +
    geom_qq_line(aes(sample=resid),size=2,color="white") +
    geom_qq(aes(sample=resid)) +
    labs(x="Theoretical Quantiles",y="Sample Quantiles")
dev.off()

#lagplot(residuals)
fnam <- "../results/modelling/visualization6.tiff"
tiff(file=fnam,units="in",width=3,height=2.4,res=300,compression="lzw")
sim1 %>%
  ggplot() +
    geom_point(aes(c(resid[-1],NA),resid)) +
    labs(x=expression(resid[i-1]),y=expression(resid[i]))
dev.off()


############################################
# Part v
p = 0.1
rho = 0.5
n = 200

# function to generate one dataset
# following Qaqish (2003) algorithm
gendataAR1 = function(n,p,rho){
  dat = c(rbinom(1,1,p),rep(NA,n-1))
  for(i in 2:n){
    j = i-1
    prob = p + rho*(dat[j]-p)
    dat[i] = rbinom(1,1,prob)
  }
  return(dat)
}

# Generate 100 replicates
x = matrix(NA,100,n)
for(r in 1:100){
  x[r,]=gendataAR1(n,p,rho)
}

write(t(x),"p.10_ar50_n200_r100.txt",ncol=n) # each row in this file is a different simulated song

#############################################
# Part vi
p = 0.1
rho = 0.5
n = 600

# function to generate one dataset
# following Qaqish (2003) algorithm
gendataAR1 = function(n,p,rho){
  dat = c(rbinom(1,1,p),rep(NA,n-1))
  for(i in 2:n){
    j = i-1
    prob = p + rho*(dat[j]-p)
    dat[i] = rbinom(1,1,prob)
  }
  return(dat)
}

# Generate 100 replicates
x = matrix(NA,100,n)
for(r in 1:100){
  x[r,]=gendataAR1(n,p,rho)
}

write(t(x),"p.10_ar50_n600_r100.txt",ncol=n) # each row in this file is a different simulated song

#############################################
# Part vii
p = 0.1
rho = 0.3
n = 200

# function to generate one dataset
# following Qaqish (2003) algorithm
gendataAR1 = function(n,p,rho){
  dat = c(rbinom(1,1,p),rep(NA,n-1))
  for(i in 2:n){
    j = i-1
    prob = p + rho*(dat[j]-p)
    dat[i] = rbinom(1,1,prob)
  }
  return(dat)
}

# Generate 100 replicates
x = matrix(NA,100,n)
for(r in 1:100){
  x[r,]=gendataAR1(n,p,rho)
}

write(t(x),"p.10_ar30_n200_r100.txt",ncol=n) # each row in this file is a different simulated song

#############################################
# Part viii
p = 0.1
rho = 0.3
n = 600

# function to generate one dataset
# following Qaqish (2003) algorithm
gendataAR1 = function(n,p,rho){
  dat = c(rbinom(1,1,p),rep(NA,n-1))
  for(i in 2:n){
    j = i-1
    prob = p + rho*(dat[j]-p)
    dat[i] = rbinom(1,1,prob)
  }
  return(dat)
}

# Generate 100 replicates
x = matrix(NA,100,n)
for(r in 1:100){
  x[r,]=gendataAR1(n,p,rho)
}

write(t(x),"p.10_ar30_n600_r100.txt",ncol=n) # each row in this file is a different simulated song

#############################################
# Part ix
p = 0.2
rho = 0.5
n = 200

# function to generate one dataset
# following Qaqish (2003) algorithm
gendataAR1 = function(n,p,rho){
  dat = c(rbinom(1,1,p),rep(NA,n-1))
  for(i in 2:n){
    j = i-1
    prob = p + rho*(dat[j]-p)
    dat[i] = rbinom(1,1,prob)
  }
  return(dat)
}

# Generate 100 replicates
x = matrix(NA,100,n)
for(r in 1:100){
  x[r,]=gendataAR1(n,p,rho)
}

write(t(x),"p.20_ar50_n200_r100.txt",ncol=n) # each row in this file is a different simulated song

#############################################
# Part x
p = 0.2
rho = 0.5
n = 600

# function to generate one dataset
# following Qaqish (2003) algorithm
gendataAR1 = function(n,p,rho){
  dat = c(rbinom(1,1,p),rep(NA,n-1))
  for(i in 2:n){
    j = i-1
    prob = p + rho*(dat[j]-p)
    dat[i] = rbinom(1,1,prob)
  }
  return(dat)
}

# Generate 100 replicates
x = matrix(NA,100,n)
for(r in 1:100){
  x[r,]=gendataAR1(n,p,rho)
}

write(t(x),"p.20_ar50_n600_r100.txt",ncol=n) # each row in this file is a different simulated song


=begin
= Algebra

2006.09.14

*Version: 0.72
*Author: Shin-ichiro HARA
*e-mail: sinara@blade.nagaokaut.ac.jp
*Home Page: ((<URL:http://blade.nagaokaut.ac.jp/~sinara/ruby/math/>))

== Preface

This is a library for mathematical computations.
Our purpose is to express the mathematical object naturally in Ruby.
Though it is not operated fast, we can see the algorithm of the
mathematical processing not in black box but in scripts.

This library is in development stage.
At present, things we can handle are as follows:

* One-variate polynomial
  * Fundamental operations (addition, multiplication, quotient/remainder, ...)
  * factorization
  * Galois group
* Multi-variate polynomial
  * Fundamental operations (addition, multiplication, ...)
  * factorization
  * Creating Groebner-basis, quotient/remainder by Groebner-basis.
* Algebraic systems
  * Creating quotient fields
  * Creating residue class fields
  * Operating matrices
  * Operating permutation groups
* Sets and Maps

== Installation

Install Ruby (See: ((<URL:http://www.ruby-lang.org/>)) ).

After expanding this archive, do

  ruby install.rb

Then all files and directories under ((|lib|)) are copyed in
the directory where Ruby can load.

To accelerate calculation, it is better to use an extension
library of rational number:
(((<URL:http://blade.nagaokaut.ac.jp/~sinara/ruby/rational/>))
than to use the stardard library rational.rb.

== Usage and Samples

See ((<index.html|URL:index.html>)) in ((|doc|)) directory, where
manuals and sample codes are.

== Reference
* D.Cox, J.Little and D.O'Shea, "IDEALS, VARIETIES AND ALGORITHMS", 1997, Springer.
* K. Kodama, "Polynomial", ((<URL:http://www.math.kobe-u.ac.jp/HOME/kodama/tips-RubyPoly.html>))
* H.Anai, M.Noro and K.Yokoyama, "Computation of the splitting fields and the Galois groups of polynomials", Progres in Mathematics, 28-50, Vo.143, 1996

=end


directoryPath <- "/home/mashrin/Workarea/Bearings/1st_test/"
data <- read.table(paste0(directoryPath, "2003.10.22.12.06.24"), header=FALSE, sep="\t")
head(data)
colnames(data) <- c("bearing1.x", "bearing1.y", "bearing2.x", "bearing2.y", "bearing3.x", "bearing3.y", "bearing4.x", "bearing4.y")
summary(data$bearing1.x)
plot(data$bearing1.x, t="l")
bearing1.x.fft <- fft(data$bearing1.x)
amplitudeData <- Mod(bearing1.x.fft[1:(length(bearing1.x.fft)/2)])
frequencyData <- seq(0, 10000, length.out=length(bearing1.x.fft)/2)
plot(amplitudeData ~ frequencyData, t="l")
plot(amplitudeData ~ frequencyData, t="l", xlim=c(0,1000), ylim=c(0,500))
axis(1, at=seq(0,1000,100), labels=FALSE)
sortingAmplitude <- sort.int(amplitudeData, decreasing=TRUE, index.return=TRUE)
bestFifteen <- sortingAmplitude$ix[1:15]
bestFifteenf <- frequencyData[bestFifteen]
fft.profile <- function (dataset, n)
{
  fft.data <- fft(dataset)
  amplitudeData <- Mod(fft.data[1:(length(fft.data)/2)])
  frequencies <- seq(0, 10000, length.out=length(fft.data)/2)
  sortingAmplitude <- sort.int(amplitudeData, decreasing=TRUE, index.return=TRUE)
  top <- sortingAmplitude$ix[1:n]
  return (frequencies[top])
}
n <- 5
bearing1 <- matrix(nrow=0, ncol=(2*n+1))
bearing2 <- matrix(nrow=0, ncol=(2*n+1))
bearing3 <- matrix(nrow=0, ncol=(2*n+1))
bearing4 <- matrix(nrow=0, ncol=(2*n+1))
for (filename in list.files(directoryPath))
{
  cat("Presently processing the file: ", filename, "\n")
  timestamp <- as.character(strptime(filename, format="%Y.%m.%d.%H.%M.%S"))
  data <- read.table(paste0(directoryPath, filename), header=FALSE, sep="\t")
  colnames(data) <- c("bearing1.x", "bearing1.y", "bearing2.x", "bearing2.y", "bearing3.x", "bearing3.y", "bearing4.x", "bearing4.y")
  bearing1 <- rbind(bearing1, c(timestamp, fft.profile(data$bearing1.x, n), fft.profile(data$bearing1.y, n)))
  bearing2 <- rbind(bearing2, c(timestamp, fft.profile(data$bearing2.x, n), fft.profile(data$bearing2.y, n)))
  bearing3 <- rbind(bearing3, c(timestamp, fft.profile(data$bearing3.x, n), fft.profile(data$bearing3.y, n)))
  bearing4 <- rbind(bearing4, c(timestamp, fft.profile(data$bearing4.x, n), fft.profile(data$bearing4.y, n)))
}
write.table(bearing1, file=paste0(directoryPath, "../bearing1.csv"), sep=",", row.names=FALSE, col.names=FALSE)
write.table(bearing2, file=paste0(directoryPath, "../bearing2.csv"), sep=",", row.names=FALSE, col.names=FALSE)
write.table(bearing3, file=paste0(directoryPath, "../bearing3.csv"), sep=",", row.names=FALSE, col.names=FALSE)
write.table(bearing4, file=paste0(directoryPath, "../bearing4.csv"), sep=",", row.names=FALSE, col.names=FALSE)
directoryPath <- "/home/mashrin/Workarea/Bearings/1st_test/"
bearing1 <- read.table(file=paste0(directoryPath, "../bearing1.csv"), sep=",", header=FALSE)
bearing2 <- read.table(file=paste0(directoryPath, "../bearing2.csv"), sep=",", header=FALSE)
bearing3 <- read.table(file=paste0(directoryPath, "../bearing3.csv"), sep=",", header=FALSE)
bearing4 <- read.table(file=paste0(directoryPath, "../bearing4.csv"), sep=",", header=FALSE)

par(mfrow=c(5,2))
plot(bearing1[, 2], pch=4, col="deepskyblue4", ylab="Frequency", main="Degraded x", ylim=c(0, 2))
points(bearing2[, 2], pch=3, col="blueviolet")
points(bearing4[, 2], pch=1, col="green2")
points(bearing3[, 2], pch=20, col="chocolate")
legend("topleft", c("bearing 1", "bearing 2", "bearing 3", "bearing 4"), col=c("deepskyblue4", "blueviolet", "chocolate", "green2"), pch=c(4, 3, 20, 1))
plot(bearing1[, 7], pch=4, col="deepskyblue4", ylab="Frequency", main="Degraded y", ylim=c(0, 2))
points(bearing2[, 7], pch=3, col="blueviolet")
points(bearing4[, 7], pch=1, col="green2")
points(bearing3[, 7], pch=20, col="chocolate")
legend("topleft", c("bearing 1", "bearing 2", "bearing 3", "bearing 4"), col=c("deepskyblue4", "blueviolet", "chocolate", "green2"), pch=c(4, 3, 20, 1))
plot(bearing1[, 3], pch=4, col="deepskyblue4", ylab="Frequency", main="Needs replacement x", ylim=c(0,10000))
points(bearing2[, 3], pch=3, col="blueviolet")
points(bearing4[, 3], pch=1, col="green2")
points(bearing3[, 3], pch=20, col="chocolate")
plot(bearing1[, 8], pch=4, col="deepskyblue4", ylab="Frequency", main="Needs replacement y", ylim=c(0,10000))
points(bearing2[, 8], pch=3, col="blueviolet")
points(bearing4[, 8], pch=1, col="green2")
points(bearing3[, 8], pch=20, col="chocolate")
plot(bearing1[, 4], pch=4, col="deepskyblue4", ylab="Frequency", main="Level one degradation x", ylim=c(0,10000))
points(bearing2[, 4], pch=3, col="blueviolet")
points(bearing4[, 4], pch=1, col="green2")
points(bearing3[, 4], pch=20, col="chocolate")
plot(bearing1[, 9], pch=4, col="deepskyblue4", ylab="Frequency", main="Level one degradation y", ylim=c(0,10000))
points(bearing2[, 9], pch=3, col="blueviolet")
points(bearing4[, 9], pch=1, col="green2")
points(bearing3[, 9], pch=20, col="chocolate")
plot(bearing1[, 5], pch=4, col="deepskyblue4", ylab="Frequency", main="Level two degradation x", ylim=c(0,10000))
points(bearing2[, 5], pch=3, col="blueviolet")
points(bearing4[, 5], pch=1, col="green2")
points(bearing3[, 5], pch=20, col="chocolate")
plot(bearing1[, 10], pch=4, col="deepskyblue4", ylab="Frequency", main="Level two degradation y", ylim=c(0,10000))
points(bearing2[, 10], pch=3, col="blueviolet")
points(bearing4[, 10], pch=1, col="green2")
points(bearing3[, 10], pch=20, col="chocolate")
plot(bearing1[, 6], pch=4, col="deepskyblue4", ylab="Frequency", main="Lubrication Required x", ylim=c(0,10000))
points(bearing2[, 6], pch=3, col="blueviolet")
points(bearing4[, 6], pch=1, col="green2")
points(bearing3[, 6], pch=20, col="chocolate")
plot(bearing1[, 11], pch=4, col="deepskyblue4", ylab="Frequency", main="Lubrication Required y", ylim=c(0,10000))
points(bearing2[, 11], pch=3, col="blueviolet")
points(bearing4[, 11], pch=1, col="green2")
points(bearing3[, 11], pch=20, col="chocolate")


compute_π <- function(trials) {
    points <- matrix(runif(2*trials), nrow=2)
    inside <- sum(colSums(points^2) <= 1.0)
    return(4.0*inside/trials)
}

args = commandArgs(trailingOnly=TRUE)
if(length(args) < 1) {
    error("must provide number of trials")
}
trials = as.integer(args[1])
set.seed(2018)

start.time <- Sys.time()
invisible(compute_π(trials))
stop.time <- Sys.time()
cat("First invocation: ", stop.time - start.time, "s\n")

start.time <- Sys.time()
π <- compute_π(trials)
stop.time <- Sys.time()
cat("Second invocation:", stop.time - start.time, "s\n")

cat("π ≈ ", π, "\n")


      library(zoo)         # time series library
      library(ggplot2)     # graphing library
      library(readxl)      # reading excel files library
      library(strucchange) # library implementing breakpoint analysis
      library(ggfortify)   # extension for ggplot time series graphing

      # Country codes list
      # https://web.stanford.edu/~chadj/shcodes.txt
      country_code = "ZWE"

      # Read and transfrom data
      pwt91 <- read_excel("sample_data/pwt91.xlsx", sheet = "Data")
      country_gdp <- subset(pwt91,countrycode==country_code,select = c("year","rgdpe"))
      # remove rows with NA
      country_gdp <- country_gdp[complete.cases(country_gdp),]
      country_gdp <- ts(country_gdp$rgdpe,start = country_gdp$year[1], frequency=1)
      start_year = time(country_gdp)[1]
      autoplot(country_gdp) + labs(title=paste("RGDP growth in",country_code),x="year",y="RGDP value")

      # calculating percentage growth in time
      prc <- sapply(1:length(country_gdp)-1, function(i){
        1-country_gdp[i]/country_gdp[i+1]
      })
      start_year = start_year + 1
      country_gdp <- ts(unlist(prc, use.names=FALSE),start = start_year,frequency=1)

      # Plot the data and CUSUM & MOSUM
      autoplot(country_gdp) + labs(title=paste("Percentage change of RGDP per year in",country_code), x="year", y="percent in decimal")
      # cusum and mosum for residuals (value - mean)
      #plot cumsum
      CUSUM = cumsum(country_gdp - mean(country_gdp))
      CUSUM <- ts(CUSUM,start =start_year)
      autoplot(CUSUM)+ geom_hline(yintercept = 0,color="blue")+labs(title="Cumulative Sum", x="year", y="percent in decimal")

      # plot moving sum
      MOSUM = rollapply(country_gdp - mean(country_gdp), 15, sum)
      autoplot(MOSUM)+ geom_hline(yintercept = 0,color="blue")+labs(title="Moving Sum from 15 observations", x="year", y="percent in decimal")

      # plot rec-cumsum (mean of all observations prior to given time)
      rec_cusum <- numeric(length(country_gdp))
      for (i in 1:length(country_gdp)){
        rec_cusum[i] = mean(country_gdp[1:(i-1)])
      }
      rec_cusum <- ts(rec_cusum,start = start_year,frequency = 1)
      autoplot(rec_cusum)+labs(title="Recursive Cumulative Sum", x="year", y="percent in decimal")

      # calculate residual sum of squares
      rss =  sapply(5:(length(country_gdp)-5), function(i) {
        before <- 1:i
        after <- (i+1):length(country_gdp)
        res <- c(Nile[before] - mean(Nile[before]), Nile[after] - mean(Nile[after]))
        sum(res^2)
        })

      rss <- ts(rss,start=start_year-1+5,frequency=1)
      autoplot(rss) + labs(title = "Residual Sum of Squares",x="Year",y="RSS")

      # find suspected breakpoint
      breakpoint <- time(rss)[which.min(rss)]
      plot(country_gdp)
      abline(v=breakpoint, col="red",lty=2)
      lines(ts(predict(lm((country_gdp[1:(breakpoint-start_year+1)]) ~ 1)),start=start_year,freq=1),col='darkgreen',lwd=2)
      lines(ts(predict(lm((country_gdp[(breakpoint-start_year+1):length(country_gdp)]) ~ 1)),start=breakpoint,freq=1),col='darkgreen',lwd=2)

      #-------------------------------
      # Strucchange based calculations
      # 1. Simple model country_gdp ~ 1   (y = β0) β0 = mean

      # F statistics at 5% significance level, h=0.1 (partition size)
      fs <- Fstats(country_gdp ~ 1,from=0.1)
      plot(fs,main="F test")
      cat("Potential breakpoint form F test at:", time(country_gdp)[fs$breakpoint],"\n")

      # test the null hypothesis that the GDP growth remains constant over the years
      # compute OLS-based CUSUM & MOSUM process and plot

      par(mfrow=c(2,2))
      ocus <- efp(country_gdp ~ 1, type = "OLS-CUSUM")
      omos <- efp(country_gdp ~ 1, type = "OLS-MOSUM")
      rmos <- efp(country_gdp ~ 1, type = "Rec-CUSUM")
      rcus <- efp(country_gdp ~ 1, type = "Rec-MOSUM")
      plot(ocus)
      plot(omos)
      plot(rmos)
      plot(rcus)
      par(mfrow=c(1,1))

      # finding date of the breakpoint
      bp <- breakpoints(country_gdp ~ 1)
      for(i in bp$breakpoints){cat("Breakpoint found at year:",time(country_gdp)[i],"\n")}
      # finding segmentation of the data
      bfac <- breakfactor(bp, breaks = length(bp$breakpoints))
      # model
      fm <- lm(country_gdp ~ bfac - 1)
      plot(bp)
      autoplot(bp)

      plot(country_gdp, ylab="RGDPE")
      lines(ts(predict(fm),start=start_year,freq=1), col='darkgreen',lwd=2)
      # compute 95% confidence intervals
      ci_ts <- confint(bp)
      lines(ci_ts)

      # 2. model with two explanatory variables

      gdp_lag <- cbind(country_gdp, lag(country_gdp, k = -1), lag(country_gdp, k = -3))
      colnames(gdp_lag) <- c("y", "ylag1", "ylag3")

      gdp_lag <- window(gdp_lag, start = time(gdp_lag)[4], end = time(gdp_lag)[length(gdp_lag)/3-3])
      model <- lm(y~ylag1 + ylag3,data=gdp_lag)
      # EFP
      re.seat <- efp(y ~ ylag1 + ylag3, data = gdp_lag, type = "RE")
      plot(re.seat)
      sctest(re.seat)
      # F statistics
      fs <- Fstats(y ~ ylag1 + ylag3, data = gdp_lag, from = 0.1)
      plot(fs)
      cat("Potential breakpoint form F test (multivariable regression) at:", time(gdp_lag[,"y"])[fs$breakpoint],"\n")

      plot(gdp_lag[,"y"],main="Breapoint from F test",ylab="RGDP",xlab="year")
      abline(v=time(gdp_lag)[fs$breakpoint],col="red",lty=2)
      # reset plot arguments
      par(mfrow=c(1,1))


##########################################################
#### R code for adding noise to correlation matrices  ####
#### J. Hardin, S.R. Garcia, D. Golan                 ####
#### last updated 1/18/2013                           ####
##########################################################

#################
##   EXAMPLE   ##
#################

# adding noise to a 15x15 identity matrix

noise.iden <- noisecor(diag(15), epsilon = .5, eidim=2)

# adding noise to a 2 block constant correlation matrix
rho.blck = c(.9,.2)
eps.blck = 0.99 - max(rho.blck)
samp.blck <- simcor(k = 2, size = c(10, 5), rho = c(0.9, 0.2), delta = 0.39, epsilon = eps.blck, eidim = 2)

# adding noise to a 2 block correlation matrix with an AR(1) strucutre
rho.Top = c(.7,.9)
eps.Top = (1-max(rho.Top))/(1+max(rho.Top)) - .01
samp.Top <- simcorTop(k=2, size=c(10,5), rho=c(.7,.9), epsilon = eps.Top, eidim=2)

# adding noise to a 2 block correlation matrix with a Hub structure
rho.Hub = c(.9,.7)
tau.Hub = c( (.9 - .7) / (10-2), (.7-.6)/(5-2))
eps.Hub = min(1-(rho.Hub) - 0.75*(tau.Hub) ) - .01
samp.Hub <- simcor.H(k=2, size=c(10,5),	rho=rbind(c(.9,.7), c(.7,.6)), power=1,
	epsilon=eps.Hub, eidim=2)

########################
## The Basic Function ##
########################

# this adds noise to any user specified correlation matrix

noisecor <- function(cormat, epsilon = .01, eidim=2){

ndim=dim(cormat)[1]
diag(cormat) <- 1 - epsilon

### adding noise to the correlation matrix

eivect <- c( )
for (i in 1:ndim) {
	ei <- runif(eidim, -1, 1)
	eivect <- cbind(eivect, sqrt(epsilon) * ei / sqrt(sum(ei^2) ) )
}

bigE <- t(eivect) %*% eivect
cor.nz <- cormat + bigE
cor.nz

}

#######################################
##  Simulating different correlation ##
##  structures as in Hardin et al.   ##
#######################################

################################
##  Simulating the Constant Correlation
################################

# this function simulates a block correlation matrix
# The size and base correlation for each block is user specified
# There is an additional delta parameter for the off diagonal correlations

# k is the number of groups
# size is a vector of length k specifying the size of each group
# rho is a vector of length k specifying base correlation values
# epsilon <- 0.99 - max(rho)
# eidim is the space from which the noise is generated, the smaller the more noise
# delta is the correlation of the off diagonal blocks

simcor = function (k = 6, size = c(10, 5, 8, 2, 15, 50), rho = c(0.7,
    0.7, 0.5, 0.9, 0.85, 0.4), delta = 0.39, epsilon = 0.99 -
    max(rho), eidim = 2)
{
    ndim <- sum(size)
    bigcor <- matrix(rep(delta, ndim * ndim), ncol = ndim)
    for (i in 1:k) {
        cor <- matrix(rep(rho[i], size[i] * size[i]), ncol = size[i])
        if (i == 1) {bigcor[1:size[1], 1:size[1]] <- cor}
        if (i != 1) {bigcor[(sum(size[1:(i - 1)]) + 1):sum(size[1:i]),
                (sum(size[1:(i - 1)]) + 1):sum(size[1:i])] <- cor}
    }
    diag(bigcor) <- 1 - epsilon

    eivect <- c()
    for (i in 1:ndim) {
        ei <- runif(eidim, -1, 1)
        eivect <- cbind(eivect, sqrt(epsilon) * ei/sqrt(sum(ei^2)))
    }
    bigE <- t(eivect) %*% eivect
    cor.nz <- bigcor + bigE
    cor.nz
}

################################
##  Simulating the Toeplitz Matrix
################################

# this function calculates an AR(1) Toeplitz matrix
# with a block diagonal structure.  The size and base correlation for each
# block is user specified

# k is the number of groups
# size is a vector of length k specifying the size of each group
# rho is a vector of length k specifying base correlation values
# epsilon <- (1-max(rho))/(1+max(rho)) - .01
# eidim is the space from which the noise is generated, the smaller the more noise

simcorTop <- function(k=6,size=c(10,5,8,2,15,50),rho=c(.7,.7,.5,.9,.85,.4),epsilon= .01, eidim=2) {

ndim <- sum(size)# dim of correlation matrix
bigcor<- matrix(rep(0, ndim*ndim), ncol=ndim)

### generating the basic correlation matrix

for (i in 1:k){

	top <- c(1,rho[i]^(seq(1:(size[i]-1))))
	cor <- toeplitz(top)

	if (i==1){bigcor[1:size[1], 1:size[1]] <- cor}
	if (i!=1){bigcor[(sum(size[1:(i-1)]) + 1):sum(size[1:i]),
		(sum(size[1:(i-1)]) + 1):sum(size[1:i])] <- cor}
	}

diag(bigcor) <- 1 - epsilon

### adding noise to the correlation matrix

eivect <- c( )
for (i in 1:ndim) {
	ei <- runif(eidim, -1, 1)
	eivect <- cbind(eivect, sqrt(epsilon) * ei / sqrt(sum(ei^2) ) )
}

bigE <- t(eivect) %*% eivect
cor.nz <- bigcor + bigE
cor.nz

}

################################
##  Simulating the Hub Matrix (entries filled in using Toeplitz structure)
################################

# this function calculates a Toeplitz matrix with values descending
# from a user specified maximum to minimum.  The matrix has a
# block diagonal structure.  The size and base correlation for each
# block is user specified.

# k is the number of groups
# size is a vector of length k specifying the size of each group
# rho is a vector of length k specifying base correlation values
# epsilon <- (1-min(rho) - 0.75*min(tau) ) - .01
# tau_k = (max(rho_k) - min(rho_k) )/ (size_k -2)
# eidim is the space from which the noise is generated, the smaller the more noise
# power = 2 makes the correlations stay high
# power = 0.5 makes the correlations descent rapidly

simcor.H <- function(k=6, size=c(10,5,8,7,15,50),
	rho=rbind(c(.9,.7), c(.7,.7), c(.7,.2), c(.5,.3), c(.9,.85), c(.3,.2)), power=1,
	epsilon=.08, eidim=2){

	ndim <- sum(size)# dim of correlation matrix
	bigcor<- matrix(rep(0, ndim*ndim), ncol=ndim)

### generating the basic correlation matrix

	for (i in 1:(k) ){

	cor <- toeplitz(rho.func(rho[i,1],rho[i,2],power,size[i]) )

	if (i==1){bigcor[1:size[1], 1:size[1]] <- cor}
	if (i!=1){bigcor[(sum(size[1:(i-1)]) + 1):sum(size[1:i]),
		(sum(size[1:(i-1)]) + 1):sum(size[1:i])] <- cor}
	}
	diag(bigcor) <- 1 - epsilon

### adding noise to the correlation matrix

	eivect <- c( )
	for (i in 1:ndim) {
	ei <- runif(eidim, -1, 1)
	eivect <- cbind(eivect, sqrt(epsilon) * ei / sqrt(sum(ei^2) ) )
	}

	bigE <- t(eivect) %*% eivect
	cor.nz <- bigcor + bigE
	cor.nz
	}

# rho.func is needed for filling in the rest of the structure of the Hub
# correlation matrix
# r.max is the maximum user specified correlation
# r.min is the minimum user specified correlation
# power is the power at which the correlations descend
# p is the size of the correlation block

rho.func <- function(r.max, r.min, power,p){
	rhovec <-c()

	rhovec[1] <- 1
	for(i in 2:p){
	rhovec[i] <- r.max - ((i-2)/(p-2))^power*(r.max-r.min)
	}
	rhovec}


# 4. faza: Analiza podatkov

# 1.regresijska premica: ŠTEVILO UMRLIH V CESTNOPROMETNIH NESREČAH NA 10.000 REGISTRIRANIH MOTORNIH VOZIL V NASLEDNJIH LETIH

grupa <- group_by(preminuli, Leto)
preminuli_Slovenija <- summarise(grupa, Stevilo=(sum(Preminuli, na.rm = TRUE)))
preminuli_Slovenija <- transform(preminuli_Slovenija, Stevilo = (Stevilo / 12))
preminuli_Slovenija$Stevilo <- round(preminuli_Slovenija$Stevilo, digits=2)
prileganje <- lm(data = preminuli_Slovenija, Stevilo ~ Leto )
m <- data_frame(Leto=seq(2019,2023,1))
predvidevanje <- mutate(m, Stevilo=predict(prileganje,m))
predvidevanje$Stevilo <- round(predvidevanje$Stevilo, digits = 2)

graf_regresijska_premica_preminulih <- ggplot(preminuli_Slovenija, aes(x=Leto, y=Stevilo)) +
  geom_smooth(method=lm, fullrange = TRUE, color = 'blue') +
  geom_point(data=predvidevanje, aes(x=Leto, y=Stevilo), color='red', size=2) +
  geom_point() +
  labs(title='Predvidevanje števila smrti v prometu v naslednjih letih', y="Stevilo")

# 2.regresijska premica: ŠTEVILO OSEBNIH AVTOMOBILOV NA 1000 PREBIVALCEV V PRIHODNOSTI
oseb_avto <- group_by(osebni_avtomobili,Leto)
oseb_avto1 <- summarise(oseb_avto, Stevilo=sum(Osebni_avtomobili, na.rm=TRUE))
oseb_avto_regije <- transform(oseb_avto1, Stevilo = Stevilo / 12)
oseb_avto_regije$Stevilo <- round(oseb_avto_regije$Stevilo, digits=2)
prileganje <- lm(data = oseb_avto_regije, Stevilo ~ Leto )
n <- data_frame(Leto=seq(2020,2024,1))
predvidevanje_oseb_avto <- mutate(n, Stevilo=predict(prileganje, n))

graf_regresijske_premice_oseb_avto <- ggplot(oseb_avto_regije, aes(x=Leto, y=Stevilo)) +
  geom_smooth(method=lm, fullrange = TRUE, color = 'blue') +
  geom_point(data=predvidevanje_oseb_avto, aes(x=Leto, y=Stevilo), color='red', size=2) +
  geom_point() +
  labs(title='Predvidevanje števila osebnih avtomobilov na 1000 prebivalcev v prometu v prihodnosti', y="Stevilo")

# Cluster regij: ŠTEVILO UMRLIH V CESTNOPROMETNIH NESREČAH

# Preminuli
grup <- group_by(preminuli, Regija)
preminuli_sum <- summarise(grup, vsote=sum(Preminuli, na.rm = TRUE))

preminuli_e <- dcast(preminuli, Regija~Leto, value.var = 'Preminuli' )
preminuli_e <- left_join(preminuli_e, preminuli_sum, by = 'Regija')
preminuli_e <- preminuli_e[order(preminuli_e$vsote, decreasing = FALSE),]
preminuli_b <- preminuli_e[,-19]
preminuli_b <- preminuli_b[,-1]

n <- 5
fit <- hclust(dist(scale(preminuli_b)))
skupine <- cutree(fit, n)

cluster <- mutate(preminuli_e, skupine)
cluster <- cluster[,-2:-19]
colnames(cluster) <- c("Regija", "Preminuli")

# zemljevid

Regije <- unique(zemljevid$NAME_1)
Regije <- as.data.frame(Regije, stringsAsFactors=FALSE)
names(Regije) <- "Regija"
skupaj <- left_join(Regije, cluster, by="Regija")

zemljevid_cluster_preminuli <- ggplot() + geom_polygon(data=left_join(zemljevid, skupaj, by=c("NAME_1"="Regija")),
                                                   aes(x=long, y=lat, group=group,
                                                       fill=factor(Preminuli))) +
  geom_line() +
  theme(axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.text.y=element_blank(),
        axis.ticks.y=element_blank()) +
  guides(fill=guide_colorbar(title="Skupine")) +
  ggtitle('Razvrstitev regij v skupine glede na število preminulih v cestnoprometnih nesrečah na 10.000 registriranih motornih vozil') +
  labs(x = " ") +
  labs(y = " ") +
  scale_fill_brewer(palette="YlOrRd", na.value = "#e0e0d1")

#SHINY

graf.regije <- function(regija){
  ggplot(preminuli %>% filter(Regija %in% regija)) + aes(x=Leto, y=Preminuli, group=Regija, color=Regija) +
    geom_line() + geom_point()+ xlab("Leto") + ylab("Število preminulih") +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.3, hjust=1))
}

graf_osebni_avto <- function(cifra) {
  ggplot(osebni_avtomobili %>% filter(Leto==cifra), aes(x=Regija, y=Osebni_avtomobili, fill=factor(Regija))) +
    ylim(0, 650) + geom_bar(stat = "identity") +
    xlab("Regija") + ylab("Število osebnih avtomobilov") +
    theme(axis.text.x = element_text(angle = 90, size = 8, hjust = 1, vjust = 0.5)) +
    labs(fill='Regija')

}


setwd('~/Code/SMAI/KNN')
manhattan_distance <- function(p1,p2) {
  return(abs(sum(p1 - p2)))
}

squared_euclidean_distance <- function(p1,p2) {
  return(sum((p1 - p2)**2))
}

get_centroid <- function(l) {
  if(length(l) > 91) {
    v <- apply(l,2,function(x) sum(x))
    v <- v/nrow(l)
  } else {
    v <- l
  }
  return(v)
}

merge_clusters <- function(clusters,min_i,val_i,val_j) {
  for(i in 1:length(clusters)) {
    if(clusters[[i]] == val_i || clusters[[i]] == val_j) {
      clusters[[i]] <- min_i
    }
  }
  return(clusters)
}

cluster_centroids <- function(data,clusters) {
  reduced_set <- unique(clusters)
  min_val = squared_euclidean_distance(data[[1]],data[[2]])
  min_i = 1
  min_val_i = reduced_set[[1]]
  min_val_j = reduced_set[[2]]
  for(i in 1:length(data)) {
    for(j in i:length(data)) {
      if(i != j) {
      distance = squared_euclidean_distance(data[[i]],data[[j]])
      if(distance < min_val) {
        min_val = distance
        min_i = i
        min_val_i = reduced_set[[i]]
        min_val_j = reduced_set[[j]]
      }
      }
    }
  }
  clusters <- merge_clusters(clusters,min_i,min_val_i,min_val_j)
  return(clusters)
}

get_min_distance <- function(c1,c2) {
  min_val = squared_euclidean_distance(c1[[1]],c2[[1]])
  for(i in 1:length(c1)) {
    for(j in 1:length(c2)) {
      distance = squared_euclidean_distance(c1[[i]],c2[[j]])
      if(distance <= min_val) {
        min_val = distance
      }
    }
  }
  return(min_val)
}

cluster_min <- function(data,clusters) {
  reduced_set <- unique(clusters)
  min_i = 1
  min_val_i = reduced_set[[1]]
  min_val_j = reduced_set[[2]]
  min_val <- 99999
  for(i in reduced_set) {
    for(j in reduced_set) {
      if(i != j) {
      c1 <- data[clusters == i,]
      c2 <- data[clusters == j,]
      distance <- get_min_distance(c1,c2)
      if(distance < min_val) {
        min_val = distance
        min_i = i
        min_val_i = reduced_set[[i]]
        min_val_j = reduced_set[[j]]
      }
      }
    }
  }
  print(min_val_i)
  print(min_val_j)
  clusters <- merge_clusters(clusters,min_i,min_val_i,min_val_j)
  return(clusters)
}

data <- as.matrix(read.csv("Datasets/movement_libras_1.data",header = FALSE, sep = ",",fill = FALSE))
clusters <- vector('integer')
for(i in 1:45) {
  #mat[[i]] <- data[i,]
  clusters[[i]] <- i
}
#clusters <- cluster(mat,clusters)
while(length(unique(clusters)) > 1) {
  mat <- list()
  val <- unique(clusters)
  # for(i in 1:length(val)) {
  #   mat[[i]] <- get_centroid(data[clusters == val[i],])
  # }
  print(length(val))
  # clusters <- cluster_centroids(mat,clusters)
  clusters <- cluster_min(data,clusters)
}


# ......................................................................................
# .................... Cvičení 9. Intervalové odhady (jednoho výběru)...................
# ............... Michal Béreš, Martina Litschmannová, Veronika Kubíčková...............
# ......................................................................................

# 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

#  Demonstrace na úvod - co je to intervalový odhad? ####
# Uvažujme náhodnou veličinu z normálního rozdělení se střední hodnotou $\mu$ a
# směrodatnou odchylkou $\sigma$. Budeme pracovat s výběry z této náhodné veličiny a
# pomoci jich se budeme snažit odhadnout střední hodnutu rozdělení (zde známe její
# skutečnou hodnotu, ale v praxi je její hodnota neznámá).

n = 30        # velikost výběru
mu = 100      # střední hodnota
sigma = 10    # směr. odchylka

# simulace náhodného výběru ze zadané náhodné veličiny
vyber = rnorm(n = n, mean = mu, sd = sigma)

X = mean(vyber) # výběrový průměr jako bodový odhad
S = sd(vyber)   # výběrová směr. odch.
X
S

# Pro přehlednost si můžeme výběr vizualizovat.

options(repr.plot.width = 12) # šířka grafů v Jupyteru
par(mfrow = c(1, 2))          # matice grafů 1x2

hist(vyber)
boxplot(vyber)

# ** Samotné sestrojení Intervalového odhadu pomocí výběrové charakteristiky ####
# Použijeme tuto výběrovou charakteristiku: (předpokládáme, že neznáme žádné skutečné
# parametry rozdělení, pouze to, že je normální)
# $Y=\frac{\bar X - \mu}{S}\sqrt{n} \sim t_{n-1}$
# Jelikož, známe rozdělení Y jsme schopni napočítat $a$ a $b$ v následujícím výrazu:
# $P(a<Y<b)\geq 1 - \alpha$
# - $\alpha$ nazýváme hladinou významnosti (pravděpodobnost, že hledaná hodnota leží
# mimo náš interval)
# - $1-\alpha$ nazýváme spolehlivost intervalového odhadu

# $a$ a $b$ zvolíme tak aby byly v pravděpodobnosti symetrické, tzn.:
# - $P(Y<a)\leq \alpha / 2 \rightarrow a=t_{\alpha / 2;n-1}$
# - $P(b<Y)\leq \alpha / 2 \rightarrow P(Y\leq b)\geq 1 - \alpha / 2 \rightarrow
# b=t_{1-\alpha / 2;n-1}$

# maximální pravděpodobnost s jakou připouštíme aby
# skutečná st. hod. ležela mimo sestrojený interval
alpha = 0.05

# příslušné kvantily studentova rozdělení
t_low = qt(alpha/2, df = n-1)
t_high = qt(1 - alpha/2, df = n-1)

t_low
t_high

# Dále jen doplníme do výrazu a upravíme:
# $P(t_{\alpha / 2;n-1}<\frac{\bar X - \mu}{S}\sqrt{n}<t_{1-\alpha / 2;n-1})\geq 1 -
# \alpha$
# $P(\bar X - t_{1-\alpha / 2;n-1}\frac{S}{\sqrt{n}}<\mu<\bar X - t_{\alpha /
# 2;n-1}\frac{S}{\sqrt{n}})\geq 1 - \alpha$

I_dolni = X - t_high*S/sqrt(n)
I_horni = X - t_low*S/sqrt(n)
paste("P(", I_dolni, " < µ < ", I_horni, ") ≥ ", 1-alpha)

# Tento konkrétní odhad, můžeme dostat také pomocí Rkovské funkce t.test:

t.test(vyber, alternative = 'two.sided', conf.level = 1-alpha)$conf.int

# ** Otestování intervalového odhadu na více výběrech ####

pocet_pokusu = 10000 # počet výběrů

n = 30             # velikost výběru
mu = 100           # střední hodnota
sigma = 10         # směrodat. odchyl.

alpha = 0.05        # hladina významnosti

# příslušné kvantily studentova rozdělení
t_low = qt(alpha/2, df = n-1)
t_high = qt(1 - alpha/2, df = n-1)

# vykreslení skutečné střední hodnoty
plot(c(1, pocet_pokusu), c(mu, mu), type = 'l', ylim = c(90,110))

pocet_neuspesnych = 0
# cyklus přes jednotlivé výběry
for(i in 1:pocet_pokusu){
    vyber = rnorm(n = n, mean = mu, sd = sigma)
    X = mean(vyber)
    S = sd(vyber)
    I_dolni = X - t_high*S/sqrt(n)
    I_horni = X - t_low*S/sqrt(n)

    # zvolíme barvu vykreslení, podle toho zda IO obsahuje stř. hod.
    if( I_dolni<mu & mu<I_horni){
        barva = "blue"
    }else{
        barva = "red"
        pocet_neuspesnych = pocet_neuspesnych + 1
    }
    # vykreslíme IO jako vertikální čáru
    lines(c(i, i), c(I_dolni, I_horni), col=barva)
}
paste('alpha = ', alpha, ', relativní četnost něúspěšných IO = ',
      pocet_neuspesnych/pocet_pokusu)

# vrátím šířku na standardní velikost
options(repr.plot.width = 8) # šířka grafů v Jupyteru

#  Typy intervalových odhadů ####
# (Ukázky na odhadu střední hodnoty dat z normálního rozdělení.)
# * Dolní/Levostranný IO ####
# - $P(M_D^* < \mu) = 1-\alpha$
# - v Rku **alternative="greater"**

vyber = rnorm(n = 30, mean = 100, sd = 10)
alpha = 0.05
t.test(vyber, alternative = 'greater', conf.level = 1-alpha)$conf.int

# * Horní/Pravostranný IO ####
# - $P(\mu < M_H^*) = 1-\alpha$
# - v Rku **alternative="less"**

vyber = rnorm(n = 30, mean = 100, sd = 10)
alpha = 0.05
t.test(vyber, alternative = 'less', conf.level = 1-alpha)$conf.int

# * Oboustranný IO ####
# - $P(M_D < \mu < M_H) = 1-\alpha$
# - v Rku **alternative="two.sided"**

vyber = rnorm(n = 30, mean = 100, sd = 10)
alpha = 0.05
t.test(vyber, alternative = 'two.sided', conf.level = 1-alpha)$conf.int

#  Přehled parametrů výběru a jejich bodových/intervalových odhadů ####
# Běžně máme k dispozici více konstrukcí IO (funkcí v Rku které to za nás udělají), ale
# každá konstrukce má jiné požadavky na data a vytváří různě "kvalitní" (ve smyslu
# velikosti IO) odhady. My budeme vždy vybírat "nejkvalitnější" IO, který **má splněny**
# předpoklady použití.
# Pořadí různých IO níže bude vždy od "nejlepšího" po nejrobustnější.
# * Míry polohy jednoho výběru ####
# Mírami polohy rozumíme údaj určující polohu dat, nehledě na tom jak jsou rozptýlená.
# Pro data z normálního rozdělení můžeme odhadovat střední hodnotu, pro ostatní medián.
# *** a) studentův t-test IO ####
# - odhadujeme střední hodnotu - bodový odhad je výběrový průměr
# - data musejí pocházet z normálního rozdělení
#     - exploračně: šikmost a špičatost leží v (-2,2)
#     - exploračně: QQ graf má body přibližně na čáře
#     - exaktně: pomocí statistického testu, např. Shapiro-Wilk test
# (shapiro.test(data))

vyber = rnorm(n = 30, mean = 100, sd = 10)
alpha = 0.05

# exploračně test normality
# library(moments) - tomuto se můžeme vyhnout voláním moments::
# je to bezpečnější - máme jistotu, že voláme funkci z tohoto balíčku
moments::skewness(vyber)
moments::kurtosis(vyber) - 3
qqnorm(vyber)
qqline(vyber)

# exaktně test normality dat
shapiro.test(vyber)$p.value
# vysledná p-hodnota musím být větší než hl. výz. (př. 0.05)

# bodový odhad
mean(vyber)
# IO
t.test(vyber, alternative = 'two.sided', conf.level = 1-alpha)$conf.int

# *** b) Wilcoxnův test IO ####
# - odhadujeme medián - bodový odhad je výběrový medián
# - data musejí pocházet ze symetrického rozdělení
#     - exploračně: šikmost leží v (-2,2)
#     - exploračně: histogram vypadá přibližně symetricky
#     - exaktně: pomocí statistického testu, např. balíček "lawstat", funkce
# "symmetry.test(data,boot=FALSE)"
# - funkce v Rku vyžaduje dodatečný parametr (conf.int = TRUE)

vyber = runif(n = 30, min = 80, max = 120)
alpha = 0.05

# exploračně
moments::skewness(vyber)
hist(vyber, breaks = 5)

# exaktně: test symetrie
#install.packages("lawstat")
library(lawstat)
symmetry.test(vyber,boot=FALSE)$p.value
# vysledná p-hodnota musím být větší než hl. výz. (př. 0.05)

# bodový odhad
quantile(vyber, probs = 0.5)
median(vyber)
# IO
wilcox.test(vyber, alternative = 'two.sided', conf.level = 1-alpha,
            conf.int = TRUE)$conf.int

# *** c) znaménkový test test IO ####
# - odhadujeme medián - bodový odhad je výběrový medián
# - výběr většího rozsahu (>10)
# - funkce v Rku vyžaduje dodatečný parametr (conf.int = TRUE)
# - vyžaduje knihovnu "BSDA"
# - jakožto nejrobustnější test, se dá použít i na nespojitá data - např. pořadí v
# nějakém seznamu

vyber = rexp(n = 30, rate = 1/100)
alpha = 0.05

# skutečný medián
qexp(p = 0.5, rate = 1/100)

# bodový odhad
# quantile(vyber, probs = 0.5)
median(vyber)
# IO
# install.packages("BSDA")
library(BSDA)
SIGN.test(vyber, alternative = 'two.sided', conf.level = 1-alpha,
          conf.int = TRUE)$conf.int

# * Míry variability jednoho výběru ####
# Mírami variability rozumíme údaj určující rozptýlenost/variabilitu dat, nehledě na
# celkových hodnotách. Pro data z normálního rozdělení můžeme odhadovat směrodatnou
# odchylku.
# *** IO směrodatné odchylky ####
# - odhadujeme směrodatnou odchylku - bodovým odhadem je výběrový směrodatná odchylka
# - data musejí pocházet z normálního rozdělení
#     - exploračně: šikmost a špičatost leží v (-2,2)
#     - exploračně: QQ graf má body přibližně na čáře
#     - exaktně: pomocí statistického testu, např. Shapiro-Wilk test
# (shapiro.test(data))
# - vyžaduje balíček "EnvStats"
# - funkce v Rku, dává výpočet rozptylu - nutná odmocnina výsledku

vyber = rnorm(n = 30, mean = 100, sd = 10)
alpha = 0.05

# exploračně test normality
moments::skewness(vyber)
moments::kurtosis(vyber) - 3
qqnorm(vyber)
qqline(vyber)

# exaktně test normality dat
shapiro.test(vyber)$p.value
# vysledná p-hodnota musím být větší než hl. výz. (př. 0.05)

# bodový odhad
sd(vyber)
# IO
#install.packages("EnvStats")
library(EnvStats)
sqrt(varTest(vyber, alternative = 'two.sided', conf.level = 1-alpha)$conf.int)

# Přidáme si ruční výpočet:
# - vycházíme ze statistiky: $\frac{S^2}{\sigma^2}(n-1) \sim \chi^2_{n-1}$
# - Horní mez:
#     - $P(\frac{S^2}{\sigma^2}(n-1) < \chi^2_{\alpha /2, n-1}) = \alpha /2$
#     - $P(\frac{S^2}{\chi^2_{\alpha /2, n-1}}(n-1) < \sigma^2 ) = \alpha /2$
# - Dolní mez:
#     - $P(\frac{S^2}{\sigma^2}(n-1) > \chi^2_{1-\alpha /2, n-1}) = \alpha /2$
#     - $P(\frac{S^2}{\chi^2_{1-\alpha /2, n-1}}(n-1) > \sigma^2 ) = \alpha /2$
# - Dohromady: $P(\frac{S^2}{\chi^2_{1-\alpha /2, n-1}}(n-1) < \sigma^2
# <\frac{S^2}{\chi^2_{\alpha /2, n-1}}(n-1)) = 1 - \alpha$

# ruční výpočet
alpha = 0.05
n = 30
S = sd(vyber)

hor_q = qchisq(1 - alpha/2, n-1)
dol_q = qchisq(alpha/2, n-1)
hor_q
dol_q

sqrt(S^2*(n-1)/dol_q)
sqrt(S^2*(n-1)/hor_q)

# * Pravděpodobnost výskytu u jednoho výběru ####
# *** IO pravděpodobnosti ####
# - odhadujeme pravděpodobnost - bodový odhad je relativní četnost
# - vyžadujeme dostatečný počet dat: $n>\frac{9}{p(1-p)}$
# - Clopperův - Pearsonův odhad (binom.test)
#     - jako parametr nebere data, ale počet úspěchů a počet pozorování
# - Waldův - z výběrových charakteristik

pi = 0.3
n = 60
alpha = 0.05
vyber = runif(n = n, min = 0, max = 1) < pi

# ověření předpokladů
p = mean(vyber)
p
9/(p*(1-p))

# bodový odhad
p
# intervalový odhad Clopperův - Pearsonův
celk_pocet = length(vyber)
pocet_poz = sum(vyber)
binom.test(x = pocet_poz, n = celk_pocet, alternative = 'two.sided',
           conf.level = 1 - alpha)$conf.int

# Intervalový odhad Waldův
dol_q = qnorm(alpha/2)
hor_q = qnorm(1-alpha/2)

p - hor_q*sqrt(p*(1-p)/n)   # dolní mez IO
p - dol_q*sqrt(p*(1-p)/n)       # horní mez IO

# Výpočet 11 nejčastěji používaných intervalů spolehlivosti param. bin. rozdělení
# pomocí balíčku binom
# install.packages("binom")
library(binom)
binom.confint(n = celk_pocet, x = pocet_poz)

#  Příklady ####
# * Příklad 1. ####
# Při kontrolních zkouškách 16 žárovek byl stanoven odhad střední hodnoty $\bar x$ = 3
# 000 hodin a směrodatné odchylky s = 20 hodin jejich životnosti. Za předpokladu,že
# životnost žárovky má normální rozdělení, určete 90% intervalový odhad pro parametry µ
# a σ

# Odhadujeme stř.hodnotu a směr.odchylku životnosti žárovek
# Součástí zadání je informace o normalitě dat

n = 16         # rozsah souboru
x.bar = 3000   # hodin.... průměr (bodový odhad střední hodnoty)
s = 20         # hodin.... výběrová směrodatná odchylka (bodový odhad sm. odchylky)
alpha = 0.1    # hladina významnosti (spolehlivost 1-alpha = 0.9)

# Oboustranný intervalový odhad střední hodnoty
dol_q = qt(alpha/2,n-1)
hor_q = qt(1 - alpha/2,n-1)

x.bar - hor_q*s/sqrt(n)   # dolní mez IO
x.bar - dol_q*s/sqrt(n)   # horní mez IO

# Oboustranný intervalový odhad směrodatné odchylky
dol_q = qchisq(alpha/2,n-1)
hor_q =  qchisq(1 - alpha/2,n-1)

sqrt((n-1)*s^2/hor_q)      # dolní mez IO
sqrt((n-1)*s^2/dol_q)      # horní mez IO

# * Příklad 2. ####
# Hloubka moře se měří přístrojem, jehož systematická chyba je rovna nule a náhodné
# chyby mají normální rozdělení se směrodatnou odchylkou 20 m. Kolik nezávislých měření
# je třeba provést,aby s pravděpodobností 95 % stanovila hloubku s chybou menší než 10
# m?

# Určujeme odhad potřebného rozsahu výběru (počtu potřebnych měření)

# Předpokládáme normalitu dat, se známým rozpylem (dle zadání)

sigma = 20   # metrů .... známá směrodatná odchylka
alpha = 0.05 # hladina významnosti (spolehlivost 1-alpha = 0.95)
delta = 10   # metrů ... přípustná chyba měření

# Odhad rozsahu výběru
# Y = delta/sigma*sqrt(n) ~ N(0,1), delta = X-mu
# P(Y > Z_(1-alpha/2)) = alpha/2

(qnorm(1 - alpha/2)*sigma/delta)^2

# * Příklad 3. ####
# Úkolem je určit průměrnou hladinu cholesterolu v séru v určité populaci mužů. V
# náhodném výběru (pocházejícím z normálního rozdělení ) 25 mužů je výběrový průměr 6,3
# mmol/l a výběrová směrodatná odchylka 1,3 mmol/l.

# Odhadujeme střední hladinu cholesterolu v séru
# Předpokládáme normalitu dat (dle zadání)

n = 25        # rozsah souboru
x.bar = 6.3   # mmol/l .... průměr (bodový odhad střední hodnoty)
s = 1.3       # mmol/l .... výběrová směr. odchylka (bodový odhad sm. odchylky)
alpha = 0.05  # hladina významnosti (spolehlivost 1-alpha = 0.95)

# Oboustranný intervalový odhad střední hodnoty
dol_q = qt(alpha/2, n-1)
hor_q = qt(1 -alpha/2, n-1)

x.bar - hor_q*s/sqrt(n)   # dolní mez IO
x.bar - dol_q*s/sqrt(n)   # horní mez IO

# * Příklad 4. ####
# Předpokládejme, že v náhodném výběru 200 mladých mužů má 120 z nich vyšší než
# doporučenou hladinu cholesterolu v séru. Určete 95% interval spolehlivosti pro
# procento mladých mužů
# s vyšší hladinou cholesterolu v populaci.

# Odhadujeme podíl mužů s vyšší hladinou cholesterolu v celé populaci,
# tj. pravděpodobnost,že náhodně vybraný muž bude mít vyšší hladinu cholesterolu

n = 200  # rozsah souboru
x = 120  # počet "úspěchů"
p = x/n  # relativní četnost (bodový odhad pravděpodobnosti)
p
alpha = 0.05 # hladina významnosti (spolehlivost 1-alpha = 0.95)

# Ověření předpokladů
9/(p*(1-p))

# Oboustranný Clopperův - Pearsonův (exaktní) int.ý odhad param. binom. rozdělení
binom.test(x,n,alternative="two.sided",conf.level=0.95)$conf.int

## Waldův (asymptotický) odhad (z-statistika) - aprox. normálním rozdělením dle CLV
dol_q = qnorm(alpha/2)
hor_q = qnorm(1-alpha/2)

p - hor_q*sqrt(p*(1-p)/n)   # dolní mez IO
p - dol_q*sqrt(p*(1-p)/n)       # horní mez IO

# * Příklad 5. ####
# V rámci výzkumné studie pracujeme s náhodným výběrem 70 žen z české populace. U každé
# z žen byl změřen hemoglobin s přesností 0,1 g/100 ml. Naměřené hodnoty jsou v uvedeny
# v souboru Hemoglobin.xls. Nalezněte 95% intervalové odhady směrodatné odchylky a
# střední hodnoty hemoglobinu v populaci českých žen. (Normalitu ověřte na základě
# exploračních grafů.)

## Odhadujeme střední hodnotu a směrodatnou odchylku hemoglobinu v séru

## Načtení dat z xlsx souboru (pomoci balíčku readxl)
library(readxl)
hem = read_excel("data/intervalove_odhady.xlsx",
                  sheet = "Hemoglobin")
colnames(hem) = "hodnoty"
head(hem)

## Explorační analýza
boxplot(hem$hodnoty)

# Data neobsahují odlehlá pozorování.
summary(hem$hodnoty)
sd(hem$hodnoty)

# Ověření normality - exploračně
qqnorm(hem$hodnoty)
qqline(hem$hodnoty)

moments::skewness(hem$hodnoty)
moments::kurtosis(hem$hodnoty) - 3
# Šikmost i špičatost odpovídá norm. rozdělení.

# ověření normality: exaktně - test normality.
# Známe-li testování hypotéz, ověříme Shapirovým . Wilkovým testem.
shapiro.test(hem$hodnoty)$p.value
# Na hl. významnosti 0.05

# 95% oboustranný intervalový odhad střední hodnoty
mean(hem$hodnoty)
t.test(hem$hodnoty, altarnative="two.sided", conf.level=0.95)$conf.int

## 95% oboustranný intervalový odhad směrodatné odchylky
library(EnvStats)
sd(hem$hodnoty)

sqrt(varTest(hem$hodnoty, alternative = "two.sided", conf.level = 0.95)$conf.int)

# * Příklad 6. ####
# Jaký musí být počet pozorování, jestliže chceme s pravděpodobností 0,95 stanovit
# průměrnou hodnotu hemoglobinu u novorozenců s chybou nejvýše 1,0 $g/l$. Populační
# rozptyl hodnot se
# odhaduje hodnotou 46,0 $g^2/l^2$.

# Určujeme odhad potřebného rozsahu výb. (počtu novorozenců, které musíme testovat)

# Předpokládáme normalitu dat, bez tohoto předpokladu je příklad neřešitelný

sigma = sqrt(46)  # g/l .... známá směrodatná odchylka
alpha = 0.05      # hladina významnosti (spolehlivost 1-alpha = 0.95)
delta = 1         # g/l ... přípustná chyba měření

# Odhad rozsahu výběru
# Y = delta/sigma*sqrt(n) ~ N(0,1), delta = X-mu
# P(Y > Z_(1-alpha/2)) = alpha/2

(qnorm(1 - alpha/2)*sigma/delta)^2

# * Příklad 7. ####
# V datovém souboru pr7.xlsx naleznete měření hluku způsobeného větrákem počítače [dB].
# Spočtěte 95% intervalový odhad průměrného hluku a 95% intervalový odhad variability
# hluku.

library(readxl)
# načtení dat
data = read_excel("data/pr7.xlsx")
head(data)

length(data$dB)

# vizualizace
pom = boxplot(data$dB)

# odstranění OP
data_op = data
data_op$dB[data_op$dB %in% pom$out] = NA
data_op = na.omit(data_op)
boxplot(data_op$dB)

# test normality dat exploračně
moments::skewness(data_op$dB)
moments::kurtosis(data_op$dB) - 3

qqnorm(data_op$dB)
qqline(data_op$dB)

# test normality exaktně
shapiro.test(data_op$dB)$p.value

# bodový a intervalový odhad střední hodnoty
mean(data_op$dB)

t.test(data_op$dB, alternative = "two.sided", conf.level = 0.95)$conf.int

# bodový a intervalový odhad směrodatné odchylky
sd(data_op$dB)

sqrt(varTest(data_op$dB,alternative = "two.sided", conf.level = 0.95)$conf.int)

# * Příklad 8. ####
# V datovém souboru pr8.xlsx naleznete měření doby do poruchy elektrické součástky [h].
# Spočtěte 99% intervalový odhad průměrné životnosti daného typu součastky.

library(readxl)
# načtení dat
data = read_excel("data/pr8.xlsx")
head(data)

length(data$cas_h)

# vizualizace a ověření OP
boxplot(data$cas_h)

hist(data$cas_h)

# test normality dat exploračně
moments::skewness(data$cas_h)
moments::kurtosis(data$cas_h) - 3

qqnorm(data$cas_h)
qqline(data$cas_h)

# test normality exaktně
shapiro.test(data$cas_h)$p.value

# test symetrie exploračně
moments::skewness(data$cas_h)
hist(data$cas_h)

# exaktně: test symetrie
# install.packages("lawstat")
library(lawstat)
symmetry.test(data$cas_h,boot=FALSE)$p.value
# vysledná p-hodnota musím být větší než hl. výz. (př. 0.05)

# bodový a intervalový odhad mediánu
median(data$cas_h)
# IO
# install.packages("BSDA")
alpha = 0.01
library(BSDA)
SIGN.test(data$cas_h, alternative = 'two.sided', conf.level = 1-alpha,
          conf.int = TRUE)$conf.int

sd(data$cas_h)


compute_π <- function(trials) {
    inside <- 0.0
    for (i in 1:trials) {
        point <- runif(2)
        inside <- inside + (sum(point^2) <= 1.0)
    }
    return(4.0*inside/trials)
}

args = commandArgs(trailingOnly=TRUE)
if(length(args) < 1) {
    error("must provide number of trials")
}
trials = as.integer(args[1])
set.seed(2018)

start.time <- Sys.time()
invisible(compute_π(trials))
stop.time <- Sys.time()
cat("First invocation: ", stop.time - start.time, "s\n")

start.time <- Sys.time()
π <- compute_π(trials)
stop.time <- Sys.time()
cat("Second invocation:", stop.time - start.time, "s\n")

cat("π ≈ ", π, "\n")


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

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

mersenne <- function(x, n) { 2^x - 1 < n }
nextPrime <- primeSeq()
m <- 5
cat(sapply(as.integer(readLines(tail(commandArgs(), n=1))), function(n) {
  while (2^m - 1 < n) {
    isPrime(m)
    m <<- m + 2
  }
  paste(2^primes[mersenne(primes, n)] - 1, collapse=", ")
}), sep="\n")