# do_gate.r
#
# Copyright (c) 2020 VIB (Belgium) & Babraham Institute (United Kingdom)
#
# Software written by Carlos P. Roca, as research funded by the European Union.
#
# This software may be modified and distributed under the terms of the MIT
# license. See the LICENSE file for details.

# Returns a vector with the indexes of events inside the initial gate on
# scatter parameters.
#
# Proceeds in three steps:
#    - Defines bound by data trimming
#    - Defines region around the target maximum found in bound
#    - Defines gate around target maximum, only in region
#
# Uses numerical search of maxima over estimated densities.
# Uses Voronoi tesselations to improve density estimation around maxima.

do.gate <- function( gate.data, gate.param, samp, flow.control, asp )
{
    gate.marker <- colnames( gate.data )

    gate.bound <- NULL
    gate.region <- NULL
    gate.boundary <- NULL

    # trim data

    gate.data.x.min <- max( flow.control$expr.data.min,
        min( gate.data[ , 1 ] ) )
    gate.data.x.max <- min( flow.control$expr.data.max,
        max( gate.data[ , 1 ] ) )

    gate.data.y.min <- max( flow.control$expr.data.min,
        min( gate.data[ , 2 ] ) )
    gate.data.y.max <- min( flow.control$expr.data.max,
        max( gate.data[ , 2 ] ) )

    gate.data.trim.x.min <-
        ( 1 - asp$gate.data.trim.factor.x.min ) * gate.data.x.min +
        asp$gate.data.trim.factor.x.min * gate.data.x.max
    gate.data.trim.x.max <-
        ( 1 - asp$gate.data.trim.factor.x.max ) * gate.data.x.min +
        asp$gate.data.trim.factor.x.max * gate.data.x.max

    gate.data.trim.y.min <-
        ( 1 - asp$gate.data.trim.factor.y.min ) * gate.data.y.min +
        asp$gate.data.trim.factor.y.min * gate.data.y.max
    gate.data.trim.y.max <-
        ( 1 - asp$gate.data.trim.factor.y.max ) * gate.data.y.min +
        asp$gate.data.trim.factor.y.max * gate.data.y.max

    # set bound from trimmed data

    gate.bound.x.low <- gate.data.trim.x.min
    gate.bound.x.high <- gate.data.trim.x.max

    gate.bound.y.low <- gate.data.trim.y.min
    gate.bound.y.high <- gate.data.trim.y.max

    gate.bound.data.idx <- which(
        gate.data[ , 1 ] > gate.bound.x.low &
        gate.data[ , 1 ] < gate.bound.x.high &
        gate.data[ , 2 ] > gate.bound.y.low &
        gate.data[ , 2 ] < gate.bound.y.high )

    gate.bound.density <- kde2d(
        gate.data[ gate.bound.data.idx, 1 ],
        gate.data[ gate.bound.data.idx, 2 ],
        asp$gate.bound.density.bw.factor *
            apply( gate.data[ gate.bound.data.idx, ], 2, bandwidth.nrd ),
        n = asp$gate.bound.density.grid.n )

    # get density maxima in bound

    gate.bound.neighbor.idx <- list(
        x = - asp$gate.bound.density.neigh.size :
            asp$gate.bound.density.neigh.size,
        y = - asp$gate.bound.density.neigh.size :
            asp$gate.bound.density.neigh.size )

    gate.bound.density.max.bool <- matrix( FALSE,
        nrow = asp$gate.bound.density.grid.n,
        ncol = asp$gate.bound.density.grid.n )

    for ( x.idx in 1 : asp$gate.bound.density.grid.n )
        for ( y.idx in 1 : asp$gate.bound.density.grid.n )
            gate.bound.density.max.bool[ x.idx, y.idx ] <-
                gate.bound.density$z[ x.idx, y.idx ] >=
                max( gate.bound.density$z[
                    pmax( 0, pmin( asp$gate.bound.density.grid.n,
                        x.idx + gate.bound.neighbor.idx$x ) ),
                    pmax( 0, pmin( asp$gate.bound.density.grid.n,
                        y.idx + gate.bound.neighbor.idx$y ) ) ] )

    gate.bound.density.max.idx <- which( gate.bound.density.max.bool,
        arr.ind = TRUE )

    gate.bound.density.max.n <- nrow( gate.bound.density.max.idx )

    check.critical( gate.bound.density.max.n >= 1,
        paste0( "gate error: no population found in sample bound", samp ) )

    gate.bound.density.max <- data.frame(
        x = gate.bound.density$x[ gate.bound.density.max.idx[ , 1 ] ],
        y = gate.bound.density$y[ gate.bound.density.max.idx[ , 2 ] ],
        z = gate.bound.density$z[ gate.bound.density.max.idx ] )

    gate.bound.density.max <- gate.bound.density.max[
        order( gate.bound.density.max$z, decreasing = TRUE ), ]

    row.names( gate.bound.density.max ) <- NULL
    gate.bound.density.max$num.label <- paste0( " ",
        row.names( gate.bound.density.max ) )

    # locate target maximum in bound, avoiding maxima located near the
    # bottom left corner

    gate.bound.density.max.offset <- 1

    while ( gate.bound.density.max.offset <= gate.bound.density.max.n )
    {
        if ( ( gate.bound.density.max$x[ gate.bound.density.max.offset ] -
                    gate.bound.x.low ) /
                    ( gate.bound.x.high - gate.bound.x.low ) >
                asp$gate.bound.density.max.exclusion.corner ||
            ( gate.bound.density.max$y[ gate.bound.density.max.offset ] -
                    gate.bound.y.low ) /
                    ( gate.bound.y.high - gate.bound.y.low ) >
                asp$gate.bound.density.max.exclusion.corner )
            break

        gate.bound.density.max.offset <- gate.bound.density.max.offset + 1
    }

    check.critical(
        gate.bound.density.max.offset <= gate.bound.density.max.n,
        paste0( "gate error: no good maximum found in sample bound",
            samp ) )

    gate.bound.density.max.target <- asp$gate.bound.density.max.target +
        gate.bound.density.max.offset - 1

    check.critical(
        gate.bound.density.max.target <= gate.bound.density.max.n,
        paste0( "gate error: target maximum not found in sample bound",
            samp ) )

    if ( gate.bound.density.max.n > 1 )
    {
        # get voronoi tesselation for density maxima

        gate.bound.voronoi <- deldir( gate.bound.density.max,
            rw = c( gate.bound.x.low, gate.bound.x.high, gate.bound.y.low,
                gate.bound.y.high ), suppressMsge = TRUE )

        gate.bound.tile <- tile.list( gate.bound.voronoi )

        # get data in the tile of target maximum

        gate.bound.density.max.data.idx <- gate.bound.data.idx[
            sapply( gate.bound.data.idx, function( gbdi )
                which.tile( gate.data[ gbdi, 1 ], gate.data[ gbdi, 2 ],
                    gate.bound.tile ) == gate.bound.density.max.target )
        ]
    }
    else
    {
        gate.bound.voronoi <- NULL
        gate.bound.density.max.data.idx <- gate.bound.data.idx
    }

    if ( gate.param$region.auto )
    {
        # set region from target maximum found in bound

        gate.bound.density.max.x.median <- median( gate.data[
            gate.bound.density.max.data.idx, 1 ] )
        gate.bound.density.max.x.mad <- mad(
            gate.data[ gate.bound.density.max.data.idx, 1 ],
            center = gate.bound.density.max.x.median )

        gate.bound.density.max.y.median <- median( gate.data[
            gate.bound.density.max.data.idx, 2 ] )
        gate.bound.density.max.y.mad <- mad(
            gate.data[ gate.bound.density.max.data.idx, 2 ],
            center = gate.bound.density.max.y.median )

        gate.region.x.low <- max( gate.data.trim.x.min,
            gate.bound.density.max.x.median -
                asp$gate.bound.density.max.mad.factor *
                    gate.bound.density.max.x.mad )
        gate.region.x.high <- min( gate.data.trim.x.max,
            gate.bound.density.max.x.median +
                asp$gate.bound.density.max.mad.factor *
                    gate.bound.density.max.x.mad )

        gate.region.y.low <- max( gate.data.trim.y.min,
            gate.bound.density.max.y.median -
                asp$gate.bound.density.max.mad.factor *
                    gate.bound.density.max.y.mad )
        gate.region.y.high <- min( gate.data.trim.y.max,
            gate.bound.density.max.y.median +
                asp$gate.bound.density.max.mad.factor *
                    gate.bound.density.max.y.mad )
    }
    else
    {
        gate.region.x.low <-
            ( 1 - gate.param$region.factor.x.low ) * gate.bound.x.low +
            gate.param$region.factor.x.low * gate.bound.x.high
        gate.region.x.high <-
            ( 1 - gate.param$region.factor.x.high ) * gate.bound.x.low +
            gate.param$region.factor.x.high * gate.bound.x.high

        gate.region.y.low <-
            ( 1 - gate.param$region.factor.y.low ) * gate.bound.y.low +
            gate.param$region.factor.y.low * gate.bound.y.high
        gate.region.y.high <-
            ( 1 - gate.param$region.factor.y.high ) * gate.bound.y.low +
            gate.param$region.factor.y.high * gate.bound.y.high
    }

    gate.bound <- list(
        density = gate.bound.density,
        density.max = gate.bound.density.max,
        density.max.n = gate.bound.density.max.n,
        density.max.data.idx = gate.bound.density.max.data.idx,
        density.max.target = gate.bound.density.max.target,
        voronoi = gate.bound.voronoi,
        x.low = gate.bound.x.low,
        x.high = gate.bound.x.high,
        y.low = gate.bound.y.low,
        y.high = gate.bound.y.high
    )

    if ( ! is.null( asp$figure.gate.dir ) && asp$gate.plot.stage )
        plot.gate( 1, samp, gate.data, gate.marker, gate.bound,
            gate.region, gate.population, flow.control, asp )

    gate.region.data.idx <- which(
        gate.data[ , 1 ] > gate.region.x.low &
        gate.data[ , 1 ] < gate.region.x.high &
        gate.data[ , 2 ] > gate.region.y.low &
        gate.data[ , 2 ] < gate.region.y.high )

    # get density maxima in region

    gate.region.density <- kde2d(
        gate.data[ gate.region.data.idx, 1 ],
        gate.data[ gate.region.data.idx, 2 ],
        asp$gate.region.density.bw.factor *
            apply( gate.data[ gate.region.data.idx, ], 2, bandwidth.nrd ),
        n = asp$gate.region.density.grid.n )

    gate.region.neighbor.idx <- list(
        x = - asp$gate.region.density.neigh.size :
            asp$gate.region.density.neigh.size,
        y = - asp$gate.region.density.neigh.size :
            asp$gate.region.density.neigh.size )

    gate.region.density.max.bool <- matrix( FALSE,
        nrow = asp$gate.region.density.grid.n,
        ncol = asp$gate.region.density.grid.n )

    for ( x.idx in 1 : asp$gate.region.density.grid.n )
        for ( y.idx in 1 : asp$gate.region.density.grid.n )
            gate.region.density.max.bool[ x.idx, y.idx ] <-
                gate.region.density$z[ x.idx, y.idx ] >=
                max( gate.region.density$z[
                    pmax( 0, pmin( asp$gate.region.density.grid.n,
                        x.idx + gate.region.neighbor.idx$x ) ),
                    pmax( 0, pmin( asp$gate.region.density.grid.n,
                        y.idx + gate.region.neighbor.idx$y ) ) ] )

    gate.region.density.max.idx <- which( gate.region.density.max.bool,
        arr.ind = TRUE )

    gate.region.density.max.n <- nrow( gate.region.density.max.idx )

    check.critical( gate.region.density.max.n >= 1,
        paste0( "gate error: no population found in sample region", samp ) )

    gate.region.density.max <- data.frame(
        x = gate.region.density$x[ gate.region.density.max.idx[ , 1 ] ],
        y = gate.region.density$y[ gate.region.density.max.idx[ , 2 ] ],
        z = gate.region.density$z[ gate.region.density.max.idx ] )

    gate.region.density.max <- gate.region.density.max[
        order( gate.region.density.max$z, decreasing = TRUE ), ]

    row.names( gate.region.density.max ) <- NULL
    gate.region.density.max$num.label <- paste0( " ",
        row.names( gate.region.density.max ) )

    if ( gate.region.density.max.n > 1 )
    {
        # get voronoi tesselation for density maxima

        gate.region.voronoi <- deldir( gate.region.density.max,
            rw = c( gate.region.x.low, gate.region.x.high, gate.region.y.low,
                gate.region.y.high ), suppressMsge = TRUE )

        gate.region.tile <- tile.list( gate.region.voronoi )

        # get data in the tile of largest maximum

        gate.region.density.max.data.idx <- gate.region.data.idx[
            sapply( gate.region.data.idx, function( grdi )
                which.tile( gate.data[ grdi, 1 ], gate.data[ grdi, 2 ],
                    gate.region.tile ) == 1 )
        ]
    }
    else
    {
        gate.region.voronoi <- NULL
        gate.region.density.max.data.idx <- gate.region.data.idx
    }

    gate.region <- list(
        data.idx = gate.region.data.idx,
        density = gate.region.density,
        density.max = gate.region.density.max,
        density.max.n = gate.region.density.max.n,
        density.max.data.idx = gate.region.density.max.data.idx,
        voronoi = gate.region.voronoi,
        x.low = gate.region.x.low,
        x.high = gate.region.x.high,
        y.low = gate.region.y.low,
        y.high = gate.region.y.high
    )

    if ( ! is.null( asp$figure.gate.dir ) && asp$gate.plot.stage ) {
        plot.gate( 2, samp, gate.data, gate.marker, gate.bound, gate.region,
            gate.population, flow.control, asp )
        plot.gate( 3, samp, gate.data, gate.marker, gate.bound, gate.region,
            gate.population, flow.control, asp )
    }

    # thresold data in region around target maximum

    gate.region.max.density <- kde2d(
        gate.data[ gate.region.density.max.data.idx, 1 ],
        gate.data[ gate.region.density.max.data.idx, 2 ],
        asp$gate.region.max.density.bw.factor *
            apply( gate.data[ gate.region.density.max.data.idx, ], 2,
                bandwidth.nrd ),
        n = asp$gate.region.max.density.grid.n )

    gate.region.max.density.interp <- interp.surface( gate.region.max.density,
        gate.data[ gate.region.density.max.data.idx, ] )

    gate.region.max.density.threshold <-
        ( 1 - gate.param$density.threshold ) *
            min( gate.region.max.density.interp ) +
        gate.param$density.threshold * max( gate.region.max.density.interp )

    gate.population.strict.idx <- gate.region.density.max.data.idx[
        gate.region.max.density.interp > gate.region.max.density.threshold ]

    gate.population.strict.idx <- gate.population.strict.idx[
        ! duplicated( data.frame( gate.data[ gate.population.strict.idx, ] ) ) ]

    gate.population.boundary <- convex.hull( tri.mesh(
        gate.data[ gate.population.strict.idx, 1 ],
        gate.data[ gate.population.strict.idx, 2 ] ) )

    gate.population.pip <- point.in.polygon(
        gate.data[ , 1 ], gate.data[ , 2 ],
        gate.population.boundary$x, gate.population.boundary$y )

    gate.population.idx <- which( gate.population.pip != 0 )

    gate.population <- list( boundary = gate.population.boundary )

    if ( ! is.null( asp$figure.gate.dir ) && asp$gate.plot.stage ) {
        plot.gate( 4, samp, gate.data, gate.marker, gate.bound, gate.region,
            gate.population, flow.control, asp )
        plot.gate( 0, samp, gate.data, gate.marker, gate.bound, gate.region,
            gate.population, flow.control, asp )
    }
    else if ( ! is.null( asp$figure.gate.dir ) )
        plot.gate( NULL, samp, gate.data, gate.marker, gate.bound, gate.region,
            gate.population, flow.control, asp )

    gate.population.idx
}


LoadRequiredLibraries <- function() {

  # Libraries
  library(data.table);
  library(bit64);
  library(tidyverse);
  library(caret);
  library(plyr);
  library(dplyr);
  library(magrittr);
  library(haven);
  library(HDInterval);
  library(BEST);
  library(plotly);
  # install_github("rmcelreath/rethinking")
  library(rethinking);
  library(missMDA)
}


#začetni graf

mojgraf1 <- ggplot(stevilo_podjetij_ki_so_prenehala_z_delovanjem, aes(x=leto,
            y=stevilopropadlih, group=regije, color=regije)) + geom_line() +
  xlab("Leto") + ylab("Število podjetij, ki so prenehala z delovanjem") +
  ggtitle("Graf števila propadlih podjetij") + scale_color_discrete(name="Regije",
  labels=c("Gorenjska", "Goriška", "Jugovzhodna Slovenija", "Koroška", "Obalno-kraška", "Osrednjeslovenska", "Podravska", "Pomurska", "Posavska", "Primorsko-notranjska", "Savinjska", "Zasavska")) + theme(axis.text.x = element_text(angle = 90, vjust = 0.3, hjust=1))

mojgraf <- ggplot(stevilo_zaposlenih_v_podjetjih, aes(x=leto, y=stevilozaposlenih, group=regije, color=regije)) + geom_line() + xlab("Leto") + ylab("Število podjetij, ki so prenehala z delovanjem") + ggtitle("Graf števila propadlih podjetij") + scale_color_discrete(name="Regije", labels=c("Gorenjska", "Goriška", "Jugovzhodna Slovenija", "Koroška", "Obalno-kraška", "Osrednjeslovenska", "Podravska", "Pomurska", "Posavska", "Primorsko-notranjska", "Savinjska", "Zasavska")) + theme(axis.text.x = element_text(angle = 90, vjust = 0.3, hjust=1))

#najprej sem naplošno pogledala koliko podjetij imamo v sloveniji..izkjazalo se je da jih je najvec v
#osrednjeslovenski regiji. ker je ta tudi največja ima največ podjetij. zato bom to regijo bolj podrobno
#analizirala.

graf1 <-  ggplot(stevilo_podjetij, aes(x=leto, y=stevilopodjetij,
                                                     group=regije, color=regije)) + geom_line() + xlab("Leto") +
  ylab("Število podjetij") +
  ggtitle("Število podjetij") +
  scale_color_discrete(name="Regije", labels=c("Gorenjska", "Goriška", "Jugovzhodna Slovenija",
                                               "Koroška", "Obalno-kraška", "Osrednjeslovenska", "Podravska", "Pomurska", "Posavska",
                                               "Primorsko-notranjska", "Savinjska", "Zasavska")) + theme(axis.text.x = element_text
                                                                                (angle = 90, vjust = 0.3, hjust=1))
#videli smo da graf števila podjetij ni ravno zanimiv. saj linearno narašča. bolj je zanimiv graf
#stevila hitrorastočih podjetij

graf2 <- ggplot(stevilo_hitrorastocih_podjetij, aes(x=leto, y=stevilo,
        group=regije, color=regije)) + geom_line() + xlab("Leto") +
  ylab("Število hitrorastočih podjetij") +
  ggtitle("Število hitrorastočih podjetij") +
  scale_color_discrete(name="Regije", labels=c("Gorenjska", "Goriška", "Jugovzhodna Slovenija",
"Koroška", "Obalno-kraška", "Osrednjeslovenska", "Podravska", "Pomurska", "Posavska",
"Primorsko-notranjska", "Savinjska", "Zasavska")) + theme(axis.text.x = element_text
                    (angle = 90, vjust = 0.1, hjust=1))

stevilo_brezposelnih.stevilo.propadlih.podjetij <-right_join(stevilo_zaposlenih_v_podjetjih,
            stevilo_podjetij_ki_so_prenehala_z_delovanjem %>% filter(leto == 2016))

#graf povezave med številom podjetji in stevilom zaposlenih v podjetjih
o <- (stevilo_zaposlenih_v_podjetjih)
u <- (stevilo_podjetij)
b <- right_join(o,u)

graf3 <- ggplot(b) + geom_point(aes(x=stevilopodjetij, y=stevilozaposlenih, color=regije)) + geom_smooth(aes(x=stevilopodjetij, y=stevilozaposlenih)) + xlab("Število podjetij") +
  ylab("Število zaposlenih v podjetijh") + ggtitle("Število podjetij v primerjavi s številom zaposlenih") +
  scale_color_discrete(name="Regije", labels=c("Gorenjska", "Goriška",
                                    "Jugovzhodna Slovenija",
                                               "Koroška", "Obalno-kraška", "Osrednjeslovenska", "Podravska", "Pomurska", "Posavska",
                                               "Primorsko-notranjska", "Savinjska", "Zasavska"))

#graf povezave med stevilom brezposelnih v sloveniji in
#stevilom podjetji ki so prenehala z delovanjem
i <- (stevilo_brezposelnih)
r <- (stevilo_podjetij_ki_so_prenehala_z_delovanjem)
hh <- right_join(i,r)

graf4 <- ggplot(hh) + geom_point(aes(x=stevilobrezposelnih, y=stevilopropadlih, color=regije)) + geom_smooth( aes(x=stevilobrezposelnih, y=stevilopropadlih)) + xlab("Število brezposelnih") +
  ylab("Število podjetji, ki so prenehala z delovanjem") + ggtitle("Število brezposelnih v primerjavi s propadlimi podjetji") +
  scale_color_discrete(name="Regije", labels=c("Gorenjska", "Goriška",
                                               "Jugovzhodna Slovenija",
                                               "Koroška", "Obalno-kraška", "Osrednjeslovenska", "Podravska", "Pomurska", "Posavska",
                                              "Primorsko-notranjska", "Savinjska", "Zasavska"))

#se ena povezava

ii <- (stevilo_brezposelnih)
rr <- (stevilo_novonastalih_podjetij)
hhh <- right_join(ii,rr)

graf5 <- ggplot(hhh) + geom_point(aes(x=stevilobrezposelnih, y=stevilonovonastalih, color=regije)) + geom_smooth( aes(x=stevilobrezposelnih, y=stevilonovonastalih)) + xlab("Leto") +
  ylab("Število novonastalih podjetij") + ggtitle("Število zaposlenih v podjetjih") +
  scale_color_discrete(name="Regije", labels=c("Gorenjska", "Goriška",
                                               "Jugovzhodna Slovenija",
                                               "Koroška", "Obalno-kraška", "Osrednjeslovenska", "Podravska", "Pomurska", "Posavska",
                                               "Primorsko-notranjska", "Savinjska", "Zasavska"))

#se ena povezava
iii <- (stevilo_brezposelnih)
rrr <- (stevilo_podjetij)
hhhh <- right_join(iii,rrr)

graf6 <- ggplot(hhhh) + geom_point(aes(x=stevilobrezposelnih, y=stevilopodjetij, color=regije)) + geom_smooth( aes(x=stevilobrezposelnih, y=stevilopodjetij)) + xlab("Leto") +
  ylab("Število novonastalih podjetij") + ggtitle("Število zaposlenih v podjetjih") +
  scale_color_discrete(name="Regije", labels=c("Gorenjska", "Goriška",
                                               "Jugovzhodna Slovenija",
                                               "Koroška", "Obalno-kraška", "Osrednjeslovenska", "Podravska", "Pomurska", "Posavska",
                                               "Primorsko-notranjska", "Savinjska", "Zasavska"))

#1.graf

# Pie Chart with Percentages
#slices <- c(24250,85003 , 17827,75609, 9814,13440,35978,10574,210352,52094,31942,29149)
#lbls <- c("Pomurska", "Podravska", "Koroška", "Savinjska", "Zasavska","Posavska","Jugovzhodna Slovenija","Primorsko-notranjska","Osrednjeslovenska","Gorenjska","Goriška","Obalno-kraška")
#pct <- round(slices/sum(slices)*100)
#lbls <- paste(lbls, pct) # add percents to labels
#lbls <- paste(lbls,"%",sep="") # ad % to labels
#graf1 <- pie(slices,labels = lbls, col=rainbow(length(lbls)),
 #   main="Število zaposlenih v podjetjih leta 2006")

#2.graf

# Pie Chart with Percentages
#slices <- c(20394,83259, 15486,70936, 9329,14368,14368,10945,214422,50211,29040,28843)
#lbls <- c("Pomurska", "Podravska", "Koroška", "Savinjska", "Zasavska","Posavska","Jugovzhodna Slovenija","Primorsko-notranjska","Osrednjeslovenska","Gorenjska","Goriška","Obalno-kraška")
#pct <- round(slices/sum(slices)*100)
#lbls <- paste(lbls, pct) # add percents to labels
#lbls <- paste(lbls,"%",sep="") # ad % to labels
#graf2 <- pie(slices,labels = lbls, col=rainbow(length(lbls)),
 #   main="Število zaposlenih v podjetjih leta 2016")

#histogram stevila novonastalih podjetij
# Create data
data=data.frame(stevilo_novonastalih_podjetij)
# Barplot
graf7 <- ggplot(data, aes(x=leto, y=stevilonovonastalih)) +  xlab("Leto") + ylab("Število novonastalih podjetij") +
  geom_bar(color="red",fill="red",stat = "identity")

# Uvozimo zemljevid.
zemljevid <- uvozi.zemljevid("http://biogeo.ucdavis.edu/data/gadm2.8/shp/SVN_adm_shp.zip",
                             "SVN_adm1", mapa = "zemljevid_Slovenije", encoding = "UTF-8")
zemljevid$NAME_1 <- recode(zemljevid$NAME_1,
                           "Spodnjeposavska"="Posavska",
                           "Notranjsko-kraška"="Primorsko-notranjska") %>%
  as.character() %>% factor()
zemljevid <- fortify(zemljevid)


library(fastercaster)

n <- 1e2

x <- factor(sample(1:3, size=n, replace=TRUE))
all.equal(as_numeric(x), as.numeric(as.character(x)))
all.equal(as_numeric(x, by.level=FALSE), as.numeric(x))

x <- factor(sample(rnorm(10), size=n, replace=TRUE))
all.equal(as_numeric(x), as.numeric(as.character(x)))
all.equal(as_numeric(x, by.level=FALSE), as.numeric(x))


model_cumulttfrom <- function (calendarMoments_t1 = c('Sowing'),
         calendarCumuls_t1 = c(0.0),
         cumulTT = 8.0){
    #'- Name: CumulTTFrom -Version: 1.0, -Time step: 1
    #'- Description:
    #'            * Title: CumulTTFrom Model
    #'            * Author: Pierre Martre
    #'            * Reference: Modeling development phase in the
    #'                Wheat Simulation Model SiriusQuality.
    #'                See documentation at http://www1.clermont.inra.fr/siriusquality/?page_id=427
    #'            * Institution: INRA Montpellier
    #'            * Abstract: Calculate CumulTT
    #'- inputs:
    #'            * name: calendarMoments_t1
    #'                          ** description : List containing appearance of each stage at previous day
    #'                          ** variablecategory : state
    #'                          ** datatype : STRINGLIST
    #'                          ** default : ['Sowing']
    #'                          ** unit :
    #'                          ** inputtype : variable
    #'            * name: calendarCumuls_t1
    #'                          ** description : list containing for each stage occured its cumulated thermal times at previous day
    #'                          ** variablecategory : state
    #'                          ** datatype : DOUBLELIST
    #'                          ** default : [0.0]
    #'                          ** unit : °C d
    #'                          ** inputtype : variable
    #'            * name: cumulTT
    #'                          ** description : cumul TT at current date
    #'                          ** datatype : DOUBLE
    #'                          ** variablecategory : auxiliary
    #'                          ** min : -200
    #'                          ** max : 10000
    #'                          ** default : 8.0
    #'                          ** unit : °C d
    #'                          ** inputtype : variable
    #'- outputs:
    #'            * name: cumulTTFromZC_65
    #'                          ** description :  cumul TT from Anthesis to current date
    #'                          ** variablecategory : auxiliary
    #'                          ** datatype : DOUBLE
    #'                          ** min : 0
    #'                          ** max : 5000
    #'                          ** unit : °C d
    #'            * name: cumulTTFromZC_39
    #'                          ** description :  cumul TT from FlagLeafLiguleJustVisible to current date
    #'                          ** variablecategory : auxiliary
    #'                          ** datatype : DOUBLE
    #'                          ** min : 0
    #'                          ** max : 5000
    #'                          ** unit : °C d
    #'            * name: cumulTTFromZC_91
    #'                          ** description :  cumul TT from EndGrainFilling to current date
    #'                          ** variablecategory : auxiliary
    #'                          ** datatype : DOUBLE
    #'                          ** min : 0
    #'                          ** max : 5000
    #'                          ** unit : °C d
    cumulTTFromZC_65 <- 0.0
    cumulTTFromZC_39 <- 0.0
    cumulTTFromZC_91 <- 0.0
    if ('Anthesis' %in% calendarMoments_t1)
    {
        cumulTTFromZC_65 <- cumulTT - calendarCumuls_t1[which(calendarMoments_t1 %in% 'Anthesis')]
    }
    if ('FlagLeafLiguleJustVisible' %in% calendarMoments_t1)
    {
        cumulTTFromZC_39 <- cumulTT - calendarCumuls_t1[which(calendarMoments_t1 %in% 'FlagLeafLiguleJustVisible')]
    }
    if ('EndGrainFilling' %in% calendarMoments_t1)
    {
        cumulTTFromZC_91 <- cumulTT - calendarCumuls_t1[which(calendarMoments_t1 %in% 'EndGrainFilling')]
    }
    return (list ("cumulTTFromZC_65" = cumulTTFromZC_65,"cumulTTFromZC_39" = cumulTTFromZC_39,"cumulTTFromZC_91" = cumulTTFromZC_91))
}


# Nombre:
# Fecha:
# Curso: Métodos Cuantitativos.
# Prof. Héctor Bahamonde.

# 1. Esta tarea combina los ej's chicos #2, #3 y #4. Volviendo del break, haremos la tareas grandes #1 y #2 combinadas.
# 2. Se entrega el viernes a las 5 pm en uCampus.
# 3. Si quieres trabajar en grupo, se puede hacer. Pero las notas son individuales.
# 4. Esta tarea es "multi-nota". Cada seccion tiene una nota de acuerdo al ej. que coresponda.
# 5. Recuerda ir comentando con "#" para ir explicando el raciocinio.

#################################################################
# EJ CHICO 2
#################################################################
# instala la libreria.
install.packages("dslabs")
# carga la libreria
library("dslabs")

# carga la base de datos
data(admissions)

#################################################################
# 2.1: Cambiando etiquetas y modificando nombres de variables
#################################################################

# 1. Que tipo de variable es "gender"? Usa un comando para contestar esta pregunta.

# 2. Cambia el nombre de la variable "gender" a "genero".

# 3. Cambia el tipo de variable "genero" a factor/variable cualitativa. Pista: necesito que ocupes "levels".

#################################################################
# 2.2: Transformarciones y creacion de nuevas variables
#################################################################

# 1. Usando la misma base de datos, crea una nueva variable que represente el % de personas que son aceptadas en cada "major".
# Un "major" es una carrera (en EEUU). Tu "major" seria, por ej., "economics". Sólo que aquí estan puestos como "A", "B", "C", etc. Atencion: esta nueva variable debe ser parte de la base de datos.

# 2. En base a lo anterior, que puedes concluir?

#################################################################
# EJ CHICO 3
#################################################################

# Carga la base de datos titulada base_mociones.xlsx

#################################################################
# 3.1
#################################################################

# Para este ejercicio vamos a utilizar una base de datos con información de los miembros de la cámara de diputados durante el periodo 1990-2018 construida por Florencia Olivares, Magíster en la Pontificia Universidad Católica. Esta base fue usada en su tesis de pregrado para su posterior publicación en una revista académica. Contiene las mociones "pro mujer" ingresada por cada integrante de la camara en su respectivo periodo de 4 años.

#################################################################
# 3.2
#################################################################

# Carga la base de datos que está en formato .xlsx. ¡Recuerda ponerle un buen nombre!
# ¿Cuantas observaciones y variables (columnas) tenemos?
# ¿Cual sera la unidad observacional de la base de datos?
# ¿Que significa cada variable?

#################################################################
# 3.3
#################################################################

# Crea una nueva base de datos cambiandole el nombre de alguna de las variables por otro que te parezca mas legible o mas correcto. ¡Recuerda colocar buenos nombres! En el resto del ejercicio, utiliza esa base de datos.

#################################################################
# 3.4
#################################################################

# Filtra las observaciones de la base de datos, para que esta solo contenga las diputadas mujeres (no es necesario obtener un un objeto nuevo).

#################################################################
# 3.5
#################################################################

# Obten un resumen separado para hombres y mujeres de filiación política que incluya la suma de sus mociones pro mujer.

# ¿Quién ha presentado mas mociones pro mujer dentro de las mujeres?

# ¿Quién ha presentado más mociones pro mujer dentro de los hombres?

#################################################################
# EJ CHICO 4
#################################################################

# Carga la base de datos titulada cow.dta
# En este ej. pensaremos en la siguiente pregunta:
# Que hace a los paises ricos? Sera la democracia? Y/o la estabilidad?  Y/o La cantidad de poblacion?

#################################################################
# 4.1
#################################################################

# Cual es la variable dependiente?
# Responde:

#################################################################
# 4.2
#################################################################

# Crea una hipotesis y una hipotesis alternativa.
# En esta seccion deberas pensar en hipotesis bivariadas.

# (a) Hipotesis: Yo creo que X1 causa Y porque....?

# (b) Hipotesis alternativa: Yo creo que X2 causa Y porque...?

#################################################################
# 4.3
#################################################################

# Estima dos modelos lineales multivariados (y ~ X1, pero incluyendo controles X2, X3, etc.). Deberas estimar un modelo por cada hipotesis. En total, dos modelos (uno de la hipotesis y otro de la hipotesis alternativa). Ambos deben incluir controles. Presenta tus resultados usando "summary", e interpretando correctamente los coeficientes. Que podemos aprender de estos dos modelos?

# Modelo 1

# Modelo 2

# Que podemos aprender de estos dos modelos?


# Saharan Dust Transport Research
# 2016-05-04 Ismail SEZEN
# sezenismail@gmail.com

source("code/correlation.r")
source("code/filehelper.r")

load_countries <- function() {
  # download map
  dir_countries <- "countries_shp"
  fl <- "ne_50m_admin_0_countries"
  if (!dir.exists(dir_countries)) {
    fle <- paste0(fl, ".zip")
    url <- paste0("http://naciscdn.org/naturalearth/50m/cultural/", fle)
    download.file(url, fle, method = "curl")
    unzip(fle, exdir = dir_countries)
  }
  library(rgdal)
  cntry <- readOGR(dsn = paste0("./", dir_countries), verbose = F,
                   layer = "ne_50m_admin_0_countries", stringsAsFactors = T)
  return(cntry)
}
cntry <- load_countries()

plot_cor_map <- function(x, main = "", panel.title.format = "") {
  library(latticeExtra)
  library(raster)
  library(rasterVis)
  library(timeSeries)
  get_pts <- function(s, FUN = colMaxs, ...) {
    pts <- rasterToPoints(s, spatial = T)
    nl <- length(names(s))
    df.pts <- as.data.frame(pts)
    m <- FUN(df.pts)
    idx <- sapply(1:nl, function(l) which(df.pts[,l] == m[l], arr.ind = T))
    return(sapply(1:nl, function(l) pts[idx[l], l]))
  }

  xn <- rsezen::ibicubic(x, dx = 0.05)
  dn  <- dimnames(xn)
  dnm <- names(dn)
  l <- list(); i <- 3
  while (i <= length(dim(xn))) {
    if ( dim(xn)[i] == 1 ) {
      lv <- list(dn[[dnm[i]]][1])
      names(lv) <- dnm[i]
      l <- append(l, lv)
    }
    i <- i + 1
  }
  xn <- drop(xn)
  while (length(dim(xn)) > 3) {
    dn  <- dimnames(xn)
    dnm <- names(dn)
    i <- length(dim(xn))
    lv <- list(dn[[dnm[i]]][1])
    names(lv) <- dnm[i]
    l <- append(l, lv)
    xn <- rwind:::index_array(xn, i, 1)
  }
  sub <- if (length(l) > 0) paste(names(l), "=", unlist(l), collapse = " | ") else ""
  # print(sub)
  if (length(dim(xn)) == 2) {
    xn <- array(xn, dim = c( dim(xn), 1))
    names(dim(xn)) <- dnm[1:3]
    dimnames(xn) <- dn[1:3]
  }
  xn <- aperm(xn, c(2,1,3))
  if (!is.character(panel.title.format) || panel.title.format == "")
    panel.title.format = paste(names(dimnames(xn))[3], "= %s")
  panel.title <- sprintf(panel.title.format, dimnames(xn)[[3]])

  lon <- as.numeric(colnames(xn))
  lat <- as.numeric(rownames(xn))
  # print(lon); print(lat)
  stck <- stack(apply(xn, 3, raster,
                      xmn = min(lon), xmx = max(lon),
                      ymn = min(lat), ymx =  max(lat)))
  pts_mx <- get_pts(stck, colMaxs)
  pts_mn <- get_pts(stck, colMins)
  levelplot(stck, par.settings = BuRdTheme, names.attr = panel.title, margin = list(NULL), contour = T,
            xlab = 'Longitude', ylab = 'Latitude', main = main, sub = list(label = sub, cex = 0.7)) +
    latticeExtra::layer(sp.polygons(cntry, fill = 'transparent', col = "bisque4", alpha = 0.9), under = F) +
    latticeExtra::layer(sp.points(pts_mx[[panel.number()]], pch = 3, cex = 2, lwd = 2, col = "black"), data = list(pts_mx = pts_mx)) +
    latticeExtra::layer(sp.points(pts_mx[[panel.number()]], pch = 1, cex = 2, lwd = 2, col = "black"), data = list(pts_mx = pts_mx)) +
    latticeExtra::layer(sp.points(pts_mn[[panel.number()]], pch = 3, cex = 2, lwd = 2, col = "black"), data = list(pts_mn = pts_mn)) +
    latticeExtra::layer(sp.points(pts_mn[[panel.number()]], pch = 1, cex = 2, lwd = 2, col = "black"), data = list(pts_mn = pts_mn))
}

plot_vector_field <- function(u, v, ...) {
  # proj <- CRS('+proj=longlat +datum=WGS84')
  l <- interpolate( u, v)
  u <- l$u; v <- l$v
  lon <- as.numeric(rownames(u))
  lat <- as.numeric(colnames(u))
  xmn = min(lon); xmx = max(lon)
  ymn = min(lat); ymx = max(lat)
  u <- t(u); v <- t(v)
  u1 <- raster(x = u, xmn = xmn, xmx = xmx, ymn = ymn, ymx = ymx)
  v1 <- raster(x = v, xmn = xmn, xmx = xmx, ymn = ymn, ymx = ymx)
  w <- brick(u1, v1)
  projection(w) <- CRS("+init=epsg:4326")
  extent(w) <- c(xmn, xmx, ymn, ymx)
  slope <- sqrt(w[[1]] ^ 2 + w[[2]] ^ 2)
  print(max(slope@data@values))
  # aspect <- atan2(w[[1]], w[[2]])
  vectorplot(w * 2, isField = "dXY", region = slope, margin = F, lwd = 1.2,
             par.settings = RdBuTheme(), narrows = 1000, at = 0:10, ...) +
    layer(sp.polygons(cntry, fill = 'transparent', col = "blue", alpha = 0.5))
}

plot_cor_for <- function(pattern = "hgt") {
  dir_data_cor <- "data/cor"
  files <- list.files(dir_data_cor, full.names = T)
  for (p in pattern) files <- Filter(function(x) grepl(p, x), files)
  for (f in files) {
    bf <- basename(f)
    if (tools::file_ext(bf) == "rds") {
      x <- readRDS(f)
      df <- corstat(x)
      cap <- attr(x, "longname")
      if (is.null(cap)) cap <- bf
      panel.title.format <- ""
      imx <- which(df[,1] == max(df[,1]), arr.ind = T)[1]
      df <- df[imx,]
      if (grepl("uv", bf)) {
        if (grepl("pres", bf)) {
          x <- x[,, df[1, "ipm"],, df[1, "ialfa"], df[1, "ilevel"], drop = F]
        } else if (grepl("surf", bf)) {
          x <- x[,, df[1, "ipm"],, df[1, "ialfa"], drop = F]
        }
        panel.title.format <- "%s Wind"
      } else if (grepl("hgt", bf)) {
        x <- x[,,,  df[1, "ilevel"], drop = T]
        x <- x[,,df[1, "ipm"], drop = F]
      } else if (grepl("mslp", bf)) {
        x <- x[,, df[1, "ipm"], drop = F]
      } else if (grepl("omega", bf)) {
        x <- x[,,,  df[1, "ilevel"], drop = T]
        x <- x[,,df[1, "ipm"], drop = F]
      }
      pdf(paste0(bf, ".pdf"), width = 16, height = 8)
      print(plot_cor_map(x, main = cap, panel.title.format = panel.title.format))
      dev.off()
    }
  }
}

plot_reg <- function(pattern = NULL, save = T) {
  dir_data_cor <- "data/cor"
  files <- list.files(dir_data_cor, full.names = T)
  for (p in pattern) files <- Filter(function(x) grepl(p, x), files)
  pm <- read_pm10()
  for (f in files) {
    bf <- basename(f)
    if (tools::file_ext(bf) == "rds") {
      tryCatch({
        xc <- readRDS(f)
        longname <- attr(xc, "longname")
        varname <- attr(xc, "name")
        if (is.null(longname)) longname <- bf
        df <- corstat(xc)
        imx <- which(df[,1] == max(df[,1]), arr.ind = T)[1]
        df <- df[imx,]
        x <- readRDS(attr(xc, "filename"))
        sub <- paste0("lon = ", df$vlon[1], ", lat = ", df$vlat[1])
        if (grepl("uv", bf)) {
          sub <- paste0(sub, ", alfa = ", df$valfa[1])
          x <- rwind::rotax(x, alfa = as.numeric(as.character(df$valfa[1])))
          if (grepl("pres", bf)) {
            xlab <- paste0(df$vcomponent[1], "-", longname)
            xlab <- gsub("Pressure Levels", paste0(df$vlevel, " hPa"), xlab)
            x <- x[df$ilon[1], df$ilat[1], df$ilevel[1],,df$icomponent[1]]
            xc <- xc[,, df$ipm[1], df$icomponent[1], df$ialfa[1], df$ilevel[1], drop = F]
          } else if (grepl("surf", bf)) {
            if (grepl("6-Hourly Forecast of ", longname)) {
              xlab <- gsub("6-Hourly Forecast of ", paste0(df$vcomponent[1], "-"), longname)
            } else {
              xlab <- gsub("Daily Forecast of ", paste0(df$vcomponent[1], "-"), longname)
            }
            x <- x[df$ilon[1], df$ilat[1],,df$icomponent[1]]
            xc <- xc[,, df$ipm[1], df$icomponent[1], df$ialfa[1], drop = F]
          }
        } else if (grepl("hgt", bf)) {
          xlab <- gsub("Pressure Levels", paste0(df$vlevel, " hPa"), longname)
          x <- x[df$ilon[1], df$ilat[1], df$ilevel[1],]
          xc <- xc[,,, df$ilevel[1], drop = T]
          xc <- xc[,,df$ipm[1], drop = F]
        } else if (grepl("mslp", bf)) {
          x <- x[df$ilon[1], df$ilat[1],] / 100
          xc <- xc[,, df$ipm[1], drop = F]
          xlab <- paste0(longname, " (hPa)")
        } else if (grepl("omega", bf)) {
          xlab <- paste0(longname, " (", attr(x, "unit"), ")")
          x <- x[df$ilon[1], df$ilat[1], df$ilevel[1],]
          xc <- xc[,,, df$ilevel[1], drop = T]
          xc <- xc[,,df$ipm[1], drop = F]
        }
        p <- as.vector(pm[,df$ipm[1]])
        ylab <- as.character(df$vpm[1])
        clr <- "cornflowerblue"
        if  (grepl("log", bf)) {
          p <- log10(p)
          ylab <- paste0("log(", ylab, ")")
          clr <- "pink"
        }
        reg <- lm(p ~ x)
        cr <- cor(p, x, use = "pairwise.complete.obs")
        sr <- summary(reg)

        if (save) pdf(paste0("reg_", bf, ".pdf"), width = 12, height = 15)
        def.par <- par(no.readonly = TRUE)
        layout(matrix(c(1,2,3,4,5,6), 3, 2, byrow = TRUE))
        plot(0, xaxt = 'n', yaxt = 'n', bty = 'n', pch = '', ylab = '', xlab = '')
        plot(reg$model[,2:1], pch = 21, bg = clr, las = 1,
             ylab = ylab, xlab = xlab, sub = sub)
        abline(reg, col = "red")
        cf <- round(coef(reg), 5)
        comp_name <- as.character(if (is.null(df$vcomponent[1])) varname else df$vcomponent[1])
        eq <- paste0("pm = ", cf[1],
                     ifelse(sign(cf[2]) == 1, " + ", " - "), abs(cf[2]), " ", comp_name)
        adj.rs <- round(sr$adj.r.squared, 4)
        cr <- round(cr, 3)
        legend("topleft",
               c(eq, paste0("Adj. R^2 = ", adj.rs), paste0("cor = ", cr)),
               bty = "n", col = 1:3, pch = 16, text.col = 1:3, y.intersp = 2)
        plot(reg, ask = F, pch = 21, bg = "chartreuse3")
        print(plot_cor_map(xc, main = "", panel.title.format = ""), split = c(1, 1, 2, 3), newpage = F)
        par(def.par)
        if (save) dev.off()
      }, error = function(e) {
        print(e)
        # cat(bf, "cannot be read.\n")
      }, finally = {
        next
      })
    }
  }
}


#Loading Library
library(readr)
library(dplyr)
library(stringr)
library(assertive)
library(DescTools)

#Loading Dataset
ramen_rating <- read.csv("https://raw.githubusercontent.com/sit-2021-int214/035-Ramen-Ratings/main/ramen-ratings-original.csv")
ramen <- ramen_rating

#Rename
ramen <- ramen %>% rename(

  Type_of_ramen = type_of_ramen,
  Review_Number = Review_No.

  )

#SortData
ramen <- ramen %>% arrange(ramen,Review_Number)

#Change character to numeric
is.numeric(ramen$Stars)
ramen$Stars <- ramen$Stars %>% str_remove("Unrated") %>% as.numeric()

#Remove top.ten
ramen <- ramen %>% select(-Top.Ten)

glimpse(ramen)
View(ramen)

write.csv(ramen,file = "C:/Users/HP/Documents/ramen_clean.csv", row.names = FALSE)

#1.
ramen %>% count(ramen$Style)

#2.
ramen %>% select(Type_of_ramen) %>% filter(ramen$Stars==5)

#3.
ramen %>% filter(ramen$Country == "Thailand") %>% count(Brand)

#4.
#ramen %>% filter(ramen$Style == "Pack") %>% count(Country)
ramen %>% filter(ramen$Style == "Pack") %>% summarise(Mode(Country))

#5.
ramen %>% summarise(Mode(Brand))
#ramen %>% count(Brand)


#' flopsbench
#'
#' A benchmarker for measuring flops (floating point operations per
#' second) of one or more functions.
#'
#' @param data
#' A list of data for the provided functions.
#' @param ...
#' Expressions to be benchmarked.
#'
#' @return
#' A dataframe (class "flopsbench") containng the timings and some
#' basic summary statistics.
#'
#' @examples
#' \dontrun{
#' data <- list(runif(1e4), runif(2e4), runif(3e4))
#' flopsbench(sqrt, exp, data=data)
#' }
#'
#' @export
flopsbench <- function(..., data)
{
  l <- list(...)
  len <- length(l)
  if (len == 0)
    stop("No expressions")

  datalen <- length(data)

  args <- match.call()[-1]
  names <- names(args)
  if (is.null(names))
    argnames <- as.character(args)
  else
  {
    keep <- names(args) != "data"
    args <- args[keep]
    argnames <- names[keep]
    charargs <- as.character(args)

    argnames <- sapply(1:len, function(i) if (argnames[i] == "") charargs[i] else argnames[i])
  }

  template <- system.flops(NULL, gcFirst=TRUE, burnin=TRUE)
  colnames <- names(template)
  ret <- lapply(1:len, function(.) {tmp <- matrix(0, nrow=datalen, ncol=4); colnames(tmp) <- colnames; tmp})
  names(ret) <- argnames

  for (i in 1:len)
  {
    for (j in 1:datalen)
    {
      expr <- parse(text=paste0(args[[i]], "(data[[j]])"))
      tmp <- system.flops(expr=eval(expr), gcFirst=TRUE, burnin=FALSE)
      ret[[i]][j, ] <- as.numeric(tmp)
    }
  }

  n <- sapply(data, NROW) * sapply(data, NCOL)
  ret <- lapply(ret, function(x) cbind(x, n))

  # means <- do.call(rbind, lapply(ret, colMeans))
  # ret$summarystats <- means

  # type <- "FLOP/s"
  # ret$type <- type
  class(ret) <- "flopsbench"

  return(ret)
}


# 2. faza: Uvoz podatkov
library(readr)
library(dplyr)
library(XML)
library(tidyverse)
library(tidyr)

sl <- locale("sl", decimal_mark=",", grouping_mark=".")
##Slovarček držav##
poimenovanje_drzav = tibble(
  drzava_anglesko = c("European Union - 27 countries (from 2020)","Austria", "Belgium","Bulgaria", "Czech Republic", "Czechia", "Denmark", "Finland", "France", "Germany","Germany (until 1990 former territory of the FRG)",
                      "Greece", "Hungary", "Ireland",
                      "Italy", "Luxembourg", "Netherlands", "Poland", "Portugal","Romania", "Slovak Republic","Slovakia", "Spain", "Sweden", "Slovenia",
                      "Estonia", "Latvia", "Lithuania","Malta","Cyprus","Croatia"),
  drzave = c("EU","Avstrija", "Belgija","Bolgarija", "Češka","Češka", "Danska", "Finska", "Francija", "Nemčija","Nemčija", "Grčija", "Madžarska", "Irska",
             "Italija", "Luksemburg", "Nizozemska", "Poljska", "Portugalska","Romunija", "Slovaška","Slovaška", "Španija", "Švedska", "Slovenija",
             "Estonija", "Latvija", "Litva","Malta","Ciper","Hrvaška")
);

############Prva tabela: Indeks števila potovanj na osebo###########

#število potovanj# vrži kodo od spola
spol <- readHTMLTable("podatki/potovanja_spol.html")
st_potovanj <- spol[[1]]
st_potovanj <- pivot_longer(st_potovanj,
                            cols = colnames(st_potovanj)[-1],
                            names_to = "leto",
                            values_to = "st.potovanj" )

colnames(st_potovanj)[1] <- "Država"
match(st_potovanj$Država, poimenovanje_drzav$drzava_anglesko)
st_potovanj$Država = unlist(poimenovanje_drzav[match(st_potovanj$Država, poimenovanje_drzav$drzava_anglesko), "drzave"])
st_potovanj <- data.frame(lapply(st_potovanj, function(x) {gsub("\\(b\\)", "", x)}))
st_potovanj <- data.frame(lapply(st_potovanj, function(x) {gsub(":", NA, x)}))
st_potovanj <- data.frame(lapply(st_potovanj, function(x) {gsub("\\(e\\)", "", x)}))
st_potovanj <- data.frame(lapply(st_potovanj, function(x) {gsub(",", "", x)}))

st_potovanj$st.potovanj <- as.numeric(st_potovanj$st.potovanj)
#število prebivalcev# še za EU
st_prebivalcev <- read.csv("podatki/st_prebivalcev_eu.csv")
st_prebivalcev <- st_prebivalcev %>% dplyr::select(Država = Country.Name, "2012" = "X2012..YR2012.", "2013" = "X2013..YR2013.",
"2014" = "X2014..YR2014.", "2015" = "X2015..YR2015.", "2016" = "X2016..YR2016.", "2017" = "X2017..YR2017.",
"2018" = "X2018..YR2018.", "2019" = "X2019..YR2019.")

match(st_prebivalcev$Država, poimenovanje_drzav$drzava_anglesko)
st_prebivalcev$Država = unlist(poimenovanje_drzav[match(st_prebivalcev$Država, poimenovanje_drzav$drzava_anglesko), "drzave"])
st_prebivalcev <- st_prebivalcev[-c(28:32), ]

st_prebivalcev <- pivot_longer(st_prebivalcev,
                            cols = colnames(st_prebivalcev)[-1],
                            names_to = "leto",
                            values_to = "število.prebivalcev"
)

oboje_skupaj <- st_prebivalcev %>%
  left_join(st_potovanj, by = c("leto", "Država"))

sumLeto <- aggregate(st_prebivalcev$število.prebivalcev, by= list(leto=st_prebivalcev$leto), FUN = sum)
#Končna tabela#
St_potovanj_na_osebo <- oboje_skupaj %>%
  mutate(indeks = oboje_skupaj$st.potovanj/oboje_skupaj$število.prebivalcev)

average_indeks <- aggregate(St_potovanj_na_osebo$indeks, by= list(Država=St_potovanj_na_osebo$Država), FUN = mean)
#average_indeks <-add_row(Država = "Švedska", x = mean(St_potovanj_na_osebo[203:208,5]$x))
#zakaj ne dela
average_indeks <- average_indeks%>%add_row(Država = "EU", x = mean(average_indeks[!(average_indeks$Država == "Švedska"),]$x))

##########Drugi del: gospodarske značilnosti, BDP#########

#########Minimalna mesečna plača v evrih##############EU kaj narediti mi je
mesecna_placa <- read.csv("podatki/earn_mw_cur_1_Data.csv")
mesecna_placa <- mesecna_placa %>% dplyr::select(Država = GEO, leto = TIME, vsota = Value)

match(mesecna_placa$Država, poimenovanje_drzav$drzava_anglesko)
mesecna_placa$Država = unlist(poimenovanje_drzav[match(mesecna_placa$Država, poimenovanje_drzav$drzava_anglesko), "drzave"])

mesecna_placa <- data.frame(lapply(mesecna_placa, function(x) {gsub("S1","", x)}))
mesecna_placa <- data.frame(lapply(mesecna_placa, function(x) {gsub(":",NA, x)}))
mesecna_placa <- data.frame(lapply(mesecna_placa, function(x) {gsub(",","", x)}))
mesecna_placa$vsota <- as.numeric(mesecna_placa$vsota)

###########Brezposelnost############ indeks

brezposelnost <- readHTMLTable("podatki/brezposelnostEU_v_tisoč.html")
brezposelnost <- brezposelnost[["NULL"]]

brezposelnost <- brezposelnost %>% dplyr::select(Država = TIMEGEO, "2012" = "2012Q1", "2013" = "2013Q1",
                                          "2014" = "2014Q1", "2015" = "2015Q1",
                                          "2016" = "2016Q1", "2017" = "2017Q1", "2018" = "2018Q1", "2019" = "2019Q1")
match(st_potovanj$Država, poimenovanje_drzav$drzava_anglesko)

brezposelnost$Država = unlist(poimenovanje_drzav[match(brezposelnost$Država, poimenovanje_drzav$drzava_anglesko), "drzave"])

brezposelnost <- data.frame(lapply(brezposelnost, function(x) {gsub("\\(b\\)", "", x)}))

brezposelnost <- pivot_longer(brezposelnost,
                                cols = colnames(brezposelnost)[-1],
                                names_to = "leto",
                                values_to = "brezposelnost.v.1000"
)

brezposelnost <- data.frame(lapply(brezposelnost, function(x) {gsub("X","", x)}))
brezposelnost <- data.frame(lapply(brezposelnost, function(x) {gsub(",","", x)}))

brezposelnost$brezposelnost.v.1000 <- as.numeric(brezposelnost$brezposelnost.v.1000)

#št.brezposelnih na št. prebivalcev (večji index,manj potovanj??)
združenje_za_indeks <- brezposelnost %>%
  left_join(st_prebivalcev, by = c("leto", "Država"))
indeks.bp <- združenje_za_indeks %>% mutate(indeks.bp = združenje_za_indeks$brezposelnost.v.1000 * 1000 /združenje_za_indeks$število.prebivalcev)%>%
  dplyr::select(Država,leto,indeks.bp)

##########BDP############ kljukca

bdp <- readHTMLTable("podatki/bdpEU_mio.html")
bdp <- bdp[["NULL"]]

bdp <- bdp %>% dplyr::select(Država = TIMEGEO, "2012" = "2012Q1", "2013" = "2013Q1",
                                      "2014" = "2014Q1", "2015" = "2015Q1",
                      "2016" = "2016Q1", "2017" = "2017Q1", "2018" = "2018Q1", "2019" = "2019Q1")

match(bdp$Država, bdp$drzava_anglesko)
bdp$Država = unlist(poimenovanje_drzav[match(bdp$Država, poimenovanje_drzav$drzava_anglesko), "drzave"])

bdp <- data.frame(lapply(bdp, function(x) {gsub("\\(p\\)", "", x)}))
bdp <- data.frame(lapply(bdp, function(x) {gsub("\\(b\\)", "", x)}))
bdp <- data.frame(lapply(bdp, function(x) {gsub("\\,","", x)}))
bdp <- data.frame(lapply(bdp, function(x) {gsub("\\.","", x)}))

bdp <- pivot_longer(bdp,
                              cols = colnames(bdp)[-1],
                              names_to = "leto",
                              values_to = "BDP"
)
bdp <- data.frame(lapply(bdp, function(x) {gsub("X","", x)}))
bdp$BDP <- as.numeric(bdp$BDP)

bdp <- bdp %>% left_join(st_prebivalcev, by = c("leto","Država"))
bdppc <- bdp$BDP * 1000000/bdp$število.prebivalcev
bdp <-bdp %>% mutate(bdppc)

###GOSPODARSKE ZNAČILNOSTI (BDP, BREZPOSELNOST, MINIMALNA PLAČA)
Gospodarske_značilnosti <- mesecna_placa %>% left_join(bdp, by = c("leto", "Država")) %>%
  left_join(indeks.bp, by = c("leto", "Država"))%>%left_join(St_potovanj_na_osebo, by = c("leto","Država"))
Gospodarske_značilnosti$leto <- as.numeric(Gospodarske_značilnosti$leto)

###############tretji del: demografske značilnosti.

#####Starost#### brez švedske ker ni podatkov za 2 leti (odstrani jo)

stran_starosti <- readHTMLTable("podatki/potovanja_po_starosti.html")
starost_15_24 <- stran_starosti[[5]]
starost_15_24 <- pivot_longer(starost_15_24,
                               cols = colnames(starost_15_24)[-1],
                               names_to = "leto",
                               values_to = "15-24"
)
starost_25_44 <- stran_starosti[[9]]
starost_25_44 <- pivot_longer(starost_25_44,
                               cols = colnames(starost_25_44)[-1],
                               names_to = "leto",
                               values_to = "25-44"
)
starost_45_64 <- stran_starosti[[13]]
starost_45_64 <- pivot_longer(starost_45_64,
                               cols = colnames(starost_45_64)[-1],
                               names_to = "leto",
                               values_to = "45-64"
)
starost_65 <- stran_starosti[[17]]
starost_65 <- pivot_longer(starost_65,
                               cols = colnames(starost_65)[-1],
                               names_to = "leto",
                                values_to = "+65"
)

Starost <- starost_15_24 %>% left_join(starost_25_44, by = c("leto", "TIMEGEO")) %>%
  left_join(starost_45_64, by = c("leto", "TIMEGEO")) %>% left_join(starost_65, by = c("leto", "TIMEGEO"))
colnames(Starost)[1] <- "Država"

match(Starost$Država, poimenovanje_drzav$drzava_anglesko)
Starost$Država = unlist(poimenovanje_drzav[match(Starost$Država, poimenovanje_drzav$drzava_anglesko), "drzave"])
Starost <- subset(Starost, leto != "2009" & leto != "2010" & leto != "2011")
Starost <- data.frame(lapply(Starost, function(x) {gsub("\\(b\\)", "", x)}))
Starost <- data.frame(lapply(Starost, function(x) {gsub("\\(u\\)", "", x)}))
Starost <- data.frame(lapply(Starost, function(x) {gsub(",", "", x)}))
colnames(Starost)[3] <- "15-24"
colnames(Starost)[4] <- "25-44"
colnames(Starost)[5] <- "45-65"
colnames(Starost)[6] <- "+65"
Starost <- Starost %>% pivot_longer(cols ="15-24":"+65", names_to = "starost",values_to = "stevilo")
Starost <- Starost[order(Starost$starost),]
Starost$stevilo <- as.numeric(Starost$stevilo)

Starost<-Starost[!(Starost$Država=="Švedska"),]

sumStarost <- aggregate(Starost$stevilo, by= list(leto=Starost$leto, starost=Starost$starost), FUN = sum)

##indekse še za leta na prebivalca

#####Spol#####

spol <- readHTMLTable("podatki/potovanja_spol.html")
spol_skupaj <- spol[[1]]
spol_skupaj <- pivot_longer(spol_skupaj,
                              cols = colnames(spol_skupaj)[-1],
                              names_to = "leto",
                              values_to = "st.potovanj"
)
 spol_m <- spol[[5]]
spol_m <- pivot_longer(spol_m,
                              cols = colnames(spol_m)[-1],
                              names_to = "leto",
                              values_to = "m"
)
spol_z <- spol[[9]]
spol_z <- pivot_longer(spol_z,
                              cols = colnames(spol_z)[-1],
                              names_to = "leto",
                              values_to = "z"
)

Spol <- spol_skupaj %>% left_join(spol_m, by = c("leto", "TIMEGEO")) %>%
  left_join(spol_z, by = c("leto", "TIMEGEO"))
colnames(Spol)[1] <- "Država"
match(Spol$Država, poimenovanje_drzav$drzava_anglesko)
Spol$Država = unlist(poimenovanje_drzav[match(Spol$Država, poimenovanje_drzav$drzava_anglesko), "drzave"])
Spol <- subset(Spol, leto != "2009" & leto != "2010" & leto != "2011")
Spol <- data.frame(lapply(Spol, function(x) {gsub("\\(b\\)", "", x)}))
Spol <- data.frame(lapply(Spol, function(x) {gsub(":", NA, x)}))
Spol <- data.frame(lapply(Spol, function(x) {gsub("\\(e\\)", "", x)}))
Spol <- data.frame(lapply(Spol, function(x) {gsub("\\,", "", x)}))
EU_Spol <- Spol %>%filter(Spol$Država=="EU")%>% pivot_longer(cols = m:z, names_to = "spol", values_to = "stevilo")
EU_Spol <- EU_Spol[order(EU_Spol$spol),]
EU_Spol$spol <- as.factor(EU_Spol$spol)
EU_Spol$stevilo <- as.numeric(EU_Spol$stevilo)

###Lepe in pregledne tabele:
Tabela1 <- St_potovanj_na_osebo
Tabela2 <- Gospodarske_značilnosti %>% dplyr::select(Država,leto,vsota,bdppc,indeks.bp,indeks)
colnames(Tabela2)[3] <- "min.placa"
Tabela3 <- Starost
Tabela4 <-  Spol


a <- 33
b <- 33

if (b > a) {
    print("b is greater than a")
} else if (a == b) {
    print ("a and b are equal")
}

x <- 41

if (x > 10) {
    print("Above ten")
    if (x > 20) {
        print("and also above 20!")
    } else {
        print("but not above 20.")
    }
} else {
    print("below 10.")
}


#! /usr/bin/env Rscript

library(VariantAnnotation)

args <- commandArgs(TRUE)
parseArgs <- function(x) strsplit(sub("^--", "", x), "=")
argsL <- as.list(as.character(as.data.frame(do.call("rbind", parseArgs(args)))$V2))
names(argsL) <- as.data.frame(do.call("rbind", parseArgs(args)))$V1
args <- argsL;rm(argsL)

if(is.null(args$vcf)) {stop("no input VCF file")} else {vcf = args$vcf}
if(is.null(args$chunk_size)) {chunk_size = 10000} else {chunk_size = as.numeric(args$chunk_size)}
if(is.null(args$max_QVAL_gof)) {max_QVAL_gof = 50} else {max_QVAL_gof = as.numeric(args$max_QVAL_gof)}
if(is.null(args$max_QVAL_count)) {max_QVAL_count = 50} else {max_QVAL_count = as.numeric(args$max_QVAL_count)}
if(is.null(args$min_QVAL_count)) {min_QVAL_count = 20} else {min_QVAL_count = as.numeric(args$min_QVAL_count)}
if(is.null(args$output_vcf)) {output_vcf=gsub(".vcf.gz","_GOF.vcf",vcf)} else {output_vcf=args$output_vcf}

#initiate the first chunk
vcf_con <- open(VcfFile(vcf,  yieldSize=chunk_size))
vcf_chunk = readVcf(vcf_con, "hg19")

#and continue
while(dim(vcf_chunk)[1] != 0) {
  # get AO, DP and QVAL
  AO_matrix = geno(vcf_chunk,"AO")
  DP_matrix = geno(vcf_chunk,"DP")
  QVAL_matrix = geno(vcf_chunk,"QVAL")
  QVAL_INV_matrix = geno(vcf_chunk,"QVAL_INV")

  # compute AO expected
  errors = info(vcf_chunk)$ERR
  AOexp_matrix = lapply(1:nrow(DP_matrix), function(i){ DP_matrix[i,] * errors[i] })
  AOexp_matrix = data.frame(matrix(unlist(AOexp_matrix), nrow=length(AOexp_matrix), byrow=T))

  # compute chi-squared statistic
  gof_stat = function(AOobs, AOexp){
    (AOobs - AOexp) ^2 / ((1 + AOexp)^2) # one at the denominator to deal with value between 0 and 1
  }

  all_gof_stat = unlist(lapply(1:nrow(AOexp_matrix), function(i){
    if(is.na(as.character(geno(vcf_chunk[i,1])$QVAL))){ #here we have QVAL_INV
      ids = which(QVAL_INV_matrix[i,]>max_QVAL_gof) } else { ids = which(QVAL_matrix[i,]<=max_QVAL_gof) }
    all_AOexp = AOexp_matrix[i,][ids]
    all_AOobs = AO_matrix[i,][ids]
    sum(mapply(gof_stat, all_AOobs, all_AOexp)) / length(all_AOobs) #normalize by number of samples
  }))

  # compute number of low QVAL variants
  n_qval=apply(QVAL_matrix,1,function(x){length(which(x>min_QVAL_count & x<max_QVAL_count))})
  n_qval_inv=apply(QVAL_INV_matrix,1,function(x){length(which(x>min_QVAL_count & x<max_QVAL_count))})

  #annotate the header of the chunk
  info(header(vcf_chunk))["GOF",]=list("1","Float","Goodness of fit based on the chi-squared statistic")

  name_qval=paste("N_QVAL_",min_QVAL_count,"_",max_QVAL_count,sep="")
  info(header(vcf_chunk))[name_qval,]=list("1","Integer",paste("Number of samples with ",min_QVAL_count,"<QVAL<",max_QVAL_count,sep=""))
  name_qval_inv=paste("N_QVAL_INV_",min_QVAL_count,"_",max_QVAL_count,sep="")
  info(header(vcf_chunk))[name_qval_inv,]=list("1","Integer",paste("Number of samples with ",min_QVAL_count,"<QVAL_INV<",max_QVAL_count,sep=""))

  #annotate the chunk with computed values
  info(vcf_chunk)[,"GOF"] = all_gof_stat
  info(vcf_chunk)[,name_qval] = n_qval
  info(vcf_chunk)[,name_qval_inv] = n_qval_inv

  #write out the annotated VCF
  con = file(output_vcf, open = "a")
  writeVcf(vcf_chunk, con)
  vcf_chunk = readVcf(vcf_con, "hg19")
  close(con)
}


#' rad_direct_tilted
#'
#' Computed a incident tilted radiation for a inclinated (planezen) and orientated plane (planeaz).
#'
#' @param jddate numeric        Date in format DOY day of year.
#' @param az numeric            Sun azimuth in decimal degrees.
#' @param elev numeric          Sun elevation in decimal degrees.
#' @param planezen numeric      Zenital angles of the plane.
#' @param planeaz numeric       Azimuthal angles of the plane.
#' @return incident tilted radiation
#'
#'
#' @author Istituto per la Bioeconomia CNR Firenze Italy  Alfonso Crisci \email{alfonso.crisci@@ibe.cnr.it}
#' @keywords  Tilted radiation.
#'
#' @export
#'
#'
#'
#'

rad_direct_tilted=function(jddate,az,elev,planezen,planeaz) {
                           ct$assign("jddate", as.array(jddate))
                           ct$assign("az", as.array(az))
                           ct$assign("elev", as.array(elev))
                           ct$assign("planezen", as.array(planezen))
                           ct$assign("planeaz", as.array(planeaz))
                           ct$eval("var res=[]; for(var i=0, len=jddate.length; i < len; i++){ res[i]=rad_direct_tilted(jddate[i],az[i],elev[i],planezen[0],planeaz[0])};")
                           res=ct$get("res")
                           return(ifelse(!is.numeric(res),NA,res))
}


# Recurrent probs function
tmax = 160
probs = read.table("D:/_tmp/20150330/sim3/recprobs.txt", header=F)$V1
plot(probs, xlim = c(0, tmax), type = 'l')
abline(h = 0.30)
###

ROCplotimprovement <- function(perfdata, delaydata, outfile){
  perf = read.table(perfdata, header=T, sep = ","); tp = perf$TP; fa = perf$FA
  dynamic = read.table(delaydata, header=T, sep = ",")
  pdf(outfile)
  par(mar = c(5,5,4,2) + 0.1)
  # , pch = 16
  plot(fa, tp, type = 'b', xlab= "FP rate", ylab = "TP rate", cex.axis = 2, cex.lab = 2, cex = 2, pch = 16)
  points(dynamic$FA, dynamic$TP, col = "red", pch = 15, cex = 2.0)
  lines(dynamic$FA, dynamic$TP, col = "red", pch = 15, cex = 1.5)
  #text(0.011, 0.8, "D = 0 mu", cex = 2.0)
  text(0.014, 0.8, "D = 0", cex = 2.0)
  text(0.010, 0.7, "D = 1 mu", cex = 2.0)
  text(0.033, 0.5, "D = 2 mu", cex = 2.0)
  #
  #text(0.016, 0.8, expression(paste("D = ", 1, mu)), cex = 1.5)
  #text(0.014, 0.7, expression(paste("D = ", 2, mu)), cex = 1.5)
  #text(0.028, 0.5, expression(paste("D = ", 3, mu)), cex = 1.5)
  dev.off()
}
ROCplotimprovement("D:/_tmp/20150330/sim3/NotadAptivePerf.txt", "D:/_tmp/20150330/sim3/DelayVsPerformance.txt", "D:/_tmp/_toPaper/ROCImprovementAndDelay3.pdf")

tstprobsconf = read.table("D:/_tmp/20150330/sim3/tstconfprobs.txt", header=F)$V1
plot(tstprobsconf)
###
tstdynamich = read.table("D:/_tmp/20150330/sim3/tstdynamich.txt", header=F)$V1
plot(tstdynamich, typ = 'l')
###
plot(probs2, typ = 'b')
lines(probs2, col = "blue")
abline(v = seq(10, 100, 10))

# sig = read.table("D:/_tmp/20150330/sim3/signal.txt", header=F)$V1
# par(mfrow = c(2,1))
# plot(sigexmpl, typ = 'b')
#
# probsconf = read.table("D:/_tmp/20150330/sim3/confProbs.txt", header=F)$V1
# plot(probs2, type = 'l')
# lines(probsconf, col = "red")
#
# dh = read.table("D:/_tmp/20150330/sim3/Dynthr.txt", header=F)$V1
# plot(probs2, type = 'l')
# lines(dh, typ = 'l')
#
# tsig = read.table("D:/_tmp/20150330/sim3/tstsig.txt", header=F)$V1
# tchps = read.table("D:/_tmp/20150330/sim3/tstchps.txt", header=F)$V1
# plot(tsig)
# abline(v = tchps)


#############################################################
# Load libraries
# Ref: https://rstudio.github.io/shinydashboard/structure.html
#############################################################
library(shiny)
library(shinydashboard)
library(dashboardthemes)
library(leaflet)
library(ggplot2)
library(maps)
#library(ggmap)
#library(mapproj)
library(dplyr)
library(tidyr)
library(sqldf)
library(scales)
library(plotly)
library(data.table)
states_map <- map_data("state")

#############################################################
# Data Preprocessing
#############################################################

# CRIMES DATASET
crimes_df <- read.csv('crimes_df.csv')
crimes_df$state <- tolower(crimes_df$state)

# # read data set and the shapes for drawing states from map package then create a data set where state names and order match mapStates.
# mapStates = map("state", fill = TRUE, plot = FALSE)
#
# snames_c <- data.frame(mapStates$names)
# colnames(snames_c) <- c("state")
# snames_c$state <- gsub(":.*", "", snames_c$state)
# npop_c <- merge(snames_c, crimes_df, by="state")
#
# stcenters <- data.frame(tolower(state.name), state.center)
# colnames(stcenters) <- c("state","Lon","Lat")
# snpop_c <- merge(npop_c, stcenters, by="state")

#gnpop = gather(npop, State)
#colnames(gnpop) <- c("State", "Year", "Pop")
#gnpop_c = gather(npop_c, Year, Pop, -State)

metrics_list <- c('state', 'population', 'violent_crime', 'murder_and_manslaughter', 'rape_legacy', 'rape_revised', 'robbery', 'aggravated_assault', 'property_crime', 'burglary', 'larceny_theft', 'mvt', 'violent_crime_rate', 'murder_manslaughter_rate', 'rape_legacy_rate', 'rape_revised_rate', 'robbery_rate', 'aggravated_assault_rate', 'property_crime_rate', 'burglary_rate', 'larceny_theft_rate', 'mvt_rate', 'year')

##################
# TEST DATASET
##################
# read data set and the shapes for drawing states from map package then create a data set where state names and order match mapStates.
pop <- read.csv('pop_state_proj.csv')
pop$State <- tolower(pop$State)
pal <- colorNumeric("YlOrRd", domain = c(0,47000000))
mapStates = map("state", fill = TRUE, plot = FALSE)

snames <- data.frame(mapStates$names)
colnames(snames) <- c("State")
snames$State <- gsub(":.*", "", snames$State)
npop <- merge(snames, pop, by="State")

stcenters <- data.frame(tolower(state.name), state.center)
colnames(stcenters) <- c("State","Lon","Lat")
snpop <- merge(npop, stcenters, by="State")

#gnpop = gather(npop, State)
#colnames(gnpop) <- c("State", "Year", "Pop")
gnpop = gather(npop, Year,Pop, -State)

#############################################################
# UI Function
#############################################################
ui <- dashboardPage(skin = "black",
  dashboardHeader(title = "FBI Crime Data",
                  dropdownMenu(
                    type = "notifications",
                    icon = icon("question-circle"),
                    badgeStatus = NULL,
                    headerText = "More links:",
                    notificationItem("git repo", icon = icon("github"),
                                    href = "https://github.com/rjfranssen/crime-dash"),
                    notificationItem("shiny", icon = icon("r-project"),
                                     href = "http://shiny.rstudio.com/"),
                    notificationItem("shinydashboard", icon = icon("r-project"),
                                     href = "https://rstudio.github.io/shinydashboard/")
                    )
                  ),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Crimes Dash 1", tabName = "crimes-dash-1", icon=icon("dashboard")),
      menuItem("Crimes Dash 2", tabName = "crimes-dash-2", icon=icon("dashboard")),
      menuItem("Interactive Map", tabName = "interactive-map", icon=icon("globe")),
      menuItem("(Test Dash)", tabName = "test-dashboard-tab-id", icon=icon("dashboard"))
      #menuItem("Raw data", tabName = "rawdata-tab-id", icon = icon("th"))
    )
  ),

  dashboardBody(
    #shinyDashboardThemes(
    #  theme = "grey_dark"
    #),
    tabItems(

      #############################################################
      # CRIMES DASH 2
      #############################################################
      tabItem(tabName="crimes-dash-1",
              fluidRow(
                column(4, selectInput(inputId="select_state_1", label="State: ", choices=snames, selected="pennsylvania")),
                column(4, selectInput(inputId="select_metric_1", label="Metric: ", choices=metrics_list, selected="mvt"))
              ),
              fluidRow(
                column(8, plotlyOutput('crimes_plot_1'))
              )
      ),
      #############################################################

      #############################################################
      # CRIMES DASH 2
      #############################################################
      tabItem(tabName="crimes-dash-2",
              fluidRow(
                #column(4, selectInput(inputId="select_state_2", label="State: ", choices=snames, selected="pennsylvania")),
                column(4, selectInput(inputId="select_metric_2", label="Metric: ", choices=metrics_list, selected="mvt"))
              ),
              fluidRow(
                column(8, plotlyOutput('crimes_plot_2'))
              )
      ),
      #############################################################

      #############################################################
      # TEST DASHBOARD
      #############################################################
      tabItem(tabName="test-dashboard-tab-id",
              fluidRow(
                #box(leafletOutput('map')),
                #box("Box content here", br(), "More box content",
                #    plotOutput('plot'),
                #    sliderInput("slider", "Slider input:", 1, 100, 50),
                #    textInput("text", "Text input:")
                #    ),
                column(6, leafletOutput('map')),
                column(6, plotOutput('plot'))
              ),
              fluidRow(column(4,verbatimTextOutput('text')),
                       column(8, sliderInput("slider","Years", min=2000, max=2030, step=5, value=2000, sep="")))
      ),
      #############################################################

      #############################################################
      # INTERACTIVE MAP
      #############################################################
      tabItem(tabName="interactive-map",
              fluidRow(
                column(4,verbatimTextOutput('text_3')),
                column(4, selectInput(inputId="select_metric_3", label="Metric: ", choices=metrics_list, selected="mvt")),
                column(4, sliderInput("slider_3","Year", min=1994, max=2012, step=2, value=2012, sep=""))
              ),

              fluidRow(
                column(8, leafletOutput('crimes_map_3'))
              ),

              fluidRow(
                column(8, plotOutput('crimes_plot_3'))
              )
      )
      #############################################################
    )

  )
)

#############################################################
# Server Function
#############################################################
server <- function(input, output) {

  #############################################################
  # CRIMES DASHBOARD
  #############################################################

  #############################################################################
  # 1. CRIMES BAR CHART SELECTABLE
  #############################################################################

  # Faceting by metric
  output$crimes_plot_1 <- renderPlotly({

    #plot_data_1 <- crimes_df %>% filter(state==input$select_state_1) %>% select(year, state, mvt)
    plot_data_1 <- crimes_df %>% filter(state==input$select_state_1) %>% select(year, state, input$select_metric_1)
    plot_data_long_1 <- melt(as.data.table(plot_data_1), id.vars = c('state', 'year'))

    plt_1 <- ggplot(plot_data_long_1, aes(x=year, y=value)) +
      #geom_boxplot(aes(group=year, color=year)) +
      geom_bar(stat = "identity") +
      #geom_jitter(width = 0.2) +
      #facet_wrap(~variable, scales="free") +
      #facet_wrap(~year, scales="free") +
      #coord_flip() +
      ylab("Motor Vehicle Thefts") +
      #xlab("") +
      #ggtitle(paste0("Motor Vehicle Thefts in ", input$select_state_1, " per 100k People from 1994-2012")) +
      theme(axis.text.x = element_text(angle = 90))

    ggplotly(plt_1)

  })

  #############################################################################
  # 2. CRIMES BAR CHART AVG BY STATE
  #############################################################################

  output$crimes_plot_2 <- renderPlotly({

  #options(repr.plot.width=12, repr.plot.height=8)

  plot_data_2 <- sqldf(paste0("select state, avg(", input$select_metric_2, ") as avg_rate from crimes_df group by 1 order by 1"))

  plt_2 <- ggplot(plot_data_2, aes(x=state, y=avg_rate)) +
    geom_bar(stat = "identity") +
    scale_y_continuous(label=comma) +
    ggtitle(paste0("Average Rates of ", input$select_metric_2, " per 100k People from 1994-2012")) +
    ylab(paste0(input$select_metric_2)) +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 90))

  ggplotly(plt_2)

  })

  #############################################################################
  # 3. Interactive Map
  #############################################################################

  # INITIALIZE REACT VARIABLES
  reac_3 <- reactiveValues(year=1994, metric='mvt')

  # MAKE REAC DEPENDENT ON INPUT$SLIDER (update reac$year)
  observe ({

    # if (input$slider_1 == "2000") {
    #   reac_1$year = paste0("Census_", input$slider_1)
    # }
    # else {
    #   reac_1$year = paste0("Proj_",input$slider_1)
    # }

    reac_3$year = input$slider_3

    reac_3$metric = input$select_metric_3

  })

  # CREATE MAP OUTPUT (map)
  output$crimes_map_3 = renderLeaflet({

    # UPDATE THE MAP WHENEVER REAC$YEAR IS CHANGED
    map_data <- crimes_df %>% filter(year==reac_3$year) %>% select(reac_3$metric)
    colnames(map_data) <- c('variable')
    pal_3 <- colorNumeric("YlOrRd", domain = c(min(map_data), max(map_data)))

    crimes_map_3 <- leaflet(data = mapStates) %>%
      addTiles() %>%

      # Add State Polygons - fillColor based on population for year selected
      #addPolygons(fillColor = ~pal(crimes_df %>% filter(year==reac_3$year) %>% select(reac_3$metric)),
      addPolygons(fillColor = ~pal_3(map_data$variable),
                  weight = 1,
                  opacity = 1,
                  color = "white",
                  fillOpacity = 0.9,
                  highlight = highlightOptions(
                    weight = 5,
                    color = "#666",
                    fillOpacity = 0.9,
                    bringToFront = TRUE)
      )

    crimes_map_3
  })

  #############################################################
  # TEST DASHBOARD FOR POP DATASET
  #############################################################
  # INITIALIZE REACT VARIABLES
  reac <- reactiveValues (year = "Census_2000", state = "missouri")

  # MAKE REAC DEPENDENT ON INPUT$SLIDER (update reac$year)
  observe ({

    if (input$slider == "2000") {
      reac$year = paste0("Census_", input$slider)
    }
    else {
      reac$year = paste0("Proj_",input$slider)
    }
  })

  # CREATE MAP OUTPUT (map)
  output$map = renderLeaflet({

    # UPDATE THE MAP WHENEVER REAC$YEAR IS CHANGED
    map <- leaflet(data = mapStates) %>%
      addTiles() %>%

      # Add State Polygons - fillColor based on population for year selected
      addPolygons(fillColor = ~pal(npop[[reac$year]]),
                  weight = 1,
                  opacity = 1,
                  color = "white",
                  fillOpacity = 0.9,
                  highlight = highlightOptions(
                    weight = 5,
                    color = "#666",
                    fillOpacity = 0.9,
                    bringToFront = TRUE)
      ) %>%

      # Add Circles - Radius based on population in year 2000
      addCircles(~snpop$Lon, ~snpop$Lat, radius=~sqrt(snpop$Census_2000)*10,
                 color="orange",
                 stroke = TRUE,
                 fillOpacity = 0.2,
                 popup = ~as.character(snpop$State)
      )

    map
  })

  # CREATE BARCHART OUTPUT (plot)
  output$plot = renderPlot({

    # UPDATE THE CHART WHENEVER REAC$STATE IS CHANGED
    p <- ggplot(data=subset(gnpop, State==reac$state), aes(x=Year, y=Pop, group=reac$state)) +
      # 1- The plot on the right should have line plots for all states grayed out as in the example app link.
      # 3- The annotations on the right plot should be prominently placed (font, size, etc.) like in the example.
      #geom_bar(stat="identity") +
      geom_line(data=gnpop, aes(x=Year, y=Pop, group=State), color="lightgrey", size=1) + # All States
      geom_line(position='identity', size=3) + # SELECTED STATE Need to add 'group' to aesthetic for geom_line
      ylim(0, 47000000) +
      ggtitle(paste0(reac$state, " population projection"))

    p
  })

  # OBSERVE LEAFLET OBJECT EVENT CLICK
  # 2- When the user hovers over a state, the state's line on the right plot should be drawn in darker color.
  #observeEvent(input$map_shape_click, {
  observeEvent(input$map_shape_mouseover, {

    # GET THE COORDINATES FOR THE SHAPE CLICK EVENT
    lon <- input$map_shape_mouseover$lng
    lat <- input$map_shape_mouseover$lat

    # USE MAP.WHERE TO FIND THE STATE NAME BASED ON THE CLICK COORDINATES ("maps" package)
    st <- map.where("state", lon, lat)

    # UPDATE REAC$STATE WITH THE CLICK EVENT - WILL TRIGGER PLOT UPDATE
    # 4- At least: state's name and population should be displayed in the annotation.
    reac$state <- gsub(":.*", "", st)  # get everything until : character
    output$text <- renderPrint(paste0("State: ", isolate(reac$state), " Population: ", gnpop[gnpop$State==reac$state & gnpop$Year==reac$year,]$Pop))
  })
}

#############################################################
# Start App
#############################################################
#shinyApp(ui=ui, server=server)
shinyApp(ui=ui, server=server, options = list(display.mode = 'showcase'))
# Ref for display modes: https://shiny.rstudio.com/articles/display-modes.html


#' Stacks arrays while respecting names in each dimension
#'
#' @param ...         N-dimensional arrays, or a list thereof
#' @param along       Which axis arrays should be stacked on (default: new axis)
#' @param fill        Value for unknown values (default: \code{NA})
#' @param drop        Drop unused dimensions (default: FALSE)
#' @param keep_empty  Keep empty elements when stacking (default: FALSE)
#' @param allow_overwrite  Overwrite values if more arrays share same key
#' @param fail_if_empty    Stop if no arrays left after removing empty elements
#' @return            A stacked array, either n or n+1 dimensional
#' @export
stack = function(..., along=length(dim(arrayList[[1]]))+1, fill=NA, drop=FALSE,
                 keep_empty=FALSE, allow_overwrite=FALSE, fail_if_empty=TRUE) {

    arrayList = list(...)
    if (length(arrayList) == 1 && is.list(arrayList[[1]]))
        arrayList = arrayList[[1]]

    if (!is.list(arrayList))
        stop(paste("arrayList needs to be a list, not a", class(arrayList)))
    length0 = sapply(arrayList, length) == 0
    if (!keep_empty && any(length0)) {
        drop_idx = names(arrayList)[length0]
        if (is.null(drop_idx))
            drop_idx = which(length0)
        arrayList = arrayList[!length0]
    }
    if (length(arrayList) == 0) {
        if (fail_if_empty)
            stop("No element remaining after removing NULL entries")
        else
            return(NULL)
    }

    arrayList = vectors_to_row_or_col(arrayList, along=along)

    newAxis = FALSE
    if (along > length(dim(arrayList[[1]])))
        newAxis = TRUE

    # get dimension names; dimNames is set of all elements in list
    dn = dimnames(arrayList)
    dimNames = lapply(1:length(dn[[1]]), function(j)
        unique(c(unlist(sapply(1:length(dn), function(i)
            dn[[i]][[j]]
        ))))
    )
    # check if names are valid
    all_names = unlist(dimNames)
    if (any(is.na(all_names)))
        stop("NA found in list dimension names")
    if (any(nchar(all_names) == 0))
        stop("Empty dimension name found in list")

    # track the stacking dimension index if there are no names
    stack_offset = FALSE
    ndim = sapply(dimNames, length)
    if (along <= length(ndim) && ndim[along] == 0) {
        ndim[along] = sum(sapply(arrayList, function(x) dim(x)[along]))
        stack_offset = TRUE
    }
    if (any(ndim == 0))
        stop("Names are required for all dimensions except the one stacked along.
  Use bind() if you want to just bind together arrays without names.")

    # if creating new axis, amend ndim and dimNames
    if (newAxis) {
        dimNames = c(dimNames, list(names(arrayList)))
        ndim = c(ndim, length(arrayList))
    }

    # create an empty result matrix
    result = array(fill, dim=ndim, dimnames=dimNames)

    # fill each result matrix slice with matched values of arrayList
    offset = 0
    pb = pb(length(arrayList))
    for (i in seq_along(arrayList)) {
        dm = dimnames(arrayList[[i]], null_as_integer=TRUE)
        if (stack_offset) {
            dm[[along]] = dm[[along]] + offset
            offset = offset + dim(arrayList[[i]])[along]
        }

        if (newAxis)
            dm[[along]] = i
        else {
            # do not overwrite values unless empty or the same
            slice = do.call("[", c(list(result), dm, drop=FALSE))
            if (!allow_overwrite && (!all(slice==fill | is.na(slice) | slice==arrayList[[i]])))
                stop("value aggregation not allowed, stack along new axis+summarize after")
        }

        # assign to the slice if there are any values in it
        result = do.call("[<-", c(list(result), dm, list(arrayList[[i]])))
        pb$tick()
    }

    drop_if(result, drop)
}


#' Generate R code to reproduce a SEM model
#'
#' Generate R code from your data frame, an existing covariance matrix, or
#' a \code{lavaan} object. The R code reproduces your structural equation model
#' (SEM) to support open science with minimal effort, and makes it easy to
#' supply your code to a journal article, or to share your model with others
#' without sharing your full dataset that may contain sensitive information.
#'
#' Semproducible is useful when you need to create a reproducible covariance
#' matrix that can be used by a structural equation model (SEM) in
#' \code{\link[lavaan:sem]{lavaan}}.
#'
#' You supply a data frame with numeric variables (or a covariance matrix that
#' you have already prepared).{\code{semproducible} then generates R code that
#' can reproduce the SEM model as a covariance matrix.
#'
#' You can also directly supply a lavaan SEM model, and semproducible will use
#' the fitted (observed) covariance matrix and produce R code that reproduce the
#' model, using the estimator of your lavaan model. Note, however, that this
#' will not give you all the possible models that you could have ran with all
#' the data, but only the variables that are passed to lavaan.
#'
#' @param x a \code{\link[base:data.frame]{data.frame}} with numeric variables,
#' a \code{\link[base:matrix]{matrix}} with covariances, or a fitted
#' \code{\link[lavaan:sem]{lavaan}} object that you want to reproduce.
#' @param formula character string with a custom lavaan formula syntax
#' (e.g. \code{y ~ x}) that should be included in the code. If formula is
#' \code{NULL}, and \code{x} is a lavaan object, then a formula is generated
#' automatically from the lavaan object.
#' @param target_variable character string with arbitrary target variable name
#' for the generated covariance matrix. Defaults to \code{"cov_mat"}.
#' @param digits number of decimal digits of the covariance matrix. The
#' default (\code{NULL}) will show all available digits as specified by your R
#' options. The higher the number of decimal digits, the more accurate the
#' reproducible model will be.
#' @param drop_non_numeric whether non-numeric columns should be dropped
#' from the data frame. This is useful if you have characters or factors as
#' columns, which should be excluded from the covariance matrix. Defaults to
#' \code{FALSE}.
#' @param vars_per_line number of variables/values per line. Use a low
#' value to decrease the width of the generated code.
#' @param eval whether the generated code and \code{\link[lavaan:sem]{lavaan}}
#' model will be executed during generation. If \code{TRUE}, a message will
#' tell you whether the code executed with errors or not.
#' @param use character string for computing the covariances in the presence
#' of missing values. This value is simply passed on to the \code{use}
#' parameter of the \code{\link[stats:cor]{cov}} function. The value must be
#' \code{everything}, \code{all.obs}, \code{complete.obs},
#' \code{na.or.complete}, or \code{pairwise.complete.obs}.
#' @param template a character string with a custom code template that
#' is used when generating the R code. A \code{NULL} value (default) will use
#' the default template from \code{\link{code_template}}.
#' @return a character string with the generated R code.
#' @export
#'
#' @examples
#' \dontrun{
#' library(semproducible)
#' library(lavaan)
#'
#' # Create random data.
#' set.seed(5543)
#' data <- data.frame(x = rnorm(100),
#'                    y = rnorm(100),
#'                    z = rnorm(100),
#'                    w = rnorm(100),
#'                    q = rnorm(100))
#'
#' # Generate R code for the data.
#' code <- semproducible(data, formula="y ~ x")
#'
#' # Use 5 decimal digits.
#' code <- semproducible(data, formula="y ~ x", digits=5)
#'
#' # Restrict number of values per line to 4.
#' code <- semproducible(data, formula="y ~ x", digits=5, vars_per_line=4)
#'
#' # View code.
#' cat(code)
#'
#' # Save code to a file.
#' save_code(code, "create_data.r")
#'
#' # Reproduce lavaan object (from http://lavaan.ugent.be/tutorial/cfa.html)
#' HS.model <- ' visual  =~ x1 + x2 + x3
#'               textual =~ x4 + x5 + x6
#'               speed   =~ x7 + x8 + x9 '
#' fit <- cfa(HS.model, data=HolzingerSwineford1939)
#' code <- semproducible(fit)
#' }
semproducible <- function(x, formula = NULL, target_variable = "cov_mat",
                          digits = NULL, drop_non_numeric = FALSE,
                          vars_per_line = 9, eval = FALSE, use = "complete.obs",
                          template = NULL) {
  # Check inputs for errors.
  if ("matrix" %in% class(x)) {
    input_type <- "matrix"
    cov_mat <- x
  } else if ("lavaan" %in% class(x)) {
    input_type <- "lavaan"
  } else if (is.data.frame(x)) {
    input_type <- "data.frame"
  } else {
    stop("x must be of type 'matrix', 'data.frame' or 'lavaan'.")
  }

  # Check for non-numeric columns (doesn't apply to matrices).
  if (input_type == "data.frame") {
    # Check that all columns are numeric, throw error if not.
    non_numeric_cols <- NCOL(x) - sum(sapply(x, is.numeric))
    if (drop_non_numeric & non_numeric_cols != 0) {
      # Drop all non-numeric columns.
      x_raw <- x
      x <- x[sapply(x, is.numeric)]
      num_columns_dropped <- NCOL(x_raw) - NCOL(x)
      columns_dropped <- paste(names(setdiff(x_raw, x)), collapse=" ")
      message(paste("Dropped", num_columns_dropped, "non-numeric column(s):",
                    columns_dropped, sep=" "))
    } else if (non_numeric_cols != 0) {
      # Get name of non-numeric columns.
      non_numeric_colums <- paste(names(x[!sapply(x, is.numeric)]),
                                  collapse=" ")
      # Throw error.
      stop(paste("x contain ", non_numeric_cols, " non-numeric column(s).",
                 " Use 'drop_non_numeric = TRUE' to remove them",
                 " automatically, or remove them manually.\n",
                 "Columns: ", trimws(non_numeric_colums), sep=""),
           call. = FALSE)
    }
  }

  # Create covariance matrix if it's not already.
  if (input_type == "data.frame") {
    cov_mat <- stats::cov(x, use=use)
  }

  # Default lavaan call.
  lavaan_call <- paste("lavaan::sem(model = model,",
                       "sample.cov = %%TARGET%%,",
                       "sample.nobs = observations)")

  # Get the number of observations in the data frame or matrix.
  num_observations <- NROW(x)

  # Extract lavaan objects.
  if (input_type == "lavaan") {
    cov_mat <- lavaan::lavInspect(x, what = "sampstat")
    if (class(cov_mat) == "list") {
      cov_mat <- cov_mat$cov
      num_observations <- lavaan::nobs(x)
      # Get laavan call, replace name of data variable.
      lavaan_call <- x@call
      lavaan_call$data <- NULL
      lavaan_call$sample.nobs <- "%NOBS%"
      lavaan_call$sample.cov <- "%COV%"
      lavaan_call <- paste0(utils::capture.output(lavaan_call), collapse="\n")
      lavaan_call <- gsub('"%NOBS%"', "observations", lavaan_call)
      lavaan_call <- gsub('"%COV%"', target_variable, lavaan_call)
    }

    # Extract lavaan parameter estimates and generate formula.
    if (is.null(formula)) {
      est <- lavaan::parameterEstimates(x)
      formula <- paste(stringi::stri_c(est$lhs, " ", est$op, " ", est$rhs),
                       collapse="\n")
    }
  }

  # Indenting covariance values.
  #indent <- paste0(rep(" ", 14), collapse = "")
  indent <- " "

  # Generate variable names.
  var_names <- ""
  var_i <- 0
  for (variable in row.names(cov_mat)) {
    var_i <- var_i + 1
    var_names <- stringi::stri_c(var_names, "~", variable, ", ")
    if (var_i >= vars_per_line) {
      # Add line break after a specific number of variables.
      var_names <- stringi::stri_c(var_names, "\n")
      var_i <- 0
    }
  }

  # Generate values.
  values <- ""
  var_i <- 0
  for (i in seq.int(ncol(cov_mat))) {
    for (j in seq(ncol(cov_mat))) {
      var_i <- var_i + 1
      if (is.null(digits)) {
        value <- cov_mat[i, j]
      } else {
        value <- round(cov_mat[i, j], digits=digits)
      }
      values <- stringi::stri_c(values, value, ", ", sep="")
      if (var_i >= vars_per_line) {
        # Add line break after a specific number of variables.
        values <- stringi::stri_c(values, "\n")
        var_i <- 0
      }
    }
  }
  # Remove superfluous comma (,) at the end of values.
  values <- trimws(values, which = "right")
  values <- substr(values, 1, nchar(values) - 1)

  # Use default or custom code template.
  if (is.null(template)) {
    code <- code_template()
  } else {
    code <- template
  }

  # Replace placeholders with variable names and variable values.
  code <- gsub("%%LAVAAN_CALL%%", lavaan_call, code)
  code <- gsub("%%OBSERVATIONS%%", num_observations, code)
  code <- gsub("%%FORMULA%%", formula, code)
  code <- gsub("%%TARGET%%", target_variable, code)
  code <- gsub("%%VARIABLES%%", var_names, code)
  code <- gsub("%%VALUES%%", values, code)

  # Run the code to check for errors?
  if (eval) {
    if (is.null(formula)) {
      stop("No lavaan formula specified, cannot evaluate lavaan model.",
           call. = FALSE)
    }
    if (is.null(code)) {
      stop("No code was generated, cannot evaluate code or lavaan model.",
           call. = FALSE)
    }
    tryCatch(utils::capture.output(base::eval(parse(text = code))),
             error = function(e) stop(e))
    message("Code and lavaan model evaluated successfully.")
  }
  return(code)
}