x <- 1:4; y <- 6:9
x + y
x > 2
x >= 2
y == 8
x * y
x / y

x <- matrix(1:4, 2, 2); y <- matrix(rep(10,4),2,2)

x * y
x / y
x %*% y

# Subsetting

x[1]

x <- c("a","b","c","c","d","a")
x[2]
x[2:4]
x[c(2:3,5)]
x>"a"
x[x>"a"]
x[x=="c"]

u <- x > "a"
u
x[u]

x <- matrix(1:6, 2, 3)
x
x[1,2]
x[2,1]
x[,3]

colnames(x) <- c("a", "b", "c")

x[1,"b"]
x[,"c"]

x <- matrix(1:6, 2, 3)
x[1,2]
x[1,2, drop=FALSE]

y <-x[1:2, 1:2, drop=FALSE]
y

z <-x[1:2, 1:2]
z

x <- matrix(1:6, 2, 3)
print("x[1,]")
x[1,]
print("imprimindo x", quote = TRUE)

print("Com drop")
x[1, , drop = FALSE]

x <- list(foo = 1:4, bar = 0.6)
print("----")
x[1]
x$foo

x[[2]]
x$bar
x[["bar"]]
x["bar"]

f <- function(dataf, col_inicio, col_fim){
  n <- names(dataf)

  datar <- data.frame(matrix(ncol = length(n), nrow = nrow(dataf)))
  colnames(datar) <- n

  for(colname in n){
    print(colname)
    datar[colname] <- sapply(dataf[colname], mean)
  }

  return(datar)
}


arabica <-
  read.csv(
    url(
      "https://raw.githubusercontent.com/jldbc/coffee-quality-database/master/data/arabica_data_cleaned.csv"
    )
  )
robusta <-
  read.csv(
    url(
      "https://raw.githubusercontent.com/jldbc/coffee-quality-database/master/data/robusta_data_cleaned.csv"
    )
  )

pointsArabica <-
  data.frame(points = arabica$Total.Cup.Points, species = "arabica")
pointsRobusta <-
  data.frame(points = robusta$Total.Cup.Points, species = "robusta")

points <- rbind(pointsArabica, pointsRobusta)

library(ggplot2)

ggplot(data = points, aes(x = species)) +
  geom_bar(aes(fill = species)) +
  scale_fill_manual(values = c("#00ff00", "#0000ff")) +
  labs(x = "Species", y = "Count", title = "Total observations") +
  theme_minimal()

ggplot(data = points, aes(x = points)) +
  geom_density(aes(fill = species, alpha = species)) +
  scale_fill_manual(values = c("#00ff00", "#0000ff")) +
  scale_alpha_manual(values = c(1, 0.25)) +
  scale_x_continuous(breaks = round(seq(
    min(points$points), max(points$points), by = 3
  ), 1)) +
  labs(x = "Total Cup Points", y = "Density", title = "Total Cup Points distribution by species") +
  theme_minimal()

library("corrplot")

corrplot(
  cor = cor(x = arabica[c(13, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 36, 42, 43, 44)], use =
              "na.or.complete", method = "spearman"),
  method = "number",
  order = "hclust"
)

corrplot(
  cor = cor(x = robusta[c(13, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 36, 42, 43, 44)], use =
              "na.or.complete", method = "spearman"),
  method = "number",
  order = "hclust"
)

# Arabica

## Acidity / Altitude

j1 <- position_jitter(width = 0.1, height = 0.1)

ggplot(
  data = arabica,
  aes(
    x = Acidity,
    y = altitude_mean_meters,
    size = Total.Cup.Points,
    color = Country.of.Origin
  )
) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(85, 87.5, 90),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(
    name = "Origin",
    values = c(
      "#808080",
      "#556b2f",
      "#006400",
      "#8b0000",
      "#808000",
      "#483d8b",
      "#3cb371",
      "#008080",
      "#4682b4",
      "#000080",
      "#9acd32",
      "#32cd32",
      "#daa520",
      "#7f007f",
      "#b03060",
      "#d2b48c",
      "#ff4500",
      "#00ced1",
      "#ff8c00",
      "#ffff00",
      "#7fff00",
      "#00fa9a",
      "#8a2be2",
      "#dc143c",
      "#9370db",
      "#0000ff",
      "#f08080",
      "#ff7f50",
      "#ff00ff",
      "#1e90ff",
      "#f0e68c",
      "#dda0dd",
      "#add8e6",
      "#ee82ee",
      "#7fffd4",
      "#ff69b4",
      "#ffc0cb"
    )
  ) +
  geom_point(position = j1, alpha = .666) +
  xlim(5.25, 8.75) +
  ylim(0, 2750) +
  labs(x = "Acidity", y = "Altitude [m]", title = "Acidity / Altitude / Total Cup Points (bubble size) / Origin") +
  theme_minimal()

ggplot(
  data = arabica,
  aes(
    x = Acidity,
    y = altitude_mean_meters,
    size = Total.Cup.Points,
    color = Variety
  )
) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(85, 87.5, 90),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(
    name = "Variety",
    values = c(
      "#696969",
      "#556b2f",
      "#228b22",
      "#7f0000",
      "#483d8b",
      "#008b8b",
      "#9acd32",
      "#00008b",
      "#daa520",
      "#7f007f",
      "#8fbc8f",
      "#b03060",
      "#ff0000",
      "#ffff00",
      "#7cfc00",
      "#deb887",
      "#8a2be2",
      "#00ff7f",
      "#dc143c",
      "#00ffff",
      "#00bfff",
      "#0000ff",
      "#ff7f50",
      "#ff00ff",
      "#1e90ff",
      "#90ee90",
      "#add8e6",
      "#ff1493",
      "#ee82ee",
      "#ffc0cb"
    )
  ) +
  geom_point(position = j1, alpha = .666) +
  xlim(5.25, 8.75) +
  ylim(0, 2750) +
  labs(x = "Acidity", y = "Altitude [m]", title = "Acidity / Altitude / Total Cup Points (bubble size) / Variety") +
  theme_minimal()

ggplot(
  data = arabica,
  aes(
    x = Acidity,
    y = altitude_mean_meters,
    size = Total.Cup.Points,
    color = Processing.Method
  )
) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(85, 87.5, 90),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(
    name = "Processing Method",
    values = c(
      "#66cdaa",
      "#ffa500",
      "#00ff00",
      "#0000ff",
      "#1e90ff",
      "#ff1493"
    )
  ) +
  geom_point(position = j1, alpha = .666) +
  xlim(5.25, 8.75) +
  ylim(0, 2750) +
  labs(x = "Acidity", y = "Altitude [m]", title = "Acidity / Altitude / Total Cup Points (bubble size) / Processing Method") +
  theme_minimal()

## Balance / Moisture

j2 <- position_jitter(width = 0.1, height = 0.01)

ggplot(data = arabica,
       aes(
         x = Balance,
         y = Moisture,
         size = Total.Cup.Points,
         color = Country.of.Origin
       )) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(85, 87.5, 90),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(
    name = "Origin",
    values = c(
      "#808080",
      "#556b2f",
      "#006400",
      "#8b0000",
      "#808000",
      "#483d8b",
      "#3cb371",
      "#008080",
      "#4682b4",
      "#000080",
      "#9acd32",
      "#32cd32",
      "#daa520",
      "#7f007f",
      "#b03060",
      "#d2b48c",
      "#ff4500",
      "#00ced1",
      "#ff8c00",
      "#ffff00",
      "#7fff00",
      "#00fa9a",
      "#8a2be2",
      "#dc143c",
      "#9370db",
      "#0000ff",
      "#f08080",
      "#ff7f50",
      "#ff00ff",
      "#1e90ff",
      "#f0e68c",
      "#dda0dd",
      "#add8e6",
      "#ee82ee",
      "#7fffd4",
      "#ff69b4",
      "#ffc0cb"
    )
  ) +
  geom_point(position = j2, alpha = .666) +
  xlim(6, 9) +
  labs(x = "Balance", y = "Moisture", title = "Balance / Moisture / Total Cup Points (bubble size) / Origin") +
  theme_minimal()

ggplot(data = arabica,
       aes(
         x = Balance,
         y = Moisture,
         size = Total.Cup.Points,
         color = Variety
       )) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(85, 87.5, 90),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(
    name = "Variety",
    values = c(
      "#696969",
      "#556b2f",
      "#228b22",
      "#7f0000",
      "#483d8b",
      "#008b8b",
      "#9acd32",
      "#00008b",
      "#daa520",
      "#7f007f",
      "#8fbc8f",
      "#b03060",
      "#ff0000",
      "#ffff00",
      "#7cfc00",
      "#deb887",
      "#8a2be2",
      "#00ff7f",
      "#dc143c",
      "#00ffff",
      "#00bfff",
      "#0000ff",
      "#ff7f50",
      "#ff00ff",
      "#1e90ff",
      "#90ee90",
      "#add8e6",
      "#ff1493",
      "#ee82ee",
      "#ffc0cb"
    )
  ) +
  geom_point(position = j2, alpha = .666) +
  xlim(6, 9) +
  labs(x = "Balance", y = "Moisture", title = "Balance / Moisture / Total Cup Points (bubble size) / Variety") +
  theme_minimal()

ggplot(data = arabica,
       aes(
         x = Balance,
         y = Moisture,
         size = Total.Cup.Points,
         color = Processing.Method
       )) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(85, 87.5, 90),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(
    name = "Processing Method",
    values = c(
      "#66cdaa",
      "#ffa500",
      "#00ff00",
      "#0000ff",
      "#1e90ff",
      "#ff1493"
    )
  ) +
  geom_point(position = j2, alpha = .666) +
  xlim(6, 9) +
  labs(x = "Balance", y = "Moisture", title = "Balance / Moisture / Total Cup Points (bubble size) / Processing Method") +
  theme_minimal()

## Category Two Defects / Aftertaste

j3 <- position_jitter(width = 0.1, height = 0.1)

ggplot(
  data = arabica,
  aes(
    x = Category.Two.Defects,
    y = Aftertaste,
    size = Total.Cup.Points,
    color = Country.of.Origin
  )
) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(85, 87.5, 90),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(
    name = "Origin",
    values = c(
      "#808080",
      "#556b2f",
      "#006400",
      "#8b0000",
      "#808000",
      "#483d8b",
      "#3cb371",
      "#008080",
      "#4682b4",
      "#000080",
      "#9acd32",
      "#32cd32",
      "#daa520",
      "#7f007f",
      "#b03060",
      "#d2b48c",
      "#ff4500",
      "#00ced1",
      "#ff8c00",
      "#ffff00",
      "#7fff00",
      "#00fa9a",
      "#8a2be2",
      "#dc143c",
      "#9370db",
      "#0000ff",
      "#f08080",
      "#ff7f50",
      "#ff00ff",
      "#1e90ff",
      "#f0e68c",
      "#dda0dd",
      "#add8e6",
      "#ee82ee",
      "#7fffd4",
      "#ff69b4",
      "#ffc0cb"
    )
  ) +
  geom_point(position = j3, alpha = .666) +
  ylim(6, 9) +
  labs(x = "Category Two Defects", y = "Aftertaste", title = "Category Two Defects / Aftertaste / Total Cup Points (bubble size) / Origin") +
  theme_minimal()

ggplot(
  data = arabica,
  aes(
    x = Category.Two.Defects,
    y = Aftertaste,
    size = Total.Cup.Points,
    color = Variety
  )
) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(85, 87.5, 90),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(
    name = "Variety",
    values = c(
      "#696969",
      "#556b2f",
      "#228b22",
      "#7f0000",
      "#483d8b",
      "#008b8b",
      "#9acd32",
      "#00008b",
      "#daa520",
      "#7f007f",
      "#8fbc8f",
      "#b03060",
      "#ff0000",
      "#ffff00",
      "#7cfc00",
      "#deb887",
      "#8a2be2",
      "#00ff7f",
      "#dc143c",
      "#00ffff",
      "#00bfff",
      "#0000ff",
      "#ff7f50",
      "#ff00ff",
      "#1e90ff",
      "#90ee90",
      "#add8e6",
      "#ff1493",
      "#ee82ee",
      "#ffc0cb"
    )
  ) +
  geom_point(position = j3, alpha = .666) +
  ylim(6, 9) +
  labs(x = "Category Two Defects", y = "Aftertaste", title = "Category Two Defects / Aftertaste / Total Cup Points (bubble size) / Variety") +
  theme_minimal()

ggplot(
  data = arabica,
  aes(
    x = Category.Two.Defects,
    y = Aftertaste,
    size = Total.Cup.Points,
    color = Processing.Method
  )
) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(85, 87.5, 90),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(
    name = "Processing Method",
    values = c(
      "#66cdaa",
      "#ffa500",
      "#00ff00",
      "#0000ff",
      "#1e90ff",
      "#ff1493"
    )
  ) +
  geom_point(position = j3, alpha = .666) +
  ylim(6, 9) +
  labs(x = "Category Two Defects", y = "Aftertaste", title = "Category Two Defects / Aftertaste / Total Cup Points (bubble size) / Processing Method") +
  theme_minimal()

# Robusta

## Fragrance...Aroma / Altitude

j4 <- position_jitter(width = 0.1, height = 0.1)

ggplot(
  data = robusta,
  aes(
    x = Fragrance...Aroma,
    y = altitude_mean_meters,
    size = Total.Cup.Points,
    color = Country.of.Origin
  )
) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(75, 77.5, 80),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(
    name = "Origin",
    values = c("#008b8b", "#ffa500", "#00ff00", "#0000ff", "#ff1493")
  ) +
  geom_point(position = j4, alpha = .666) +
  labs(x = "Fragrance...Aroma", y = "Altitude [m]", title = "Fragrance...Aroma / Altitude / Total Cup Points (bubble size) / Origin") +
  theme_minimal()

ggplot(
  data = robusta,
  aes(
    x = Fragrance...Aroma,
    y = altitude_mean_meters,
    size = Total.Cup.Points,
    color = Region
  )
) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(75, 77.5, 80),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(
    name = "Region",
    values = c(
      "#2f4f4f",
      "#006400",
      "#000080",
      "#ff0000",
      "#00ced1",
      "#ffa500",
      "#ffff00",
      "#00ff00",
      "#00fa9a",
      "#0000ff",
      "#ff00ff",
      "#fa8072",
      "#eee8aa",
      "#dda0dd",
      "#ff1493"
    )
  ) +
  geom_point(position = j4, alpha = .666) +
  labs(x = "Fragrance...Aroma", y = "Altitude [m]", title = "Fragrance...Aroma / Altitude / Total Cup Points (bubble size) / Region") +
  theme_minimal()

ggplot(
  data = robusta,
  aes(
    x = Fragrance...Aroma,
    y = altitude_mean_meters,
    size = Total.Cup.Points,
    color = Variety
  )
) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(75, 77.5, 80),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(name = "Variety",
                      values = c("#ff0000", "#00ff00", "#0000ff")) +
  geom_point(position = j4, alpha = .666) +
  labs(x = "Fragrance...Aroma", y = "Altitude [m]", title = "Fragrance...Aroma / Altitude / Total Cup Points (bubble size) / Variety") +
  theme_minimal()

ggplot(
  data = robusta,
  aes(
    x = Fragrance...Aroma,
    y = altitude_mean_meters,
    size = Total.Cup.Points,
    color = Processing.Method
  )
) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(75, 77.5, 80),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(name = "Processing Method",
                      values = c("#ff0000", "#00ff00", "#0000ff")) +
  geom_point(position = j4, alpha = .666) +
  labs(x = "Fragrance...Aroma", y = "Altitude [m]", title = "Fragrance...Aroma / Altitude / Total Cup Points (bubble size) / Processing Method") +
  theme_minimal()

## Category Two Defects / Moisture

j5 <- position_jitter(width = 0.1, height = 0.1)

ggplot(
  data = robusta,
  aes(
    x = Moisture,
    y = Category.Two.Defects,
    size = Total.Cup.Points,
    color = Country.of.Origin
  )
) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(75, 77.5, 80),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(
    name = "Origin",
    values = c("#008b8b", "#ffa500", "#00ff00", "#0000ff", "#ff1493")
  ) +
  geom_point(position = j5, alpha = .666) +
  labs(x = "Moisture", y = "Category Two Defects", title = "Moisture / Category Two Defects / Total Cup Points (bubble size) / Origin") +
  theme_minimal()

ggplot(
  data = robusta,
  aes(
    x = Moisture,
    y = Category.Two.Defects,
    size = Total.Cup.Points,
    color = Region
  )
) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(75, 77.5, 80),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(
    name = "Region",
    values = c(
      "#2f4f4f",
      "#006400",
      "#000080",
      "#ff0000",
      "#00ced1",
      "#ffa500",
      "#ffff00",
      "#00ff00",
      "#00fa9a",
      "#0000ff",
      "#ff00ff",
      "#fa8072",
      "#eee8aa",
      "#dda0dd",
      "#ff1493"
    )
  ) +
  geom_point(position = j5, alpha = .666) +
  labs(x = "Moisture", y = "Category Two Defects", title = "Moisture / Category Two Defects / Total Cup Points (bubble size) / Region") +
  theme_minimal()

ggplot(
  data = robusta,
  aes(
    x = Moisture,
    y = Category.Two.Defects,
    size = Total.Cup.Points,
    color = Variety
  )
) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(75, 77.5, 80),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(name = "Variety",
                      values = c("#ff0000", "#00ff00", "#0000ff")) +
  geom_point(position = j5, alpha = .666) +
  labs(x = "Moisture", y = "Category Two Defects", title = "Moisture / Category Two Defects / Total Cup Points (bubble size) / Variety") +
  theme_minimal()

ggplot(
  data = robusta,
  aes(
    x = Moisture,
    y = Category.Two.Defects,
    size = Total.Cup.Points,
    color = Processing.Method
  )
) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(75, 77.5, 80),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(name = "Processing Method",
                      values = c("#ff0000", "#00ff00", "#0000ff")) +
  geom_point(position = j5, alpha = .666) +
  labs(x = "Moisture", y = "Category Two Defects", title = "Moisture / Category Two Defects / Total Cup Points (bubble size) / Processing Method") +
  theme_minimal()

## Category Two Defects / Cup Cleanliness

j6 <- position_jitter(width = 0.1, height = 0.1)

ggplot(
  data = robusta,
  aes(
    x = Category.Two.Defects,
    y = Clean.Cup,
    size = Total.Cup.Points,
    color = Country.of.Origin
  )
) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(75, 77.5, 80),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(
    name = "Origin",
    values = c("#008b8b", "#ffa500", "#00ff00", "#0000ff", "#ff1493")
  ) +
  geom_point(position = j6, alpha = .666) +
  labs(x = "Category Two Defects", y = "Cup Cleanliness", title = "Category Two Defects / Cup Cleanliness / Total Cup Points (bubble size) / Origin") +
  theme_minimal()

ggplot(
  data = robusta,
  aes(
    x = Category.Two.Defects,
    y = Clean.Cup,
    size = Total.Cup.Points,
    color = Region
  )
) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(75, 77.5, 80),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(
    name = "Region",
    values = c(
      "#2f4f4f",
      "#006400",
      "#000080",
      "#ff0000",
      "#00ced1",
      "#ffa500",
      "#ffff00",
      "#00ff00",
      "#00fa9a",
      "#0000ff",
      "#ff00ff",
      "#fa8072",
      "#eee8aa",
      "#dda0dd",
      "#ff1493"
    )
  ) +
  geom_point(position = j6, alpha = .666) +
  labs(x = "Category Two Defects", y = "Cup Cleanliness", title = "Category Two Defects / Cup Cleanliness / Total Cup Points (bubble size) / Region") +
  theme_minimal()

ggplot(
  data = robusta,
  aes(
    x = Category.Two.Defects,
    y = Clean.Cup,
    size = Total.Cup.Points,
    color = Variety
  )
) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(75, 77.5, 80),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(name = "Variety",
                      values = c("#ff0000", "#00ff00", "#0000ff")) +
  geom_point(position = j6, alpha = .666) +
  labs(x = "Category Two Defects", y = "Cup Cleanliness", title = "Category Two Defects / Cup Cleanliness / Total Cup Points (bubble size) / Variety") +
  theme_minimal()

ggplot(
  data = robusta,
  aes(
    x = Category.Two.Defects,
    y = Clean.Cup,
    size = Total.Cup.Points,
    color = Processing.Method
  )
) +
  scale_size(
    name = "Total Cup Points",
    breaks = c(75, 77.5, 80),
    range = c(4, 20),
    trans = "exp"
  ) +
  scale_colour_manual(name = "Processing Method",
                      values = c("#ff0000", "#00ff00", "#0000ff")) +
  geom_point(position = j6, alpha = .666) +
  labs(x = "Category Two Defects", y = "Cup Cleanliness", title = "Category Two Defects / Cup Cleanliness / Total Cup Points (bubble size) / Processing Method") +
  theme_minimal()


formatC(x, width=9, flag="0")
# "00007.125"


rm(list=ls())

library(sn)
library(stats4)

#dataFile <- '/scr/rain2/rsfdata/projects/pecan/zdr_in_ice/qcv3/rhi/ZdrmInIce_june.txt'
s=dataFile <- '/scr/rain1/rsfdata/projects/dynamo/zdr_in_ice/qcv2/rhi/ZdrmInIce.nov.txt'
#Read elevation and zdr data
elevZdr <- read.table(dataFile)

par(mfrow=c(2,1))
histZdr <- hist(elevZdr[,1],breaks=40,freq=FALSE, xlab = "ZDR", ylab = "Frequency", main='Dynamo November, histogram')

#olo.ph <- wines[wines$wine=="Barolo", "phenols"]
fit <- selm(elevZdr[,1] ~ 1, family="SN", xlab = "ZDR", ylab = "Frequency", xlim=c(-0.2,1.2),main='Dynamo November, skewed normal fit')
plot(fit, which=2)

#dev.copy2pdf(file = paste('/h/eol/romatsch/nex-Spol/figs/ZDRice/skewedNormal_dynamoNovember.pdf',sep=""))


library("car")
library("MASS")
library("RJSONIO")

data <- read.csv("people.csv")

write(toJSON(sapply(data[-(1:5)],mean)), file="mean.json")
write(toJSON(sapply(data[-(1:5)],sd)), file="sd.json")

standardized = as.data.frame(scale(data[-(1:5)]))

ranking = prcomp(standardized)

screeplot(ranking, type="lines")

write(toJSON(ranking$rotation), file="pca.json")
write.csv(ranking$rotation, file="pca.csv")


#Dimensionality reduction
#次元削減

#参考
#https://www.slideshare.net/mikayoshimura50/150905-wacode-2nd
#http://d.hatena.ne.jp/hoxo_m/20120313/p1
#https://blog.albert2005.co.jp/2014/12/11/%E9%AB%98%E6%AC%A1%E5%85%83%E3%83%87%E3%83%BC%E3%82%BF%E3%81%AE%E5%8F%AF%E8%A6%96%E5%8C%96%E3%81%AE%E6%89%8B%E6%B3%95%E3%82%92swiss-roll%E3%82%92%E4%BE%8B%E3%81%AB%E8%A6%8B%E3%81%A6%E3%81%BF%E3%82%88/

dr <- function(formula, data, normalize = TRUE, unique = TRUE,
               methods = c("pca", "kpca" ,"mds", "tsne", "lle", "som", "diffmap"),
               kpca.par = list(kernel = "rbfdot", sigma = 0.1),
               mds.par = list(k = 2),
               tsne.par = list(dims = 2, initial_dims = 50, perplexity = 30, theta = 0.5),
               lle.par = list(m = 2, k = 5, reg = 2, p = 0.5),
               som.par = list(xdim = 5, ydim = 6),
               diffmap.par = list(neigen = NULL, t = 0, maxdim = 50, delta=10^-5))
  {

  #kpca.par はsigma,degree, scale, offset,orderも指定できる。
  #tsne.parのdimsは3以下がよい。

  #入力をチェック---
  if(is.null(formula)){stop("formula is null.")}
  if(is.null(data)){stop("data is null.")}

  #データを準備---
  ret <- list() #戻り値
  ret$parameter$formula <- formula
  ret$parameter$normalize <- normalize
  ret$parameter$unique <- unique

  #解析用データ
  if(length(formula) == 3){
    data.original <- model.matrix(object = formula[-2], data = data)[,-1] #解析用データ。[,-1]で切片を除く。
  }else{
    data.original <- model.matrix(object = formula, data = data)[,-1] #解析用データ。[,-1]で切片を除く。
  }

  #ユニークなデータを抜粋
  #https://qiita.com/weda_654/items/97c8dbba9f8198845537
  u.no <- !duplicated(data.original)
  data.original <- data.original[u.no,]

  #目的変数がある場合の処理
  if(length(formula) == 3){
    y.formula  <- as.formula(paste0(as.character(formula[2]), "~+0"))
    y.data <- model.frame(y.formula, data)[u.no,1]
    ret$y <- y.data
    formula[2] <- NULL #目的変数を削除
  }else{
    ret$y <- NULL
  }

  #説明変数の項目名を抜粋
  ret$parameter$names  <- names(data.original[1, ])

  #規格化。data.maが解析用の元データのマトリクス
  if(normalize){
    data.mean <- apply(data.original, 2, mean)
    data.sd <- apply(data.original, 2, sd)
    #規格化。もうちょっとスマートなのがある気がする…
    data.ma <- t(apply(data.original,1,function(x){(x - data.mean)/data.sd}))
  }else{
    data.mean <- NULL
    data.sd <- NULL
    data.ma <- data.original
  }
  ret$parameter$data.mean <- data.mean
  ret$parameter$data.sd <- data.sd

  #変換
  data.df <- data.frame(data.ma) #データフレームに変換
  data.di <- dist(data.ma) #dist classの距離に変換

  #ここから解析本体-----------------------------------------------

  #PCA
  #(数値のみしか使用できない。)
  if(!is.na(match("pca", methods))){
    cat("\n[Principal Components Analysis] \n")
    ret$pca <- prcomp(~., data = data.df,
                      scale = normalize, center = normalize,
                      retx = TRUE)
  }

  #kernel PCA
  if(!is.na(match("kpca", methods))){
    cat("\n[Kernel Principal Components Analysis] \n")
    #kpcaに渡すデータを編集。
    kpca.kernel <- kpca.par$kernel
    kpca.par$kernel <- NULL

    #kpca本体
    ret$kpca <- kpca(x = ~., data = data.df,
                     kernel = kpca.kernel, kpar = kpca.par)
  }

  #MDS
  if(!is.na(match("mds", methods))){
    cat("\n[Classical Multidimensional Scaling]\n")
    ret$mds <- cmdscale(d = as.matrix(data.di), k = mds.par$k)
  }

  #t-SNE
  #https://blog.albert2005.co.jp/2015/12/02/tsne/
  #注意点として、t-SNE で圧縮する次元は、 2・3 次元が推奨されています
  if(!is.na(match("tsne", methods))){
    cat("\n[t-Distributed Stochastic Neighbor Embedding]\n")
    ret$tsne <- Rtsne(data.df,
                      dims = tsne.par$dims, initial_dims = tsne.par$initial_dims,
                      perplexity = tsne.par$perplexity, theta = tsne.par$theta)
  }

  #LLE
  #m,kは再考の必要あり。
  if(!is.na(match("lle", methods))){
    cat("\n[Locally linear embedding]\n")
    ret$lle <- lle(data.ma, m = lle.par$m,
                   k = lle.par$k,
                   reg = lle.par$reg, p = lle.par$p)
  }

  #SOM
  #その他のパラメータもあったほうがいい？
  if(!is.na(match("som", methods))){
    cat("\n[Self-Organizing Map]\n")
    ret$som <- som(data.df, xdim=som.par$xdim, ydim=som.par$ydim)
  }

  #diffusion map
  if(!is.na(match("diffmap", methods))){
    cat("\n[Diffusion Map]\n")
    ret$diffmap <- diffuse(data.di,
                           neigen = diffmap.par$neigen,
                           t = diffmap.par$t, maxdim = diffmap.par$maxdim,
                           delta = diffmap.par$delta)
  }

  #戻り値
  class(ret) <- "dr"
  return(ret)
}

predict.dr <- function(result, data){
  data.original <- model.matrix(object = result$parameter$formula, data = data)[,-1]

  #モデルで使用した説明変数と、新データで作った説明変数が一致するか確認。
  #カテゴリカル変数まわりでエラーが起きる気がする。
  if(!setequal(result$parameter$names, names(data.original[1, ]))){
    stop("Explanatory variable is different from model.")
  }

  #規格化。data.maが解析用の元データのマトリクス
  if(result$parameter$normalize){
    #規格化。もうちょっとスマートなのがある気がする…
    data.ma <- t(apply(data.original,1,
                       function(x){(x - result$parameter$data.mean)/result$parameter$data.sd}))
  }else{
    data.ma <- data.original
  }

  #変換
  data.df <- data.frame(data.ma) #データフレームに変換

  res <- list()

  res$pca <- predict(result$pca, data.df)
  res$kpca <- predict(result$kpca, data.df)

  #res$tsne <- predict(result$tsne, data.df)
  #https://stackoverflow.com/questions/43377941/t-sne-predictions-in-r
  #t-SNEでpredictできないみたい。
  #res$lle <- predict(result$lle, data.ma)
  #res$som <- predict(result$som, data.df)
}

plot.dr <- function(result, cex = 1){
  if(!is.null(result$y)){
    if(is.factor(result$y)){
      col_p <- rainbow(length(unique(result$y)))
      plot_bg <- col_p[unclass(result$y)]
    }else{
      rank_y <- round(rank(result$y))
      plot_bg <- heat.colors(length(result$y))[rank_y]
    }
  }else{
    plot_bg <- NULL; col_p <- NULL
  }

  chk_hit <- FALSE
  hit_ret <- function(chk_hit){
    if(chk_hit){
      cat("Hit <Return> to see next plot: \n")
      readline()
    }
  }

  plot_dr <- function(x, y, main, xlab, ylab){
    hit_ret(chk_hit)
    #https://www1.doshisha.ac.jp/~mjin/R/Chap_07/07.html
    plot(x, y, main = main, xlab = xlab, ylab = ylab, type = "p", pch = 21, cex = cex, bg = plot_bg)

  }

  if(!is.null(result$pca)){
    plot_dr(x = result$pca$x[,1], y = result$pca$x[,2],
            main = "Principal Components Analysis", xlab = "PC1", ylab = "PC2")
    chk_hit <- TRUE
  }

  if(!is.null(result$kpca)){
    plot_dr(x = result$kpca@pcv[,1], y = result$kpca@pcv[,2],
            main = "Kernel Principal Components Analysis",
            xlab = "K-PC1", ylab = "K-PC2")
    chk_hit <- TRUE
  }

  if(!is.null(result$mds)){
    plot_dr(x = result$mds[,1], y = result$mds[,2],
            main = "Classical Multidimensional Scaling", xlab = "Dimension 1", ylab = "Dimension 2")
    chk_hit <- TRUE
  }

  if(!is.null(result$tsne)){
    plot_dr(x = result$tsne$Y[,1], y = result$tsne$Y[,2],
            main = "t-Distributed Stochastic Neighbor Embedding", xlab = " ", ylab = " ")
    chk_hit <- TRUE
  }

  if(!is.null(result$lle)){
    plot_dr(x = result$lle$Y[,1], y = result$lle$Y[,2],
            main = "Locally linear embedding main function", xlab = " ", ylab = " ")
    chk_hit <- TRUE
  }

  if(!is.null(result$som)){
    plot_dr(x = result$som$visual$x, y = result$som$visual$y,
            main = "Self-Organizing Map", xlab = "x", ylab = "y")
    chk_hit <- TRUE
  }

  if(!is.null(result$diffmap)){
    plot_dr(x = result$diffmap$X[,1], y = result$diffmap$X[,2],
            main = "diffusion map", xlab = " ", ylab = " ")
    chk_hit <- TRUE
  }

}


# Program to convert decimal number into binary number using recursive function
convert_to_binary <- function(n) {
if(n > 1) {
convert_to_binary(as.integer(n/2))
}
cat(n %% 2)
}


library(rstan)
library(tidyverse)
library(lubridate)

load('cleanedData.RData')

dat <- dat%>%filter(!is.na(anxlevel)|!is.na(anyHard),
  !is.na(Date))%>%
  group_by(StudyId)%>%mutate(ntimes=n())%>%filter(ntimes>1)%>%
  arrange(Date)%>%mutate(time=as.numeric(Date-min(Date))/100)%>%
  ungroup()%>%
  mutate(id=as.numeric(as.factor(StudyId)))

datAnx <- filter(dat,!is.na(anxlevel))
datSub <- filter(dat,!is.na(anyHard))

stanDat <- list(
  Nanx=nrow(datAnx),
  Nsubj=max(dat$id),
  subjAnx=datAnx$id,
  timeAnx=datAnx$time,
  anx=datAnx$anxlevel,
  Nsub=nrow(datSub),
  subjSub=datSub$id,
  timeSub=datSub$time,
  sub=datSub$anyHard
  )

## subject-level covariates

dat$race <- as.factor(dat$Race_R)

covDat <- dat%>%
  dplyr::select(id,age,gender,race,Hispanic_R,Site,ntimes)%>%
  group_by(id)%>%
  summarize_all(function(x) if(any(!is.na(x))) x[!is.na(x)][1] else NA)

## fill in missing values by assumption
covDat$race[is.na(covDat$race)] <- 1

covDat$Hispanic_R[is.na(covDat$Hispanic_R)] <- 2
covDat$hisp <- ifelse(covDat$Hispanic_R==1,1,0)

covDat$gender[is.na(covDat$gender)] <- 1

X <- model.matrix(~age+gender+race+hisp+Site,covDat)

stanDat$X <- scale(X[,-1])

stanDat$p <- ncol(X)-1

mod <- stan('anxSub.stan',data=stanDat,chains=4,iter=5000,cores=4); save(mod,file='anxSub.RData')


library(dplyr)
library(readr)
library(ggplot2)

args = commandArgs(trailingOnly=TRUE)

input_file = args[1]
output = args[2]

data  = read_tsv(input_file, col_names= FALSE)

#Compute Media
data %>% filter(X4 != 0) %>% summarize( Median_depth = median(X4) ) -> median_estimation

#Compute distribution
data %>% filter(X4 != 0) %>% ggplot() + geom_density(aes(X4)) + geom_vline(xintercept = median_estimation$Median_depth, linetype="dotted",
                color = "red", size=1) + theme_bw() -> distribution

#Compute genome length
data %>% mutate(Range= X3 - X2) %>% summarise(sum(Range)) -> total
total = total[[1]]
#Compute Genome coverage
data %>% mutate(Range= X3 - X2) %>% mutate(present = ifelse(X4 != 0, 1, 0)) %>%
 group_by(present) %>% summarise(coverage=sum(Range)/total) %>% filter(present=="1") -> Covered
Covered = Covered$coverage

#Two column output, Median Depth and Genome coverage
median_estimation %>% mutate(Coverage = Covered) -> result

write.table(result, file=output, quote=FALSE, sep=',', row.names = FALSE)
ggsave(filename=paste(output,"_distribution.pdf",sep = ""), plot=distribution)


### fimd4.R
### R code from Van Buuren, S. (2012).
###		Flexible Imputation of Missing Data.
###		CRC/Chapman & Hall, Boca Raton, FL.
### (c) 2012 Stef van Buuren, www.multiple-imputation.com
### Version 1, 7mar2012
### Version 2, 4nov2015 tested with mice 2.23
### Tested with Mac OS X 10.7.3, R2.14-2, mice 2.12

library("mice")
library("lattice")

### Chapter 4 Multivariate missing data

### Section 4.1 Missing data patterns

### define data sets pattern1-pattern4 with four patterns
data <- matrix(sample(1:100,4*8*3,replace=TRUE),nrow=8*4,
                dimnames=list(NULL,c("A","B","C")))
data <- as.data.frame(data)
data[c(31:32),"A"] <- NA
data[c(15:16,22:24,30:32),"B"] <- NA
data[c(6:8,12:16,17:21,27:29),"C"] <- NA
mdpat <- cbind(expand.grid(rec = 8:1, pat = 1:4, var = 1:3), r=as.numeric(as.vector(is.na(data))))
pattern1 <- data[1:8,]
pattern2 <- data[9:16,]
pattern3 <- data[17:24,]
pattern4 <- data[25:32,]

### Figure 4.1
types <-  c("Univariate","Monotone","File matching","General")
tp41 <- levelplot(r~var+rec|as.factor(pat), data=mdpat,
          as.table=TRUE, aspect="iso",
          shrink=c(0.9),
          col.regions = mdc(1:2),
          colorkey=FALSE,
          scales=list(draw=FALSE),
          xlab="", ylab="",
          between = list(x=1,y=0),
          strip = strip.custom(bg = "grey95", style = 1,
            factor.levels = types))
print(tp41)

md.pattern(pattern4)
p <- md.pairs(pattern4)
p

### proportion of usable cases
p$mr/(p$mr+p$mm)

### outbound statistics
p$rm/(p$rm+p$rr)

### Figure 4.2
par(mfrow=c(2,2))
fluxplot(pattern1, main="", xlim=c(-0.1,1.1), ylim=c(-0.1,1.1))
text(x=0.5,y=1,label="Univariate")
fluxplot(pattern2, main="", xlim=c(-0.1,1.1), ylim=c(-0.1,1.1))
text(x=0.5,y=1,label="Monotone")
fluxplot(pattern3, main="", xlim=c(-0.1,1.1), ylim=c(-0.1,1.1))
text(x=0.5,y=1,label="File matching")
fluxplot(pattern4, main="", xlim=c(-0.1,1.1), ylim=c(-0.1,1.1))
text(x=0.5,y=1,label="General")

### calculate pobs, influx, outflux of general pattern
flux(pattern4)[,1:3]

### section 4.3 Monotone data imputation
### monotone data imputation on three columns
data <- nhanes2[,1:3]
md.pattern(data)
imp <- mice(data, visit="monotone", maxit=1, m=2)

### Numerical example, approximate two-step
ini <- mice(nhanes2, maxit=0)
pred <- ini$pred
pred["bmi","chl"] <- 0
pred["hyp",c("chl","bmi")] <- 0
imp <- mice(nhanes2, vis="monotone", pred=pred, maxit=1, m=2)

### Section 4.5 Fully Conditional Specification

### Example of slow convergence
generate <- function(n = c(1000, 4500, 4500, 0),
                     cor = matrix(c(1, 0.9, 0.9, 0.9, 1, 0.7, 0.9, 0.7, 1), nrow = 3)) {
  require(MASS)
  nt <- sum(n)
  cs <- cumsum(n)
  data <- mvrnorm(nt, mu = rep(0,3), Sigma = cor)
  dimnames(data) <- list(1:nt, c("X", "Y1", "Y2"))
  if (n[2] > 0) data[(cs[1]+1):cs[2],"Y1"] <- NA
  if (n[3] > 0) data[(cs[2]+1):cs[3],"Y2"] <- NA
  if (n[4] > 0) data[(cs[3]+1):cs[4],c("Y1","Y2")] <- NA
  return(data)
}

impute <- function(data, m = 5, method="norm", print=FALSE, maxit = 10, ...) {
  statistic <- matrix(NA, nrow=maxit, ncol=m)
  for (iter in 1:maxit) {
    if (iter==1) imp <- mice(data, m = m, method = method, print=print, maxit = 1, ...)
    else imp <- mice.mids(imp, maxit=1, print=print, ...)
    statistic[iter,] <- unlist(with(imp, cor(Y1,Y2))$analyses)
  }
  return(list(imp=imp, statistic=statistic))
}

simulate <- function(ns=matrix(c(1000,500,250,100,50,0,
                               rep(c(4500,4750,4875,4950,4975,5000),2),
                       rep(0,6)), nrow=6), m = 5, maxit=10,
                       seed=1, ...) {
  if (!missing(seed)) set.seed(seed)
  s <- cbind(rep(1:nrow(ns), each=maxit*m),
             apply(ns, 2, rep, each=maxit*m),
             rep(1:maxit,each=m), 1:m, NA)
  colnames(s) <- c("k","n111","n101","n110","n100","iteration","m","rY1Y2")
  for (k in 1:nrow(ns)){
    data <- generate(ns[k,], ...)
    r <- impute(data, m=m, maxit=maxit, ...)
    s[s[,"k"]==k,"rY1Y2"] <- t(r$statistic)
  }
  return(data.frame(s))
}

### perform simulation - TIME CONSUMING (10 minutes)
slow.demo <- simulate(maxit=150, seed=62771)

### Figure 4.3
labels <- c("90% missing", "95% missing", "97.5% missing",
            "99% missing", "99.5% missing", "100% missing")
tp43 <- xyplot(rY1Y2~iteration|as.factor(k), group=m,
       data = slow.demo, layout=c(3,2),
       type="l", as.table = TRUE,
       ylab = "Correlation between Y1 and Y2",
       xlab = "Iteration", col=mdc(3),
       scales=list(y=list(alternating=1, tck=c(1,0))),
       strip = strip.custom(bg="grey95", style=1,
         factor.levels=labels))
print(tp43)

### Section 4.6.3 Illustration

## boys data: select subset
select <- with(boys, age>=8 & age<=21.0)

### version with all numeric data for jm and pmm
djm <- boys[select,-4]
djm$gen <- as.integer(djm$gen)
djm$phb <- as.integer(djm$phb)
djm$reg <- as.integer(djm$reg)

### version with categorical variables for fcs
dfcs <- boys[select,-4]

### impute according to joint multivariate normal
jm.10 <- mice(djm, method="norm", seed=93005, m=10)

### impute according to predictive mean matching
pmm.10 <- mice(djm, seed=71332,m=10)

### impute according to proportional odds model
fcs.10 <- mice(dfcs, seed=81420, m=10)

### Figure 4.4
tp44 <- xyplot(jm.10, gen~age|.imp, subset=as.integer(.imp)<7,
       xlab="Age", ylab="Genital stage")
print(tp44)

### Figure 4.5
tp45 <- xyplot(fcs.10, gen~age|.imp, subset=as.integer(.imp)<7,
       xlab="Age", ylab="Genital stage")
print(tp45)

### Figure 4.6 is too complex, and will not be given here


rt_fun <- function(){

  args <- commandArgs(trailingOnly = TRUE)
  filename <- args[1]
  model_input <- args[2]

  if(model_input %in% c('combined', 'combinedTDI', 'combined_hospitals')){
    load(paste0(model_input, "/results/", filename))
  } else{
    load(paste0("single/",model_input, "/results/", filename))
  }

  filename <- strsplit(filename, "-stanfit.Rdata")[[1]][1]

  out = rstan::extract(fit)

  Rt_adj <- out$Rt_adj[,1:length(dates[[1]]),]
  R_0_tmp <- Rt_adj[,dates[[1]]<interventions[1]]
  R_0 <- mean(R_0_tmp, na.rm = TRUE)
  R_0_li <- quantile(R_0_tmp, probs = 0.025)
  R_0_ui <- quantile(R_0_tmp, probs = 0.975)

  if(dates[[1]][length(dates[[1]])] == interventions[length(interventions)]) interventions <- interventions[-length(interventions)]
  R_N_tmp <- Rt_adj[,dates[[1]]>interventions[length(interventions)]]
  R_N <- mean(R_N_tmp, na.rm = TRUE)
  R_N_li <- quantile(R_N_tmp, probs = 0.025)
  R_N_ui <- quantile(R_N_tmp, probs = 0.975)

  ###
  # Alphas:

  alphas <- colMeans(out$alpha[,,1], na.rm = TRUE)
  alphas_li <- matrixStats::colQuantiles(out$alpha[,,1], probs=.025)
  alphas_ui <- matrixStats::colQuantiles(out$alpha[,,1], probs=.975)

  if(model_input %in% c('combined', 'combinedTDI', 'combined_hospitals')){
    file_output <- paste0(model_input, '/results/sens_', filename, '.RData')
  } else{
    file_output <- paste0('single/',model_input, '/results/sens_', filename, '.RData')
  }
  save(R_0, R_0_li, R_0_ui, R_N, R_N_li, R_N_ui,
       alphas, alphas_li, alphas_ui,
       file=file_output)

}

rt_fun()

# for(i in 1:nrow(Rt_adj)){
#   if(i==1) plot(1:ncol(Rt_adj), Rt_adj[i,], ylim=c(0,10))
#   else lines(1:ncol(Rt_adj), Rt_adj[i,])
# }
# lines(1:ncol(Rt_adj), colMeans(Rt_adj[,]), col='red')


# Note: This method may produce a slight drift, especially with shorter time series. I will attempt to fix this in the future.
# Per my own explorations, this is hardly noticeable for longer time series (over 300 samples per time series).

# preliminaries
library(crqa)
library(ggplot2)

# create two categorical time series
ts1 = c(0,0,0,0,0,0,1,1,0,1,0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,1,1,1,1,1,1,0,0,1,1,0,0,
	0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0)
ts2 = c(0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,1,0,0,1,1,1,1,1,1,1,1,0,0,0,0,0,0,1,1,1,1,1,1,0,0,
	0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0)

# set parameters for all CRQA analyses
delay = 1
embed = 1
rescale = 1
radius = 1
normalize = 0
mindiagline = 2
minvertline = 2
tw = 0
whiteline = FALSE
recpt = FALSE
side = "both"
checkl = list(do = FALSE, thrshd = 3, datatype = "categorical", pad = TRUE)

# calculate CRQA
rec_analysis = crqa(ts1, ts2, delay, embed, rescale, radius, normalize, mindiagline,
	minvertline, tw, whiteline, recpt, side, checkl)

# use ggplot2's qplot function to generate the recurrence plot
qplot(rec_analysis$RP@i,seq_along(rec_analysis$RP@i), colour='red') +
  theme(legend.position="none",axis.text.x = element_blank(), axis.text.y = element_blank()) +
  ylab("Time Series 1") + xlab("Time Series 2")


suppressMessages(library(kazaam, quietly=TRUE))

source("./utils.r")
data = read.iris("./iris.csv")
iris = data$iris
species = data$species

# best of 100 starts
rand = numeric(100)
for (i in 1:100){
  labels = km(iris, k=3, seed=i)$labels
  l1 = collapse(labels)
  l2 = collapse(species)
  if (comm.rank() == 0)
    rand[i] = rand_measure(l1, l2)
}

comm.print(max(rand))

finalize()


findMed <- function(x,y,ref=0.5){

		np 		= length(x)
		s0 		= max(y)
		s0.4	= s0*ref
		ix 		= which.min(abs(s0.4 - y))
		ixx 	= min(np-1,max(2,ix))
		tx 		= x[ixx + c(-1,0,1)]
		ty 		= y[ixx + c(-1,0,1)]
		cou 	= lm(ty ~ tx + I(tx^2))
		co      = data.frame(tx=seq(tx[1],tx[3],length.out=100))
		f0.4	= predict(cou,newdata=co)
		ix 		= co[which.min(abs(s0.4 - f0.4)),1]
		return(c(x=ix,y=s0.4,Ref=ref))
}


#' @title calcResistanceShipPwr
#'
#' @description Calculate ship power (kW) for resistance-based power models.
#'
#' @param Rtot Total ship resistance (vector of numericals, kN) (see
#' \code{\link{calcKristTotalRes}} or \code{\link{calcHMTotalRes}})
#' @param shipSpeed Ship actual speed (vector of numericals, m/s) (see
#'  \code{\link{calcSpeedUnitConversion}})
#' @param hullEff Hull efficiency (vector of numericals, dimensionless) (see
#' \code{\link{calcHullEff}})
#' @param openWaterEff Open water efficiency (vector of numericals,
#' dimensionless) (see \code{\link{calcOpenWaterEff}})
#' @param totalInstalledPwr Total installed main engine power (vector of
#' numericals, kW) (maximum
#' continuous rated power)
#' @param shaftEff Shaft efficiency (dimensionless). Default = 0.98.
#'  Ratio of power delivered to the propeller and the brake power delivered by
#'  the engine. Can supply either a vector of numericals, a single
#'  number, or rely on the default
#' @param relRotationEff Relative rotational efficiency (dimensionless).
#'  Default = 1. Accounts for effect of rotational flow of water around propeller.
#'  Can supply either a vector of numericals, a single number, or rely on the default
#' @param pwrUpperBoundPercent Percent of total installed power at which
#' required power is capped (1 indicates required power cannot exceed
#' \code{totalInstalledPwr}). Can supply either a vector of numericals, a single
#'  number, or rely on the default
#' @param pwrLowerBoundPercent Percent of total installed power to act as lower
#' bound for required power (0.02 indicates required power cannot go below 2\%
#' of \code{totalInstalledPwr}). Can supply either a vector of numericals, a
#' single number, or rely on the default
#'
#' @return power (vector of numericals, kW)
#'
#' @details
#' This function is called by both Holtrop & Mennen (\code{\link{calcHMPwr}})
#' and Kristensen (\code{\link{calcKristPwr}}) power calculations, where each
#' uses has its own total resistance calculation (\code{\link{calcHMTotalRes}}
#' and \code{\link{calcKristTotalRes}}).
#'
#' Assumptions for shaft efficiency and relative rotational efficiency are based
#' on MAN.
#'
#' @references
#'
#'\href{https://www.man-es.com/marine/products/propeller-aft-ship}{MAN Energy
#' Solutions. 2011. "Basic Principles of Propulsion."}
#'
#' @seealso
#' \itemize{
#' \item \code{\link{calcKristTotalRes}}
#' \item \code{\link{calcHMTotalRes}}
#' \item \code{\link{calcSpeedUnitConversion}}
#' \item \code{\link{calcHullEff}}
#' \item \code{\link{calcOpenWaterEff}}
#' \item \code{\link{calcHMPwr}}
#' \item \code{\link{calcKristPwr}}
#' }
#'
#' @examples
#' calcResistanceShipPwr(398.487,10.8, 1.191176, 0.721239,9363, shaftEff=0.98,relRotationEff=1)
#'
#' @export

calcResistanceShipPwr <- function(Rtot,shipSpeed, hullEff, openWaterEff,totalInstalledPwr,
                                  shaftEff=0.98,relRotationEff=1, pwrUpperBoundPercent=1, pwrLowerBoundPercent=0.02){

  power <-ifelse(shipSpeed==0,
                 0,
                 pmin(pwrUpperBoundPercent*totalInstalledPwr,
    pmax(pwrLowerBoundPercent*totalInstalledPwr,
         ((Rtot*shipSpeed)/
            (hullEff*openWaterEff*shaftEff*relRotationEff))
    )
  )
  )

  return(power)

}


pdf('SRR4238355_subsamp.sorted.rseqc.junctionSaturation_plot.pdf')
x=c(5,10,15,20,25,30,35,40,45,50,55,60,65,70,75,80,85,90,95,100)
y=c(8,15,20,23,25,27,29,32,34,36,37,39,41,42,46,47,50,50,51,52)
z=c(10,18,25,28,30,32,34,37,39,42,45,48,50,52,56,58,61,61,63,65)
w=c(2,3,5,5,5,5,5,5,5,6,8,9,9,10,10,11,11,11,12,13)
m=max(0,0,0)
n=min(0,0,0)
plot(x,z/1000,xlab='percent of total reads',ylab='Number of splicing junctions (x1000)',type='o',col='blue',ylim=c(n,m))
points(x,y/1000,type='o',col='red')
points(x,w/1000,type='o',col='green')
legend(5,0, legend=c("All junctions","known junctions", "novel junctions"),col=c("blue","red","green"),lwd=1,pch=1)
dev.off()


str(iris)

model = lm(Petal.Width ~ . ,iris)

p = predict(model,iris)

cbind(p,iris$Petal.Width)

library(ggplot2)

ggplot(iris,aes(x = p,
                y = Petal.Width))+
  geom_point()+
  geom_smooth(method = "lm",se=T)

R Community/R Stats_Basics Part 1/Assignment5.r


for (u in 1:10000000) {
	j <- nchar(u)
	set2 <- c()
	for (i in 1:j) {
		set2[i] <- as.numeric(substr(u, i, i))
		}
	control <- c()
	for (k in 1:j) {
		control[k] <- set2[k]^(j)
		}
	if (sum(control) == u) print(u)
}


####################################################################################################
# 4. faza: Napredna analiza podatkov
####################################################################################################
#NAVODILA:
#-sestavite predikcijski model za napovedovanje:
#   za prihodnost, kako je neka vrednost odvisna od drugih, morda uporabite kako metodo iz strojnega učenja, ...
#-na podlagi modela naključno modelirate nove podatke (npr. napovedovanje gibanja delnic),
#-s pomočjo razvrščanja določite skupine s podobnimi lastnostmi,
#-s pomočjo gručenja izločite osamelce (in morda tako izboljšate model), ali pa za različne
# skupine podatkov naredite različne modele.

#-Kot rezultat te faze lahko sestavite tudi aplikacijo v ogrodju Shiny (za boljšo oceno).
#-Vaš program bo narisal enega ali več grafov (lahko tudi zemljevidov),
#ki jih boste nato vključili v poročilo skupaj z opisom vaše analize in njenimi zaključki.

#---------------------------------------------------------------------------------------------------
#PLAN/KAJ ME ZANIMA:
#-predikcijski model za napovedovanje kdo bo zmagal na olimpijskih igrah 2021 skupinske
#-(predikcijski model za napovedovanje verjetne izbire tekmovalk, ki bodo zastopale Rusijo)
#-novi podatki: kakšne bodo ocene na OI za dino, arino in linoy
#-grupiranje E/D (induvidualne) in skupinske
#-s pomočjo razvrščanja določimo skupine tekmovalk ki so bolj spretne z rekvizitom in tiste ki imajo boljšo tehniko s telesom
#-Grupiranje po rekvizitih - kateter jim je boljši induv (in skupinsko)
#-s pomočjo gručenja izločite osamelce - soldatova, kaylen, (lala) zaradi BD (in morda tako izboljšate model), ali pa za različne
# skupine podatkov naredite različne modele.
#-----------------------------------------------------------------------------------------------------

#require(ggplot2) #geom_smooth, geom_segment - ravne črte med toččkami
#require(dplyr)
#library(NbClust) #Za določanje skupin: NbClust
#require(ggdendro) #za dendrograme: ggdendrogram, dendro_data (izvoz podatkov v obliko dalahko delamo z ggplot), segment za povezave v dendrogramu,
                  #theme_dendro
#require(ggrepel) #za overlapping

#============================================================================================
#1. KATERA DRŽAVA BO ZMAGALA NA OLIMPIJSKIH IGRAH V SKUPINSKIH SESTAVAH
#============================================================================================
#View(skupinske)

#----------------------------------------------------------------
#graf-za lažje predstavljanje podatkov
#----------------------------------------------------------------
ggplot(skupinske, aes(x = D, y = E, col = tekma)) +
  geom_point()

#---------------------------------------------------------------
# MODEL
#--------------------------------------------------------------
#lm{stats} - koliko je stolpec D odvisen od E
model_skupinske_obroci_kiji <- lm(E ~ D, data=skupinske%>%filter(rekvizit == "3 obroči + 4 kiji"))
model_skupinske_zoge <- lm(E ~ D, data=skupinske%>%filter(rekvizit == "5 žog"))

#------------------------------------------------------------------
# IZRIS LINEARNEGA MODELA
#------------------------------------------------------------------
ggplot(skupinske, aes(x = D, y = E)) +
  geom_point() +
  facet_grid(.~rekvizit)+
  geom_smooth(method=lm, formula=y~x) #ggplot2

#-----------------------------------------------------------------
# PREDIKCIJA. Kakšna bo E ko bodo D dvignile na 32, 35
#-----------------------------------------------------------------
novDskupinske <- data.frame(D=c(32, 35))
#predict {stats}
predict(model_skupinske_obroci_kiji, novDskupinske) #5.315866 4.698013
predict(model_skupinske_zoge, novDskupinske) #8.735773 9.121857

#tabela s stolpcem D in E
napovedEskupinske_obroci_kiji <- novDskupinske %>% mutate(E=predict(model_skupinske_obroci_kiji, .))
napovedEskupinske_zoge <- novDskupinske %>% mutate(E=predict(model_skupinske_zoge, .))

#napovedE_tabela_skupinske <- napovedEskupinske %>%
#  mutate(drzava = "napoved", tekma = 2021, rekvizit = c("3 obroči + 4 kiji", "5 žog"), Pen.= 0.00, koncna_ocena = c(7.518193+32, 7.536600+35) )

#napovedEskupinske_obroci_kiji %>% View
#napovedEskupinske_zoge %>% View
#napovedE_tabela_skupinske %>% view

#skupinske_predikcija_napoved <- rbind(napovedE_tabela_skupinske, skupinske)
#skupinske_predikcija_napoved #%>% view

########################################################################
#----------------
# izris napovedi
#----------------
predikcija_skupinske_obroci_kiji <- ggplot(skupinske%>%filter(rekvizit == "3 obroči + 4 kiji"), aes(x = D, y = E)) +
  geom_point(shape=1) +
  geom_smooth(method=lm, formula=y~x, fullrange = TRUE) +
  geom_point(data=napovedEskupinske_obroci_kiji, aes(x=D, y=E), color='red', size=3)+
  labs(title = "PREDIKCIJA OCENE E NA OLIMPIJSKIH IGRAH 2021 ZA SKUPINSKE SESTAVE
  V SESTAVI S KOMBINIRANIM REKVIZITOM" )+
  theme_bw()+ #brez sivega ozadja
  theme(legend.position = "none", plot.title = element_text(hjust=0.5))#naslovna na sredini

print(predikcija_skupinske_obroci_kiji)

predikcija_skupinske_zoge <- ggplot(skupinske%>%filter(rekvizit == "5 žog"), aes(x = D, y = E)) +
  geom_point(shape=1) +
  geom_smooth(method=lm, formula=y~x, fullrange = TRUE) +
  geom_point(data=napovedEskupinske_zoge, aes(x=D, y=E), color='red', size=3)+
  labs(title = "PREDIKCIJA OCENE E NA OLIMPIJSKIH IGRAH 2021 ZA SKUPINSKE SESTAVE
  V SESTAVI Z ŽOGAMI" )+
  theme_bw()+ #brez sivega ozadja
  theme(legend.position = "none", plot.title = element_text(hjust=0.5))#naslovna na sredini

print(predikcija_skupinske_zoge)

#==============================================================================
#2. GRUPIRANJE GLEDE NA E IN GLEDE NA D ZA SKUPINSKE SESTAVE
#==============================================================================

risba_skupinske <- skupinske %>%
  ggplot(aes(x=D, y=E, col=drzava, shape=rekvizit))+
  geom_point()+
  theme_minimal()+
  facet_grid(.~tekma)+
  #---------------------------------------------------------
  #oštevilčimo pikice
  #---------------------------------------------------------
  geom_text(
    data=skupinske %>% mutate(n = row_number()),
    aes(label=drzava),
    size=2,
    color='black',
    nudge_x = 0.03,
    nudge_y = 0.03
  )+
  theme_minimal()
print(risba_skupinske)

#KOMENTAR:izgleda kot da bi lahko pogrupirali skupaj v Bakuju:
#Rus, Bul, Jap, Blr

#---------------------------------------------------------------
#STANDARDIZACIJA MATRIKE
#---------------------------------------------------------------
data_skupinske <- skupinske %>%
  select(E,D) %>%
  as.matrix() %>%
  scale() #{base} naredi standardizacijo

#View(data_skupinske)

#----------------------------------------------------------------
#HIERARHIČNO RAZVRŠČANJE
#----------------------------------------------------------------
razdalje_skupinske <- dist(as.matrix(data_skupinske)) #{stats} na i,j tem mestu je razdalja med i-to in j-to vrstico
model_skupinske <- hclust(razdalje_skupinske) #model hierarhičnega razvrščanja; {stats}

#malo pregledamo
#----------------------------------------------------------------
## Dobimo opis postopka razvrščanja
#names(model_skupinske)

# Algoritem za razvrščanje: ward.D, ward.D2, single,
# complete, average, mcquitty, median, centroid
# Lahko podamo kot parameter
#model_skupinske$method

# Tip metrike: pridobljen iz matrike različnosti
# Npr. za D <- dist(X, method="manhattan") bi dobili "manhattan"
#model_skupinske$dist.method

# Opis zaporedja združevanja skupin
#model_skupinske$merge %>% View

# Višine, ko je prišlo do združevanja
#model_skupinske$height

# Preureditev elementov, da bomo lahko lepo izrisali dendrogram
#model_skupinske$order

# Poimenovanja podatkovnih enot.
#model_skupinske$labels

# Opisni klic funkcije, ki je sprožila izračun
#model_skupinske$call

#---------------------------------------------------------
#DENDROGRAM - le vmesen graf
#----------------------------------------------------------
#1. način izrisa dendrograma
#plot(model_skupinske, hang=-1,  cex=0.3, main="skupinske")

#2. način: S pomočjo paketa `ggdendro`
#require(ggdendro)

dendrogram_skupinske <- ggdendrogram(model_skupinske, labels=TRUE) +
  theme(axis.text.y = element_blank())

print(dendrogram_skupinske)

#----------------------------------------------------------------------
# Pridobitev podatkov za izris z ggplot
#----------------------------------------------------------------------
#iz ggdendro uporabimo dendro_data() za izvozi podatke v objekt na katerem lahko uporabljamo ggplot
ddata_skupinske <- dendro_data(model_skupinske, type = "rectangle")
#View(ddata_skupinske)
#names(ddata_skupinske) #"segments"    "labels"      "leaf_labels" "class"

#segment(ddata_skupinske) %>% View #povezave v dendrografu

#-----------------------------------------------------------
#dendrogram brez napisov držav - nepotrebno
#-----------------------------------------------------------
ggplot(segment(ddata_skupinske)) + #segment iz ggdendro za povezave v dendrogramu
  geom_segment(aes(x = x, y = y, xend = xend, yend = yend)) + #ggplot2- ravnačrta med dvema točkama
  #coord_flip() +
  #scale_y_reverse(expand = c(0.2, 0)) +
  theme_dendro() #ggdendro

#################################################
#------------------------------------------------
#dodamo še napise
#-------------------------------------------------
#v tabelo labels dodamo še dva stolpca label in drzava
ddata_skupinske$labels$label <- paste(skupinske$drzava[model_skupinske$order], ddata_skupinske$labels$label %>% as.character)
ddata_skupinske$labels$drzava <- skupinske$drzava[model_skupinske$order]

dendrogg_skupinske <- ggplot(segment(ddata_skupinske)) +
  geom_segment(aes(x = x, y = y, xend = xend, yend = yend), size=1) +  #size debelina črt
  labs( title = "DENDROGRAM DRŽAV GLEDE NA OCENO E IN D")+
  theme(plot.title = element_text(hjust=0.5))+
  coord_flip()  +
  scale_y_reverse(expand = c(0.5, 0)) +
  geom_text(
    data=ddata_skupinske$labels,
    aes(x=x, y=y, label=label, colour=drzava), hjust=0, size=3.5, nudge_y = 0.03, show.legend = FALSE) + #size pisava držav
  theme(axis.line.y=element_blank(),
        axis.ticks.y=element_blank(),
        axis.text.y=element_blank(),
        axis.title.y=element_blank(),
        axis.title.x = element_blank(),
        axis.ticks.x=element_blank(),
        axis.text.x=element_blank(),
        panel.background=element_rect(fill="white"),
        panel.grid=element_blank())
print(dendrogg_skupinske)
#dendrogg + ggsave("dendrogg.pdf", device="pdf")
#iz grafa se zdi da je najbolje razvrstiti v 3 skupine Elbow method

#-------------------------------------------------------
# šTEVILO SKUPIN- RAZVRSTITEV GLEDE NA REZ DENDROGRAMA
#-------------------------------------------------------
# 3 skupine
#-------------------------------
# določanje skupin
#--------------------------------
p3 <- cutree(model_skupinske, k=3) #{stats}
#p3   #1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 3 3 3 3 3 2 3 3 3 3 2 2
    #po vrstnem redu iz tabele skupinske nam pove v katero skupino gre posamezna država

#----------------------------------------------------------------------
skupinske$drzava <- recode(skupinske$drzava  #dplyr
                          ,'Bulgaria' = 'BUL'
                          ,'Israel' = 'ISR'
                          ,'Italy' = 'ITA'
                          ,'Japan' = 'JPN'
                          ,'Russia' = 'RUS'
                          ,'Ukraine' = 'UKR'
                          ,'Belarus' = 'BLR'
                          ,'Azerbaijan' = 'AZE'
                          ,'Turkey' ='TUR'
                          ,'China' = 'CHN'
                          ,'France' = 'FRA'
                          ,'Estonia' = 'EST'
                          )

#----------------------------------
#pikice pobarvane v barvah skupine
#-----------------------------------
grupiranje_skupinske3 <- skupinske %>%
  ggplot(aes(x=D, y=E, col=p3, shape = tekma)) +
  guides(color = FALSE)+ #legende za barvo ne potrebujem
  geom_point() +
  geom_text_repel( #iz ggrepel, da se ne prekrivajo imena
    aes(label=drzava),
    size=3,
    color='black',
    nudge_x = 0.05,
    nudge_y = 0.05
  )+
  labs( title = "GRUPIRANJE DRŽAV GLEDE NA OCENO E IN D")+
  scale_y_continuous(breaks=c(6, 6.5, 7, 7.5, 8, 8.5, 9, 9.5))+
  theme_minimal()+
  theme(plot.title = element_text(hjust=0.5))

print(grupiranje_skupinske3)
  #+ ggsave("risba2.pdf", device="pdf")

#KOMENTAR:
#1. SKUPINA: D med 18.2 in 21.1, E med 7.35 in 8.75
#Bul baku oba rek, Jap baku oba rek, Ita baku kiji+obroč, Blr baku kiji+obroč, Rus baku oba rek,
# china baku oba rek, Azerb baku kiji+obroči samo eni finali, Isr oba rek
#2. SKUPINA: D med 18.5 in 21.6 E 5.7 in 6.8
#ita baku kiksane žoge, Bel baku kiksane žoge, UKr baku kiksane žoge samo to v finalih, Est kijev, Fra kijev, Tur kijev
#3. SKUPINA: D med 23.00 in 27.1 in E 6.25 in 8.25
#Ukr kijev oba, Israel kijev obe, Est kijev žoge , Azer kijev oba, Fra kiji+obroč, tur kiji+obroč

#============================================================================================================
#3. GRUPIRANJE GLEDE NA BD/AD INDUVIDUALNE SESTAVE
#============================================================================================================
#s pomočjo razvrščanja določimo skupine tekmovalk, ki so bolj spretne z rekvizitom
#in tiste ki imajo boljšo tehniko s telesom.

risba_ind <- wcg %>%
  ggplot(aes(x=DA, y=DB, col=tekmovalka, shape=rekvizit))+
  geom_point()+
  theme_minimal()+
  facet_grid(.~tekma)+
  #---------------------------------------------------------
#oštevilčimo pikice
#---------------------------------------------------------
#geom_text(
#  data=wcg %>% mutate(n = row_number()),
#  aes(label=tekmovalka),
#  size=2,
#  color='black',
#  nudge_x = 0.03,
#  nudge_y = 0.03
#)+
  theme_minimal()
print(risba_ind)

#opazimo da Vlada izstopa z višjim DB in da pri DA ni takega izstopanja

#---------------------------------------------------------------
#STANDARDIZACIJA MATRIKE
#---------------------------------------------------------------
data_ind <- wcg %>%
  select(DB,DA) %>%
  as.matrix() %>%
  scale() #{base} naredi standardizacijo

#View(data_ind)

#----------------------------------------------------------------
#RAZVRŠČANJE
#----------------------------------------------------------------
razdalje_ind <- dist(as.matrix(data_ind)) #{stats} na i,j tem mestu je razdalja med i-to in j-to vrstico
model_ind <- hclust(razdalje_ind) #{stats} model

#----------------------------------------------------------------------
# Pridobitev podatkov za izris z ggplot
#----------------------------------------------------------------------
ddata_ind <- dendro_data(model_ind, type = "rectangle")

#------------------------------------------------
#dodamo še napise
#-------------------------------------------------
#v tabelo labels dodamo še dva stolpca label in drzava
ddata_ind$labels$label <- paste(wcg$tekmovalka[model_ind$order], ddata_ind$labels$label %>% as.character)
ddata_ind$labels$tekmovalka <- wcg$tekmovalka[model_ind$order]

###########################################################
dendrogg_ind <- ggplot(segment(ddata_ind)) +
  geom_segment(aes(x = x, y = y, xend = xend, yend = yend), size=0.01) +  #size debelina črt
  coord_flip()  +
  scale_y_reverse(expand = c(0.5, 0)) +
  labs(title = "DENDROGRAM GRUPIRANJA INDUVIDUALNIH
  TEKMOVALK GLEDE NA DB IN DA")+
  geom_text(data=ddata_ind$labels,
    aes(x=x, y=y, label=label, colour=tekmovalka), hjust=0, size=1.5, nudge_y = 0.03, show.legend = FALSE) + #size pisava tekmovalk
  theme(axis.line.y=element_blank(),
        axis.ticks.y=element_blank(),
        axis.text.y=element_blank(),
        axis.title.y=element_blank(),
        axis.title.x = element_blank(),
        axis.ticks.x=element_blank(),
        axis.text.x=element_blank(),
        #legend.key = element_blank(),
        panel.background=element_rect(fill="white"),
        panel.grid=element_blank(),
        plot.title = element_text(hjust=0.5))
print(dendrogg_ind)

#--------------------------------------------
#DOLOČANJE ŠTEVILA SKUPIN
#--------------------------------------------
#library(NbClust)
#-----------------------------------------------------------------
# euclidean
#-----------------------------------------------------------------
NbClust(data = data_ind, distance = "euclidean",
        min.nc = 2, max.nc = 15, method = "complete") #priporoča 2
#-----------------------------------------------------------------
NbClust(data = data_ind, distance = "euclidean",
        min.nc = 2, max.nc = 15, method = "ward.D") #priporoča 5
#-----------------------------------------------------------------
NbClust(data = data_ind, distance = "euclidean",
        min.nc = 2, max.nc = 15, method = "ward.D2") #priporoča 3
#-----------------------------------------------------------------
NbClust(data = data_ind, distance = "euclidean",
        min.nc = 2, max.nc = 15, method = "single") #priporoča 2
#-----------------------------------------------------------------
NbClust(data = data_ind, distance = "euclidean",
        min.nc = 2, max.nc = 15, method = "average") #priporoča 2
#-----------------------------------------------------------------
NbClust(data = data_ind, distance = "euclidean",
        min.nc = 2, max.nc = 15, method = "kmeans") #priporoča 5
#-----------------------------------------------------------------
#manhattan
#----------------------------------------------------------------
NbClust(data = data_ind, distance = "manhattan",
        min.nc = 2, max.nc = 15, method = "complete") #priporoča 2
#-----------------------------------------------------------------
NbClust(data = data_ind, distance = "manhattan",
        min.nc = 2, max.nc = 15, method = "ward.D") #priporoča 5
#-----------------------------------------------------------------
NbClust(data = data_ind, distance = "manhattan",
        min.nc = 2, max.nc = 15, method = "ward.D2") #priporoča 4
#-----------------------------------------------------------------
NbClust(data = data_ind, distance = "manhattan",
        min.nc = 2, max.nc = 15, method = "single") #priporoča 2
#-----------------------------------------------------------------
NbClust(data = data_ind, distance = "manhattan",
        min.nc = 2, max.nc = 15, method = "average") #priporoča 2
#-----------------------------------------------------------------
NbClust(data = data_ind, distance = "manhattan",
        min.nc = 2, max.nc = 15, method = "kmeans") #priporoča 5

#-----------------------------------------------------------------
#poskusimo 2, 3, 4, 5 skupin
#-----------------------------------------------------------------
p2ind <- cutree(model_ind, k=2)
p3ind <- cutree(model_ind, k=3)
p4ind <- cutree(model_ind, k=4)
p5ind <- cutree(model_ind, k=5)

#----------------------------------------------------------------
#1) graf če delimo na dve skupini - izloči MINAGAWA Kaho (rip njen trak :|)
#--------------------------------------------------------------
grupiranje_ind2 <- wcg %>%
  ggplot(aes(x=DA, y=DB, col=p2ind)) +
  geom_point() +
  geom_text(
    aes(label=drzava),
    size=2,
    color='black',
    nudge_x = 0.05,
    nudge_y = 0.05
  )#+
#theme_minimal()

#print(grupiranje_ind2)

#################################################################
#----------------------------------------------------------------
#2) graf če delimo na tri skupine
#--------------------------------------------------------------
grupiranje_ind3 <- wcg %>%
  ggplot(aes(x=DA, y=DB, col=p3ind, shape = tekma)) +
  geom_point() +
  geom_text_repel( #da se napisi ne prekrivajo
    aes(label=drzava),
    size=2,
    color='black',
    nudge_x = 0.05,
    nudge_y = 0.05
  )+
theme_minimal()

print(grupiranje_ind3)

#KOMENTAR:
#1. SKUPINA: minagawa z kiksano vajo
#2. SKUPINA:
#3. SKUPINA:

#----------------------------------------------------------------
#3) graf če delimo na štiri skupine
#--------------------------------------------------------------
grupiranje_ind4 <- wcg %>%
  ggplot(aes(x=DA, y=DB, col=p4ind, shape = tekma)) +
  geom_point() +
  geom_text(
    aes(label=drzava),
    size=2,
    color='black',
    nudge_x = 0.05,
    nudge_y = 0.05
  )#+
#theme_minimal()

print(grupiranje_ind4)

#################################################################
#----------------------------------------------------------------
#4) graf če delimo na pet skupin
#--------------------------------------------------------------
grupiranje_ind5 <- wcg %>%
  ggplot(aes(x=DA, y=DB, col=p5ind, shape = tekma)) +
  geom_point() +
  guides(color = FALSE)+ #legende za barvo ne potrebujem
  geom_text_repel(
    aes(label=drzava),
    size=2,
    color='black',
    nudge_x = 0.05,
    nudge_y = 0.05
  )+
  theme_minimal()+
  labs(title = "GRUPIRANJE DRŽAV PO VREDNOSTI
       DB IN DA INDUVIDUALNIH SESTAV")+
  theme(plot.title = element_text(hjust=0.5))

print(grupiranje_ind5)

#==========================================================================
#4. GRUPIRANJE PO REKVIZITIH - KATER JIM JE BOLJŠI
#==========================================================================
#View(induvidualne_finali)
#-------------------------------------------------------------------------
#PRIPRAVA PODATKOV
#-------------------------------------------------------------------------
#View(ecg)

#za vsak rekvizit bomo zapisali katero mesto je zasedla tekmovalka, potem bomo za vsako tekmovalko izbrali najvišjo uvrstitev
induvidualne_rekviziti <- ecg %>% #da ne pokvarimo podatkov
  group_by(rekvizit) %>% #morda ne bo potrebno
  mutate(mesto=as.numeric(c(1:25))) #%>% #ker imamo podatke že urejene

#view(induvidualne_rekviziti)

#-----------------------------
#mediane za posamezen rekvizit
#-----------------------------
#skupna mediana
#induvidualne_rekviziti %>%group_by(rekvizit) %>% median(.,induvidualne_rekviziti$koncna_ocena) #21.5

#mediana po rekvizitih
medians <- induvidualne_rekviziti %>%
  group_by(rekvizit) %>%
  summarize(median = median(koncna_ocena, na.rm = T)) #na.rm - odstrani na vrednosti
#summarize izračuna eno vrednost za vsak rekvizit: ball 21.65, clubs	21.75, hoop 21.00, ribbon	19.30
#View(medians) #tabela z dvema stolpcamain 4 vrsticam: rekvizit median

#------
#graf
#------
ggplot(induvidualne_rekviziti, aes(tekmovalka, koncna_ocena) ) +
  facet_grid(.~rekvizit)+
  geom_point() +
  geom_hline(yintercept = 21.5, color = "blue") + #nastavljena na medijani
  labs( x = "tekmovalke", y = "končna ocena",
        title = "GRAF KONČNIH OCEN GLEDE NA REKVIZIT" )+
  geom_text(
    aes(label=tekmovalka),
    size=2,
    color='black',
    nudge_x = 0.05,
    nudge_y = 0.05
  )

#KOMENTAR: zdi se da bi pri vsakem rekvizitu lahko tekmovalke razdelili na tri skupine
# 1.sk: nad mediano za posamezen rekvizit, 2.sk: pod mediano, 3.sk: jovana markovic, bih hana

#---------------------------------------------------------------------------------
#METODA VODITELJEV
#---------------------------------------------------------------------------------

# Izbrati moramo število voditeljev
# k = 3

data_rekviziti <- ecg %>%
  select(koncna_ocena) %>%
  as.matrix() %>%
  scale()

#----------------------------------------------------------------------------------
modelK_rekviziti <- kmeans(data_rekviziti, 3) #{stats}

# Razporeditev v skupine
modelK_rekviziti$cluster
#[1] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 1 1 1 1 1 1 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
#[42] 3 1 1 1 1 1 1 1 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 1 1 1 1 1 1 2 2 3 3 3 3 3 3 3
#[83] 3 3 3 3 3 1 1 1 1 1 1 1 1 1 1 1 2 2

# Končni centri
#modelK_rekviziti$centers

# Vsota kvadratov vseh razdalj
#modelK_rekviziti$totss #99

# Vsote kvadratov razdaj do centrov za posamezne skupine
#modelK_rekviziti$withinss #5.975027 2.111021 7.690559

# sum(modelK$withinss)
#modelK_rekviziti$tot.withinss

# totss - tot.withinss
#modelK_rekvizit$betweenss

# Število točk v vsaki skupini
#modelK_rekviziti$size #34  6 60

# Število iteracij algoritma
#modelK_rekviziti$iter
#-----------------------------------------------------------------------------------

###############################################################
#--------------------------------------------------------------
# KONČNI GRAF SKUPIN PO REKVIZITIH
#--------------------------------------------------------------
#require('ggrepel') #za overlapping

ecg$tekmovalka <- recode(ecg$tekmovalka
                                #KAJ JE = V KAJ ŽELIMO SPREMENITI
                               ,"ASHRAM Linoy" =  "ASHRAM"
                               ,"ZELIKMAN Nicol" = "ZELIKMAN"
                               ,"KALEYN Boryana" = "KALEYN"
                               ,"SALOS Anastasiia" = "SALOS"
                               ,"NIKOLCHENKO Vlada" = "NIKOLCHENKO"
                               ,"HARNASKO Alina" = "HARNASKO"
                               ,"TASEVA Katrin" = "TASEVA"
                               ,"JALILOVA Arzu" = "JALILOVA"
                               ,"VERDES Andreea" = "VERDES"
                               ,"MELESHCHUK Yeva" = "MELESHCHUK"
                               ,"STOJANOV Rejchl" = "STOJANOV"
                               ,"POLSTJANAJA Jelizaveta" = "POLSTJANAJA"
                               ,"AGHAMIROVA Zohra" = "AGHAMIROVA"
                               ,"PIGNICZKI Fanni" = "PIGNICZKI"
                               ,"VEDENEEVA Ekaterina" = "VEDENEEVA"
                               ,"BOGDANOVA Viktoria" = "BOGDANOVA"
                               ,"ICHIM Sonia" = "ICHIM"
                               ,"GUZ Anastasia" = "GUZ"
                               ,"STEPANKOVA Denisa" = "STEPANKOVA"
                               ,"SOSTAKAITE Fausta" = "SOSTAKAITE"
                               ,"TUNCEL Kamelya" = "TUNCEL"
                               ,"SMIRNOVA Elena" = "SMIRNOVA"
                               ,"SAMBOL Lana" = "SAMBOL"
                               ,"MARKOVIC Jovana" = "MARKOVIC"
                               ,"KAHRIMAN Hana" = "KAHRIMAN")

grupiranje_rekviziti <- ecg %>%
  mutate(skupina=modelK_rekviziti$cluster) %>%
  ggplot(aes(x=tekmovalka, y=koncna_ocena, col=skupina)) +
  facet_grid(.~rekvizit)+
  geom_point()+
 labs( y = "končna ocena",
      title = "SKUPINE INDIVIDUALNIH TEKMOVALK ZA VSAK REKVIZIT")+
  geom_text_repel(  #dodamo imena tekmovalk, ki se ne prekrivajo
    aes(label=tekmovalka),
    size=1.5,
    color='black',
    min.segment.length = 0, #črtica do vsake pikice
    #box.padding = 0.05,
    #nudge_x = 0.05,
    #nudge_y = 0.5
  )+
  scale_y_continuous(breaks=c(2.5, 5, 7.5, 10, 12.5, 15, 17.5, 20, 22.5, 25))+
  theme_bw()+ #brez sivega ozadja
  theme(legend.position = "none" #brez legende
        ,axis.ticks.x = element_blank() #brez črtic na x osi
        ,axis.text.x = element_blank() #brez value na x osi
        ,axis.title.x = element_blank()
        ,axis.text.y = element_text(size = 6)
        ,panel.grid.major = element_blank() #navpične črte
        ,panel.grid.minor = element_blank() #vodoravne črte
        #,strip.background = element_blank() #ozadje pri ball clubs...
        #,panel.border = element_blank()
        ,plot.title = element_text(hjust=0.5)#naslovna sredini

  )

print(grupiranje_rekviziti)

#KOMENTAR: skupine po rekvizitih
#ŽOGA:
#     1.SK: Harnasko, Kaleyn, Ashram, Salos,
#     2.SK:
#     3.SK:
#KIJI:
#OBROČ:
#TRAK:

#==========================================================================================
#5. KAKŠNE BODO OCENE NA OI
#==========================================================================================
#gledamo dvig ocen skozi čas
#---------------------------
#izbrane tekmovalke-na vseh treh tekmah
izbrane <- c("ASHRAM Linoy" ,"ZELIKMAN Nicol","NIKOLCHENKO Vlada","KALEYN Boryana"
             ,"SALOS Anastasiia")
induvidualne_predikcija <- induvidualne_finali %>%
  mutate(tekma = recode(induvidualne_finali$tekma
                                   ,"2018 Sofia" = "2018" #KAJ JE = V KAJ ŽELIMO SPREMENITI
                                   ,"2019 Baku" = "2019"
                                   ,"2020 Kijev" = "2020")) %>%
  subset(tekmovalka %in% izbrane)

#View(induvidualne_predikcija)

#----------------------------------------------------------------
#graf
#----------------------------------------------------------------
ggplot(induvidualne_predikcija, aes(x = D, y = E, col = tekma)) +
  geom_point()

#---------------------------------------------------------------
# MODEL
#--------------------------------------------------------------
model_ind <- lm(E ~ D, data=induvidualne_predikcija)

# Koeficienti premic
#model_ind$coefficients #(Intercept)6.7351068           D 0.1283348

# Residuali (razlike do premice)
#model_ind$residuals

# Dodatne statistike modela
#s <- summary(model_ind) #iz residualov in koeficientov poračuna vrednosti

# Npr. R^2 https://en.wikipedia.org/wiki/Coefficient_of_determination
#s$r.squared

# Pregled nekaterih statistik modela
#require(ggfortify)
#autoplot(model)

#------------------------------------------------------------------
# IZRIS LINEARNEGA MODELA
#------------------------------------------------------------------
ggplot(induvidualne_predikcija, aes(x = D, y = E)) +
  geom_point() +
  facet_grid(.~rekvizit)+
  geom_smooth(method=lm, formula=y~x)

#-----------------------------------------------------------------
# PREDIKCIJA. Kakšna bo E ko bodo D dvignile na 17, 17.5
#-----------------------------------------------------------------
novD <- data.frame(D=c(17.5, 18))
predict(model_ind, novD) #8.980967 9.045134
napovedE <- novD %>% mutate(E=predict(model_ind, .))

napovedE_tabela <- napovedE %>%
  mutate(tekmovalka="napoved", drzava = "napoved", tekma = 2021, rekvizit = "napoved", Pen.= 0.00, koncna_ocena = c(8.980967+17.5, 9.045134+18) )

#napovedE %>% View
#napovedE_tabela %>% view

induvidualne_predikcija_napoved <- rbind(napovedE_tabela, induvidualne_predikcija)

#----------------
# izris napovedi
#----------------
predikcija_graf_ind <- ggplot(induvidualne_predikcija_napoved, aes(x = D, y = E)) +
  geom_point(shape=1) +
  geom_smooth(method=lm, formula=y~x) +
  geom_point(data=napovedE, aes(x=D, y=E), color='red', size=3)+
  labs( title = "PREDIKCIJA POVPREČNE OCENE E ZA INDIVIDUALNE SESTAVE
        NA OLIMPIJSKIH IGRAH 2021" )+
  theme_bw()+ #brez sivega ozadja
  theme(legend.position = "none" #brez legende
        ,plot.title = element_text(hjust=0.5)#naslovna na sredini

  )

print(predikcija_graf_ind)


# allocativ 3001.2021.0002

## Stats Step 1: Import and Clean Data
st1 = 'Stats Step 1: Import and Clean Data'

### Import and Join Labels (W) with Predictors (X) and Outcomes (Y)
df_W = read.csv('_data/FIPS_ZCTA.csv', stringsAsFactors = FALSE) # Import dataset from _data folder
df_X = read.csv('_data/_learn_ZCTA.csv', stringsAsFactors = FALSE) # Import dataset from _data folder
df_Y = read.csv('_data/_spatial_ZCTA.csv', stringsAsFactors = FALSE) # Import dataset from _data folder
df_WX = merge(df_W, df_X, by = 'ZCTA', how = 'inner') # Merge data frame into data slot in SpatialDataFrame
df_WXY = merge(df_WX, df_Y, by = 'ZCTA', all.x = TRUE) # Merge data frame into data slot in SpatialDataFrame
head(df_WXY) # Verify

### Import and Join Labels (W2) with Predictors (X2) and Outcomes (Y2) for 2nd Layer
df_W2 = read.csv('_data/FIPS_ZCTA.csv', stringsAsFactors = FALSE) # Import dataset from _data folder
df_W2$ZCTA <- df_W2$ZIP <- NULL # delete variables v3 and v5
df_W2a = aggregate(df_W2$population, by = list(FIPS = df_W2$FIPS), FUN = sum)
df_W2 = merge(df_W2, df_W2a, by = 'FIPS', how = 'inner') # Merge data frame into data slot in SpatialDataFrame
df_W2$population <- df_W2$x
df_W2$x <- NULL # delete variables v3 and v5
df_W2 = unique(df_W2)
df_X2 = read.csv('_data/_learn_FIPS.csv', stringsAsFactors = FALSE) # Import dataset from _data folder
df_Y2 = read.csv('_data/_spatial_FIPS.csv', stringsAsFactors = FALSE) # Import dataset from _data folder
df_WX2 = merge(df_W2, df_X2, by = 'FIPS', how = 'inner') # Merge data frame into data slot in SpatialDataFrame
df_WXY2 = merge(df_WX2, df_Y2, by = 'FIPS', how = 'inner') # Merge data frame into data slot in SpatialDataFrame
head(df_WXY2) # Verify

### Export to Summary File
sink(file = 'summary.txt', append = TRUE, type = 'output')
cat(c(st1, '\n\n'), file = 'summary.txt', append = TRUE)
cat(c('Selected States: ', State, '\n'), file = 'summary.txt', append = TRUE)
cat(c('Zip Code Observations: ', nrow(df_WXY), '\n'), file = 'summary.txt', append = TRUE)
cat(c('County Observations: ', nrow(df_WXY2), '\n\n'), file = 'summary.txt', append = TRUE)
head(df_WXY)
cat(c('\n'), file = 'summary.txt', append = TRUE)
head(df_WXY2)
cat(c('\n'), file = 'summary.txt', append = TRUE)
cat(c('####################', '\n\n'), file = 'summary.txt', append = TRUE)
sink()

## Stats Step 2: Test for OLS Assumptions
st2 = 'Stats Step 2: Test for OLS Assumptions'
ID = 'ZCTA'
Y = 'crude'

### OLS Assumption 0: Sampling (Observations are a random sample, there are more observations than variables, IV is a result of DV)
oa0 =  'OLS Assumption 0: Sampling (Random sample, observations > predictors, predictor is independent)'
X = colnames(column_to_rownames(df_X, var = ID))
D = column_to_rownames(df_WXY[c(Y, colnames(df_X))], var = ID)
F = as.formula(paste(Y, ' ~ ', paste(X, collapse = ' + '), sep = ''))
OLS = lm(F, data = D) # Identitiy link [Y = DV*1] (aka: Linear) with gaussian error (aka: Linear regression)

### OLS Assumption 1: Specification (Relationship between predictor and outcome is linear)
oa1 = 'OLS Assumption 1: Specification (Relationship between predictor and outcome is linear)'
utt = raintest(OLS) # Utt's Rainbox Test

### OLS Assumption 2: Normality (Errors are normal with a mean = 0)
oa2 = 'OLS Assumption 2:  Normality (Errors are normal with a mean = 0)'
jb = JarqueBeraTest(resid(OLS)) # Jarque Bera Test
ad = AndersonDarlingTest(resid(OLS)) # Anderson-Darling Test
png(paste('_fig/', ST, '_QQ_', ID, '_plot.png', sep = ''))
qqnorm(resid(OLS))
qqline(resid(OLS))
dev.off()

### OLS Assumption 3: No Autocorrelation (Error terms are not correlated among observations)
oa3 = 'OLS Assumption 3: No Autocorrelation (Error terms are not correlated with each other)'
dw = DurbinWatsonTest(OLS) # Drubin-Watson Test

### OLS Assumption 4: Homoskedasticity (Error terms have constant variance across observations)
oa4 = 'OLS Assumption 4: Homoskedasticity (Error is even across observations)'
bp = bptest(OLS) # Breusch-Pagan Test
gq = gqtest(OLS) # Goldfield Quant Test
png(paste('_fig/', ST, '_residuals_', ID, '_plot.png', sep = ''))
plot(resid(OLS))
abline(0,0)
dev.off()

### OLS Assumption 5: No Colinearity (Predictors are not correlated with each other)
oa5 = 'OLS Assumption 5: No Colinearity (Predictors are not correlated with each other)'
plot = ggplot(subset(melt(round(cor(data[X], use = "pairwise.complete.obs"), 3)), value < 1),
                aes(Var1,
                    Var2)) +
            geom_tile(aes(
                fill = value)) +
            geom_text(aes(
                label = value),
                size = 1) +
            scale_fill_gradient2(
                low = low,
                mid = mid,
                high = high) +
            labs(
                title = paste('Correlation Matrix |', outcome, 'in', state, '(', Y, 'rate)', sep = " "),
                fill = 'predictor\ncorrelation') +
            theme_minimal() +
            theme(
                text = element_text(family = 'Bookman'),
                plot.title = element_text(size = 12),
                panel.grid.major = element_blank(),
                panel.grid.minor = element_blank(),
                panel.border = element_blank(),
                panel.background = element_blank(),
                axis.title = element_blank(),
                axis.text = element_text(size = 8),
                axis.text.x = element_text(angle = 90))
ggsave(paste('_fig/', ST, '_correlation_', ID, '_plot.png', sep = ''), plot = plot) # Save ggplot as jpeg

### Export to Summary File
sink(file = 'summary.txt', append = TRUE, type = 'output')
cat(c(st2, '\n\n'), file = 'summary.txt', append = TRUE)
cat(c(oa0, '\n\n'), file = 'summary.txt', append = TRUE)
summary(OLS)
cat(c(oa1, '\n'), file = 'summary.txt', append = TRUE)
print(utt)
cat(c('Significant = Non-linearity\n\n'), file = 'summary.txt', append = TRUE)
cat(c(oa2, '\n'), file = 'summary.txt', append = TRUE)
print(jb)
cat(c('Signficiant = Non-normal\n\n'), file = 'summary.txt', append = TRUE)
print(ad)
cat(c('Signficiant = Non-normal\n\n'), file = 'summary.txt', append = TRUE)
cat(c(oa3, '\n'), file = 'summary.txt', append = TRUE)
print(dw)
cat(c('Signficiant = Autocorrelation\n\n'), file = 'summary.txt', append = TRUE)
cat(c(oa4, '\n'), file = 'summary.txt', append = TRUE)
print(bp)
cat(c('Signficiant = Homoscedastic\n\n'), file = 'summary.txt', append = TRUE)
print(gq)
cat(c('Significant = Heteroscedastic\n\n'), file = 'summary.txt', append = TRUE)
cat(c('\n\n'), file = 'summary.txt', append = TRUE)
cat(c('####################', '\n\n'), file = 'summary.txt', append = TRUE)
sink()

## Stats Step 3: Create Generalized Models
st3 = 'Stats Step 3: Create Generalized Linear Models'
ID = 'ZCTA'
X = colnames(column_to_rownames(df_X, var = ID))

### Create Linear Regression Model
Y = 'scale'
glm = 'linear'
glm0 = paste('DV = ', Y, ', regression = ', glm, sep = '')
D = column_to_rownames(df_WXY[c(Y, colnames(df_X))], var = ID)
F = as.formula(paste(Y, ' ~ ', paste(X, collapse = ' + '), sep = ''))
GLM0 = glm(F, data = D, family = gaussian()) # Identitiy link [Y = DV*1] (aka: Linear) with gaussian error (aka: Linear regression)

### Create Linear Regression Model
Y = 'log'
glm = 'linear'
glm1 = paste('DV = ', Y, ', regression = ', glm, sep = '')
D = column_to_rownames(df_WXY[c(Y, colnames(df_X))], var = ID)
F = as.formula(paste(Y, ' ~ ', paste(X, collapse = ' + '), sep = ''))
GLM1 = glm(F, data = D, family = gaussian()) # Identitiy link [Y = DV*1] (aka: Linear) with gaussian error (aka: Linear regression)

### Create Logistic Regression Model
Y = 'binary'
glm = 'logistic'
glm2 = paste('DV = ', Y, ', regression = ', glm, sep = '')
D = column_to_rownames(df_WXY[c(Y, colnames(df_X))], var = ID)
F = as.formula(paste(Y, ' ~ ', paste(X, collapse = ' + '), sep = ''))
GLM2 = glm(F, data = D, family = binomial()) # Logit link [Y = logit(DV)?] (aka: Logistic) with binomial? error (aka: Logistic regression)

### Create Poisson Regression Model
Y = 'crude'
glm = 'poisson'
glm3 = paste('DV = ', Y, ', regression = ', glm, sep = '')
D = column_to_rownames(df_WXY[c(Y, colnames(df_X))], var = ID)
F = as.formula(paste(Y, ' ~ ', paste(X, collapse = ' + '), sep = ''))
GLM3 = glm(F, data = D, family = poisson()) # Log link [Y = ln(DV)] (aka: Log-Linear) with poisson error (aka: Poisson regression)

### Create Negative Binomial Regression Model
Y = 'crude'
glm = 'negbinomial'
glm4 = paste('DV = ', Y, ', regression = ', glm, sep = '')
D = column_to_rownames(df_WXY[c(Y, colnames(df_X))], var = ID)
F = as.formula(paste(Y, ' ~ ', paste(X, collapse = ' + '), sep = ''))
GLM4 = glm.nb(F, data = D) # Log link [Y = ln(DV)] (aka: Log-Linear) with gamma error (aka: Negative binomial regression)

### F-test for overdispersion
t0 = 'overdispersion'
ovd0 = 1 - pchisq(deviance(GLM0), df.residual(GLM0)) # Chi-Sq on null deviance to residual deviance
ovd1 = 1 - pchisq(deviance(GLM1), df.residual(GLM1)) # Chi-Sq on null deviance to residual deviance
ovd2 = 1 - pchisq(deviance(GLM2), df.residual(GLM2)) # Chi-Sq on null deviance to residual deviance
ovd3 = 1 - pchisq(deviance(GLM3), df.residual(GLM3)) # Chi-Sq on null deviance to residual deviance
ovd4 = 1 - pchisq(deviance(GLM4), df.residual(GLM4)) # Chi-Sq on null deviance to residual deviance

### Export to Summary File
sink(file = 'summary.txt', append = TRUE, type = 'output')
cat(c(st3, '\n\n'), file = 'summary.txt', append = TRUE)
cat(c('Generalized model for', glm0, '\n'), file = 'summary.txt', append = TRUE)
summary(GLM0)
cat(c('Generalized model for', glm1, '\n'), file = 'summary.txt', append = TRUE)
summary(GLM1)
cat(c('Generalized model for', glm2, '\n'), file = 'summary.txt', append = TRUE)
summary(GLM2)
cat(c('Generalized model for', glm3, '\n'), file = 'summary.txt', append = TRUE)
summary(GLM3)
cat(c('Generalized model for', glm4, '\n'), file = 'summary.txt', append = TRUE)
summary(GLM4)
cat(c('\n\n'), file = 'summary.txt', append = TRUE)
cat(c('####################', '\n\n'), file = 'summary.txt', append = TRUE)
sink()

## Stats Step 4: Hierarchical Linear Models
st4 = 'Stats Step 4: Hierarchical Linear Models'

### Mixed-Effects Regression for County Variable
mx1 = 'Fixed-Effects Regression for County Variables'
ID2 = 'FIPS'
Y = 'log'
df_WXY2$AHRF1746 = as.integer(cut(df_WXY2$AHRF1746, quantile(df_WXY2$AHRF1746, probs=0:4/4, na.rm = TRUE), include.lowest=TRUE))
df_WXY2$AHRF729 = as.integer(cut(df_WXY2$AHRF729, quantile(df_WXY2$AHRF729, probs=0:4/4, na.rm = TRUE), include.lowest=TRUE))
X2 = colnames(column_to_rownames(df_X2, var = ID2))
D2 = column_to_rownames(merge(df_WXY[c(ID2, Y, colnames(df_X))], df_WXY2[c(colnames(df_X2))], by  = ID2, how = 'left'), var = ID)

#### Random Intercept by County
F = as.formula(paste(Y, ' ~ (1|', ID2, ') + ' , paste(X, collapse = ' + '), sep = ''))
fix0 = lmer(F, data = D2[c(colnames(column_to_rownames(df_X, var = 'ZCTA')), Y, colnames(df_X2))]) # Poisson regression varying intercept with individual-level predictor

#### County Variable 1
H = 'AHRF101'
F = as.formula(paste(Y, ' ~ (1|', H, ') + ' , paste(X, collapse = ' + '), sep = ''))
fix1 = lmer(F, data = D2[c(colnames(column_to_rownames(df_X, var = 'ZCTA')), Y, colnames(df_X2))]) # Poisson regression varying intercept with individual-level predictor

#### County Variable 2
H = 'AHRF1451'
F = as.formula(paste(Y, ' ~ (1|', H, ') + ' , paste(X, collapse = ' + '), sep = ''))
fix2 = lmer(F, data = D2[c(colnames(column_to_rownames(df_X, var = 'ZCTA')), Y, colnames(df_X2))]) # Poisson regression varying intercept with individual-level predictor

#### County Variable 3
H = 'AHRF919'
F = as.formula(paste(Y, ' ~ (1|', H, ') + ' , paste(X, collapse = ' + '), sep = ''))
fix3 = lmer(F, data = D2[c(colnames(column_to_rownames(df_X, var = 'ZCTA')), Y, colnames(df_X2))]) # Poisson regression varying intercept with individual-level predictor

#### County Variable 4
H = 'AHRF1634'
F = as.formula(paste(Y, ' ~ (1|', H, ') + ' , paste(X, collapse = ' + '), sep = ''))
fix4 = lmer(F, data = D2[c(colnames(column_to_rownames(df_X, var = 'ZCTA')), Y, colnames(df_X2))]) # Poisson regression varying intercept with individual-level predictor

#### County Variable 5
H = 'AHRF540'
F = as.formula(paste(Y, ' ~ (1|', H, ') + ' , paste(X, collapse = ' + '), sep = ''))
fix5 = lmer(F, data = D2[c(colnames(column_to_rownames(df_X, var = 'ZCTA')), Y, colnames(df_X2))]) # Poisson regression varying intercept with individual-level predictor

#### County Variable 6
H = 'AHRF919'
F = as.formula(paste(Y, ' ~ (1|', H, ') + ' , paste(X, collapse = ' + '), sep = ''))
fix6 = lmer(F, data = D2[c(colnames(column_to_rownames(df_X, var = 'ZCTA')), Y, colnames(df_X2))]) # Poisson regression varying intercept with individual-level predictor

#### County Variable 7
H = 'AHRF1029'
F = as.formula(paste(Y, ' ~ (1|', H, ') + ' , paste(X, collapse = ' + '), sep = ''))
fix7 = lmer(F, data = D2[c(colnames(column_to_rownames(df_X, var = 'ZCTA')), Y, colnames(df_X2))]) # Poisson regression varying intercept with individual-level predictor

#### County Variable 8
H = 'AHRF845'
F = as.formula(paste(Y, ' ~ (1|', H, ') + ' , paste(X, collapse = ' + '), sep = ''))
fix8 = lmer(F, data = D2[c(colnames(column_to_rownames(df_X, var = 'ZCTA')), Y, colnames(df_X2))]) # Poisson regression varying intercept with individual-level predictor

#### County Variable 9
H = 'AHRF1746'
F = as.formula(paste(Y, ' ~ (1|', H, ') + ' , paste(X, collapse = ' + '), sep = ''))
fix9 = lmer(F, data = D2[c(colnames(column_to_rownames(df_X, var = 'ZCTA')), Y, colnames(df_X2))]) # Poisson regression varying intercept with individual-level predictor

#### County Variable 10
H = 'AHRF729'
F = as.formula(paste(Y, ' ~ (1|', H, ') + ' , paste(X, collapse = ' + '), sep = ''))
fix10 = lmer(F, data = D2[c(colnames(column_to_rownames(df_X, var = 'ZCTA')), Y, colnames(df_X2))]) # Poisson regression varying intercept with individual-level predictor

### One Way ANOVA for MLE
mx2 = 'One Way ANOVA for MLE'
hlm0 = ranova(fix0)
hlm1 = ranova(fix1)
hlm2 = ranova(fix2)
hlm3 = ranova(fix3)
hlm4 = ranova(fix4)
hlm5 = ranova(fix5)
hlm6 = ranova(fix6)
hlm7 = ranova(fix7)
hlm8 = ranova(fix8)
hlm9 = ranova(fix9)
hlm10 = ranova(fix10)

### Export to Summary File
sink(file = 'summary.txt', append = TRUE, type = 'output')
cat(c(st4, '\n\n'), file = 'summary.txt', append = TRUE)
cat(c(mx1, '\n'), file = 'summary.txt', append = TRUE)
cat(c('DV = ', Y, '\n'), file = 'summary.txt', append = TRUE)
summary(fix0)
summary(fix1)
summary(fix2)
summary(fix3)
summary(fix4)
summary(fix5)
summary(fix6)
summary(fix7)
summary(fix8)
summary(fix9)
summary(fix10)
cat(c('\n'), file = 'summary.txt', append = TRUE)
cat(c(mx2, '\n'), file = 'summary.txt', append = TRUE)
print(hlm1)
print(hlm2)
print(hlm3)
print(hlm4)
print(hlm5)
print(hlm6)
print(hlm7)
print(hlm8)
print(hlm9)
print(hlm10)
cat(c('\n'), file = 'summary.txt', append = TRUE)
cat(c('\n\n'), file = 'summary.txt', append = TRUE)
cat(c('####################', '\n\n'), file = 'summary.txt', append = TRUE)
sink()

## FINAL STEP: Create final Model
final = 'Final Step: Create final Model'
FINAL = lmer(log ~ (1|AHRF1029) +
                        D2_T4_5 +
                        D2_T2_39 +
                        D2_T1_17 +
                        D2_T1_46 +
                        D2_T2_90,
                        data = D2) # Varying intercept with individual-level predictor

### Export features and labels
Feature = c('D3_1029', 'D2_T4_5', 'D2_T2_39', 'D2_T1_17', 'D2_T1_46', 'D2_T2_90')
df_select = as.data.frame(Feature)
df_labels = read.csv('_label/CENSUS_ACS_2019_ZCTA.csv') # Import dataset from _data folder
df_labels2 = read.csv('_label/HRSA_AHRF_2019_FIPS.csv') # Import dataset from _data folder
df_labels = rbind(df_labels, df_labels2)
df_select = merge(df_select, df_labels, by = 'Feature')
head(df_select)
write.csv(df_select, paste('_data/_stats_FINAL.csv', sep = ''), row.names = FALSE) # Clean in excel and select variable

install.packages('finalfit')
library(finalfit)
D2$D3_1029 <- D2$AHRF1029

df_ff = D2[c(Feature, 'FIPS')]
colnames(df_ff) <- c(df_select$Description, 'County')
df_ff$natural_log_of_crude_prevalance <- D2$log

head(df_ff)

explanatory = c("Households By Type Total Households Average Household Size",
                    "Educational Attainment Population 25 Years And Over Bachelor'S Degree Or Higher",
                    "Class Of Worker Civilian Employed Population 16 Years And Over Government Workers",
                    "Percentage Of Families And People Whose Income In The Past 12 Months Is Below The Poverty Level People In Families",
                    "Sex And Age Total Population Female")
dependent = ('natural_log_of_crude_prevalance')
explanatory_multi = ('Manufacturing-Dep Typology Code')
random_effect = 'County'
df_ff %>% finalfit(dependent, explanatory, random_effect)

### Export to Summary File
sink(file = 'summary.txt', append = TRUE, type = 'output')
cat(c(final, '\n\n'), file = 'summary.txt', append = TRUE)
print(FINAL)
summary(FINAL)
print(ranova(FINAL))
print(anova(FINAL))
icc(FINAL)
cat(c('\n\n'), file = 'summary.txt', append = TRUE)
cat(c('####################', '\n\n'), file = 'summary.txt', append = TRUE)
sink()


#### Generate Transects for Canadian cities

## Load libraries
library(raster)
library(sf)
# library(dismo) ## used to get Canada Polygon

## load fucntions
source("scripts//functions.r")

## Download polygon for Canada
# canPoly <- getData(name="GADM", country="CAN", level=1) ## run once for download
canPoly <- readRDS("data//gadm36_CAN.rds") ## load polygon
# plot(canPoly) ## takes a while because all the islands

## dataframe of lat, lon for cities
cities <- data.frame(city = c("Vancouver","Edmonton","Winnipeg","Toronto","Montreal","Halifax"),
                     lon = c(-123.1206,-113.4939,-97.1383,-79.3832,-73.5672,-63.575),
                     lat = c(49.2828,53.5461,49.895,43.6532,45.5017,44.6486))

## Create spatial dataframe
coordinates(cities) <- ~lon+lat # specify x and y columns
cities <- st_as_sf(cities) # Proceeded here with the package "sf", I find it more userfriendly than sp. Also the format with all the cities in the same dataframe class=="sf" was easier to play with than the class=="sp".
proj4string(cities) <- CRS("+proj=longlat +datum=WGS84") ## Need to use a CRS (I picked WGS84), for non-GIS folk, this does a good job explaining a CRS https://rspatial.org/raster/spatial/6-crs.html

## Notes
## a CRS of WGS84 has units in decimal degrees. The earth is circular so 1 decimal degree does not equal the same thing at different latitudes (e.g. higher latitudes smaller distances, latitudes closer to the equator are larger).
## Every degree away from the equator is equal to cosine of that latitude.
deg2rad <- function(deg) {(deg * pi) / (180)} ## function converts decimal degrees to radians
lat2km <- function(lat){ cos(deg2rad(lat)) * 111.32 } ## cosine of latitude in radius multiplied by the size of the decimal at the equator

## Find out the units of km for decimal degrees at the latitude of Toronto.
lat2km(43.6532) ## 1 decimal degree at Toronto is 80.5435

## Decimal degrees to 10 km buffer
resToronto <- 1/80.5435*10 ## 0.1241 decimal degrees  = 10 km

## List cities to generate transects not in sp dataframe
cities <- data.frame(city = c("Vancouver","Edmonton","Winnipeg","Toronto","Montreal","Halifax"),
                     lon = c(-123.1206,-113.4939,-97.1383,-79.3832,-73.5672,-63.575),
                     lat = c(49.2828,53.5461,49.895,43.6532,45.5017,44.6486))

vancouverTransect <- cityTransect(citylon = cities[cities$city == "Vancouver","lon"], citylat = cities[cities$city == "Vancouver","lat"], nquadrat = 5, buffer = 5, distance = 10)

edmontonTransect <- cityTransect(citylon = cities[cities$city == "Edmonton","lon"], citylat = cities[cities$city == "Edmonton","lat"], nquadrat = 5, buffer = 5, distance = 10)

winnipegTransect <- cityTransect(citylon = cities[cities$city == "Winnipeg","lon"], citylat = cities[cities$city == "Winnipeg","lat"], nquadrat = 5, buffer = 5, distance = 10)

torontoTransect <- cityTransect(citylon = cities[cities$city == "Toronto","lon"], citylat = cities[cities$city == "Toronto","lat"], nquadrat = 5,  ## nquadrat is the number of quadrats
                                buffer=5, ## distance in km around the centroid of city to make the buffer. e.g. 5 = 10 x 10 km box with city as center
                                distance = 10) ## distance in km between buffered transects

montrealTransect <- cityTransect(citylon = cities[cities$city == "Montreal","lon"], citylat = cities[cities$city == "Montreal","lat"], nquadrat = 5, buffer = 5, distance = 10)

halifaxTransect <- cityTransect(citylon = cities[cities$city == "Halifax","lon"], citylat = cities[cities$city == "Halifax","lat"], nquadrat = 5, buffer = 5, distance = 10)

# ## Plot to make sure it worked
# Check Vancouver
plot(canPoly[canPoly$NAME_1=="British Columbia",]) ## plot just British columbia
plot(cities, add=T, col="blue", pch=19, cex=2) ## plot all cities
plot(vancouverTransect, add = TRUE)
# Check Edmonton
plot(canPoly[canPoly$NAME_1=="Alberta",]) ## plot just Alberta
plot(cities, add=T, col="blue", pch=19, cex=2) ## plot all cities
plot(edmontonTransect, add = TRUE)
# Check Winnipeg
plot(canPoly[canPoly$NAME_1=="Manitoba",]) ## plot just Manitoba
plot(cities, add=T, col="blue", pch=19, cex=2) ## plot all cities
plot(winnipegTransect, add = TRUE)
# Check Toronto
plot(canPoly[canPoly$NAME_1=="Ontario",]) ## plot just Ontario
plot(cities, add=T, col="blue", pch=19, cex=2) ## plot all cities
plot(torontoTransect, add = TRUE)
# Check Montreal
plot(canPoly[canPoly$NAME_1=="Québec",]) ## plot just Quebec
plot(cities, add=T, col="blue", pch=19, cex=2) ## plot all cities
plot(montrealTransect, add = TRUE)
# Check Halifax
plot(canPoly[canPoly$NAME_1=="Nova Scotia",]) ## plot just Nova Scotia
plot(cities, add=T, col="blue", pch=19, cex=2) ## plot all cities
plot(halifaxTransect, add = TRUE)

## Save to file
saveRDS(vancouverTransect, file = "data/transects/vancouver.rds")
saveRDS(edmontonTransect, file = "data/transects/edmonton.rds")
saveRDS(winnipegTransect, file = "data/transects/winnipeg.rds")
saveRDS(torontoTransect, file = "data//transects//toronto.rds")
saveRDS(montrealTransect, file = "data/transects/montreal.rds")
saveRDS(halifaxTransect, file = "data/transects/halifax.rds")


library(ggplot2) # Import library
sal = read.csv("/Salaries.csv", header = TRUE) # Open CSV

# Density Random to fit data with Legend & Overlay fill for density plot
gpplot(sal,aes(x=Salary,fill=Position))+
    geom_density(col=NA)

# Density Random to fit data with Legend & Opaque Overlay fill for density plot
ggplot(sal, aes(Salary, fill = Position, colour = Position)) +
  geom_density(alpha = 0.1)

install.packages("plyr")
library(plyr)
means <- ddply(sal, "Position", summarise, grp.mean=mean(Salary))
head(means)

ggplot(sal, aes(x=Salary))+
  geom_density()+facet_grid(Position ~ .)+
  geom_vline(data=means, aes(xintercept=grp.mean, color="red"),
             linetype="dashed")