=begin
[((<index|URL:index.html>))]
((<Algebra::MPolynomial>))
/
((<Algebra::MPolynomial::Monomial>))
/
((<Algebra::MPolynomialFactorization>))
/
((<Algebra::Groebner>))

= Algebra::MPolynomial
((*(Class of Multi-variate Polynomial Ring)*))

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

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

== SuperClass:

* ((|Object|))

== Included Modules:

* ((|Enumerable|))
* ((|Comparable|))
* ((<Algebra::Groebner>))

== Associated Function:

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

== Class Methods:

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

    The objects (({obj0, obj1, ...})) are reserved and represent variables.
    They are only to utilize for the names of variables (for ((|to_s|)) )
    and the distinction.

    The return value of this method is a sub-class of ((|Algebra::MPolynomial|)).
    This class has class-methods: ((|ground|)) and ((|vars|)),
    which return
    the coefficient ring ((|ring|)) and an array of variables.

    The variables represented by objects (({obj0, obj1, ...})) can be
    able to obtain as :(({var(obj0)})), (({var(obj1)})),... So,
    (({vars == [var(obj0), var(obj1), ...]})).

    The order of each variable is: (({obj0 > obj1 > ...})), and
    the order of monomials is determined by ((<::set_ord>)).

    Example: Polynomial ring over Integer
      require "m-polynomial"
      P = Algebra::MPolynomial.create(Integer, "x", "y", "z")
      x, y, z = P.vars
      p((-x + y + z)*(x + y - z)*(x - y + z))
      #=> -x^3 + x^2y + x^2z + xy^2 - 2xyz + xz^2 - y^3 + y^2z + yz^2 - z^3
      p P.ground #=> integer

--- ::vars([obj0 [, obj1 [, ...]]])
    ((*When no parameter is designated*)), it returns the array of
    all variables, already reserved.

    Example:
      P = Algebra.MPolynomial(Integer, "x", "y", "z")
      p P.vars #=> [x, y, z]

    ((*When only one parameter of ((|String|)) is designated *)),
    splits the string into identifiers and reserves them, which
    represent variables. The string of "AN ALPHABET + SOME DIGITS" can be
    an identifier.

    If the object has been already reserved, no new reservation is done.
    The return value of this method is an array of variables corresponding
    to the objects.

    Example:
      P = Algebra.MPolynomial(Integer)
      x, y, z, w = P.vars("a0b10cd")
      p P.vars #=> [a0, b10, c, d]
      p [x, y, z, w] #=> [a0, b10, c, d]

    ((*Otherwise*)), reserve objects (({obj0, obj1, ...})) which represent
    variables. If the object has been already reserved, no reservation is
    done.
    The return value of this method is an array of variables corresponding
    to the objects.

    Example:
      P = Algebra.MPolynomial(Integer)
      p P.vars("x", "y", "z") #=> [x, y, z]

--- ::mvar([obj0 [, obj1 [, ...]]])
    ((*When no parameter is designated*)), it returns the array of
    all variables, already reserved.

    ((*Otherwise*)), reserve objects (({obj0, obj1, ...})) which represent
    variables. If the object has been already reserved, no reservation is
    done.
    The return value of this method is an array of variables corresponding
    to the objects.

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

    Example: Define MPolynomial ring and variables simulteniously
      P, x, y, z, w = Algebra.MPolynomial(Integer, "a", "b", "c", "d")

--- ::var(obj)
    Returns the variable, which is represented by ((|obj|)).

    Example:
      P = Algebra.MPolynomial(Integer, "X", "Y", "Z")
      x, y, z = P.vars
      P.var("Y") == y #=> true

--- ::variables
    Returns the array of reserved objects, which represent variables.

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

--- ::zero?
    Returns true if ((|self|)) is zero.

--- ::zero
    Returns zero.

--- ::unity
    Returns unity.

--- ::set_ord(ord [, v_ord])
    Sets the order of monomials as ((|ord|)) which is ((|Symbol|))
    of ordering type.
    The possible designations are ((|:lex|)) (lexicographic order (default)),
    ((|:grlex|)) (graded lexicographic order), ((|:grevlex|)) (graded
    reverse lexicographic order).

    The order of variables is the order of reservation.
    By the array ((|v_ord|)), we can transform the order.

    Example: the order of (({x, y, z = P.var("xyz")}))
      require "m-polynomial"
      P = Algebra.MPolynomial(Integer)
      x, y, z = P.vars("xyz")
      f = -5*x**3 + 7*x**2*z**2 + 4*x*y**2*z + 4*z**2

      P.set_ord(:lex)
      p f #=> -5x^3 + 7x^2z^2 + 4xy^2z + 4z^2

      f.method_cash_clear
      P.set_ord(:grlex)
      p f #=> 7x^2z^2 + 4xy^2z - 5x^3 + 4z^2

      f.method_cash_clear
      P.set_ord(:grevlex)
      p f #=> 4xy^2z + 7x^2z^2 - 5x^3 + 4z^2

      f.method_cash_clear
      P.set_ord(:lex, [2, 1, 0]) # z > y > x
      p f #=> 7x^2z^2 + 4z^2 + 4xy^2z - 5x^3

    See ((<::with_ord>)).

--- ::ord=(x)
    Same as ((<::set_ord(x)>)).

#--- ::order=(obj)
#    Same as ((<::set_ord(obj)>)).

--- ::get_ord
    Returns the monomial order. (:lex, :grlex, :grevlex)

--- ::ord
    Same as ((<::get_ord>)).

#--- ::order
#    Same as ((<::get_ord>)).

--- ::with_ord(ord [, v_ord[ [, array_of_polys]])
    Executes the block with monomial ordering ((|ord|)) and
    order of variables ((|v_ord|)). These ordering are
    available only in the block.(See ((<::set_ord>)).)
    When the array of polyomials ((|array_of_polys|)) is given,
    for each of them, ((<method_cash_clear>)) is invoked before
    the execution. (This is not a thread-safe block.)

    Example:
      require "m-polynomial"
      P = Algebra.MPolynomial(Integer)
      x, y, z = P.vars("xyz")
      f = -5*x**3 + 7*x**2*z**2 + 4*x*y**2*z + 4*z**2

      P.with_ord(:lex, nil, [f]) do
        p f    #=> -5x^3 + 7x^2z^2 + 4xy^2z + 4z^2
        p f.lt #=> -5x^3
      end

      P.with_ord(:grlex, nil, [f]) do
        p f    #=> 7x^2z^2 + 4xy^2z - 5x^3 + 4z^2
        p f.lt #=> 7x^2z^2
      end

      P.with_ord(:grevlex, nil, [f]) do
        p f    #=> 4xy^2z + 7x^2z^2 - 5x^3 + 4z^2
        p f.lt #=> 4xy^2z
      end

      P.with_ord(:lex, [2, 1, 0], [f]) do # z > y > x
        p f    #=> 7x^2z^2 + 4z^2 + 4xy^2z - 5x^3
        p f.lt #=> 7x^2z^2
      end

--- ::monomial(ind[, c])
    Returns the monomial of multi-degree ((|ind|)) and
    coefficient ((|c|)).
    (((<Algebra::MPolynomial::Monomial>)) is not extend.)
    If ((|c|)) is omitted, it is assumed to be the unity.

#--- ::const(x)
#--- ::regulate(x)
#--- ::method_cash_clear(*m)

== Methods:

--- monomial(ind[, c])
    Same as ((<::monomial>))

#--- each
#--- keys
#--- values
#--- [](ind)
#--- []=(ind, c)
#--- constant_coeff
#--- include?
#--- compact!
#--- rt!

--- constant?
    Retruns true if ((|self|)) is a constant.

--- monomial?
    Returns true if ((|self|)) is a monomial.

--- zero?
    Returns true if ((|self|)) is zero.

--- zero
    Returns zero.

--- unity
    Retruns unity.

--- method_cash_clear
    Clears the cashes of methods.

    In this library, some results of methods are stored so as not to
    do same calculations. When the order of monomials is changed,
    we must clear the cashes.

    The methods which have cashes are following:
    ((<lc>)), ((<lm>)), ((<lt>)), ((<rt>)), ((<multideg>)).

    Example:
      P = Algebra.MPolynomial(Integer)
      x, y, z = P.vars("xyz")
      f = -5*x**3 + 7*x**2*z**2 + 4*x*y**2*z + 4*z**2
      P.set_ord(:lex)
      p f.lt #=> -5x^3
      P.set_ord(:grlex)
      p f.lt #=> -5x^3
      f.method_cash_clear
      p f.lt #=> 7x^2z^2

--- ==(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|)).
    ((|other|)) must be constant.

--- divmod(f0 [, f1 [,...]])
    Returns the array [the array of quotients, the remainder]
    by (({f0, f1,...})).

      P = Algebra.MPolynomial(Integer)
      x, y = P.vars("xy")
      f = x**2*y + x*y**2 + y**2
      f0 = x*y - 1
      f1 = y**2 - 1
      p f.divmod(f0, f1) #=> [[x + y, 1], x + y + 1]
      p f % [f0, f1]     #=> x + y + 1

--- %(others)
    Returns the remainder of ((|self|)) by polynomials ((|others|)).
    It is equal to (({divmod(*others)[1]})).

--- multideg
    Returns the multiple degree as an array.

    Example: in lex order,
      P = Algebra.MPolynomial(Integer)
      x, y, z = P.vars("xyz")
      f = 4*x*y**2*z + 4*z**2 - 5*x**3*y + 7*x**2*z**2
      p f.multideg #=> [3, 1]

--- totdeg
    Returns the total degree.

    Example:
      f = 4*x*y**2*z + 4*z**2 - 5*x**3*y + 7*x**2*z**2
      p f.totdeg   #=> 4

--- deg
    Same as multideg.

--- lc
    Returns the leading coefficient.

    Example: in lex order,
      f = 4*x*y**2*z + 4*z**2 - 5*x**3*y + 7*x**2*z**2
      p f.lc       #=> -5

--- lm
    Returns the leading monomial.
    The return value is extended by ((<MPolynomial::Monomial>)).

    Example: in lex order,
      f = 4*x*y**2*z + 4*z**2 - 5*x**3*y + 7*x**2*z**2
      p f.lm       #=> x^3y

--- lt
    Returns leading term. This is equal to (({lc * lm})).

    Example: in lex order
      f = 4*x*y**2*z + 4*z**2 - 5*x**3*y + 7*x**2*z**2
      p f.lt       #=> -5x^3y

--- rt
    Returns the rest term. This is equal to (({self - lt})).

    Example: in lex order,
      f = 4*x*y**2*z + 4*z**2 - 5*x**3*y + 7*x**2*z**2
      p f.rt       #=> 4*z**2 - 5*x**3*y + 7*x**2*z**2

--- to_s
    Return the representation of ((|String|)). To change the format of
    expression, use ((|display_type|)).
    The values which are able to designate to ((|display_type|)) is:
    ((|:norm|)) (default) and  ((|:code|)).

    Example:
      P = Algebra.MPolynomial(Integer)
      x, y, z = P.vars("xyz")
      f = -5*x**3 + 7*x**2*z**2 + 4*x*y**2*z + 4*z**2
      p f #=> -5x^3 + 7x^2z^2 + 4xy^2z + 4z^2
      P.display_type = :code
      p f #=> -5*x**3 + 7*x**2*z**2 + 4*x*y**2*z + 4*z**2

--- map_to(ring[, vs]){|c, ind| ... }
    Returns the sum over ((|ring|)) of the evaluations of ...
    for the multi-degree ((|ind|)) and coefficient ((|c|)).
    If ((|vs|)) is omitted, it is assumed to be ((<::vars>)).

    If (({f})) is the polynomial over (({P})),
    (({f.map_to(P) {|c, ind| c * P.monomial(ind)}})) equals to (({f})).

--- project(ring[, vs]){|c, ind| ... }
    Returns the sum over ((|ring|)) of the evaluations of ...
    on the monomial
    for the multi-degree ((|ind|)) and coefficient ((|c|)).

    If (({f})) is the polynomial over (({P})),
    (({f.progect(P) {|c, ind| c}})) equals to (({f})).

    (({project(ring){|c, ind| f(c, ind)}})) equals to (({map_to(ring){|c, ind| f(c, ind) * self.class.monomial(ind)}})).

    If ((|vs|)) is omitted, it is assumed to be ((<::vars>)).

    Example:
      require "m-polynomial"
      require "rational"
      P = Algebra::MPolynomial(Integer, "x", "y", "z")
      x, y, z = P.vars
      f = x**2 + 2*x*y - z**3
      PQ = Algebra::MPolynomial(Rational, "x", "y", "z")
      p f.project(PQ) {|c, ind| Rational(c) / (ind[0] + 1)}
                        #=> 1/3x^2 + xy - z^3
      p f.convert_to(PQ)      #=> x^2 + 2xy - z^3

--- evaluate(obj0[, [obj1, [obj2,..]]])
    Reterns the value entering ((|obj0, obj1, obj2,...|)) for each value.
    This equivalent to
    ((<project>))(({(ground, [obj0, obj1, obj2,..]){|c, ind| c}})).

    Example:
      require "m-polynomial"
      P = Algebra::MPolynomial(Integer, "x", "y", "z")
      x, y, z = P.vars
      f = x**2 + 2*x*y - z**3
      p f.evaluate(1, -1, -1) #=> 0 (in Integer)
      p f.evaluate(y, z, x)   #=> -x^3 + y^2 + 2yz (in P)

--- call(obj0[, [obj1, [obj2,..]]])
    Same as ((<evaluate>)).

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

    Example:
      require "m-polynomial"
      P = Algebra::MPolynomial(Integer)
      x, y, z = P.vars("x", "y", "z")
      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, ind| c}})).

--- derivate(var)
    Returns the partial differential by the variable ((<var>)).

= Algebra::MPolynomial::Monomial
(Module of Monomial)

The return value of ((<lt>)) and ((<lm>)) is extended by this module.

== Methods:

#--- ind
#--- coeff
#--- <=>(other)
--- divide?(other)
    Returns true if ((|self|)) is divided by ((|other|)), which is
    assumed to be a monomial.

--- /(other)
    Returns the quotient of ((|self|)) by ((|other|)), which is
    assumed to be a monomial.

--- prime_to?(other)
    Returns true if ((|self|)) is prime to ((|other|)), which is
    assumed to be a monomial.

--- lcm(other)
    Returns the least common multiple of ((|self|)) and ((<other>)), which is
    assumed to be a monomial.

--- divide_or?(other0, other1)
    Returns the same value as ((|divide?(other0.lcm(other1))|)).

= Algebra::MPolynomialFactorization
((*(Module of Factorization)*))

The module of factorization of polynomials.

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

== Methods:
--- factorize
    Returns the factorization.

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

= Algebra::Groebner
(Module of Groebner Basis)

== File Name:
* ((|groebner-basis.rb|))
* ((|groebner-basis-coeff.rb|))

== Class Methods:

--- Groebner.basis(f)
    Returns the array of reduced Groebner basis from the array of basis
    ((|f|)).
    Equivalent to ((<Groebner.basis(Groebner.minimal_basis(Groebner.basis_159A(f)))>)).

    Example:
      require "m-polynomial"
      require "rational"
      P = Algebra.MPolynomial(Rational)
      P.set_ord :grevlex
      x, y, z = P.vars("xyz")
      f1 = x**2 + y**2 + z**2 -1
      f2 = x**2 + z**2 - y
      f3 = x - z
      b = Groebner.basis([f1, f2, f3])
      p b #=> [y^2 + y - 1, z^2 - 1/2y, x - z]

--- Groebner.basis_159A(f)
    Returns the array of Groebner basis from the array of basis
    ((|f|)).

--- Groebner.minimal_basis(f)
    Returns the array of minimal Groebner basis from the array of
    Groebner basis ((|f|)).

--- Groebner.reduced_basis(f)
    Returns the array of reduced Groebner basis from the array of
    minimal Groebner basis ((|f|)).

--- Groebner.basis_coeff(f)
    Returns the array of Groebner basis from the array of basis
    ((|f|)) and the array of coefficients to express them.

    Example:
      require "m-polynomial"
      require "rational"
      P = Algebra.MPolynomial(Rational)
      P.set_ord :grevlex
      x, y, z = P.vars("xyz")
      f1 = x**2 + y**2 + z**2 -1
      f2 = x**2 + z**2 - y
      f3 = x - z
      fs = [f1, f2, f3]
      c, b = Groebner.basis_coeff(fs)
      p b #=> [y^2 + y - 1, z^2 - 1/2y, x - z]
      p c #=> [[1, -1, 0], [0, 1/2, -1/2x - 1/2z], [0, 0, 1]]
      for i in 0..2
        p c[i].inner_product(fs) == b[i] #=> true
      end

--- Groebner.basis?(f)
    Return true if ((|f|)) is an array of Groebner basis.

--- Groebner.minimal_basis?(f)
    Return true if ((|f|)) is an array of minimal Groebner basis.

--- Groebner.reduced_basis?(f)
    Return true if ((|f|)) is an array of reduced Groebner basis.

== Methods:
--- S_pair(other)
    Returns the S-pair of ((|self|)) and ((|other|)).

    Example:
      (x**2*y + y**2 + z**2 -1).S_pair(x**2*z + z**2 - y)
        #=> y^2z + y^2 - yz^2 + z^3 - z

--- divmod_s(f1[, f2[, f3...]])
    Returns a array (({[[q1, q2, q3, ...], r]}))
    of the array of quotients (coefficients of division)
    and the remainder of division of ((|self|)) by
    basis (({f1, f2, f3, ...})).

    We convert (({f1, f2, f3, ...})) into Groebner basis and make the division.
    So (({divmod(f1, f2, ...).last == 0})) is equivalent to that ((|self|))
    is in the ideal (({(f1, f2, ...)})).

    Example:
      require "m-polynomial"
      require "rational"
      P = Algebra.MPolynomial(Rational)
      P.set_ord :grevlex
      x, y, z = P.vars("xyz")
      f1 = x**2 + y**2 + z**2 -1
      f2 = x**2 + z**2 - y
      f3 = x - z
      fs = [f1, f2, f3]
      f = x**3 + y**3 + z**3
      c, r = f.divmod_s(*fs)
      p r #=> yz + 2y - 1
      p c #=> [y - 1, -y + z + 1, x^2]
      p f == c.inner_product(fs) + r #=> true

--- div_cg(f, cg)
    Returns (({[q, r]})) where q (quotients) and
    r (remain) of division, which are obtained from the basis
    ((|f|)) and (({cg}))=((<Groebner.basis_coeff>))(f).
    ((<divmod_s>))(f) returns
    (({div_cg(f, Groebner.basis_coeff(f))})).

=end


######################################################################
###
###  SVM -  cats
###
#######################################################################

## Libraries
library(e1071)
library(mlbench)
library(MASS)
library(ROCR)
# Working Directory
WD = "/Users/gianlucamastrantonio/Desktop/statistico/lavori/lezioni/DataSpace/2018/Lez8/"

# il dataset
data(cats, package="MASS")
?cats

# descrizione del dataset
dim(cats)
summary(cats)
plot(cats[,2],cats[,3], col=cats[,1], xlab= colnames(cats)[2],ylab= colnames(cats)[3], pch=20, cex=2)

# Creiamo training e testing
set.seed(1)
cats[,"train"] 	= ifelse(runif(nrow(cats))<0.8,1,0)
trainset 		= cats[cats$train==1,]
testset 		= cats[cats$train==0,]
summary(trainset)
summary(testset)
# Eliminiamo la colonna "train"
trainColNum 	= grep("train",names(trainset))
trainset 		= trainset[,-trainColNum]
testset 		= testset[,-trainColNum]

# Trovare la colonna indicatrice
typeColNum = grep("Sex",names(cats))

#modello kernel lineare
svm_model_lin = svm(Sex~ ., data=trainset, method="C-classification", kernel="linear", probability=T, scale=F)
svm_model_lin
# plot del svm
plot(svm_model_lin,trainset )

# previsioni
# train  set predictions
pred_train_lin <-predict(svm_model_lin,trainset)
mean(pred_train_lin==trainset$Sex)

#test set predictions
pred_test_lin <-predict(svm_model_lin,testset)
mean(pred_test_lin==testset$Sex)

#modello kernel radiale
svm_model_rad = svm(Sex~ ., data=trainset, method="C-classification", kernel="radial", probability=T,scale=F)
svm_model_rad
# plot del svm
plot(svm_model_rad,trainset )

# previsioni
# train  set predictions
pred_train_rad <-predict(svm_model_rad,trainset)
mean(pred_train_rad==trainset$Sex)

#test set predictions
pred_test_rad <-predict(svm_model_rad,testset)
mean(pred_test_rad==testset$Sex)

# Troviamo i migliori valori di gamma e cost
tune_out <- tune.svm(x=trainset[,-typeColNum],y=trainset[,typeColNum],gamma=10^(-3:3),cost=c(0.01,0.1,1,10,100,1000),kernel="radial")
summary(tune_out)
# salvimo i valori migliori
tune_out$best.parameters$cost
tune_out$best.parameters$gamma
# ristimiamo il modello
svm_model <- svm(Sex~ ., data=trainset, method="C-classification", kernel="radial",cost=tune_out$best.parameters$cost,gamma=tune_out$best.parameters$gamma , probability=T, scale=F)
# plot
plot(svm_model,trainset )
# Previsioni
pred_train <-predict(svm_model,trainset)
mean(pred_train==trainset$Sex)
#test set predictions
pred_test <-predict(svm_model,testset)
mean(pred_test==testset$Sex)

# plot
n_points_in_grid = 60 # dimensione della griglia
x_axis_range <- range (cats[, 2]) # range dell'asse x
y_axis_range <- range (cats[, 3]) # range dell'asse y

# griglie di valori
X_grid_points <- seq (from=x_axis_range[1], to=x_axis_range[2], length=n_points_in_grid)
Y_grid_points <- seq (from=y_axis_range[1], to=y_axis_range[2], length=n_points_in_grid)
# griglia estesa
all_grid_points <- expand.grid (X_grid_points, Y_grid_points) # generate all grid points
names (all_grid_points) <- c( "Bwt","Hwt")
# facciamo previsione su tutta la griglia
all_points_predited <- predict(svm_model, all_grid_points, probability=T)

# decidiamo il set dei colori
color_array <- c("red", "blue")[as.numeric(all_points_predited)]
plot (all_grid_points[,c(2,1)], col=color_array, pch=20, cex=0.25)
points (x=trainset$Hwt, y=trainset$Bwt, col=c("red", "blue")[as.numeric(trainset$Sex)], pch=19) # plot data points
#points (trainset[svm_model$index, c ( 3,2)], pch=5, cex=2) # plot support vectors
points (svm_model$SV[,c(2,1)], pch=5, cex=2)

# facciamo delle curve di livello per le prob di appartenenza classe
ProbGrid = attr(all_points_predited,"probabilities")[,2]
contour(Y_grid_points,X_grid_points, matrix(ProbGrid,n_points_in_grid, byrow=T),add=T, level=0.25, col=1)
contour(Y_grid_points,X_grid_points, matrix(ProbGrid,n_points_in_grid, byrow=T),add=T, level=0.5, col=2)
contour(Y_grid_points,X_grid_points, matrix(ProbGrid,n_points_in_grid, byrow=T),add=T, level=0.75, col=3)
contour(Y_grid_points,X_grid_points, matrix(ProbGrid,n_points_in_grid, byrow=T),add=T, level=0.90, col=4)

# ROC - training
PredProb_lin <-predict(svm_model_lin,trainset, probability=T)
PredProb_rad <-predict(svm_model_rad,trainset, probability=T)
PredProb_best <-predict(svm_model,trainset, probability=T)

# ROC - maschio
pred_lin = prediction(attr(PredProb_lin,"probabilities")[,2], ifelse(trainset$Sex=="M",1,0))
pred_rad = prediction(attr(PredProb_rad,"probabilities")[,2], ifelse(trainset$Sex=="M",1,0))
pred_best = prediction(attr(PredProb_best,"probabilities")[,2], ifelse(trainset$Sex=="M",1,0))
perf_lin = performance(pred_lin,"tpr","fpr")
perf_rad = performance(pred_rad,"tpr","fpr")
perf_best = performance(pred_best,"tpr","fpr")
plot(perf_lin,colorize=TRUE)
plot(perf_rad,colorize=TRUE, add=T, lty=2)
plot(perf_best,colorize=TRUE, add=T, lty=4)
abline(a=0,b=1)
legend("bottomright",c("lin", "rad","best"), col=1, lty=c(1,2,4))

# ROC - femmine
pred_lin = prediction(attr(PredProb_lin,"probabilities")[,1], ifelse(trainset$Sex=="F",1,0))
pred_rad = prediction(attr(PredProb_rad,"probabilities")[,1], ifelse(trainset$Sex=="F",1,0))
pred_best = prediction(attr(PredProb_best,"probabilities")[,1], ifelse(trainset$Sex=="F",1,0))
perf_lin = performance(pred_lin,"tpr","fpr")
perf_rad = performance(pred_rad,"tpr","fpr")
perf_best = performance(pred_best,"tpr","fpr")
plot(perf_lin,colorize=TRUE)
plot(perf_rad,colorize=TRUE, add=T, lty=2)
plot(perf_best,colorize=TRUE, add=T, lty=4)
abline(a=0,b=1)
legend("bottomright",c("lin", "rad","best"), col=1, lty=c(1,2,4))


rm(list=ls())
library(snpStats)

file.results    <- commandArgs()[4]
numof.cases     <- as.numeric(commandArgs()[5])
numof.controls  <- as.numeric(commandArgs()[6])
disease_name    <- commandArgs()[7]

# get chisq values
pval <- read.table(file.results, header=T)$P
# calc vector of quantiles
chivect_observed <- qchisq(pval, df=1, ncp=0, lower.tail = FALSE, log.p = FALSE)

# qqplot
retval = qq.chisq(chivect_observed, overdisp=TRUE, slope.one=FALSE, main=basename(file.results), slope.lambda=TRUE)
lambda <- as.numeric(retval[3])
#print(lambda)
#print(numof.cases)
#print(numof.controls)
lambda_1000 <- 1.0 + (lambda - 1.0) * ( (1/numof.cases + 1/numof.controls) / (1/1000 + 1/1000) )

# plot results
#pdf(file=paste(file.results, ".pdf", sep=""), width=6, height=6)
jpeg(file=paste(file.results, ".qqplot.pval2chisq.jpg", sep=""), quality=100,width=700,height=700)
retval = qq.chisq(chivect_observed, x.max=80, overdisp=TRUE, slope.one=FALSE, main=paste( disease_name, ", lambda_1000=", round(lambda_1000, digits=4), ", slope.lambda=T" ,sep="" ) , slope.lambda=TRUE)
dev.off()


=begin
  # sample-quotientfield02.rb

  require "algebra"

  F13 = ResidueClassRing(Integer, 13)

  P = Polynomial(F13, "x")
  Q = LocalizedRing(P)
  x = Q[P.var]
  p ( 1 / (x**2 - 1) - 1 / (x**3 - 1) )

  #This is equivalent to the following
  F = RationalFunctionField(F13, "x")
  x = F.var
  p ( 1 / (x**2 - 1) - 1 / (x**3 - 1) )
((<_|CONTENTS>))
=end


# Reading in Data
ds = read.csv('Social_Network_Ads.csv')
ds = ds[, 3:5]

# Scaling and splitting
library(caTools)
ds[,1:2] = scale(ds[,1:2])

split = sample.split(ds$Purchased, SplitRatio = 0.75)
train = subset(ds, split == TRUE)
test = subset(ds, split == FALSE)

# Classifier
library(class)
y_pred = knn(train[, -3],
             test[, -3],
             cl = train[, 3],
             k = 5)

# Confusion matrix
cm = table(test[, 3], y_pred)

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


#Reading the dataset
library(pls)
data(longley)

View(longley)

str(longley)

library(dplyr)
library(tidyr)

summary(longley)

 head(longley)

tail(longley)

View(longley)
names(longley)[1]<-"GNP Deflator"
names(longley)[4]<-"Armed Forces"

class(longley)

dim(longley)

colnames(longley)

str(longley)

glimpse(longley)
Observations: 16

Variables: 7

plot(longley$GNP, longley$Unemployed, main = "Rate of Unemployment with GNP", xlab = "GNP", ylab = "Unemployed")

t.test(longley$GNP, longley$Unemployed)

t.test(longley$GNP, mu = 5, alternative = 'two.sided')

t.test(longley$Unemployed, mu = 5, alternative = 'two.sided')

#Parsimonious model

install.packages('devtools')

GNP<-longley[,2]
Unemployed<-longley[,3]
Population<-longley[,5]
dim(longley)

m1 <- MoE_clust(GNP, G=0:2, verbose=FALSE)
m2 <- MoE_clust(GNP, G=2, verbose=FALSE)
m3 <- MoE_clust(GNP, G=2:16, verbose=FALSE)

comp <- MoE_compare(m1, m2, m3)

comp

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

plot(mod, what="classification")

#leveneTest examination
library(car)

leveneTest(longley$GNP, longley$Unemployed)

#Graphical Visualization
library('ggplot2')

library(readr)

options(repr.plot.width = 6, repr.plot.height = 6)

class(longley)

View(longley)
head(longley)

summary(longley)

ggplot(data=longley,aes(x=longley$GNP, y=longley$Unemployed)) + geom_point() + theme_minimal()
ggplot(data=longley,aes(x=longley$`GNP Deflator`, y=longley$Unemployed)) + geom_point() + theme_minimal()

pairs(longley[,1:4], pch = 19)
pairs(longley[,5:7], pch = 19)

base<-lm(Employed ~., longley)
summary(base)

pcrFit<-pcr(Employed ~ ., data = longley, valdiation = "cv")
summary(pcrFit)


#' mean_center
#' centers a vector by subtracting the mean.
#' if there no variance in a column, just returns the column untransformed (i.e. a vector of 1s for intercept).
#'
#' @param x matrix or dataframe
#'
#' @return martix or dataframe, mean centered.
#' @export
#'
#' @examples
mean_center <- function(x) {
  ifelse(sd(x) == 0,
         return(x),
         return(x - mean(x, na.rm=T))
  )
}


###############################################################################
# Pessismistic Open Field RL algorithm
#
# From Figure 1, Zorowitz et al. (2020)
# Translated from Python to R
# See https://github.com/ndawlab/seqanx for the original code
#
# Value iteration
#
###############################################################################

library(pheatmap)
library(proxy)
library(dplyr)
library(RColorBrewer)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
# Define parameters.
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#

# Variables
reward = 10
punishment = -10
epsilon = 0
start = 116

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
# Environment setup and visualization.
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#

# Initialize environment:
size <- 11
grid <- matrix(0, nrow = size, ncol = size)
grid[2,3] <- reward # number 14
grid[2,9] <- punishment # number 20

# Visualize environment:
pheatmap::pheatmap(grid, legend = FALSE, cluster_col = FALSE, cluster_row = FALSE,
                   display_numbers = TRUE, color = colorRampPalette(brewer.pal(n = 7, name = "RdYlBu"))(100))

# Identify coordinates of viable states:
viable_coordinates = data.frame(x = rep(1:size, each = size), y = rep(1:size))

# Make transition matrix with NA's and 1's:
transition_matrix <- proxy::dist(viable_coordinates, viable_coordinates, method = "Euclidean")
transition_matrix <- ifelse(transition_matrix == 1, 1, NA)

transition_matrix[14,] <- NA
transition_matrix[20,] <- NA
transition_matrix[14,14] <- 1
transition_matrix[20,20] <- 1

# Define rewards:
R <- matrix(0, nrow = size*size, ncol = size*size)
R[,14] <- reward; R[14,14] <- 0
R[,20] <- punishment; R[20,20] <- 0
R <- ifelse(transition_matrix == 1, R, NA)

# Define state information:
states <- 1:(size*size)
n_states <- length(states)
viable_states <- states[-c(14,20)] # viable states are states minus terminal states
n_viable_states <- length(viable_states)

# Iteratively define MDP information:
info <- data.frame(S = 0, S_prime = 0, R = 0)
index = 1
for (s in 1:n_states) {

  # What are the possible next states?
  s_prime = which(transition_matrix[s,] %in% 1)  # check on which position are the ones

  # What are the rewards for these next states?
  r = R[s, s_prime]

  # What is the probability of transitioning to next state?
  # t = 1 # determinisitic

  for (i in 1:length(s_prime)) {
    info[index,1] = s; info[index,2] <- s_prime[i]; info[index,3] <- r[i]
    index = index + 1
  }
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
# Value iteration and visualization.
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#

# Function: Pessimism
pessimism <- function(arr, w) {
  return(w * max(arr) + (1 - w) * min(arr))
}

# Simulation parameters:
weights <- c(1, 0.5, 0)
gamma = 0.95
tol = 0.0001
max_iter = 100

# Initialize value iteration:
for (weight in weights) {

  # Initialize Q-values:
  Q <- matrix(rep(0, nrow(info)), ncol = 1) # Q is the expected reward for every possible transition
  copy <- info

  # Solve for Q-values:
  for (i in 1:max_iter) {

    # Make copy:
    q <- Q
    copy$Q <- q

    # Precompute successor value:
    V_prime <- c()
    for (s in 1:(size*size)) {
      arr <- copy %>% filter(S == s)
      V_prime[s] <- pessimism(arr$Q, weight) # V_prime is the value function for every possible state given the policy
    }

    # Compute Q-values:
    for (i in 1:nrow(info)) {
      Q[i] <- info$R[i] + gamma * V_prime[info$S_prime[i]]
    }

    # Compute delta:
    delta <- abs(Q - q)

    # Check for termination (i.e., all values of delta below threshold):
    if (all((delta < tol) == TRUE)) { break }
  }

  # Solve for values:
  copy = info
  copy$Q = Q

  # Identify max by state:
  V <- c()
  for (s in 1:(size*size)) {
    arr <- copy %>% filter(S == s)
    V[s] <- max(arr$Q) # V is the max value function for every possible state given the policy
  }

  # Fill in terminal states:
  grid_pessism <- matrix(V, nrow = size, ncol = size, byrow = TRUE)
  grid_pessism[2,3] = reward
  grid_pessism[2,9] = punishment

  # Visualize environment:
  pheatmap::pheatmap(grid_pessism, legend = FALSE, cluster_col = FALSE, cluster_row = FALSE,
                     display_numbers = TRUE, color = colorRampPalette(brewer.pal(n = 7, name = "RdYlBu"))(100),
                     main = paste0("Weight: ", weight))

  # Compute policy:
  policy <- c()
  policy[1] <- s <- start
  i = 1
  while ( s != 14 && s != 20) {

    # Compute optimal q(s, a):
    temp <- copy %>% filter(S == s)
    s <- temp$S_prime[which.max(temp$Q)]

    # Append it to policy
    policy <- c(policy, s)

    # Make sure it doesn't get stuck:
    i = i + 1
    if (i > 100) { break }
  }
}


# Getting Started in Fixed/Random Effects Models Using R.
# Oscar Torres-Reyna, Princeton University.

# Load Required Packages:
  require(foreign); library(foreign)
  require(car); library(car)
  require(gplots); library(gplots)

# Read Data Examples from Web or Local System:
  Panel <- read.dta("http://dss.princeton.edu/training/Panel101.dta")
  Panel <- read.dta(file = "C:\\Users\\Pooya\\OneDrive\\MyThesis\\MyTutorials\\Panel_Data_using_R\\Data_Examples\\Data.dta")
  Panel <- read.csv(file = "C:\\Users\\Pooya\\OneDrive\\MyThesis\\MyTutorials\\Panel_Data_using_R\\Data_Examples\\Data.csv", header = TRUE, sep = ',')

# Exploring Panel Data:
  coplot(formula = y ~ year | country, data = Panel, type = "l")
  scatterplot(y ~ year | country, data = Panel, boxplot = FALSE, smooth = TRUE, reg.line = FALSE)

# Fixed Effects: Plot Heterogeneity across Countries:
  plotmeans(formula = y ~ country, data = Panel, main = "Heterogeineity across Countries")

# Fixed Effects: Plot Heterogeneity across Years
  plotmeans(formula = y ~ year, data = Panel, main = "Heterogeineity across Years")

# OLS Regression:
  View(Panel)
  # y ~ x1:
  plot(x = Panel$x1, y = Panel$y, type = "p", xlab = "x", ylab = "y", pch = 19, col = "green")
  OLS <- lm(formula = y ~ x1, data = Panel)
  abline(OLS, lwd = 3, col = "green", lty = 2)
  summary(OLS)
  # y ~ x2:
  par(new = TRUE)
  plot(x = Panel$x2, y = Panel$y, type = "p", xlab = "x", ylab = "y", pch = 19, col = "red")
  OLS <- lm(formula = y ~ x2, data = Panel)
  abline(OLS, lwd = 3, col = "red", lty = 2)
  summary(OLS)
  # y ~ x3:
  par(new = TRUE)
  plot(x = Panel$x3, y = Panel$y, type = "p", xlab = "x", ylab = "y", pch = 19, col = "blue")
  OLS <- lm(formula = y ~ x3, data = Panel)
  abline(OLS, lwd = 3, col = "blue", lty = 2)
  summary(OLS)
  # y ~ x1 + x2 + x3:
  par(new = TRUE)
  OLS <- lm(formula = y ~ x1 + x2 + x3, data = Panel)
  abline(OLS, lwd = 3, col = "black", lty = 2)
  summary(OLS)

# Fixed Effects Using Least Squares Dummy Variable Model:
  fixed.dum <- lm(y ~ x1 + x2 + x3 + factor(country) - 1, data = Panel)
  summary(fixed.dum)

# Why Intercept Ignore: fixed.dum <- lm(y ~ x1 + factor(country), data = Panel)

yhat <- fixed.dum$fitted.values

scatterplot(yhat ~ Panel$x1 | Panel$country, boxplot = FALSE, xlab = "x1", ylab = "yhat", smooth = FALSE)
abline(lm(Panel$y ~ Panel$x1), lwd = 3, col = "red")

# Comparing OLS vs LSDV model: ----------------------------------------------------------------

apsrtable(ols, fixed.dum, model.names = c("OLS", "OLS_DUM"))

# Fixed effects: n entity-specific intercepts (using plm): ------------------------------------

fixed.individual <- plm(formula = y ~ x1 + x2 + x3, data = Panel, index = c("country", "year"), model = "within", effect = "individual")
summary(fixed.individual)

fixed.time <- plm(formula = y ~ x1 + x2 + x3, data = Panel, index = c("country", "year"), model = "within", effect = "time")
summary(fixed.time)

fixed.twoways <- plm(formula = y ~ x1 + x2 + x3, data = Panel, index = c("country", "year"), model = "within", effect = "twoways")
summary(fixed.twoways)

# Extracts the fixed effects from a plm object: Fixed Effects (constants for each coun --------

fixef(fixed.individual)
fixef(fixed.time)
fixef(fixed.twoways, effect = "time")

# F Test for Individual and/or Time Effects: Testing for fixed effects, null - OLS better -----
# than fixed (If the p-value is < 0.05 then the fixed effects model is a better choice)

pFtest(fixed.individual,ols)
pFtest(fixed.time, ols)
pFtest(fixed.twoways, ols)

# RANDOM-EFFECTS MODEL: -----------------------------------------------------------------------

random <- plm(formula = y ~ x1 + x2 + x3, data = Panel, effect = "individual", model ="random", index = c("country", "year"))
summary(random)

# Fixed or Random: Hausman Test ---------------------------------------------------------------

phtest(fixed.individual, random)

# Testing for Time-Fixed Effects --------------------------------------------------------------
fixed.time.dummy <- plm(formula = y ~ x1 + x2 + x3 + factor(year), data = Panel, model ="within", index = c("country", "year"))
summary(fixed.time.dummy)

# Testing time-fixed effects:  The null is that no time-fixed effects needed ------------------

pFtest(fixed.time.dummy, fixed.individual)

# Lagrange Multiplier Test - time effects (Breusch-Pagan): ------------------------------------

plmtest(fixed.individual, c("time"), type = ("bp"))

# Testing for random effects: Breusch-Pagan Lagrange multiplier (LM) --------------------------

pool <- plm(formula = y ~ x1 + x2 + x3, data = Panel, index = c("country", "year"), effect = "individual", model = "pooling")
summary(pool)

# Breusch-Pagan Lagrange Multiplier for random effects. Null is no panel effect (i.e.  --------

plmtest(pool, type = c("bp"))

# Testing for cross-sectional dependence/contemporaneous correlation: -------------------------
# using Breusch-Pagan LM test of independence and Pasaran CD test.
# The null hypothesis in the B-P/LM and Pasaran CD tests of independence is that residuals across entities are not correlated.

pcdtest(fixed.individual, test = c("lm"))

pcdtest(fixed.individual, test = c("cd"))

# Testing for serial correlation --------------------------------------------------------------
# The null is that there is not serial correlation:

pbgtest(fixed.individual)

# Testing for unit roots/stationarity ---------------------------------------------------------
# The Dickey-Fuller test to check for stochastic trends
# The null hypothesis is that the series has a unit root (i.e. non-stationary).

Panel.set <- plm.data(Panel, index = c("country", "year"))
adf.test(Panel.set$y, k = 2)

# Testing for heteroskedasticity: -------------------------------------------------------------


# First, define a bernoulli sample, of length 26.
x <- sample(c(0, 1), 26, replace=T)

x
# [1] 1 1 1 1 0 1 1 0 1 0 1 1 1 0 1 1 0 1 0 1 0 1 1 0 1 0

# Give names to the entries. "letters" is a builtin value
names(x) <- letters

x
# a b c d e f g h i j k l m n o p q r s t u v w x y z
# 1 1 1 1 0 1 1 0 1 0 1 1 1 0 1 1 0 1 0 1 0 1 1 0 1 0

# The unstable one, see how "a" appears after "l" now
sort(x, method="quick")
# z h s u e q x n j r t v w y p o m l a i g f d c b k
# 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1

# The stable sort, letters are ordered in each section
sort(x, method="shell")
# e h j n q s u x z a b c d f g i k l m o p r t v w y
# 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1


library(boot)
library(ggplot2)

PSDS_PATH <- file.path('~', 'statistics-for-data-scientists')

loans_income <- read.csv(file.path(PSDS_PATH, 'data', 'loans_income.csv'))[,1]
sp500_px <- read.csv(file.path(PSDS_PATH, 'data', 'sp500_px.csv'))

x <- seq(from=-3, to=3, length=300)
gauss <- dnorm(x)

png(filename=file.path(PSDS_PATH, 'figures', 'normal_density.png'),  width = 4, height=5, units='in', res=300)
par(mar=c(3, 3, 0, 0)+.1)
plot(x, gauss, type="l", col='blue', xlab='', ylab='', axes=FALSE)
polygon(x, gauss, col='blue')
dev.off()

png(filename=file.path(PSDS_PATH, 'figures', 'samp_hist.png'), width = 200, height = 250)
norm_samp <- rnorm(100)
par(mar=c(3, 3, 0, 0)+.1)
hist(norm_samp, axes=FALSE, col='red', main='')
dev.off()

## Code snippet 2.1
stat_fun <- function(x, idx) median(x[idx])
boot_obj <- boot(loans_income, R = 1000, statistic=stat_fun)

# take a simple random sample
samp_data <- data.frame(income=sample(loans_income, 1000),
                        type='data_dist')
# take a sample of means of 5 values
samp_mean_05 <- data.frame(
  income = tapply(sample(loans_income, 1000*5),
                  rep(1:1000, rep(5, 1000)), FUN=mean),
  type = 'mean_of_5')
# take a sample of means of 20 values
samp_mean_20 <- data.frame(
  income = tapply(sample(loans_income, 1000*20),
                  rep(1:1000, rep(20, 1000)), FUN=mean),
  type = 'mean_of_20')
# bind the data.frames and convert type to a factor
income <- rbind(samp_data, samp_mean_05, samp_mean_20)
income$type = factor(income$type,
                     levels=c('data_dist', 'mean_of_5', 'mean_of_20'),
                     labels=c('Data', 'Mean of 5', 'Mean of 20'))
# plot the histograms
ggplot(income, aes(x=income)) +
  geom_histogram(bins=40) +
  facet_grid(type ~ .)

## Code for Figure 6
png(filename=file.path(PSDS_PATH, 'figures', 'psds_0206.png'),  width = 3, height=4, units='in', res=300)
ggplot(income, aes(x=income)) +
  geom_histogram(bins=40) +
  facet_grid(type ~ .) +
  theme_bw()
dev.off()

## Code for Figure 11
png(filename=file.path(PSDS_PATH, 'figures', 'psds_0211.png'),  width = 4, height=4, units='in', res=300)
norm_samp <- rnorm(100)
par(mar=c(3, 3, 0, 0)+.1)
qqnorm(norm_samp, main='', xlab='', ylab='')
abline(a=0, b=1, col='grey')
dev.off()

## Code for Figure 12
png(filename=file.path(PSDS_PATH, 'figures', 'psds_0212.png'),  width = 4, height=4, units='in', res=300)
par(mar=c(3, 3, 0, 0)+.1)
nflx <- sp500_px[,'NFLX']
nflx <- diff(log(nflx[nflx>0]))
qqnorm(nflx, main='', xlab='', ylab='')
abline(a=0, b=1, col='grey')
dev.off()


####################################################################
#################### Project 1: the Bank Marketing Data Set
#################### Robert Carausu & Marc Vila, CSI - MEI 2017-2018
####################################################################
set.seed (6046)
library(reshape2)
library(ggplot2)

## Direct marketing campaigns (phone calls) of a Portuguese banking institution.
## The classification goal is to predict if the client will subscribe a term deposit

## Getting the dataset
deposit <- read.table(file="./data/bank.csv", header=TRUE, stringsAsFactors=TRUE, sep=";")
# We rename the target variable
colnames(deposit)[ncol(deposit)] <- "subscribed"
original_data = deposit # We make a copy to compare it later with our pre-processed data

# 45211 observations and 17 different variables
# (9 categorical: job, marital, education, default, housing, loan, contact, month, poutcome and y)
dim(deposit)
summary(deposit)
# 11.70% of subscribed, so our model sholdn't have a higher error than this
# Data is very unbalanced so some models will adjust worse than others
sum(deposit$subscribed=="yes")/sum(length(deposit$subscribed))*100

## Let's have a visual inspection of the continuous variables before pre-processing
# Age seems ok
# The other variables are highly skewed so we will try to scale and apply log where we can
# We can do it for duration, not for balance since it has negative values and we don't want to lose data
# pdays can be converted to categorical: "not_contacted" (in previous campaign) and "contacted"
d.cont <- melt(deposit[, c("age", "balance", "duration", "campaign", "pdays", "previous")])
ggplot(d.cont, aes(x = value)) + facet_wrap(~variable, scales = "free") + geom_histogram() + theme(axis.text.x=element_text(angle=90, hjust=1, vjust=0.5))

## Let's have a visual inspection of the factor variables before pre-processing
# They seem ok so we won't be touching these variables
d.categ <- melt(deposit, measure.vars=c("job", "marital", "education", "housing", "loan", "contact", "default", "poutcome"))
ggplot(d.categ, aes(x = value)) + facet_wrap(~variable, scales = "free") + geom_bar() + theme(axis.text.x=element_text(angle=90, hjust=1, vjust=0.5))

# This dataset needs a lot of pre-processing ... also it displays a good mixture of categorical and numeric variables
# In conclusion LDA/QDA may not the best choice, a good choice may be Logistic Regression. We will test also Naive Bayes and Random Forest and
# choose the best model that fits our problem

#### PRE-PROCESSING ####
#### Fixing skewness and scaling continuous variables
# The balance has negative values, so we can only scale it
hist(deposit$balance, col='lightskyblue', border='lightskyblue4', xlab='balance', main='balance histogram', density=50)
# There are 3766 for negative balance
# The only way to fix it is to delete this observations so we choose to leave it as it is since we don't want to lose data
sum(deposit$balance<0)
deposit$balance = scale(deposit$balance)
# Scaled balance
hist(scale(deposit$balance), col='lightskyblue', border='lightskyblue4', xlab='balance', main='balance histogram', density=50)

# duration, campaign and previous are all skewed, so we apply log and scale
hist(deposit$duration, col='lightskyblue', border='lightskyblue4', xlab='duration', main='duration histogram', density=50)
deposit$duration = log(deposit$duration+0.001) # +0.001 to avoid -Inf
hist(deposit$duration, col='lightskyblue', border='lightskyblue4', xlab='duration', main='duration histogram', density=50)
deposit$duration = scale(deposit$duration)
hist(deposit$duration, col='lightskyblue', border='lightskyblue4', xlab='duration', main='duration histogram', density=50)

# Applying log and scale to campaign and previous has some undesired effects, so we will leave them as they are
hist(scale(log(deposit$campaign + 0.001)), col='lightskyblue', border='lightskyblue4', xlab='campaign', main='scale(log(campaign)) histogram', density=50)
hist(scale(log(deposit$previous + 0.001)), col='lightskyblue', border='lightskyblue4', xlab='previous', main='scale(log(previous)) histogram', density=50)

# pdays has most of values -1 (not contacted previously).
# We make a categorical value with "contacted" for pdays!=-1 and "not contacted" previously for pdays=-1
hist(deposit$pdays, col='lightskyblue', border='lightskyblue4', xlab='pdays', main='pdays histogram', density=50)
deposit$pdays = cut(deposit$pdays, breaks=c(-Inf, 0.0, Inf), labels=c("not_contacted", "contacted"))
table(deposit$pdays)
plot(deposit$pdays)

#### Fixing "unknown" values

# There are 288 subscriptions for unknown job, we leave it as it is since we don't want to delete this data
summary(deposit[deposit$job=="unknown",])

# We could change the unknown values to NA (as well as the 0 previous contacts variables), this is useful if we use a Random Forest algorythm,
# but since it is not the case we leave it as it is

# We plot again after pre-processing
d.cont <- melt(deposit[, c("age", "balance", "duration", "campaign", "previous")])
ggplot(d.cont, aes(x = value)) + facet_wrap(~variable, scales = "free") + geom_histogram() + theme(axis.text.x=element_text(angle=90, hjust=1, vjust=0.5))

# Now pdays is categorical
d.categ <- melt(deposit, measure.vars=c("job", "marital", "education", "housing", "loan", "contact", "default", "poutcome", "pdays"))
ggplot(d.categ, aes(x = value)) + facet_wrap(~variable, scales = "free") + geom_bar() + theme(axis.text.x=element_text(angle=90, hjust=1, vjust=0.5))

library(caret)
library(MASS)
library(e1071)
library(randomForest)

# PREPARING THE TRAINING AND TEST DATA
## Since we want to use different methods, we need CV and a separate test set:

N <- nrow(deposit)
all.indexes <- 1:N

learn.indexes <- sample(1:N, round(2*N/3))
test.indexes <- all.indexes[-learn.indexes]

learn.data <- deposit[learn.indexes,]
original.learn.data <- original_data[learn.indexes,]
test.data <- deposit[test.indexes,]
original.test.data <- original_data[test.indexes,]

nlearn <- length(learn.indexes)
ntest <- N - nlearn

#### MODELLING ####
############ LOGISTIC REGRESSION ##########
# We use Logistic Regression as recommended since it doesn't need a lot of preprocessing of the data and we also have a lot of categorical variables

# ORIGINAL DATA
# First aproximation with the original unchanged data & all variables
glm.fit = glm(subscribed~., data=original.learn.data, family="binomial")

# Observing the p-values, we can have an idea of the variables that have more importance in predicting our model,
# a low p-value indicates that we can reject the null hipotesis, thus that variable has an importance on our model,
# a higher p-value means that we can discard that variable
# so we can fit the mode again with just the variable that actually have an influence on our model
# We can discard the following since they affect our model less: age, job, marital, default, balance, pdays and previous
summary(glm.fit)

# We calculate the prediction with and without the discarded variables and compare the errors
glm.probs = predict(glm.fit, original.test.data, type="response")
glm.pred = rep("no", length(glm.probs))
glm.pred[glm.probs>.5] = "yes"

# We choose 3 values to represent our model performance: accuracy, error and precision, the last one is important
# because the bank wants to contact only those clients that are more probable to subscribe to the loan
# We can see that accuracy is high (90.07 %), but precission is low (34.15%), to solve this we lower the threshold
# for which a client may subscribe a loan (the probability) compare the values again, since for the bank clients
# with 30% probability of subscribing is probably worth to spend it's ressources contacting them
res.performance = table(glm.pred, original.test.data$subscribed)
res.accuracy = (res.performance[2,2] + res.performance[1,1])/sum(res.performance)*100
res.error = 100 - res.accuracy
res.precision = (res.performance[2,2])/(res.performance[2,2] + res.performance[1,2])*100

# Accuracy is slightly lower (90.03%) but precission has almost doubled (53.78%)
glm.pred[glm.probs>.3] = "yes"
res.performance = table(glm.pred, original.test.data$subscribed)
res.accuracy = (res.performance[2,2] + res.performance[1,1])/sum(res.performance)*100
res.error = 100 - res.accuracy
res.precision = (res.performance[2,2])/(res.performance[2,2] + res.performance[1,2])*100

# Now we fit the model without the variables that had less of an impact
glm.fit = glm(subscribed~.-age-job-marital-default-balance-pdays-previous, data=original.learn.data, family="binomial")
glm.probs = predict(glm.fit, original.test.data, type="response")
glm.pred = rep("no", length(glm.probs))

# The total accuracy decreases to 89.93% and precission to 53.32%, so using less variables makes our model a bit less accurate
# but the difference is really small so it's not really important to discard those variables
# If we have too many variables and computation time is important,
# we can also see that removing the ones we selected won't affect so much our model prediction
glm.pred[glm.probs>.3] = "yes"
res.performance = table(glm.pred, original.test.data$subscribed)
res.accuracy = (res.performance[2,2] + res.performance[1,1])/sum(res.performance)*100
res.error = 100 - res.accuracy
res.precision = (res.performance[2,2])/(res.performance[2,2] + res.performance[1,2])*100

# PREPROCESSED DATA
# We will fit with all the variables and also removing the ones that we mentioned before
glm.fit = glm(subscribed~., data=learn.data, family="binomial")
glm.probs = predict(glm.fit, test.data, type="response")
glm.pred = rep("no", length(glm.probs))

# Accuracy is 89.40% and precission is 57.95%, so our model is much more precise detecting clients
# that will probably buy the finantial product of the bank with the preprocessed data
glm.pred[glm.probs>.3] = "yes"
res.performance = table(glm.pred, original.test.data$subscribed)
res.accuracy = (res.performance[2,2] + res.performance[1,1])/sum(res.performance)*100
res.error = 100 - res.accuracy
res.precision = (res.performance[2,2])/(res.performance[2,2] + res.performance[1,2])*100

# Now we fit the model without the variables that had less of an impact
glm.fit = glm(subscribed~.-age-job-marital-default-balance-pdays-previous, data=learn.data, family="binomial")
glm.probs = predict(glm.fit, test.data, type="response")
glm.pred = rep("no", length(glm.probs))

# Accuracy: 89.47%, precision: 57.44%
# As before, there is a small reduction in accuracy and precision but the results with preprocessed data are better
glm.pred[glm.probs>.3] = "yes"
res.performance = table(glm.pred, original.test.data$subscribed)
res.accuracy = (res.performance[2,2] + res.performance[1,1])/sum(res.performance)*100
res.error = 100 - res.accuracy
res.precision = (res.performance[2,2])/(res.performance[2,2] + res.performance[1,2])*100

#### To get a better grasp at the performance of our model, we do k-fold cross validation
precision <- NULL
accuracy <- NULL
error <- NULL
k <- 100

# It may take a while to compute
for (i in 1:k)
{
  N <- nrow(deposit)
  all.indexes <- 1:N

  # we choose 9/10s of the data as training data and the rest as test data
  learn.indexes <- sample(1:N, round(9*N/10))
  test.indexes <- all.indexes[-learn.indexes]

  learn.data <- deposit[learn.indexes,]
  test.data <- deposit[test.indexes,]

  nlearn <- length(learn.indexes)
  ntest <- N - nlearn
  glm.fit = glm(subscribed ~ ., data=learn.data, family="binomial")
  #glm.fit = glm(subscribed ~ .-age-job-marital-default-balance-pdays-previous, data=learn.data, family="binomial")
  glm.probs = predict(glm.fit, test.data, type="response")

  glm.pred = rep("no", length(glm.probs))
  glm.pred[glm.probs>.3] = "yes"

  res.performance = table(glm.pred, test.data$subscribed)
  accuracy[i] <- (res.performance[2,2] + res.performance[1,1])/sum(res.performance)*100
  error[i] <- 100 - accuracy[i]
  precision[i] <- (res.performance[2,2])/(res.performance[2,2] + res.performance[1,2])*100
}

# We can see that our model performs pretty well, even though the data is highly unbalanced
# Mean values with all the variables
# accuracy: 89.69%
# error: 10.31%
# precision: 58.80 %

# Mean values without the variables that influence less our model (swap the commented code in the previous bucle)
# accuracy: 89.74%
# error: 10.26%
# precision: 58.37 %
mean(accuracy)
mean(error)
mean(precision)

par(mfrow=c(1,3))
hist(accuracy, col='lightskyblue', border='lightskyblue4', xlab='Acuracy', main='Acuracy for CV', density=50)
hist(error, col='lightskyblue', border='lightskyblue4', xlab='Error', main='Error for CV', density=50)
hist(precision, col='lightskyblue', border='lightskyblue4', xlab='Precision', main='Precision for CV', density=50)

boxplot(accuracy, horizontal=T, col='lightskyblue', border='lightskyblue4', xlab='Acuracy', main='Acuracy for CV')
boxplot(error, horizontal=T, col='lightskyblue', border='lightskyblue4', xlab='Error', main='Error for CV')
boxplot(precision, horizontal=T, col='lightskyblue', border='lightskyblue4', xlab='Precision', main='Precision for CV')
dev.off()

# To compare the performance of our model we will also model with LDA and QDA and analyze their performances.
# Also we will test NaiveBayes and RandomForest
N <- nrow(deposit)
all.indexes <- 1:N

learn.indexes <- sample(1:N, round(2*N/3))
test.indexes <- all.indexes[-learn.indexes]

learn.data <- deposit[learn.indexes,]
test.data <- deposit[test.indexes,]

nlearn <- length(learn.indexes)
ntest <- N - nlearn

#################### LDA ##################
# With LDA the precision is much lower, so we won't be using this model
# 10.73% error, 89.27% accuracy, 28.51% precision
lda.fit = lda(subscribed ~ ., data=learn.data)
lda.pred = predict(lda.fit, test.data)
lda.class = lda.pred$class

res.performance = table(lda.class, test.data$subscribed)
res.accuracy = (res.performance[2,2] + res.performance[1,1])/sum(res.performance)*100
res.error = 100 - res.accuracy
res.precision = (res.performance[2,2])/(res.performance[2,2] + res.performance[1,2])*100

#################### QDA ##################
# Performs worse than LDA, but the precision is a bit higher so it detects better the subscriptions
# We confirm that both LDA and QDA are not suitable models to fit our problem
# 13.43% error, 86.57% accuracy, 37.99% precision
qda.fit <- qda(subscribed ~ ., data=learn.data)
qda.pred = predict(qda.fit, test.data)
qda.class = qda.pred$class

res.performance = table(qda.class, test.data$subscribed)
res.accuracy = (res.performance[2,2] + res.performance[1,1])/sum(res.performance)*100
res.error = 100 - res.accuracy
res.precision = (res.performance[2,2])/(res.performance[2,2] + res.performance[1,2])*100

################# NAIVE BAYES ##################
# It performs better than LDA and QDA, but worse than logistic regression
# 12.57% error, 87.43% accuracy, 43.89% precision
bayes.fit <- naiveBayes(subscribed ~ ., data = learn.data)
bayes.pred <- predict(bayes.fit, test.data)

res.performance = table(bayes.pred, test.data$subscribed)
res.accuracy = (res.performance[2,2] + res.performance[1,1])/sum(res.performance)*100
res.error = 100 - res.accuracy
res.precision = (res.performance[2,2])/(res.performance[2,2] + res.performance[1,2])*100

#################### Random Forest ##################
# 9.30% error, 90.70% accuracy, 64.66% precision, so far the best method
rf <- randomForest(subscribed ~ ., data = original_data[learn.indexes,], ntree=300, proximity=FALSE)
rf.pred <- predict(rf, newdata=original_data[-learn.indexes,])

res.performance = table(Truth=original_data[-learn.indexes,]$subscribe,Pred=rf.pred)
res.accuracy = (res.performance[2,2] + res.performance[1,1])/sum(res.performance)*100
res.error = 100 - res.accuracy
res.precision = (res.performance[2,2])/(res.performance[2,2] + res.performance[1,2])*100

#### As with logistic regresion we do k-fold CV to confirm our model accuracy and precision
# We choose k=10 since randomForest has a high computation time
precision <- NULL
accuracy <- NULL
error <- NULL
k <- 10

# It may take quite a while to compute
for (i in 1:k)
{
  N <- nrow(deposit)
  all.indexes <- 1:N

  # we choose 9/10s of the data as training data and the rest as test data
  learn.indexes <- sample(1:N, round(9*N/10))
  test.indexes <- all.indexes[-learn.indexes]

  nlearn <- length(learn.indexes)
  ntest <- N - nlearn
  #glm.fit = glm(subscribed ~ ., data=learn.data, family="binomial")
  rf <- randomForest(subscribed ~ ., data = original_data[learn.indexes,], ntree=300, proximity=FALSE)
  rf.pred <- predict(rf, newdata=original_data[-learn.indexes,])

  res.performance = table(Truth=original_data[-learn.indexes,]$subscribe,Pred=rf.pred)
  accuracy[i] <- (res.performance[2,2] + res.performance[1,1])/sum(res.performance)*100
  error[i] <- 100 - accuracy[i]
  precision[i] <- (res.performance[2,2])/(res.performance[2,2] + res.performance[1,2])*100
}
# Mean values
# accuracy: 90.83%
# error: 9.17 %
# precision: 64.66%
mean(accuracy)
mean(error)
mean(precision)

par(mfrow=c(1,3))
hist(accuracy, col='lightskyblue', border='lightskyblue4', xlab='Acuracy', main='Acuracy for CV', density=50)
hist(error, col='lightskyblue', border='lightskyblue4', xlab='Error', main='Error for CV', density=50)
hist(precision, col='lightskyblue', border='lightskyblue4', xlab='Precision', main='Precision for CV', density=50)

boxplot(accuracy, horizontal=T, col='lightskyblue', border='lightskyblue4', xlab='Acuracy', main='Acuracy for CV')
boxplot(error, horizontal=T, col='lightskyblue', border='lightskyblue4', xlab='Error', main='Error for CV')
boxplot(precision, horizontal=T, col='lightskyblue', border='lightskyblue4', xlab='Precision', main='Precision for CV')
dev.off()

# To conclude, random forest is the best method, followed by logistic regression, according to the results


easypackages::libraries("dplyr","reshape2","gridExtra", "ggplot2",
                        "tidyr", "corrplot", "corrr", "magrittr",
                        "e1071","ggplot2","RColorBrewer", "viridis")

options(scipen = 5)               #To force R to not use scientfic notation

dataset <- read.csv("dataset/train.csv")

str(dataset)

ggplot(dataset, aes(x=SalePrice)) +
  theme_bw()+
  geom_histogram(aes(y=..density..),color = 'black', fill = 'white', binwidth = 50000)+
  geom_density(alpha=.2, fill='blue') +
  labs(title = "Sales Price Density", x="Price", y="Density")

summary(dataset$SalePrice)

#bringing in variables

dataset$YearBuilt <- factor(dataset$YearBuilt)
dataset$OverallQual <- factor(dataset$OverallQual)

ggplot(dataset, aes(y=SalePrice, x=YearBuilt, group=YearBuilt, fill=YearBuilt)) +
  theme_bw()+
  geom_boxplot(outlier.colour="red", outlier.shape=8,
               outlier.size=1)+
  theme(legend.position="none")+
  scale_fill_viridis(discrete = TRUE) +
  theme(axis.text.x = element_text(angle = 90))+
  labs(title = "Year Built vs. Sale Price", x="Year", y="Price")

ggplot(dataset, aes(y=SalePrice, x=OverallQual, group=OverallQual,fill=OverallQual)) +
  geom_boxplot(alpha=0.3)+
  theme(legend.position="none")+
  scale_fill_viridis(discrete = TRUE, option="B") +
  labs(title = "Overall Quality vs. Sale Price", x="Quality", y="Price")

ggplot(dataset, aes(x=SalePrice, y=GrLivArea)) +
  theme_bw()+
  geom_point(colour="Blue", alpha=0.3)+
  theme(legend.position='none')+
  labs(title = "General Living Area vs. Sale Price", x="Price", y="Area")

ggplot(dataset, aes(x=SalePrice, y=TotalBsmtSF)) +
  theme_bw()+
  geom_point(colour="Blue", alpha=0.3)+
  theme(legend.position='none')+
  labs(title = "Total Basement Area vs. Sale Price", x="Price", y="Area")

#M <- cor(dataset)
M <- dataset %>% mutate_if(is.character, as.factor)
M <- M %>% mutate_if(is.factor, as.numeric)
M <- cor(M)

mat1 <- data.matrix(M)
print(M)

corrplot(M, method = "color", tl.col = 'black', is.corr=FALSE)       #plotting the correlation matrix

#But this ain't it chief - This is a mess we need to fix

M[lower.tri(M,diag=TRUE)] <- NA                         #remove coeff - 1 and duplicates
M[M == 1] <- NA

M <- as.data.frame(as.table(M))                   #turn into a 3-column table
M <- na.omit(M)                                   #remove the NA values from above

M <- subset(M, abs(Freq) > 0.5)             #select significant values, in this case, 0.5
M <- M[order(-abs(M$Freq)),]              #sort by highest correlation

print(M)

mtx_corr <- reshape2::acast(M, Var1~Var2, value.var="Freq")  #turn M back into matrix in order to plot with corrplot

corrplot(mtx_corr, is.corr=TRUE, tl.col="black", na.label=" ") #plot correlations visually

#This looks much better

newData <- data.frame(dataset$SalePrice, dataset$TotalBsmtSF,
                      dataset$GrLivArea, dataset$OverallQual,
                      dataset$YearBuilt, dataset$FullBath,
                      dataset$GarageCars )

pairs(newData[1:7],
      main = "Pairplot of our new set of variables",          # to get a gist of these varibles.
      col="blue"
)

clean_data <- dataset[,!grepl("^Bsmt",names(dataset))]      #remove BSMTx variables

drops <- c("clean_data$PoolQC", "clean_data$PoolArea", "clean_data$FullBath", "clean_data$HalfBath")
clean_data <- clean_data[ , !(names(clean_data) %in% drops)]

str(clean_data)

#Univariate Analysis

clean_data$price_norm <- scale(clean_data$SalePrice)    #normalizing the price variable

summary(clean_data$price_norm)

plot1 <- ggplot(clean_data, aes(x=factor(1), y=price_norm)) +
  theme_bw()+
  geom_boxplot(width = 0.4, fill = "blue", alpha = 0.2)+
  geom_jitter(
              width = 0.1, size = 1, aes(colour ="red"))+
  geom_hline(yintercept=6.5, linetype="dashed", color = "red")+
  theme(legend.position='none')+
  labs(title = "Hunt for Outliers", x=NULL, y="Normalized Price")

plot2 <- ggplot(clean_data, aes(x=price_norm)) +
  theme_bw()+
  geom_histogram(color = 'black', fill = 'blue', alpha = 0.2)+
  geom_vline(xintercept=6.5, linetype="dashed", color = "red")+
  geom_density(aes(y=0.4*..count..), colour="red", adjust=4) +
  labs(title = "", x="Normalized Price", y="Count")

grid.arrange(plot1, plot2, ncol=2)

#Bi-variate Analysis

ggplot(clean_data, aes(y=SalePrice, x=GrLivArea)) +
  theme_bw()+
  geom_point(aes(color = SalePrice), alpha=1)+
  scale_color_gradientn(colors = c("#00AFBB", "#E7B800", "#FC4E07")) +
  labs(title = "General Living Area vs. Sale Price", y="Price", x="Area")

#clean_data$GrLivArea <- sort(clean_data$GrLivArea, decreasing = TRUE)

clean_data <- clean_data[!(clean_data$GrLivArea > 4000),]   #remove outliers

ggplot(clean_data, aes(y=SalePrice, x=GrLivArea)) +
  theme_bw()+
  geom_point(aes(color = SalePrice), alpha=1)+
  scale_color_gradientn(colors = c("#00AFBB", "#E7B800", "#FC4E07")) +
  labs(title = "General Living Area vs. Sale Price [Outlier Removed]", y="Price", x="Area")

#As for Basement Area, the outliers don't look so bad.

ggplot(clean_data, aes(y=SalePrice, x=TotalBsmtSF)) +
  theme_bw()+
  geom_point(aes(color = SalePrice), alpha=1)+
  scale_color_gradientn(colors = c("#00AFBB", "#E7B800", "#FC4E07")) +
  labs(title = "Total Basement Area vs. Sale Price", y="Price", x="Basement Area")

#advanced

plot3 <- ggplot(clean_data, aes(x=SalePrice)) +
  theme_bw()+
  geom_density(fill="#69b3a2", color="#e9ecef", alpha=0.8)+
  geom_density(color="black", alpha=1, adjust = 5, lwd=1.2)+
  labs(title = "Sale Price Density", x="Price", y="Density")

plot4 <- ggplot(clean_data, aes(sample=SalePrice))+
  theme_bw()+
  stat_qq(color="#69b3a2")+
  stat_qq_line(color="black",lwd=1, lty=2)+
  labs(title = "Probability Plot for SalePrice")

grid.arrange(plot3, plot4, ncol=2)

#log transformation
clean_data$log_price <- log(clean_data$SalePrice)

plot5 <- ggplot(clean_data, aes(x=log_price)) +
  theme_bw()+
  geom_density(fill="#69b3a2", color="#e9ecef", alpha=0.8)+
  geom_density(color="black", alpha=1, adjust = 5, lwd=1)+
  labs(title = "Sale Price Density [Log]", x="Price", y="Density")

plot6 <- ggplot(clean_data, aes(sample=log_price))+
  theme_bw()+
  stat_qq(color="#69b3a2")+
  stat_qq_line(color="black",lwd=1, lty=2)+
  labs(title = "Probability Plot for SalePrice [Log]")

grid.arrange(plot5, plot6, ncol=2)

#Same for GrLivArea

plot7 <- ggplot(clean_data, aes(x=GrLivArea)) +
  theme_bw()+
  geom_density(fill="#9e69b3", color="#e9ecef", alpha=0.5)+
  geom_density(color="black", alpha=1, adjust = 5, lwd=1)+
  labs(title = "General Living Area Density", x="Area", y="Density")

plot8 <- ggplot(clean_data, aes(sample=GrLivArea))+
  theme_bw()+
  stat_qq(color="#9e69b3")+
  stat_qq_line(color="black",lwd=1, lty=2)+
  labs(title = "Probability Plot for GrLivArea")

grid.arrange(plot7, plot8, ncol=2)

#log transformation
clean_data$grlive_log <- log(clean_data$GrLivArea)

plot9 <- ggplot(clean_data, aes(x=grlive_log)) +
  theme_bw()+
  geom_density(fill="#9e69b3", color="#e9ecef", alpha=0.5)+
  geom_density(color="black", alpha=1, adjust = 5, lwd=1)+
  labs(title = "General Living Area Density [Log]", x="Area", y="Density")

plot10 <- ggplot(clean_data, aes(sample=grlive_log))+
  theme_bw()+
  stat_qq(color="#9e69b3")+
  stat_qq_line(color="black",lwd=1, lty=2)+
  labs(title = "Probability Plot for GrLivArea [Log]")

grid.arrange(plot9, plot10, ncol=2)

#Now for TotalBsmtSF

plot11 <- ggplot(clean_data, aes(x=TotalBsmtSF)) +
  theme_bw()+
  geom_density(fill="#ed557e", color="#e9ecef", alpha=0.5)+
  geom_density(color="black", alpha=1, adjust = 5, lwd=1)+
  labs(title = "Total Basement Area Density", x="Area", y="Density")

plot12 <- ggplot(clean_data, aes(sample=TotalBsmtSF))+
  theme_bw()+
  stat_qq(color="#ed557e")+
  stat_qq_line(color="black",lwd=1, lty=2)+
  labs(title = "Probability Plot for TotalBsmtSF")

grid.arrange(plot11, plot12, ncol=2)

clean_data <- transform(clean_data, cat_bsmt = ifelse(TotalBsmtSF>0, 1, 0))

#log transformation
clean_data$totalbsmt_log <- log(clean_data$TotalBsmtSF)

clean_data<-transform(clean_data,totalbsmt_log = ifelse(cat_bsmt == 1, log(TotalBsmtSF), 0 ))

plot13 <- ggplot(clean_data, aes(x=totalbsmt_log)) +
  theme_bw()+
  geom_density(fill="#ed557e", color="#e9ecef", alpha=0.5)+
  geom_density(color="black", alpha=1, adjust = 5, lwd=1)+
  labs(title = "Total Basement Area Density [transformed]", x="Area", y="Density")

plot14 <- ggplot(clean_data, aes(sample=totalbsmt_log))+
  theme_bw()+
  stat_qq(color="#ed557e")+
  stat_qq_line(color="black",lwd=1, lty=2)+
  labs(title = "Probability Plot for TotalBsmtSF [transformed]")

grid.arrange(plot13, plot14, ncol=2)

#checking for homoscedasiticity

ggplot(clean_data, aes(x=grlive_log, y=log_price)) +
  theme_bw()+
  geom_point(colour="#e34262", alpha=0.3)+
  theme(legend.position='none')+
  labs(title = "Homoscedasticity : Living Area vs. Sale Price ", x="Area [Log]", y="Price [Log]")

ggplot(clean_data, aes(x=totalbsmt_log, y=log_price)) +
  theme_bw()+
  geom_point(colour="#e34262", alpha=0.3)+
  theme(legend.position='none')+
  labs(title = " Homoscedasticity : Total Basement Area vs. Sale Price", x="Area [Log]", y="Price [Log]")


# What if x<-c(1,2,3,4,5) and y<-c("a","b","c","d","e")

x <- c(1,2,3,4,5)

y <- c("a","b","c","d","e")

A <- rbind(x, y)  # observe the matrix data types

#c.  matrix--2d arrangement of elements (elements should be of same data type)

x <- matrix(c(1,2,3,4,5,6), nrow=3, ncol=2, byrow=T) #try with character data type
x

z <- matrix(c(1,2,3,4,5,6,7,8,9,0),nrow  = 3,byrow = T,ncol = 5,dimnames =list( c('a','b','c'),c('d','e','f','g','h')))

#Row sums and Column sums ,sum of diagonal elements, sum of all elements in Matrix

rowSums(z)

colSums(x)

sum(diag(z))

sum(x)

#d.  dataframe-- it is also a matrix representation but can have multiple data types in it.
##creating an empty data frame

data <-data.frame()

#Creating a data frame

data <- data.frame( Name=c("Alpha","Beta","Gamma"),
                    Marks=c(29,NA,27),Sex=c("M","F","F"),Location=c("Chennai","Delhi","Bengaluru"))
data

data[1,3]
str(data)

#For both matrix and data frames: calling referring "elements" by position

x <- matrix(c(1,2,3,4), nrow=2, ncol=2, byrow=T)
x
x[1,1] # extracting element in first row and first column
x[1,]  #extracting all the elements from first row
x[,2]  #extracting all the elements from second column
x[2,1] #extracting  the element in second row and first column

#To get the dimensions of the matrix

dim(x)

#To name the rows or columns in the matrix
x
dimnames(x)<-list(c("One","Two","Three"),c("Four","Five"))
x

data
names(data)
dimnames(data)

names(data)<-c("Radiation", "Count")

data

#list-- a  "vector" containing other objects which could be a vector, a dataframe or a list.
#Creating a list

x <- c(1,2,3,4)
x1 <- c(5,6,7,8)
x2 <- list(x,x1)
y <- c("a","b")

z <-  data.frame(name=c("Alpha","Beta","Gamma"), Marks=c(29,30,27))

A <- list(x2,y,z)

#Try out the following and observe the output
A
A[1]
A[[1]]
A[1][1]
A[[1]][[1]]

A[[1]][[1]]
A[[1]][[2]]
A[[2]][[1]]
A[[2]][[2]]

#################Saving the work space as image, reading and loading data##################
# The workspace is your current R working environment and includes any user-defined
# objects (vectors, matrices, functions, data frames, and lists)
# The current working directory is the directory from which R will read files and to
# which it will save results by default. You can find out what the current working direc-
#   tory is by using the getwd() function. You can set the current working directory by
# using the setwd() function. If you need to input a file that isn't in the current working
# directory, use the full pathname in the call.

setwd("D:/Ravikanth/Academics/Batch25/20161211/ToShare/Data")

getwd()

#a.	Saving workspace

save.image()

save.image("Save_20161211.RData")

# Loading saved workspace

load("Save_20161211.RData")

#b.	How do save only a few variables from environment

save(x, y, file="xy.RData")

#c.	Writing data to a file

write.csv(z,"./data.csv", row.names=F)  #for different delimited file ??

#d.	Reading the csv files and RData files into R environment

grade <- read.csv("./Grade.csv", header=T, sep = ",")

##Reading other formats we use read.table command  # comma as decimal & : as field sep ?

read <- read.table("./greek.txt",sep="\t",header=T)

# removing objects from the workspace

rm(x)

x  # Error: object 'x' not found

# remove all objects from the workspace

rm(list=ls(all=TRUE))


missingSum=function()
{
  vec=c(1,2,3,4,NA,NA,NA,8,9,10)
  add=sum(vec,na.rm = TRUE)
  add
}
missingSum()


#Time series plots have time on the x-axis and a variable of interest on the y-axis.
# load and inspect gapminder data
library(dslabs)
data(gapminder)
head(gapminder)

# Single time series
# scatterplot of US fertility by year
gapminder %>%
    filter(country == "United States") %>%
    ggplot(aes(year, fertility)) +
    geom_point()

# line plot of US fertility by year
gapminder %>%
    filter(country == "United States") %>%
    ggplot(aes(year, fertility)) +
    geom_line()

# Multiple time series
# line plot fertility time series for two countries- only one line (incorrect)
countries <- c("South Korea", "Germany")
gapminder %>% filter(country %in% countries) %>%
    ggplot(aes(year, fertility)) +
    geom_line()

# line plot fertility time series for two countries - one line per country
gapminder %>% filter(country %in% countries) %>%
    ggplot(aes(year, fertility, group = country)) +
    geom_line()

# fertility time series for two countries - lines colored by country
gapminder %>% filter(country %in% countries) %>%
    ggplot(aes(year, fertility, col = country)) +
    geom_line()

# Adding text labels to a plot
# life expectancy time series - lines colored by country and labeled, no legend
labels <- data.frame(country = countries, x = c(1975, 1965), y = c(60, 72))
gapminder %>% filter(country %in% countries) %>%
    ggplot(aes(year, life_expectancy, col = country)) +
    geom_line() +
    geom_text(data = labels, aes(x, y, label = country), size = 5) +
    theme(legend.position = "none")


library(ggplot2)
library(reshape2)
library(e1071)
#load data
train.data <- read.csv("Downloads/MachineLearning-master/Example Data/SVM_Example_1.csv", stringsAsFactors=F)
#take a galance
plot1 <- ggplot(train.data) + geom_point(aes(x, y, color = label))
#change format of label from int to factor
train.data$label <- as.factor(train.data$label)
#train a simple model and predict
model <- svm(label~., data = train.data)
pred <- predict(model, train.data[,1:2])
table(pred, train.data[,3])
#get the best sigma / cost parameter based on Mike's blog
sigma <- c(0.001, 0.01, 0.1, 0.2, 0.5, 1.0, 2.0, 3.0, 10.0)
gamma <- 1/(sigma * sigma *2)
cost <- c(0.001, 0.01, 0.1, 0.2, 0.5,1.0, 2.0, 3.0, 10.0, 100.0)
tuned <- tune.svm(label~., data = train.data, gamma = gamma, cost = cost)
#print the best parameter
summary(tuned)
#train a new model with the best sigma and cost
model.new <- svm(label~., data = train.data, gamma = 0.5, cost = 1)
#combine predict result with original data
df <- cbind(train.data, data.frame(ifelse(as.numeric(predict(model.new))>1,1,0)))
colnames(df) <- c("x", "y", "label", "predict")
#remove label column
df <- df[,c(1,2,4)]
#visulize prediction
predictions <- melt(df, id.vars = c("x", "y"))
plot2 <- ggplot(predictions) + geom_point(aes(x, y, color = value))
#visualize two plots in a single screen
multiplot(plot1, plot2, cols = 2)


require("shiny")
require("plotly")
require("igraph", quietly = T)
require("networkD3", quietly = T)
source("opt_d.r")
require("pairsD3")
require("plyr")
require("reshape")
source("igraph2D3.r")

shinyServer(function(input, output) {

  # Read in the graph from graphml file
  graphFile <- reactive({

    if(input$use_demo_graph)
      inFile<- "./demo2.graphml"
    else
      inFile<-input$file1$datapath

    graph<- read.graph(inFile,
     format = "graphml")
    if(!is.connected(graph)){
      graph<-decompose.graph(graph)[[1]]
    }
    graph <- as.undirected(graph, mode = "collapse")
    graph
  })

  #Compute the max coreness
  output$KinKcore <- renderUI({
    graph <- graphFile()
    coreness <- graph.coreness(graph, "all")
    maxCoreness <- max(coreness)
    if(input$use_k_core){
      sliderInput(
        inputId = "par_k_cores",
        label = "K:",
        min = 1,
        max = maxCoreness,
        ticks = T,
        step = 1,
        value = 10
        )
    }
  })

  #simplified graph with k core
  graph_kcore<- reactive({
    g<- graphFile()
    if(input$use_k_core){
      coreness <- graph.coreness(g, "all")
      verticesHavingMaxCoreness <- which(coreness >=
        input$par_k_cores)
      g <- induced.subgraph(graph = g, vids = verticesHavingMaxCoreness)
    }
    g
  })

  # get adjacency
  Adjacency <- reactive({
    graph <- graph_kcore()
    a<-get.adjacency(
      graph,
      type = "both",
      attr = NULL,
      sparse = T,
      edges = F
      )
    A = a > 0

    A
  })

  # get laplacian
  subLaplacian <- reactive({
    A <- Adjacency()
    denseA <- as.matrix(A) * 1
    D<- rowSums(denseA)
    denseA <-  diag(D) - denseA
    denseA
  })

  # get normalized laplacian
  Laplacian <- reactive({
    A <- Adjacency()
    denseA <- as.matrix(A) * 1
    D<- rowSums(denseA)
    D_half <- sqrt(D)
    denseA <-  diag(1 / D_half) %*% denseA %*% diag(1 / D_half)
    denseA
  })

  # kmeans
  Cluster <- reactive({
    # L<- Laplacian()
    # A <- Adjacency()

    # if(input$svd_mat=="Adjacency")
    svdL <- svd(Adjacency())
    # if(input$svd_mat=="Normalized Laplacian")
      # svdL <- svd(Laplacian())
    # if(input$svd_mat=="Laplacian")
      # svdL <- svd(subLaplacian())

    u<- svdL$u[,1:input$embedding_d]
    d<- svdL$d[1:input$embedding_d]
    X<- u %*% diag(sqrt(d))
    clusters <- kmeans(X, input$embedding_k)
    clusters
    # group_col= clusters$cluster
    # group_col
  })

  #1st viz: layout
  output$graph_layout <- renderForceNetwork({
    graph <- graph_kcore()

    members <- rep(1, length(V(graph)))

    if(input$embedding_sbm  & input$embedding_model == 'Stochastic Block Model'){
      members = Cluster()$cluster
        # members<- members[coreness >= input$par_k_cores]
    }

    graph_d3 <- igraph2D3(graph, members)

    forceNetwork(
      Links = graph_d3$links,
      Nodes = graph_d3$nodes,
      Source = 'source',
      Target = 'target',
      NodeID = 'name',
      Group = 'group',
      zoom = TRUE
      )
  })

  # # vertex stats
  # output$vertex_dist <- renderPlotly({

  #   graph <- graph_kcore()
  #   dg <- degree(graph)

  #   block<- rep(1, length(dg))

  #   if(      input$embedding_sbm){
  #   block <- Cluster()$cluster
  #   }

  #   df <- data.frame(x <- dg, block <- factor(block))
  #   names(df)<- c("x","block")

  #   p <- ggplot(df, aes(x=x, fill=block)) + geom_density(alpha = 0.7, bw = input$bw_adjust_overlay)+   ggtitle("Degree in each Block")

  #   # geom_histogram(
  #   #  position="identity",
  #   #   aes(y = ..density..),
  #   #     alpha = 0.7,
  #   #     binwidth = 1
  #   #   )
  #   ggplotly(p)

  # })

  output$AttributeSelect <- renderUI({
    graph <- graphFile()
    vertexAtt<- get.vertex.attribute(graph)
    count<- lapply(vertexAtt, function(x){length(unique(x))})
    nameAtt<- names(vertexAtt)
    pickAtt<- nameAtt[(count<10 & count>=2)]

    selectInput(
        inputId = "pickAttribute",
        label = "Pick attributes",
        choices =  pickAtt ,
        selected = pickAtt[1]
        )
  })

    # attributes condtional stats
  output$vertex_dist <- renderPlotly({

    graph <- graph_kcore()

     if(input$graph_stats=="Degree"){
        bw <- degree(graph)
      }
      if(input$graph_stats=="Betweenness Centrality"){
        bw <- betweenness(graph)

      }
      if(input$graph_stats=="Closeness Centrality"){
        bw <- closeness(graph)

      }
      if(input$graph_stats=="Eigenvector Centrality"){
        eg<- evcent(graph)
        bw <- eg$vector

      }

      if(input$graph_stats=="Bonacich Power Centrality"){
        bw<- power_centrality(graph)

      }

      if(input$graph_stats=="Authority Score"){
        bw<- authority_score(graph)$vector
      }

    Attribute<- rep("overall", length(V(graph)))
    if(input$vertex_conditional){

      vertexAtt<- get.vertex.attribute(graph)

      Attribute <- vertexAtt[[input$pickAttribute]]

      countAttribute<- table(Attribute)

      namesWithCountSmallerThan5<- names(countAttribute[countAttribute <=5])

      Attribute[Attribute %in% namesWithCountSmallerThan5]<- paste("Others: ", paste(namesWithCountSmallerThan5, collapse = ',') , collapse = " ")
    }

    df <- data.frame(x <- bw, Attribute <- factor(Attribute))
    names(df)<- c("x","attribute")

    p <- ggplot(df, aes(x=x, fill=Attribute)) + geom_density(alpha = 0.7, bw = input$bw_adjust_overlay)+   ggtitle(input$graph_stats)

    # geom_histogram(
    #  position="identity",
    #   aes(y = ..density..),
    #     alpha = 0.7,
    #     binwidth = 1
    #   )
    ggplotly(p)

  })

  #2nd viz:graph stats
  output$density_dist <- renderPlotly({
    # g<- graphFile()
    graph <- graph_kcore()
    A <- Adjacency()

    if (input$plot_degree) {
      if(input$graph_stats=="Degree"){
        bw <- degree(graph)
        df <- data.frame(x <- bw, group <- 1)
        min_binwidth = 1
      }
      if(input$graph_stats=="Betweenness Centrality"){
        bw <- betweenness(graph)
        df <- data.frame(x <- bw, group <- 1)
        min_binwidth = (quantile(bw,0.6)-quantile(bw,0.4))/20
      }
      if(input$graph_stats=="Closeness Centrality"){
        bw <- closeness(graph)
        df <- data.frame(x <- bw, group <- 1)
        min_binwidth = (quantile(bw,0.9)-quantile(bw,0.1))/10
      }
      if(input$graph_stats=="Eigenvector Centrality"){
        eg<- evcent(graph)
        bw <- eg$vector
        df <- data.frame(x <- bw, group <- 1)
        min_binwidth = (quantile(bw,0.9)-quantile(bw,0.1))/10
      }

      if(input$graph_stats=="Bonacich Power Centrality"){
        bw<- power_centrality(graph)
        df <- data.frame(x <- bw, group <- 1)
        min_binwidth = (quantile(bw,0.9)-quantile(bw,0.1))/10
      }

      if(input$graph_stats=="Authority Score"){
        bw<- authority_score(graph)$vector
        df <- data.frame(x <- bw, group <- 1)
        min_binwidth = (quantile(bw,0.9)-quantile(bw,0.1))/10
      }

      # if(input$graph_stats=="Attribute: Edge Weight"){
      #   bw<- edge_attr(graph)$weight
      #   df <- data.frame(x <- bw, group <- 1)
      #   min_binwidth = (quantile(bw,0.9)-quantile(bw,0.1))/10
      # }

      p <- ggplot(df, aes(x)) +
      geom_histogram(
        aes(y = ..density..),
        alpha = 0.7,
        fill = "#333333",
        binwidth = min_binwidth
        )

    }

    if (input$show_histogram) {
      p <- ggplot(df, aes(x)) +
      geom_histogram(
        aes(y = ..density..),
        alpha = 0.7,
        fill = "#333333",
        bins = input$hist_number_bins
        )
    }

    if (input$density) {
      p <-
      p + stat_density(fill = "skyblue",
       alpha = 0.5,
       bw = input$bw_adjust)
    }

    if (input$plot_degree) {
      p <- p +
      theme(panel.background = element_rect(fill = '#ffffff')) +
      ggtitle(input$graph_stats)

      ggplotly(p)
    }
  })

  #3rd viz: adjacency
  output$adjacency_view <-  renderPlotly({
    graph <- graph_kcore()
    A <- Adjacency()
    L <- Laplacian()

    if(input$adjacency_mode=="Adjacency"){
      denseA <- as.matrix(A) * 1
      # caption <- "Adjacency: A"

    }

    if(input$adjacency_mode=="Laplacian"){
      denseA<- subLaplacian()
      # caption <- "Laplacian: D-A"

    }

    if(input$adjacency_mode=="Normalized Laplacian"){
      denseA<- L
      caption <- expression(D^(-1/2)*A *D^(-1/2))

    }

    if(input$adjacency_mode=="Diffusion"){
      denseA <- as.matrix(A) * 1
      denseA<- diag(1/rowSums(denseA)) %*% denseA
      caption <- "Diffusion: D^{-1}A"

    }

    if (input$adjacency_sortedby == "Degree")   {
      orderByDegree<- order(rowSums(denseA),decreasing = T)
      denseA <- denseA[orderByDegree, orderByDegree]
    }

    if (input$adjacency_sortedby == "Block" &
      input$embedding_sbm
      )   {

      group_col = Cluster()$cluster
      orderByBlock = order(group_col,decreasing = F)
      denseA <- denseA[orderByBlock, orderByBlock]

    }

    vals <- unique(c(scales::rescale(c(denseA,1,0))))
    o <- order(vals, decreasing = FALSE)
    cols <- scales::col_numeric("Blues", domain = NULL)(vals)
    colz <- setNames(data.frame(vals[o], cols[o]), NULL)

    rownames(denseA) <- c(1:nrow(denseA))
    colnames(denseA) <- c(1:nrow(denseA))

    m<-melt(denseA)

    zlim <- c(0,1)

    if(input$adjacency_mode=="Laplacian")
      zlim<- c(min(denseA),max(denseA))

    p <- ggplot(m, aes(X1, X2)) +
    geom_tile(aes(fill =  value), colour = "white") +
    scale_fill_gradient(low = "white",  high = "red", limits=zlim) +
    theme(axis.ticks = element_blank(), axis.text.x = element_blank(),axis.text.y = element_blank())
    # + labs(title = paste(caption) )

    ggplotly(p)

      # vals <- c(1,0) #unique(c(scales::rescale(c(denseA,1,0))))
      # o <- order(vals, decreasing = FALSE)
      # cols <- scales::col_numeric("Blues", domain = NULL)(vals)
      # colz <- setNames(data.frame(vals[o], cols[o]), NULL)

      # plot_ly(z = denseA,
      #   type = "heatmap",
      #   colorscale = colz)

    # plot_ly(z = denseA,
    #         type = "heatmap",
    #         colorscale = colz)

  })

  output$caption_adjacency <- renderUI({

    if (input$adjacency_mode == "Adjacency")   {
      caption = 'Adjacency: \\(A\\)'
    }

    if (input$adjacency_mode == "Laplacian")   {
      caption = 'Laplacian: \\(D-A\\)'
    }

    if (input$adjacency_mode == "Normalized Laplacian")   {
      caption = 'Normalized Laplacian: \\(D^{1/2}AD^{1/2}\\)'
    }

    if (input$adjacency_mode == "Diffusion")   {
      caption = 'Diffusion: \\(D^{-1}A\\)'
    }

    withMathJax(
      helpText(caption)
      )

  })

  output$p_hat_view <- renderPlotly({

    if(input$embedding_sbm){

      if( input$embedding_model == 'Stochastic Block Model'){
        cluster<- Cluster()
        Xhat <- cluster$centers[cluster$cluster,]
        p_hat <- Xhat %*% t(Xhat)
      }

      if( input$embedding_model == 'Random Dot Product Model'){

        # if(input$svd_mat=="Adjacency")
        svdL <- svd(Adjacency())
        # if(input$svd_mat=="Normalized Laplacian")
          # svdL <- svd(Laplacian())
        # if(input$svd_mat=="Laplacian")
          # svdL <- svd(subLaplacian())

        u<- svdL$u[,1:input$embedding_d]
        d<- svdL$d[1:input$embedding_d]
        Xhat <- u %*% diag(sqrt(d))

        p_hat <- Xhat %*% t(Xhat)
      }

      if (input$adjacency_sortedby == "Degree")   {
        A <- Adjacency()
        denseA <- as.matrix(A) * 1
        orderByDegree<- order(rowSums(denseA),decreasing = T)
        p_hat <- p_hat[orderByDegree, orderByDegree]
      }

      if (input$adjacency_sortedby == "Block" &
        input$embedding_sbm
        )   {

        group_col = Cluster()$cluster
        orderByBlock = order(group_col,decreasing = F)
        p_hat <- p_hat[orderByBlock, orderByBlock]

      }

      p_hat[p_hat<0]<-0
      p_hat[p_hat>1]<-1

      rownames(p_hat) <- c(1:nrow(p_hat))
      colnames(p_hat) <- c(1:nrow(p_hat))

      m<-melt(p_hat)

      caption <- "Estimated Probability"

      p <- ggplot(m, aes(X1, X2)) +
      geom_tile(aes(fill =  value), colour = "white") +
      scale_fill_gradient(low = "white",  high = "red", limits=c(0,1)) +
      theme(axis.ticks = element_blank(), axis.text.x = element_blank(),axis.text.y = element_blank())+ labs(title = caption)

      ggplotly(p)

    #   vals <- unique(c(scales::rescale(c(p_hat,1,0))))
    #   o <- order(vals, decreasing = FALSE)
    #   cols <- scales::col_numeric("Blues", domain = NULL)(vals)
    #   colz <- setNames(data.frame(vals[o], cols[o]), NULL)

    #   plot_ly(z = p_hat,
    #     type = "heatmap",
    #     colorscale = colz)
    }

  })

  #4th viz: scree plot
  output$scree_plot <-  renderPlotly({
    graph <- graph_kcore()

    p<- ggplot()

    n<- length(V(graph))
    x<- c(1:n)

    df2 <- data.frame( index= x)

    if(input$scree_A){
      svdL <- svd(Adjacency())

      y <- svdL$d
      y<- y/y[1]
      df2$Adjacency = y
    }

    if(input$scree_L){
      svdL <- svd(subLaplacian())

      y <- svdL$d
      y<- y/y[1]
      df2$Laplacian = y

    }

    if(input$scree_nL){
      svdL <- svd(Laplacian())

      y <- svdL$d
      y<- y/y[1]
      df2$nL = y
    }

    df3 = melt(df2, id=c("index"))

    p<- ggplot(df3) + geom_line(aes(x=index, y=value, colour=variable),linetype =1)    + scale_colour_manual(values = c('Adjacency' = "red", 'Laplacian' = "green", 'nL' = "blue"))

    if (input$elbow_detect) {

      if(input$scree_A){

        y<- df2$Adjacency
        y<- y/y[1]

        eb1 <- opt_d(y)

        if (eb1 < n) {
          eb2 <- opt_d(y[(eb1 + 1):n]) + eb1
          if (eb2 < n) {
            eb3 <- opt_d(y[(eb2 + 1):n]) + eb2
          }
        }
        p<- p+  geom_vline(xintercept = c(eb1,eb2,eb3), linetype =3, col="red")
        #+ geom_vline(xintercept = eb2, linetype = 3, col="red")  + geom_vline(xintercept = eb3, linetype =3, col="red")
      }

      if(input$scree_L){

        y<- df2$Laplacian
        y<- y/y[1]

        eb1 <- opt_d(y)

        if (eb1 < n) {
          eb2 <- opt_d(y[(eb1 + 1):n]) + eb1
          if (eb2 < n) {
            eb3 <- opt_d(y[(eb2 + 1):n]) + eb2
          }
        }
        p<- p+  geom_vline(xintercept = c(eb1,eb2,eb3), linetype =3, col="green")
      }

      if(input$scree_nL){
        y<- df2$nL
        y<- y/y[1]

        eb1 <- opt_d(y)

        if (eb1 < n) {
          eb2 <- opt_d(y[(eb1 + 1):n]) + eb1
          if (eb2 < n) {
            eb3 <- opt_d(y[(eb2 + 1):n]) + eb2
          }
        }
        p<- p+  geom_vline(xintercept = c(eb1,eb2,eb3), linetype =3, col="blue")
      }

    }

    ggplotly(p)

  })

  #5th viz: pairs plot

  output$pD3 <-  renderPairsD3({

    graph <- graphFile()
    A <- Adjacency()
    # L <- Laplacian()
    # if(input$svd_mat=="Adjacency")
    svdL <- svd(A)
    # if(input$svd_mat=="Normalized Laplacian")
      # svdL <- svd(Laplacian())
    # if(input$svd_mat=="Laplacian")
      # svdL <- svd(subLaplacian())

    a <- input$eigenvector_range[1]
    b <- min(input$eigenvector_range[2], input$eigenvector_range[1]+8)

    if(input$embedding_sbm  & input$embedding_model == 'Stochastic Block Model'){
      group_col = Cluster()$cluster
    }else{
      group_col = rep(1,nrow(A))
    }

    u<- svdL$u[,a:b]
    d<- svdL$d[a:b]
    X<- u %*% diag(sqrt(d))
    p<- pairsD3(X,cex = 5, group=group_col)
    # print(p)

  })

  output$pairsplot <- renderUI({
    pairsD3Output("pD3", width = '700px', height = '700px')
  })

})


# Prepare working environment
rm(list = ls())
setwd("/home/drtea/Research/Projects/CO2policy/PEDAC/")

# install required packages
install.packages('car')

# load required packages
library("car")

# constant to transform C into CO2
C2CO2 = 3.664

# read data from global carbon project
# Le Quéré et al: Global Carbon Budget 2018, Earth Syst. Sci. Data, 2018b.
#                 https://doi.org/10.5194/essd-10-2141-2018
GCP <- read.csv(file="data/Misc/GCP2018_recent_sheet.csv", header=TRUE, sep=",")

# Get indices for the considered time period
Ia = which( GCP$Year==1959 )
Ie = which( GCP$Year==2014 )

# atmospheric growth in gtC/year
years =  GCP$Year[ Ia:Ie ]
growthRateObs = GCP$atmospheric.growth[ Ia:Ie ]
growthRateRec = growthRateObs + GCP$budget.imbalance[ Ia:Ie ]

# plot the reconstruction and the atmospheric CO2
plot( NULL,
      xlim = range(years),
      xlab = "year",
      ylim = c(0,8),
      ylab = "GtC"
      )
lines(years, growthRateObs, col=1)
lines(years, growthRateRec, col=2)

# Define the imbalance process to fit an AR model, to model the error process
# between reconstruction and measurements
imbalance = ( growthRateObs - growthRateRec ) * C2CO2
n = length(imbalance)

# compute statistical descriptors
mean_imba = mean( imbalance )
sd_imba   = sd( imbalance )

# AR modeling
acf( imbalance )
pacf( imbalance )
mle = ar.mle( imbalance, aic = TRUE, order.max = NULL, demean = FALSE, intercept = FALSE)
mle$aic
mle
sqrt( mle$asy.var.coef )
sqrt( mle$var.pred )

ols = ar.ols( imbalance, aic = FALSE, order.max = 1, demean = FALSE, intercept = FALSE)
ols
acf( ols$resid[2:n] )
qqPlot( ols$resid[2:n], add.line = TRUE )

# rho = 0.44, sd = 3 in CO2, sd =  0.82 in C (0.386 in ppm)

acf(imbalance)
k = 0:17
lines(k, mle$ar^k, col='red')

mean( imbalance )
sd( imbalance )/sqrt(n*(1 - ols$ar[1]))

# Plots
png(filename = paste(figpath, "/imbalance_qqplot.png", sep=''), width = wd, height = ht)
par(cex = cex)
qqPlot(ols$resid[2:n], xlab='normal quantlies', ylab = 'sample quantiles')
dev.off()

png(filename = paste(figpath, "/imbalance_acf.png", sep=''), width = wd, height = ht)
par(cex = cex)
acf( imbalance )
k = 0:17; lines(k, mle$ar^k, col='red')
dev.off()

png(filename = paste(figpath, "/imbalance_pacf.png", sep=''), width = wd, height = ht)
par(cex = cex)
pacf( imbalance )
dev.off()


muX <- 3.68
sigma1 <- 0.64

muY <- 4.8
sigma2 <- 0.49

domanda1 <- 9.51

muSomma <- muX + muY
sigmaQuadratoSomma <- sigma1^2 + sigma2^2
sigmaSomma <- sqrt(sigmaQuadratoSomma)

risposta1 <- pnorm(domanda1, muSomma, sigmaSomma, FALSE);

risposta2 <- sigmaQuadratoSomma / ((domanda1-muSomma)^2)

print(risposta1)
print(risposta2)


setwd('/Users/demg/Projects/FA/Course III/ECONOMETRICS/task4')
data <- read.table('./AG.txt', dec=',', header=TRUE)
getwd()
#install.packages('lmtest')
library(lmtest)

x = data$x
y = data$y
x
y

#линейная модель
m<-lm(y~x,data=data)
m
sm<-summary(m)
sm
#данная модель значима
#критерий Стьюдента
#H0 отвергается, коэффициенты значимы

#показательная модель
m2<-lm(log10(y)~x,data=data)
m2
sm2=summary(m2)
sm2
#данная модель значима
#критерий Стьюдента
#H0 отвергается, коэффициенты значимы

#Линейная
print(sm$r.squared)

#Показательная
print(sm2$r.squared)


x1 <- 18.91
x2 <- 22.81

prMinore <- 6/100
prMaggiore <- 7/100

pr2C <- 1-prMaggiore

pr3 <- 10/100

x4 <- 4.64

q1 <- qnorm(prMinore)
q2 <- qnorm(pr2C)

mu <- ((-q2*x1)/q1 + x2)/(1-q2/q1);

sigma <- (x1-mu)/q1;

risposta4 <- pnorm(x4^2, mu, sigma);

print(mu)

print(sigma);

q1 <- qnorm(1-pr3);

risposta3 <- (x2 - mu)/q1

print(risposta3)

print(risposta4)


#setwd('/home/lucas/Dev/git/mlclass/01_Preprocessing')
diaInfo <- read.csv(file = 'diabetes_dataset.csv')
diaAva <- read.csv(file = 'diabetes_app.csv')
diaMean <- c()
diaNonMean <- c()
maxValue <- c()
for(categ in 1:8){
diaMean[categ] <- c(mean(diaInfo[which(diaInfo$Outcome == 1),categ],na.rm=TRUE))
diaNonMean[categ] <- c(mean(diaInfo[which(diaInfo$Outcome == 0),categ],na.rm=TRUE))
maxValue[categ] = max(diaInfo[,categ],na.rm = TRUE)
}
weight <- c()
weight[1]=2
weight[2]=2
weight[3]=1
weight[4]=1
weight[5]=1
weight[6]=2
weight[7]=0
weight[8]=6

for(i in 1:572){
  actual <- diaInfo[i,]
  for(categ in 1:8){
    if(is.na(actual[categ])|| is.null(actual[categ]))
      {
      if(actual[9]==1) {
        actual[categ] = diaMean[categ]
        }
      else {
        actual[categ] = diaNonMean[categ]
        }
      diaInfo[i,categ] = actual[categ]
      }
  }
}

normalizeData = function(df) {
  for(i in 1:8){
    df[,i] <- (df[,i]/maxValue[i])*weight[i]
  }
  return(df)
}

dfAva <- normalizeData(diaAva)
dfInfo <- normalizeData(diaInfo)

write.csv(dfAva[1:8], file = 'Valuator.csv', row.names = FALSE)
write.csv(dfInfo[1:9], file = 'Output.csv', row.names = FALSE)


johnson_tol <- function(xall, alpha=0.01, P=0.99, side=1) {

    ## xall = data set
    ## alpha  = 1 - confidence
    ## P = pvalue = coverage (tolerance interval only)
    pvalue <- P

    ## install.packages('tolerance')
    library(tolerance)
    ## install.packages('SuppDists')
    library(SuppDists)

    ## Johnson distribution calculations from SuppDists package
    jparms  <- JohnsonFit(xall)
    ## transform xall dataset to normally distributed z using Johnson distribution
    zall <- john_z(xall, jparms)
    df <- as_tibble( data.frame(x=xall, z=zall) )

    na_rows <- df[is.na(df$z),]
    if (nrow(na_rows) != 0) {

        ## z values could not be calculated for all x values
        cat('\n')
        cat('##############################\n')
        cat('  ERROR IN JOHNSON_TOL  \n')
        cat('  z(x) = NA for some x values \n')
        cat('##############################\n')
        print(jparms)
        print(na_rows)
        ztol_out <- normtol.int(zall, alpha = alpha, P=pvalue, side=side)
        ztol_upper <- NA
        xtol_upper <- NA

    } else {

        ## johnson fit returned z values for all x values so possibly a decent fit

        ## xz_plot <- plot(xall, zall)

        ## define function to find x for a given z
        ## zero <- function(x, parms=jparms, ztarget) john_z(x, parms) - ztarget
        zero <- function(x, parms, z) john_z(x, parms) - z

        ## check use of uniroot
        ## xcheck <- 13
        ## ztarget <- john_z(xcheck)
        ## ztox <- uniroot(zero, lower=min(xall), tol=1E-10, upper=2*max(xall), ztarget=ztarget)$root
        ## x_from_z <- uniroot(zero, ztarget=ztarget,
        ##                     lower=min(xall), upper=2*max(xall), tol=1E-10)$root

        ## find tolerance limits using normal distribution calculations on z
        ztol_out <- normtol.int(zall, alpha = alpha, P=pvalue, side=side)
        xmin <- min(xall)
        xmax <- max(xall)
        if (side == 1) {
            ztol_upper <- ztol_out$'1-sided.upper'
            ztol_lower <- ztol_out$'1-sided.lower'
        } else if (side == 2) {
            ztol_upper <- ztol_out$'2-sided.upper'
            ztol_lower <- ztol_out$'2-sided.lower'
        }

        ## transform z back to u
        ##  uniroot is not very robust so try newton raphson
        ##  xrange <- max(xall) - min(xall)
        ##  xtol_upper <- uniroot(zero, ztarget=ztol_upper,
        ##                        lower=xmax, upper=xmax + xrange, tol=1E-10)$root

        if (jparms$type == 'SB') {
            ## Not sure tolerance limits have meaning for a bounded fit
            xtol_lower <- NA
            xtol_upper <- NA
        } else {
            ## Tolerance limits should have meaning for SU and SN
            ## Upper tolerance limit should have meaning for SL
            xtol_upper <- newton.raphson(zero, parms=jparms, z=ztol_upper, xguess=mean(xall), tol=1E-10)
            if (jparms$type == 'SL') {
                xtol_lower <- NA
            } else {
                xtol_lower <- newton.raphson(zero, parms=jparms, z=ztol_lower, xguess=mean(xall), tol=1E-10)
            }
        }
    }
    return(list(xz=df, jparms=jparms, ztol_out=ztol_out,
                ztol_upper=ztol_upper, xtol_upper=xtol_upper,
                ztol_lower=ztol_lower, xtol_lower=xtol_lower))
}

## ## test
##
## set.seed(1)
## x                          <- rnorm(n=1E5, mean=10, sd=1)
## tol_out_john               <- johnson_tol(x, alpha=0.1, P=0.99, side=1)
## jparms                     <- tol_out_john$jparms
## ztol_upper                <- tol_out_john$ztol_upper
## ztol_upper
## upper_tolerance_limit_john <- tol_out_john$xtol_upper$`root approximation`
## upper_tolerance_limit_john
##
## xz <- tol_out_john$xz
## plotspace(1,3)
## hist(xz$x)
## hist(xz$z)
## plot(xz$x, xz$z)


library(png)
img <- readPNG("Unfilledcirc.png")
M <- img[ , , 1]
M <- ifelse(M < 0.5, 0, 1)
M <- rbind(M, 0)
M <- cbind(M, 0)
image(M, col = c(1, 0))

# https://en.wikipedia.org/wiki/Flood_fill
floodfill <- function(row, col, tcol, rcol) {
  if (tcol == rcol) return()
  if (M[row, col] != tcol) return()
  Q <- matrix(c(row, col), 1, 2)
  while (dim(Q)[1] > 0) {
    n <- Q[1, , drop = FALSE]
    west  <- cbind(n[1]    , n[2] - 1)
    east  <- cbind(n[1]    , n[2] + 1)
    north <- cbind(n[1] + 1, n[2]    )
    south <- cbind(n[1] - 1, n[2]    )
    Q <- Q[-1, , drop = FALSE]
    if (M[n] == tcol) {
      M[n] <<- rcol
      if (M[west] == tcol)  Q <- rbind(Q, west)
      if (M[east] == tcol)  Q <- rbind(Q, east)
      if (M[north] == tcol) Q <- rbind(Q, north)
      if (M[south] == tcol) Q <- rbind(Q, south)
    }
  }
  return("filling completed")
}

startrow <- 100; startcol <- 100
floodfill(startrow, startcol, 0, 2)
startrow <- 50; startcol <- 50
floodfill(startrow, startcol, 1, 3)

image(M, col = c(1, 0, 2, 3))