rm(list = ls()) # This clears everything from memory.

setwd("~/Dropbox/BCI_Turnover")
load("~/Dropbox/MS/TurnoverBCI/temp.RData")

load("BCI_turnover20141213.RData")

library(mgcv)
library(lme4)
library(dplyr)
unlist(WSG100)
unlist(Moist100)
unlist(slope.100.rare[10])
unlist(convex.100.rare[10])

D100ba <- list()
for (i in 1:7){
  D100ba[[i]] <- tapply(pi*(D[,dbh.temp[i]]/10/2)^2/100^2, list(D$quad100,D$sp), sum)
  D100ba[[i]][is.na(D100ba[[i]])] <- 0
  D100ba[[i]] <- D100ba[[i]][-51,]
}

time <- c(1982,1985,1990,1995,2000,2005,2010)
Time=c(rep(1982,50),
                           rep(1985,50),
                           rep(1990,50),
                           rep(1995,50),
                           rep(2000,50),
                           rep(2005,50),
                           rep(2010,50))

temp.ab <- data.frame(SP = colnames(D100ba[[1]]),
                      ab10_3 = D100ba[[1]][3,],
                      ab10_4 = D100ba[[1]][3,])
rownames(temp.ab) <- NULL

temp <- merge(temp.ab,trait, by="SP")

temp$moge1 <- (temp$ab10_3 * temp$convex_size_100)/temp$ab10_3
temp$moge2 <- (temp$ab10_4 * temp$convex_size_100)/temp$ab10_4

moge <- data.frame(temp$SP,temp$moge1)

moge3 <- as.character(na.omit(moge[moge[,2] < -0.2,][,1]))

ab.t.data[(rownames(ab.t.data) %in% moge3),"census_1982"]
ab.t.data[(rownames(ab.t.data) %in% moge3),"census_2010"]

unlist(convex.100.rare[10])[1:50]

WSG100.rm <-list()
Moist100.rm <-list()
slope100.rm <-list()
convex100.rm <-list()

# D100m[[1]][1:5,!(colnames(D100m[[1]]) %in% c("PIPECO","POULAR"))]

###use convex mean
for (i in 1:7){
  WSG100.rm[[i]] <- com.mean.ab(D100ba[[i]][,!(colnames(D100ba[[1]]) %in% c("PIPECO","POULAR", ))],trait,"WSG")
  Moist100.rm[[i]] <- com.mean.ab(D100ba[[i]][,!(colnames(D100ba[[1]]) %in% c("PIPECO"))],trait,"Moist")
  slope100.rm[[i]] <- com.mean.ab(D100ba[[i]][,!(colnames(D100ba[[1]]) %in% c("FARAOC","POULAR"))],trait,"sp.slope.mean")
  # convex100.rm[[i]] <- com.mean.ab(D100ba[[i]][,!(colnames(D100ba[[1]]) %in% c("ALSEBL","SWARS1"))],trait,"sp.convex.mean")
  convex100.rm[[i]] <- com.mean.ab(D100ba[[i]][,!(colnames(D100ba[[1]]) %in% c("SWARS1", "ALSEBL", "FARAOC"))],trait,"sp.convex.mean")
}

moge <- data.frame(WSG = unlist(WSG100),
                   Moist = unlist(Moist100),
                   slope = unlist(slope100),
                   convex = unlist(convex100),
                   site = as.factor(rep(1:50,7)),
                   Time)

moge20 <- data.frame(WSG = unlist(WSG20),
                   Moist = unlist(Moist20),
                   slope = unlist(slope20),
                   convex = unlist(convex20),
                   site = as.factor(rep(1:1250,7)),
                   Time)

moge100r <- data.frame(WSG = unlist(WSG100.rm),
                   Moist = unlist(Moist100.rm),
                   slope = unlist(slope100.rm),
                   convex = unlist(convex100.rm),
                   site = rep(1:50,7),
                   Time)

moge20r <- data.frame(WSG = unlist(WSG20),
                   Moist = unlist(Moist20),
                   slope = unlist(slope20),
                   convex = unlist(convex20),
                   site = as.factor(rep(1:1250,7)),
                   Time)

#
# r1.r <- gamm(WSG ~  s(Time,k=4), random = list(site=~1), data=moge20, correlation = corAR1())
# r2.r <- gamm(Moist ~  s(Time,k=4), random = list(site=~1), data=moge20, correlation = corAR1())
# r3.r <- gamm(convex ~  s(Time,k=4), random = list(site=~1), data=moge20, correlation = corAR1())
# r4.r <- gamm(slope ~  s(Time,k=4), random = list(site=~1), data=moge20, correlation = corAR1())
#
# r1 <- gamm(WSG ~  s(Time,k=4), random = list(site=~1), data=moge20, correlation = corAR1())
# r2 <- gamm(Moist ~  s(Time,k=4), random = list(site=~1), data=moge20, correlation = corAR1())
# r3 <- gamm(convex ~  s(Time,k=4), random = list(site=~1), data=moge20, correlation = corAR1())
# r4 <- gamm(slope ~  s(Time,k=4), random = list(site=~1), data=moge20, correlation = corAR1())

r1.r100<- gamm(WSG ~  s(Time,k=4), random = list(site=~1), data=moge100r, correlation = corAR1())
r2.r100<- gamm(Moist ~  s(Time,k=4), random = list(site=~1), data=moge100r, correlation = corAR1())
r3.r100<- gamm(convex ~  s(Time,k=4), random = list(site=~1), data=moge100r, correlation = corAR1())
r4.r100<- gamm(slope ~  s(Time,k=4), random = list(site=~1), data=moge100r, correlation = corAR1())

r1_100 <- gamm(WSG ~  s(Time,k=4), random = list(site=~1), data=moge, correlation = corAR1())
r2_100 <- gamm(Moist ~  s(Time,k=4), random = list(site=~1), data=moge, correlation = corAR1())
r3_100 <- gamm(convex ~  s(Time,k=4), random = list(site=~1), data=moge, correlation = corAR1())
r4_100 <- gamm(slope ~  s(Time,k=4), random = list(site=~1), data=moge, correlation = corAR1())

##############################################################
#original R2
##############################################################
moge$temp <- rnorm(nrow(moge))
moge100r <- moge100r %>% mutate(temp = rnorm(nrow(.)))
moge.cross <- moge100r[order(moge100r$temp),]
rownames(moge.cross) <- NULL
k <- 10
# res.cv <- numeric(k)
  res.cv <- NULL
  SS <- NULL
  PREDS <- NULL
  i <- 1
  r2.1 <- gamm(WSG ~  s(Time,k=4), random = list(site=~1), data=moge.cross[(35*i+1):350,], correlation = corCAR1(form=~Time))
  res <- data.frame(fitted = r2.1$gam$fitted.values, Time= r2.1$gam$model$Time)

  # res <- data.frame(fitted = r2.1$gam$fitted.values,
                    # res = r2.1$gam$residuals,
                    # res2 = r2.1$gam$y - r2.1$gam$fitted.values -r2.1$gam$residuals,
                    # Time= r2.1$gam$model$Time)

  res2 <- unique(res[order(res$Time),])
  res3 <- merge(moge.cross[1:35,],res2,by="Time")

  SS[i] <- sum((moge.cross[1:35,"WSG"] - mean(moge.cross[1:35,"WSG"]))^2)
  PREDS[i] <- sum((res3$fitted - res3$WSG)^2)
  # res.cv[i] <- 1 - mean(PREDS)/mean(SS)

  # r2.1$lme$residuals$site

for (i in 2:(k-1)){
  temp.data <- rbind(moge.cross[1:(35*(i-1)),],
                     moge.cross[(35*i+1):350,])
  r2.1 <- gamm(WSG ~  s(Time,k=4), random = list(site=~1), data=temp.data, correlation = corCAR1(form=~Time))
  res <- data.frame(fitted = r2.1$gam$fitted.values, Time= r2.1$gam$model$Time)
  res2 <- unique(res[order(res$Time),])

  K1 <- 35*(i-1) +1
  K2 <- 35*i
  res3 <- merge(moge.cross[K1:K2,],res2,by="Time")
  SS[i] <- sum((moge.cross[K1:K2,"WSG"] - mean(moge.cross[K1:K2,"WSG"]))^2)
  PREDS[i] <- sum((res3$fitted - res3$WSG)^2)
  # res.cv[i] <- 1 - mean(PREDS)/mean(SS)
}

i <- 10
  r2.1 <- gamm(WSG ~  s(Time,k=4), random = list(site=~1), data=moge.cross[1:35*k,], correlation = corCAR1(form=~Time))
  res <- data.frame(fitted = r2.1$gam$fitted.values, Time= r2.1$gam$model$Time)
  res2 <- unique(res[order(res$Time),])
  res3 <- merge(moge.cross[316:350,],res2,by="Time")
  SS[i] <- sum((moge.cross[316:350,"WSG"] - mean(moge.cross[316:350,"WSG"]))^2)
  PREDS[i] <- sum((res3$fitted - res3$WSG)^2)
  # res.cv[i] <- 1 - mean(PREDS)/(SS)

1 - mean(PREDS,na.rm=T)/mean(SS,na.rm=T)
########################################
#convex
# [1] -0.0003082712

#Moist
#[1] -0.01544178

#slope
#[1] -0.02532901

#WSG

set.seed(0)
dat <- gamSim(1,n=200,scale=2)

f

CV <- mean(res.cv,na.rm=T)
R2 <- 1 - mean(res.cv,na.rm=T)/mean((r2.1$gam$y - mean(r2.1$gam$y))^2)

data.frame(CV,R2)

res <- gamm(WSG ~  s(Time, k=4), random = list(site=~1), data=moge, correlation = corCAR1())
res2 <- res$gam$residuals
fit <- res$gam$fitted.values
sp_ef <- rep(ranef(res$lme)$site %>% unlist, 7)

data_frame(res = res2, fit = fit) %>%
  bind_cols(., moge) %>%
  mutate(res2 = WSG - fit) %>%
  mutate(fit2 = WSG - res) %>%
  mutate(WSG2 = fit + res) %>%
  # filter(site == 1)  %>%
  mutate(sp_ef = sp_ef) %>%
  mutate(fit3 = fit + sp_ef)

gamm(Moist ~  s(Time, k=4), random = list(site=~1), data=moge, correlation = corCAR1()) %>% .$gam %>% .$fitted.values %>% unique

gam(Moist ~  s(Time, k=4), data=moge, correlation = corCAR1()) %>% .$fitted.values %>% unique

  group_by(site) %>%
  summarize(res_mean = mean(res)) %>% .$res_mean %>% hist

plot(moge$Moist, res$gam$residuals)

gam(WSG ~  s(Time, k=4), data = moge %>% filter(site == 3), correlation = corCAR1()) %>% .$fitted.values %>% plot
#
# par(mfrow=c(4,5))
# for (i in 201:220) plot(Moist ~ Time, data = moge20 %>%  filter(site == i) %>% arrange(Time), type = "b")

summary(res$lme)
summary(res$gam)
plot(res$lme)

res$lme$residuals
res2 <- res$lme$fitted

res2 <- res$gam$residuals
res3 <- res$lme$residuals

data_frame(res2, res3[,3])

res2 <- res$gam$residuals
fit <- res$gam$fitted.values

res3 <- cbind(res2, moge)
par(mfrow=c(1,1))

plot(res2 ~ WSG, res3)

par(mfrow=c(1,3))
hist(res$lme$residuals[,1])
hist(res$lme$residuals[,2])
hist(res$lme$residuals[,3])

res2 <- gam(slope ~  s(Time,k=4), data=moge, correlation = corCAR1())

par(mfrow = c(1,1))
plot(WSG ~ Time, moge)
for (i in 1:50){
  points(WSG ~ Time, moge %>% filter(site == i), type = "l")
}

dat <- dat %>%
  arrange(x2)
plot(y ~x2,dat)
for(i in 1:4) points(y~x2, dat%>%filter(fac ==i), type = "l")
res <- gamm(y ~ s(x2), data=dat, random = list(fac=~1), family=poisson)

res$lme$fitted
res$gam$fitted.value

gamm(slope ~  s(Time,k=4), random = list(site=~1), data=moge.cross[(35*i+1):350,], correlation = corCAR1())

gamm(noquote("slope ~ s(Time, k= 4)"), random = list(site=~1), data=moge.cross[(35*i+1):350,], correlation = corCAR1())

sp_ef <- rep(ranef(res$lme)$site %>% unlist, 7)

data_frame(res = res2, fit = fit) %>%
  bind_cols(., moge) %>%
  mutate(res2 = WSG - fit) %>%
  mutate(fit2 = WSG - res) %>%
  mutate(WSG2 = fit + res) %>%
  # filter(site == 1)  %>%
  mutate(sp_ef = sp_ef) %>%
  mutate(fit3 = fit + sp_ef)

##############################################
## cross validation new
###########################################

  moge$temp <- rnorm(nrow(moge))
  moge100r$temp <- rnorm(nrow(moge100r))

  moge.cross <- moge[order(moge$temp),] %>%
    mutate(site = as.factor(site))
  rownames(moge.cross) <- NULL
  k <- 10
  # res.cv <- numeric(k)
  res.cv <- NULL
  SS <- NULL
  PREDS <- NULL
  i <- 1
  r2.1 <- gamm(WSG ~  s(Time,k=4), random = list(site=~1), data=moge.cross[(35*i+1):350,], correlation = corCAR1(form=~Time))
  site_ef <- ranef(r2.1$lme)$site %>% unlist
  site_ef_dat <- data_frame(site = as.factor(1:50), site_ef = site_ef)
  res <- data_frame(fitted = r2.1$gam$fitted.values, Time= r2.1$gam$model$Time,
    site = moge.cross[(35*i+1):350, "site"])

    # %>%
    # merge(., site_ef_dat, by = "site") %>%
    # mutate(fitted_site = fitted + site_ef)

  # res <- data.frame(fitted = r2.1$gam$fitted.values,
                    # res = r2.1$gam$residuals,
                    # res2 = r2.1$gam$y - r2.1$gam$fitted.values -r2.1$gam$residuals,
                    # Time= r2.1$gam$model$Time)
  res2 <- res %>%
    dplyr::select(fitted, Time) %>%
    unique %>%
    arrange(Time)

  res3 <- full_join(moge.cross[1:35,], res2, by="Time") %>%
    left_join(., site_ef_dat, by = "site") %>%
    mutate(fitted_site = fitted + site_ef)

  res3 <- res3 %>%
    mutate(obs2 = WSG - site_ef)

# plot(obs2 ~ Time, res3)
# points(fitted ~ Time, res3, pch = 16)

  # SS[i] <- sum((moge.cross[1:35,"WSG"] - mean(moge.cross[1:35,"WSG"]))^2)
  SS[i] <- sum((res3$obs2 - mean(res3$obs2))^2)
  PREDS[i] <- sum((res3$fitted - res3$obs2)^2)
  # res.cv[i] <- 1 - mean(PREDS)/mean(SS)
  # r2.1$lme$residuals$site

  for (i in 2:(k-1)){
    temp.data <- rbind(moge.cross[1:(35*(i-1)),],
                       moge.cross[(35*i+1):350,])
    r2.1 <- gamm(WSG ~  s(Time,k=4), random = list(site=~1), data=temp.data, correlation = corCAR1(form=~Time))

    site_ef <- ranef(r2.1$lme)$site %>% unlist
    site_ef_dat <- data_frame(site = as.factor(1:50), site_ef = site_ef)

    res <- data.frame(fitted = r2.1$gam$fitted.values, Time= r2.1$gam$model$Time)

    # Time= r2.1$gam$model$Time)
    res2 <- res %>%
    dplyr::select(fitted, Time) %>%
    unique %>%
    arrange(Time)

    K1 <- 35*(i-1) +1
    K2 <- 35*i

    res3 <- left_join(moge.cross[K1:K2,], res2, by = "Time") %>%
    left_join(., site_ef_dat, by = "site") %>%
    mutate(fitted_site = fitted + site_ef)

    res3 <- res3 %>%
    mutate(obs2 = WSG - site_ef)

    SS[i] <- sum((res3$obs2 - mean(res3$obs2))^2)
    PREDS[i] <- sum((res3$fitted - res3$obs2)^2)
    # res.cv[i] <- 1 - mean(PREDS)/mean(SS)
  }

  i <- 10
  r2.1 <- gamm(WSG ~  s(Time,k=4), random = list(site=~1), data=moge.cross[1:350,], correlation = corCAR1(form=~Time))

  site_ef <- ranef(r2.1$lme)$site %>% unlist
  site_ef_dat <- data_frame(site = as.factor(1:50), site_ef = site_ef)

  res <- data.frame(fitted = r2.1$gam$fitted.values, Time= r2.1$gam$model$Time)

    # Time= r2.1$gam$model$Time)
    res2 <- res %>%
    dplyr::select(fitted, Time) %>%
    unique %>%
    arrange(Time)

    res3 <- full_join(moge.cross[316:350,], res2, by="Time") %>%
    left_join(., site_ef_dat, by = "site") %>%
    mutate(fitted_site = fitted + site_ef)

    res3 <- res3 %>%
    mutate(obs2 = WSG - site_ef)

  SS[i] <- sum((res3$obs2 - mean(res3$obs2))^2)
  PREDS[i] <- sum((res3$fitted - res3$obs2)^2)
  # res.cv[i] <- 1 - mean(PREDS)/(SS)

  1 - mean(PREDS,na.rm=T)/mean(SS,na.rm=T)

########################===============================================

##############################################
## cross validation  fixed + rand
###########################################

  moge$temp <- rnorm(nrow(moge))
  moge100r$temp <- rnorm(nrow(moge100r))

  moge.cross <- moge100r[order(moge100r$temp),] %>%
    mutate(site = as.factor(site))
  rownames(moge.cross) <- NULL
  k <- 10
  # res.cv <- numeric(k)
  res.cv <- NULL
  SS <- NULL
  PREDS <- NULL
  i <- 1
  r2.1 <- gamm(WSG ~  s(Time,k=4), random = list(site=~1), data=moge.cross[(35*i+1):350,], correlation = corCAR1(form=~Time))
  site_ef <- ranef(r2.1$lme)$site %>% unlist
  site_ef_dat <- data_frame(site = as.factor(1:50), site_ef = site_ef)
  res <- data_frame(fitted = r2.1$gam$fitted.values, Time= r2.1$gam$model$Time,
    site = moge.cross[(35*i+1):350, "site"])

    # %>%
    # merge(., site_ef_dat, by = "site") %>%
    # mutate(fitted_site = fitted + site_ef)

  # res <- data.frame(fitted = r2.1$gam$fitted.values,
                    # res = r2.1$gam$residuals,
                    # res2 = r2.1$gam$y - r2.1$gam$fitted.values -r2.1$gam$residuals,
                    # Time= r2.1$gam$model$Time)
  res2 <- res %>%
    dplyr::select(fitted, Time) %>%
    unique %>%
    arrange(Time)

  res3 <- full_join(moge.cross[1:35,], res2, by="Time") %>%
    left_join(., site_ef_dat, by = "site") %>%
    mutate(fitted_site = fitted + site_ef)

  res3 <- res3 %>%
    mutate(obs2 = WSG - site_ef)

  SS[i] <- sum((res3$WSG - mean(res3$WSG))^2)
  PREDS[i] <- sum((res3$fitted_site - res3$WSG)^2)
  # res.cv[i] <- 1 - mean(PREDS)/mean(SS)
  # r2.1$lme$residuals$site

  for (i in 2:(k-1)){
    temp.data <- rbind(moge.cross[1:(35*(i-1)),],
                       moge.cross[(35*i+1):350,])
    r2.1 <- gamm(WSG ~  s(Time,k=4), random = list(site=~1), data=temp.data, correlation = corCAR1(form=~Time))

    site_ef <- ranef(r2.1$lme)$site %>% unlist
    site_ef_dat <- data_frame(site = as.factor(1:50), site_ef = site_ef)

    res <- data.frame(fitted = r2.1$gam$fitted.values, Time= r2.1$gam$model$Time)

    # Time= r2.1$gam$model$Time)
    res2 <- res %>%
    dplyr::select(fitted, Time) %>%
    unique %>%
    arrange(Time)

    K1 <- 35*(i-1) +1
    K2 <- 35*i

    res3 <- left_join(moge.cross[K1:K2,], res2, by = "Time") %>%
    left_join(., site_ef_dat, by = "site") %>%
    mutate(fitted_site = fitted + site_ef)

    res3 <- res3 %>%
    mutate(obs2 = WSG - site_ef)

    SS[i] <- sum((res3$WSG - mean(res3$WSG))^2)
    PREDS[i] <- sum((res3$fitted_site - res3$WSG)^2)
    # res.cv[i] <- 1 - mean(PREDS)/mean(SS)
  }

  i <- 10
  r2.1 <- gamm(WSG ~  s(Time,k=4), random = list(site=~1), data=moge.cross[1:350,], correlation = corCAR1(form=~Time))

  site_ef <- ranef(r2.1$lme)$site %>% unlist
  site_ef_dat <- data_frame(site = as.factor(1:50), site_ef = site_ef)

  res <- data.frame(fitted = r2.1$gam$fitted.values, Time= r2.1$gam$model$Time)

    # Time= r2.1$gam$model$Time)
    res2 <- res %>%
    dplyr::select(fitted, Time) %>%
    unique %>%
    arrange(Time)

    res3 <- full_join(moge.cross[316:350,], res2, by="Time") %>%
    left_join(., site_ef_dat, by = "site") %>%
    mutate(fitted_site = fitted + site_ef)

    res3 <- res3 %>%
    mutate(obs2 = WSG - site_ef)
    SS[i] <- sum((res3$WSG - mean(res3$WSG))^2)
    PREDS[i] <- sum((res3$fitted_site - res3$WSG)^2)
  # res.cv[i] <- 1 - mean(PREDS)/(SS)

  1 - mean(PREDS,na.rm=T)/mean(SS,na.rm=T)

########################===============================================

plot(obs2 - fitted ~fitted, data = res3)

set.seed(2)
sp <- rnorm(10, 0 , 10)

x <- rnorm(20)

mu <- 0.5 * rep(x, 10) - 3 + rep(sp, each = 20)
mu2 <- -0.5 * rep(x, 10) - 3 + rep(sp, each = 20)

# mu <- c(mu[1:100], mu2[101:200])

dat <- data_frame(y = y, mu = mu, x = rep(x, 10), sp = rep(sp, each = 20)) %>%
  mutate(sp2 = rep(1:10, each = 20)) %>%
  arrange(x)

plot(y ~ x, dat)
for(i  in 1:10) points(y ~ x, data = dat %>% filter(sp2 == i), type = "l")

lm(y ~ x + as.factor(sp2), dat) %>% summary

res1 <- lm(y ~ x, dat)
res2 <- lmer(y ~ x + (1|sp2), dat)

plot(y ~ x,dat)
abline(res1, lty =2)
abline(res2)

dat %>%
  mutate(sp_ef = rep(ranef(res2) %>% unlist, 20)) %>%
  mutate(y2 = y - sp_ef) %>%
  plot(y2 ~ x,.)

Fixed <- fixef(res2)[1] + fixef(res2)[2] * dat$x
VarF <- var(Fixed)
VarF / (VarF + VarCorr(res2)$sp2[1] + attr(VarCorr(res2), "sc")^2)

(VarF + VarCorr(res2)$sp2[1] )/ (VarF + VarCorr(res2)$sp2[1] + attr(VarCorr(res2), "sc")^2)

##ALL ---------------------------------------------------------------------
moge <- data.frame(WSG = scale(unlist(WSG100)),
                   Moist = scale(unlist(Moist100)),
                   slope = scale(unlist(slope100)),
                   convex = scale(unlist(convex100)),
                   site = as.factor(rep(1:50,7)),
                   Time)

moge100r <- data.frame(WSG = scale(unlist(WSG100.rm)),
                  Moist = scale(unlist(Moist100.rm)),
                  slope = scale(unlist(slope100.rm)),
                  convex = scale(unlist(convex100.rm)),
                  site = rep(1:50,7),
                  Time)

r2.1 <- gamm(convex ~  s(Time,k=4), random = list(site=~1), data = moge100r %>% arrange(WSG), correlation = corCAR1())

# plot(r2.1$gam)

# r2.1 <- gamm(convex ~  s(Time,k=4), random = list(site=~1), data = moge100r %>% arrange(convex))

# r2.1 <- gamm(convex ~  s(Time,k=4), random = list(site=~1), data = moge100r %>% arrange(convex), correlaion = corARMA(form = ~1|site, p =1))

  (site_ef <- ranef(r2.1$lme)$site %>% unlist)
  site_ef_dat <- data_frame(site = as.factor(1:50), site_ef = site_ef)
  res <- data_frame(fitted = r2.1$gam$fitted.values, Time= r2.1$gam$model$Time,
    site = as.factor(moge100r[,"site"]))

  res2 <- res %>%
    dplyr::select(fitted, Time) %>%
    unique %>%
    arrange(Time)

  res3 <- full_join(moge100r %>% mutate(site =as.factor(site)), res2, by="Time") %>%
    left_join(., site_ef_dat, by = "site") %>%
    mutate(fitted_site = fitted + site_ef)

  res3 <- res3 %>%
    mutate(obs2 = convex - site_ef)

par(mfrow=c(1,2))
plot(obs2 ~ Time, res3, col = "gray")
for(i in 1:50) points(obs2 ~ Time, res3 %>% filter(site == i),
  col = "gray", type = "l")
points(fitted ~ Time, res3, pch = 16)

res3 %>% group_by(Time) %>% summarize(convex = mean(convex)) %>%
points(convex ~ Time, ., pch = 2)

plot(convex ~ Time, res3)
for (i in 1:50) points(convex ~ Time, res3 %>% filter(site==i),
  col = "grey", type = "l")
par(mfrow=c(1,1))

####
par(mfrow=c(3,4))
for (i in 1:12) plot(convex ~ Time, temp.data %>% filter(site ==i))
par(mfrow=c(1,1))

Fixed <- fixef(mF)[2] * mF@X[, 2] + fixef(mF)[3] * mF@X[, 3] + fixef(mF)[4] * mF@X[, 4]

# Calculation of the variance in fitted values
VarF <- var(Fixed)

# R2GLMM(m) - marginal R2GLMM
# Equ. 26, 29 and 30
# VarCorr() extracts variance components
# attr(VarCorr(lmer.model),'sc')^2 extracts the residual variance
VarF/(VarF + VarCorr(mF)$Container[1] + VarCorr(mF)$Population[1] + attr(VarCorr(mF), "sc")^2)

##
temp1 <- moge100r %>% filter(Time==1982)
temp2 <- moge100r %>% filter(Time==2010)

temp2$Moist - temp1$Moist

data_frame(site = D100m[[1]] %>% rownames,

temp <- gamm(convex ~  s(Time,k=4), random = list(site=~1), data=moge %>% filter(site==11), correlation = corCAR1())
plot(convex ~ Time, moge %>% filter(site ==11))
summary(temp$gam)


score <- function(input) {
    if ((input[3]) <= (2.449999988079071)) {
        var0 <- c(1.0, 0.0, 0.0)
    } else {
        if ((input[4]) <= (1.75)) {
            if ((input[3]) <= (4.950000047683716)) {
                if ((input[4]) <= (1.6500000357627869)) {
                    var0 <- c(0.0, 1.0, 0.0)
                } else {
                    var0 <- c(0.0, 0.0, 1.0)
                }
            } else {
                var0 <- c(0.0, 0.3333333333333333, 0.6666666666666666)
            }
        } else {
            var0 <- c(0.0, 0.021739130434782608, 0.9782608695652174)
        }
    }
    return(var0)
}


#!usr/bin/env Rscript

 # Install this package if it's not already installed

install.packages('gap', repos = "https://cran.revolutionanalytics.com/")

library(gap)

# Load data
eur <- read.csv("SUMMARY_EUR_rareCADD_collapse_risk_pval.csv",header=T,as.is=T,comment.char="")
mex <- read.csv("SUMMARY_MEX_rareCADD_collapse_risk_pval.csv",header=T,as.is=T,comment.char="")

# Make plots
png("SUMMARY_EUR_rareCADD_collapse_risk_qqplot.png")
qqunif(eur$pVal, main="EUR Results", equal.axes=T)
dev.off()

png("SUMMARY_MEX_rareCADD_collapse_risk_qqplot.png")
qqunif(mex$pVal, main="MEX Results")
dev.off()


library(readr)
library(xgboost)
library(e1071)
library(AUC)
library(randomForest)

set.seed(321)

args = commandArgs(trailingOnly = TRUE)

cat("reading the train : ", args[1], args[2], args[3], "\n")

train_train <- read_csv(args[1])
train_test  <- read_csv(args[2])

cat("Train: ", dim(train_train), "\n", "Test: ", dim(train_test), "\n")

feature.names <- names(train_train)[2:ncol(train_train)]
#cat(feature.names)

###############################################################
#Prediction on Training Data
cat("training a XGBoost classifier on train-train\n")
clf_train_train <- xgboost(data = data.matrix(train_train[, feature.names]),
                           label       = train_train$target,
                           nrounds     = 20,
                           objective   = "binary:logistic",
                           eval_metric = "auc")

cat("training a RF classifier on train-train\n")
model_formula = as.formula(paste("target ~", paste(feature.names, collapse="+")))
#print(model_formula)
#print( as.factor(train_train$target)[1:nrow(train_train)])
#rf_train_train = randomForest(model_formula, data=data.frame(train_train),
#                              tree = 20, do.trace = 1, y = (train_train$target))

rf_train_train = randomForest(x = data.frame(train_train[, feature.names]),
                              y = as.factor(train_train$target)[1:nrow(train_train)],
                              ntree = 1000,
                              do.trace=1)

#rf_train_train = tuneRF(x = data.frame(train_train[, feature.names]),
#                        y = as.factor(train_train$target)[1:nrow(train_train)],
#                        ntreeTry = 50, stepFactor=2, improve=0.05,
#                        plot=TRUE, doBest=FALSE, trace=TRUE)

rm(train_train)
gc()
###############################################################
#Predict on Train-Test Phase
cat("Predict XGBoost on train-test\n")
train_test_predctions_xgb = data.frame(1:nrow(train_test))
#train_test_predctions_xgb$xgb = NA
train_test_predctions_rf = data.frame(1:nrow(train_test))
#train_test_predctions_rf$rf = NA

for (rows in split(1:nrow(train_test), ceiling((1:nrow(train_test))/10000)))
{
  train_test_predctions_xgb[rows, "xgb"] <- predict(clf_train_train, data.matrix(train_test[rows, feature.names]))
  train_test_predctions_rf[rows, "rf"] <- predict(rf_train_train,
                                                      newdata =  data.matrix(train_test[rows, feature.names]),
                                                      type = "prob")
}

train_test_predctions_rf$rf = 1 - train_test_predctions_rf$rf

#print(train_test_predctions_xgb)
#cat("Prediction XGB AUC: \n")
#print (accuracy(train_test_predctions_xgb$xgb, train_test$target))
cat("Prediction XGB AUC: \n")
print(auc(roc(train_test_predctions_xgb$xgb[1:nrow(train_test)], as.factor(train_test$target)[1:nrow(train_test)])) )
cat("Prediction RF AUC: \n")
print(auc(roc(train_test_predctions_rf$rf[1:nrow(train_test)], as.factor(train_test$target)[1:nrow(train_test)]) ) )

gc()

###############################################################
####################################################################################################
if(FALSE){
#Prepare the fianl test
test  <- read_csv(args[3])
final_test_featurenames <- names(test)
final_test_pred_step_1_xgb = data.frame(1:nrow(test))
final_test_pred_step_1_xgb$xgb = NA
final_test_pred_step_1_rf = data.frame(1:nrow(test))
final_test_pred_step_1_rf$rf = NA
cat("done-1\n", dim(final_test_pred_step_1_rf), "\n")

for (rows in split(1:nrow(test), ceiling((1:nrow(test))/10000)))
{
    final_test_pred_step_1_xgb[rows, "xgb"] <- predict(clf_train_train,
                                                       data.matrix(test[rows, ]))
    final_test_pred_step_1_rf[rows, "rf"] <- predict(rf_train_train,
                                                       newdata= data.matrix(test[rows, ]),
                                                       type="prob")
}
#print(final_test_pred_step_1_rf)
#Write Data to file
write.csv(final_pred_step_2, file = 'Combined_Pred-test.csv', row.names = FALSE)
}
#RF
#rf = randomForest(log(train$cost + 1)~., train[,-match(c("id", "cost"), names(train))], ntree = 20, do.trace = 2)

#SVM
####################################################################################
if(FALSE){
#SVM Learing
cat("Start SVM\n")
x_train = train[,feature.names]
y_train = train$target
svm_model = svm(x_train, y_train, scale = TRUE, type = 'C-classification', kernel = "radial", gamma =  1 / ncol(x_train),
                cost = 1, nu = 0.5, class.weights = NULL, cachesize = 1000, tolerance = 0.001, epsilon = 0.1,
                shrinking = TRUE, cross = 5, probability = FALSE, fitted = TRUE)

print(summary(svm_model))
svm_submission <- data.frame(ID=test$ID)
svm_submission$target = NA
}


#' Evaluate MaxEnt model performance
#'
#' @param raster_data A raster dataset.
#' @param method A character string indicating the spatial data partitioning method. Possible values are `jackknife`, `randomkfold`, `user`, `block`, `checkerboard1`, `checkerboard2`.
#'
#' @return A list containing AUC value and predict object (for plotting).
#' @examples
#' \dontrun{
#' # download benchmarking data
#' benchmarking_data <- get_benchmarking_data("Lynx lynx",
#'                                            limit = 1500)
#' # run MaxEnt evaluation
#' maxent_results <- evaluate_maxent(raster_data = benchmarking_data$raster_data,
#'                                   method = "block")
#'
#' # get AUC of best model run
#' maxent_results$best_auc
#' }
#' @export
evaluate_maxent <- function(raster_data, method) {
    eval <- ENMeval::ENMevaluate(occ = raster_data$coords_presence,
                                 env = raster_data$climate_variables,
                                 bg.coords = raster_data$background,
                                 method = method,
                                 RMvalues = c(1, 2),
                                 fc = c("L"))

    best_model_id <- as.integer(row.names(eval@results[which.max(eval@results$avg.test.AUC), ]))
    best_auc <- eval@results$avg.test.AUC[[best_model_id]]
    best_model_pr <- dismo::predict(raster_data$climate_variables, eval@models[[best_model_id]])
    me_results <- list(best_auc = best_auc, best_model_pr = best_model_pr)

    return(me_results)
}


# stats about impacts on protected areas from shifting species

####################
## helper functions
####################
# require(Hmisc)
require(data.table)
# require(lme4) # for mixed-effects models
# require(car) # for testing ME models

lu <- function(x) return(length(unique(x)))

se <- function(x,na.rm=FALSE){ # standard error
	if(!na.rm){
		return(sd(x, na.rm=FALSE)/sqrt(length(x)))
	}
	if(na.rm){
		return(sd(x, na.rm=TRUE)/sqrt(sum(!is.na(x))))
	}
}

# weighted mean function to use with summarize()
wmean <- function(x){ # values in col 1, weights in col 2
	inds <- !is.na(x[,1]) & !is.na(x[,2])
	return(weighted.mean(x[inds,1], x[inds,2]))
}

###########################################
# Examine MPA size relative to grid size
###########################################
wdpagrid <- fread('gunzip -c output/wdpa_cov_by_grid0.05.csv.gz', drop = 1) # shows which MPAs are in which grid cells. each line is a unique grid cell-MPA combination.

# plot vs. grid size
wdpagrid[!duplicated(WDPA_PID), hist(log10(area_fullwdpa), xlab = 'log10(area in m2)', main = 'MPA vs. grid cell sizes')]
abline(v = log10(unique(wdpagrid$area_grid)), col = '#FF000001')

# number > grid size
wdpagrid[!duplicated(WDPA_PID), .N] # 925
wdpagrid[!duplicated(WDPA_PID), sum(area_fullwdpa >= area_grid)] # 332
wdpagrid[!duplicated(WDPA_PID), sum(area_fullwdpa < area_grid)] # 593
wdpagrid[!duplicated(WDPA_PID), sum(area_fullwdpa < area_grid)/.N] # 64%

#############################################
# Examine turnover within MPAs
# Examine all climate models individually
#############################################
# read in turnover data
wdpaturnbyMPAbymod <- fread('gunzip -c temp/wdpaturnbyMPAbymod.csv.gz', drop=1) # Turnover in each MPA. Don't read the row numbers

ntk <- wdpaturnbyMPAbymod[,NO_TAKE %in% c('All', 'Part')] # no take reserves (index into wdpaturnbyMPAbymod)
sum(ntk) # 74 no take reserves
wdpaturnbyMPAbymod[ntk, sort(SUB_LOC)]
wdpaturnbyMPAbymod[ntk, sum(grepl('US-CA', SUB_LOC))] # 49 no-take in California

# calculate Sorenson turnover and fractional change
for (r in c(26, 85)) {
    for (m in 1:18) {
        wdpaturnbyMPAbymod[, (paste0('beta_sor.', r, '.', m)) :=
                               2*get(paste0('nshared.', r, '.', m)) /
                               (2*get(paste0('nshared.', r, '.', m)) + get(paste0('ngained.', r, '.', m)) + get(paste0('nlost.', r, '.', m)))]
        wdpaturnbyMPAbymod[, (paste0('flost.', r, '.', m)) :=
                               get(paste0('nlost.', r, '.', m)) /
                               get(paste0('ninit.', r, '.', m))]
        wdpaturnbyMPAbymod[, (paste0('fgained.', r, '.', m)) :=
                               get(paste0('ngained.', r, '.', m)) /
                               get(paste0('nfinal.', r, '.', m))]
    }
}

# convert to long format
wdpalong <- melt(wdpaturnbyMPAbymod, id.vars = c('WDPA_PID', 'NAME', 'MANG_AUTH', 'SUB_LOC', 'lat_min', 'lat_max', 'lon_min', 'lon_max', 'area_fullwdpa', 'network'),
                 measure.vars = patterns('26|85'), variable.name = 'measure', value.name = 'val')
wdpalong[, c('measure', 'rcp', 'model') := tstrsplit(measure, '.', fixed = TRUE)] # split name of turnover measure apart from RCP and model #
    dim(wdpalong) # 266400 x 14

# read in change in temp by region
# trend1 <- read.csv('data/climTrendbyreg_rcp45.csv', row.names=1)
# 	trend1$rcp <- 45
# trend2 <- read.csv('data/climTrendbyreg_rcp85.csv', row.names=1)
# 	trend2$rcp <- 85
# nms <- c('region', 'rcp', 'delta_surf', 'delta_bott')
# trend <- as.data.table(rbind(trend1[,nms], trend2[,nms]))

# Fraction of species lost (fraction of original community)
    # all MPAs
wdpalong[measure == 'flost', .(mean = mean(val,na.rm = TRUE)),
         by = c('rcp','WDPA_PID')][, .(mean = mean(mean), se = se(mean), min = min(mean), max = max(mean)),
                                by = 'rcp'] # first mean is across climate models with MPAs/RCPs, then average across MPAs

wdpalong[measure == 'flost', .(mean = mean(val,na.rm = TRUE), lat = mean(c(lat_min, lat_max)), pac = (lon_min< -100)[1]),
         by = c('rcp','WDPA_PID')][, plot(lat, mean, col = ifelse(rcp == 26, ifelse(pac, 'light blue', 'pink'),
                                                       ifelse(pac, 'blue', 'red')))] # plot MPA ensemble mean vs. lat. Ocean by color (Pac is blue, Atl is red), RCPs by shade (26 is light, 85 is dark.

	# no-take
wdpalong[ntk & measure == 'flost', .(mean = mean(val,na.rm = TRUE)),
         by = c('rcp','WDPA_PID')][, .(mean = mean(mean), se = se(mean), min = min(mean), max = max(mean)),
                                by = 'rcp'] # first mean is across climate models with MPAs/RCPs, then average across MPAs

# Fraction of species gained (fraction of final community)
	# all MPAs
wdpalong[measure == 'fgained', .(mean = mean(val,na.rm = TRUE)),
         by = c('rcp','WDPA_PID')][, .(mean = mean(mean), se = se(mean), min = min(mean), max = max(mean)),
                                by = 'rcp'] # first mean is across climate models with MPAs/RCPs, then average across MPAs

wdpalong[measure == 'fgained', .(mean = mean(val,na.rm = TRUE), lat = mean(c(lat_min, lat_max)), pac = (lon_min< -100)[1]),
         by = c('rcp','WDPA_PID')][, plot(lat, mean,
                                          col = ifelse(rcp == 26, ifelse(pac, 'light blue', 'pink'),
                                                       ifelse(pac, 'blue', 'red')))] # plot MPA ensemble mean vs. lat. Ocean by color (Pac is blue, Atl is red), RCPs by shade (26 is light, 85 is dark.

	# no-take
wdpalong[ntk & measure == 'fgained', .(mean = mean(val,na.rm = TRUE)),
         by = c('rcp','WDPA_PID')][, .(mean = mean(mean), se = se(mean), min = min(mean), max = max(mean)),
                                by = 'rcp'] # first mean is across climate models with MPAs/RCPs, then average across MPAs

# Similarity
	# all MPAs
wdpalong[measure == 'beta_sor', .(mean = mean(val,na.rm = TRUE)),
         by = c('rcp','WDPA_PID')][, .(mean = mean(mean), se = se(mean), min = min(mean), max = max(mean)),
                                by = 'rcp'] # first mean is across climate models with MPAs/RCPs, then average across MPAs

wdpalong[measure == 'beta_sor', .(mean = mean(val,na.rm = TRUE), lat = mean(c(lat_min, lat_max)), pac = (lon_min< -100)[1]),
         by = c('rcp','WDPA_PID')][, plot(lat, mean,
                                          col = ifelse(rcp == 26, ifelse(pac, 'light blue', 'pink'),
                                                       ifelse(pac, 'blue', 'red')))] # plot MPA ensemble mean vs. lat. Ocean by color (Pac is blue, Atl is red), RCPs by shade (26 is light, 85 is dark.

	# no-take
wdpalong[ntk & measure == 'beta_sor', .(mean = mean(val,na.rm = TRUE)),
         by = c('rcp','WDPA_PID')][, .(mean = mean(mean), se = se(mean), min = min(mean), max = max(mean)),
                                by = 'rcp'] # first mean is across climate models with MPAs/RCPs, then average across MPAs

	# examine similarity vs. MPA size
wdpalong[measure == 'beta_sor', cor.test(area_fullwdpa, val), by = c('rcp', 'model')]

wdpalong[measure == 'beta_sor', .(beta_sor = mean(val,na.rm = TRUE), log10size = mean(log10(area_fullwdpa))),
         by = c('rcp','WDPA_PID')][, plot(log10size, beta_sor,
                                          col = ifelse(rcp == 26, 'blue', 'red'))] # plot MPA ensemble mean vs. size. RCP by color.

	# examine similarity by MPA latitudinal range
wdpalong[measure == 'beta_sor', cor.test(lat_max - lat_min, val), by = c('rcp', 'model')]

wdpalong[measure == 'beta_sor', .(beta_sor = mean(val,na.rm = TRUE), latsize = mean(log10(lat_max - lat_min + 0.1))),
         by = c('rcp','WDPA_PID')][, plot(latsize, beta_sor,
                                          col = ifelse(rcp == 26, 'blue', 'red'))] # plot MPA ensemble mean vs. size. RCP by color.

# examine similarity by MPA size and lat rng
wdpalong[measure == 'beta_sor', .(beta_sor = mean(val, na.rm = TRUE), latsize = mean(log10(lat_max - lat_min + 0.1)), log10size = mean(log10(area_fullwdpa))),
         by = c('rcp','WDPA_PID')][, summary(mod <- lm(beta_sor~rcp*latsize*log10size))] # linear model with 3-way interaction

		require(interplot) # to plot the interaction
		interplot(m=mod, var1='latsize', var2='log10size') +
			xlab('log(area) scaled') +
			ylab('Coefficient for scaled latitudinal range')

		interplot(m=mod, var2='latrngsc', var1='lrep_areasc') +
			ylab('Coefficient for log(area) scaled') +
			xlab('Latitudinal range scaled')

################################################################
# Examine change within MPA networks and the component MPAs
# Across each model in the ensemble
################################################################
wdpaturnbynetbymod <- fread('gunzip -c temp/wdpaturnbynetbymod.csv.gz') # network results
# also need wdpalong from above section

# Size of networks
	wdpaturnbyMPAbymod[!is.na(network),.(num_mpas=length(unique(WDPA_PID))), by=network]

# calculate Sorenson turnover and fractional change
for (r in c(26, 85)) {
    for (m in 1:18) {
        wdpaturnbynetbymod[, (paste0('beta_sor.', r, '.', m)) :=
                               2*get(paste0('nshared.', r, '.', m)) /
                               (2*get(paste0('nshared.', r, '.', m)) + get(paste0('ngained.', r, '.', m)) + get(paste0('ngained.', r, '.', m)))]
        wdpaturnbynetbymod[, (paste0('flost.', r, '.', m)) :=
                               get(paste0('nlost.', r, '.', m)) /
                               get(paste0('ninit.', r, '.', m))]
        wdpaturnbynetbymod[, (paste0('fgained.', r, '.', m)) :=
                               get(paste0('ngained.', r, '.', m)) /
                               get(paste0('nfinal.', r, '.', m))]
    }
}

# convert to long format
wdpanetlong <- melt(wdpaturnbynetbymod, id.vars = c('network', 'lat', 'lon', 'area'),
                 measure.vars = patterns('26|85'), variable.name = 'measure', value.name = 'val')
wdpanetlong[, c('measure', 'rcp', 'model') := tstrsplit(measure, '.', fixed = TRUE)] # split name of turnover measure apart from RCP and model #
    dim(wdpanetlong) # 864 x 8

# Fraction of species lost
	# all MPA networks
wdpanetlong[measure == 'flost', .(mean = mean(val,na.rm = TRUE)),
         by = c('rcp','network')][, .(mean = mean(mean), se = se(mean), min = min(mean), max = max(mean)),
                                by = 'rcp'] # first mean is across climate models within networks x RCPs, then average across networks

	# within the individual MPAs of these networks
wdpalong[measure == 'flost' & !is.na(network), .(mean = mean(val,na.rm = TRUE)),
         by = c('rcp','WDPA_PID')][, .(mean = mean(mean), se = se(mean), min = min(mean), max = max(mean)),
                                by = 'rcp'] # first mean is across climate models within MPAs x RCPs, then average across MPAs

# Fraction of species gained (fraction of final community)
	# all MPA networks
wdpanetlong[measure == 'fgained', .(mean = mean(val,na.rm = TRUE)),
         by = c('rcp','network')][, .(mean = mean(mean), se = se(mean), min = min(mean), max = max(mean)),
                                by = 'rcp'] # first mean is across climate models within networks x RCPs, then average across networks

	# within the individual MPAs of these networks
wdpalong[measure == 'fgained' & !is.na(network), .(mean = mean(val,na.rm = TRUE)),
         by = c('rcp','WDPA_PID')][, .(mean = mean(mean), se = se(mean), min = min(mean), max = max(mean)),
                                by = 'rcp'] # first mean is across climate models within MPAs x RCPs, then average across MPAs

# Similarity (Sorenson)
	# all MPA networks
wdpanetlong[measure == 'beta_sor', .(mean = mean(val,na.rm = TRUE)),
         by = c('rcp','network')][, .(mean = mean(mean), se = se(mean), min = min(mean), max = max(mean)),
                                by = 'rcp'] # first mean is across climate models within networks x RCPs, then average across networks

	# within the individual MPAs of these networks
wdpalong[measure == 'beta_sor' & !is.na(network), .(mean = mean(val,na.rm = TRUE)),
         by = c('rcp','WDPA_PID')][, .(mean = mean(mean), se = se(mean), min = min(mean), max = max(mean)),
                                by = 'rcp'] # first mean is across climate models within MPAs x RCPs, then average across MPAs


# ===============================================================
# read data & preprocessing
#================================================================

df = read.delim(file = 'C:/Users/Yixuan/Documents/000-Semester/CIS-520/project/my_dat.csv', sep = ',', header=FALSE)
colnames(df) <- c("user", "artist", "song")
df <- df[ -c(4:8) ]
df <- df[-which(df$artist == ""), ]
df <- df[-which(df$song == ""), ]

df$A = match(df$artist,levels(df$artist))
df$S = match(df$song,levels(df$song))
df$U = match(df$user,levels(df$user))

df <- df[ -c(1:6) ]

# basic stats
m = nrow(df)
mU = length(unique(df$U))
mG = 12
mS = length(unique(df$S))
mA = length(unique(df$A))

# we are working on smaller sets
# delete unpopular songs that have cumulative <200 plays
songlist = c()
for (i in 1:mS){
  if(sum(df$S==i)>200){
    print(i)
    songlist = c(songlist,i)
  }
}
sdf = df[1,]
for (i in songlist){
  sdf = rbind(sdf,df[df$S==i,])
}
# reorder the factors
sdf$A = as.factor(sdf$A)
sdf$A = match(sdf$A,levels(sdf$A))
sdf$S = as.factor(sdf$S)
sdf$S = match(sdf$S,levels(sdf$S))
sdf$U = as.factor(sdf$U)
sdf$U = match(sdf$U,levels(sdf$U))

# create frequency column to group redundant rows
library(plyr)
sdf=ddply(sdf,.(U,S,A),nrow)
colnames(sdf) <- c("U", "S", "A","F")

# update basic stats
m = nrow(sdf)
mU = length(unique(sdf$U))
mG = 12
mS = length(unique(sdf$S))
mA = length(unique(sdf$A))

# random sample from this smaller set to form our training set
mtr=300
mtst=m-mtr
ind = sample.int(m,mtr)
trsdf = sdf[ind,]
tstsdf = sdf[-ind,]

# Now we have smaller data-set sdf, split into trsdf & tstsdf

#=======================================================================
# Learning Model: E-M
# ======================================================================

# random init params
b = matrix(rexp(mU*mG), ncol=mG)
g = matrix(rexp(mG*mS), ncol=mS)
q = matrix(rexp(mtr*mG),  ncol=mG)

# E-M iterations
logl_curve = c()
for (iter in 1: 550){
  # update: E-step
  for (i in 1:mtr){
    for (j in 1:mG){
      q[i,j] = b[trsdf$U[i],j] / sum(b[trsdf$U[i],]) * g[j, trsdf$S[i]] / sum(g[j,])
    }
    q[i,] = q[i,] / sum(q[i,])
  }

  # update: M-step
  # update b and g
  for (i in 1:mtr){
    b[trsdf$U[i],] = b[trsdf$U[i],] + q[i,] * trsdf$F[i]
    g[,trsdf$S[i]] = g[,trsdf$S[i]] + t(q[i,]) * trsdf$F[i]
  }

  # expected complete data log likelihood
  L = 0
  for (i in 1:mtr){
    for (j in 1:mG){
      L = L + q[i,j]* ( log(b[trsdf$U[i],j] / sum(b[trsdf$U[i],])) + log(g[j, trsdf$S[i]] / sum(g[j,])) )
    }
  }
  print(L)
  logl_curve = c(logl_curve,L)
}

#==================================================================
# performance evaluation
#==================================================================

# generate 10000-song play list for each user
num_song = 10000
playlist = matrix(nrow=mU,ncol=num_song)
for (i in 1:mU){
  for (k in 1:num_song){
    genre = match(1,rmultinom(1,1,b[i,]))
    song = match(1,rmultinom(1,1,g[genre,]))
    playlist[i,k] = song
  }
}

# Evaluate each metric

rank_results = c()
rank_results_w = c()
freq_pred = c()
freq_gt = c()

for (i in unique(tstsdf$U)){
  user_list = as.data.frame(table(playlist[i,]))
  user_list = user_list[order(-user_list$Freq),]

  # measure rank performance
  user_tst = tstsdf[tstsdf$U==i,]
  for (j in user_tst$S){
    rank_results = c(rank_results, match(j,user_list$Var1))
    rank_results_w = c(rank_results_w, user_tst[user_tst$S==j,4])
  }

  # measure freq prediction performance
  user_tr = trsdf[trsdf$U==i,]
  total_freq = sum(user_tr$F)
  playlist_old_freq = 0
  for (j in user_tr$S){
    playlist_old_freq = playlist_old_freq + user_list[user_list$Var1==j,2]
  }
  scale_up = total_freq / playlist_old_freq
  user_list$Adj.Freq = user_list$Freq * scale_up
  for (j in user_tst$S){
    if( sum(user_list$Var1==j) > 0 ) {
      freq_gt = c(freq_gt, user_tst[user_tst$S==j,4])
      freq_pred = c(freq_pred, user_list[user_list$Var1==j,3])
    }
  }

}

rank_results_pure = rank_results
rank_results[is.na(rank_results)] = 109
hist(rank_results)
median(rank_results)

#==================================================================
# Learning Model: Gibbs Sampler
#==================================================================

# expand training set (replicate entries according to frequency)
trsdf_exp = data.frame(U=integer(), S=integer(), A=integer(), G=integer())
for (i in 1:nrow(trsdf)){
  print(i)
  for (k in 1:trsdf[i,4]){
    trsdf_exp = rbind(trsdf_exp,trsdf[i,1:3])
  }
}

#trsdf_exp$G = 0

# update basic stats
mtr_exp = nrow(trsdf_exp)
num_samples = 5000
mU = 44
# User 45 is not in training set but in test set.
# For simplicity ignore users 45-50 for training and testing.

# random init params
someData <- rexp(num_samples*mU*mG);
b = array(someData, c(num_samples, mU, mG));
someData <- rexp(num_samples*mU*mG);
g = array(someData, c(num_samples, mG, mS));
someData <- rexp(num_samples*mtr_exp);
genre = array(someData, c(num_samples, mtr_exp));

# gibbs iterations
for (iter in 2: num_samples){
  print(iter)
  # sample genre
  for (i in 1:mU){
    # compute genre multinom dist for each user
    prob = rep(0,mG)
    for (j in 1:mG){
      prob[j] = b[iter-1,trsdf_exp$U[i],j] / sum(b[iter-1,trsdf_exp$U[i],]) * g[iter-1,j, trsdf_exp$S[i]] / sum(g[iter-1,j,])
    }
    prob = prob / sum(prob)

    num_entries = nrow(trsdf_exp[trsdf_exp$U==i,])
    temp = rmultinom(num_entries,1,prob)
    temp = cbind(1:nrow(t(temp)), max.col(t(temp), 'first'))
    trsdf_exp$G[trsdf_exp$U==i] = temp[,2]
  }
  genre[iter,] = trsdf_exp$G

  library(MCMCpack)
  # sample b
  for (i in 1:mU){
    aUK = rep(0,mG)
    for (j in 1:mG){
      aUK[j] = 1 + sum(trsdf_exp$U==i & trsdf_exp$G==j)
    }
    b[iter,i,] = rdirichlet(1,aUK)
  }

  # sample g
  for (i in 1:mG){
    aGg = rep(0,mS)
    for (j in 1:mS){
      aGg[j] = 1 + sum(trsdf_exp$G == i & trsdf_exp$S == j)
    }
    g[iter,i,] = rdirichlet(1,aGg)
  }
}

# acf shows that we need to give up one sample every 200 iterations
# burn-out is small from observation. we will exclude first 1000.
acf_gap = 200
burnout = 1000
num_true_samples = (num_samples - burnout) / acf_gap

# Get true samples after account for acf and burn-out
someData <- rexp(num_true_samples*mU*mG);
b_tr = array(someData, c(num_true_samples, mU, mG));
someData <- rexp(num_true_samples*mU*mG);
g_tr = array(someData, c(num_true_samples, mG, mS));
someData <- rexp(num_true_samples*mtr_exp);
genre_tr = array(someData, c(num_true_samples, mtr_exp));

for (i in 1:num_true_samples){
  idx = burnout+acf_gap*i
  b_tr[i,,] = b[idx,,]
  g_tr[i,,] = g[idx,,]
  genre_tr[i,] = genre[idx,]
}

#==================================================================
# performance evaluation
#==================================================================

# generate 10000-song play list for each user
num_song_per_param = 10000 / num_true_samples
playlist = matrix(nrow=mU,ncol=num_song)
for (i in 1:mU){
  for (k in 1:num_true_samples){
    for (j in 1:num_song_per_param){
      genre = match(1,rmultinom(1,1,b_tr[k,i,]))
      song = match(1,rmultinom(1,1,g_tr[k,genre,]))
      playlist[i,(k-1)*num_song_per_param+j] = song
    }
  }
}

# Evaluate each metric

rank_results = c()
rank_results_w = c()
freq_pred = c()
freq_gt = c()

for (i in 1:mU){
  #if (sum(tstsdf$U==i)==0 || sum(trsdf$U==i)==0){
  #  continue
  #}
  user_list = as.data.frame(table(playlist[i,]))
  user_list = user_list[order(-user_list$Freq),]

  # measure rank performance
  user_tst = tstsdf[tstsdf$U==i,]
  for (j in user_tst$S){
    rank_results = c(rank_results, match(j,user_list$Var1))
    rank_results_w = c(rank_results_w, user_tst[user_tst$S==j,4])
  }

  # measure freq prediction performance
  user_tr = trsdf[trsdf$U==i,]
  total_freq = sum(user_tr$F)
  playlist_old_freq = 0
  for (j in user_tr$S){
    playlist_old_freq = playlist_old_freq + user_list[user_list$Var1==j,2]
  }
  scale_up = total_freq / playlist_old_freq
  user_list$Adj.Freq = user_list$Freq * scale_up
  for (j in user_tst$S){
    if( sum(user_list$Var1==j) > 0 ) {
      freq_gt = c(freq_gt, user_tst[user_tst$S==j,4])
      freq_pred = c(freq_pred, user_list[user_list$Var1==j,3])
    }
  }

}

rank_results[is.na(rank_results)] = 109
hist(rank_results)
plot(log(freq_gt),log(freq_pred))
median(rank_results)


bottom.contact.smooth = function( sm, bcp )  {
  ## Smooth method: smooth data to remove local trends and compute first derivatives

  res = list( bc0=NA, bc1=NA)

  names( sm) = c("Z", "timestamp", "ts" ) # Z is used to abstract the variable name such that any variable can be passed
  N = nrow(sm)

  # expand tails a bit more:
  Z0 = modes( sm$Z )
  aoi.i = which( sm$Z > (Z0$lb2 + bcp$depth.range[1]/2) & sm$Z < (Z0$ub2 + bcp$depth.range[2]/2 ) )

  if (length( which( is.finite( aoi.i))) < 10  ) return( res) # need some data

  sm$dZ = grad( approxfun( sm$ts, sm$Z, rule=2 ), sm$ts, method="simple" )

  dZ.modes = modes( sm$dZ[aoi.i] )
  ii = which( abs(sm$dZ) < dZ.modes$sd * bcp$smooth.zeros ) # remove discretization induced zero-values
  sm$dZ[ii] = NA

  ub =  dZ.modes$ub2
  lb =  dZ.modes$lb2

  # remove high freq variation
  sm$dZ.smoothed = interpolate.xy.robust( sm[, c("ts", "dZ")],
        trim=bcp$noisefilter.trim, probs=bcp$smooth.filter.quants, method="sequential.linear" )

  sm$dZ.smoothed = interpolate.xy.robust( sm[, c("ts", "dZ.smoothed")],
        trim=bcp$noisefilter.trim, probs=bcp$smooth.filter.quants, method="moving.window" )

  ml0 = which.max( sm$dZ.smoothed )
  mr0 = which.min( sm$dZ.smoothed )

  dZ.sd = sd( sm$dZ.smoothed[aoi.i], na.rm=TRUE )
  ub =  dZ.modes$mode + dZ.sd * bcp$smooth.sd.multiplier
  lb =  dZ.modes$mode - dZ.sd * bcp$smooth.sd.multiplier

  # now using (smoothed) first derivative determine inflection points (crossing of the (near)-zero line)
  iib = intersect( which( sm$dZ.smoothed <= ub & sm$dZ.smoothed >= lb ), c(ml0:mr0))
  ib = min(iib): max(iib)

  ng = floor( length(ib) / 10 ) # small chunk close to candidate area of interest
  ml = ib[ ng ]
  mr = ib[ (length(ib) - ng) ]

  smooth.threshold = 0.5
  mwin = - bcp$smooth.windowsize : bcp$smooth.windowsize

  # left side
  if ( abs( min(sm$Z[ml0:ml], na.rm=TRUE) - Z0$mode ) < Z0$sd ) {
    # assuming it is truncated without the left tail ..
    k0 = 1
  } else {
    for( k0 in ml0:ml) {
      ri = k0+mwin
      ri = ri[ ri >= 1 & ri <=N ]
      nri = length(ri)
      if ( nri >= 1.5*(bcp$smooth.windowsize) ) {
        nx = length( which( sm$dZ.smoothed[ri] < ub ) )
        prx = nx / nri
        if (prx > smooth.threshold) break()
      }
    }
  }

  if ( abs( min(sm$Z[mr0:mr], na.rm=TRUE) - Z0$mode ) < Z0$sd ) {
    # assuming it is truncated without the right tail ..
    k1 = N
  } else {
    for( k1 in mr0:mr) {
      ri = k1+mwin
      ri = ri[ ri >= 1 & ri <=N ]
      nri = length(ri)
      if ( nri >= 1.5*(bcp$smooth.windowsize) ) {
        nx = length( which( sm$dZ.smoothed[ri] > lb ) )
        prx = nx / nri
        if (prx > smooth.threshold) break()
      }
    }
  }

  res =  list( bc0=sm$timestamp[k0], bc1=sm$timestamp[k1] )

  return(res)
}


################################################
## STEP 1. Cell size distribution filter
#################################################
# cell_size_distribution_filter function
# This is a simplest filter that looks at the shape of the cell size (# of UMIs per cell) distribution and looks for some local minima, minimum of second derivative, etc.
# To separate the large cell barcodes that correspond to real cells from the tail containing 'empty droplets'.
# This can be a useful first guess. The settings for such a filter can also contain a simple "min cell size" setting.
#
#' @description Filters seurat object based on cell size distribution
#' @param config list containing the following information
#'          - enable: true/false. Refering to apply or not the filter.
#'          - auto: true/false. 'True' indicates that the filter setting need to be changed depending on some sensible value (it requires
#'          to call generate_default_values_cellSizeDistribution)
#'          - filterSettings: slot with thresholds
#'                  - minCellSize: Integer. Threshold that contain the minimun number of UMIs per cell
#'                  - binStep: Integer. Bin size for the histogram
#' @export return a list with the filtered seurat object by cell size ditribution, the config and the plot values

# CalculateBarcodeInflections calculates an adaptive inflection point ("knee")
# of the barcode distribution for each sample group. This is
# useful for determining a threshold for removing low-quality
# samples.
generate_default_values_cellSizeDistribution <- function(seurat_obj, config) {
  # Q: should we check for precalculated values? e.g.:
  # is.null(Tool(seurat_obj, slot = "CalculateBarcodeInflections"))
  # Returns Seurat object with a new list in the `tools` slot,
  # `CalculateBarcodeInflections` including inflection point calculatio

  seurat_obj_tmp <- CalculateBarcodeInflections(
                                        object = seurat_obj,
                                        barcode.column = "nCount_RNA",
                                        group.column = "orig.ident",
                                        # [HARDCODED]
                                        threshold.low = 1e2,
                                        threshold.high = NULL
  )
  # extracting the inflection point value which can serve as minCellSize threshold
  # all other side effects to the scdate object will be discarded
  # [TODO unittest]: this calculation assumes a single sample, i.e. only one group in orig.ident!
  # otherwise it will return multiple values for each group!
  # returned is both the rank(s) as well as inflection point
  # orig.ident          nCount_RNA  rank
  # SeuratProject       1106        10722
  tmp <- Tool(seurat_obj_tmp, slot = "CalculateBarcodeInflections")$inflection_points
  # extracting only inflection point(s)
  return(tmp$nCount_RNA)
}

cellSizeDistribution <- function(seurat_obj, config) {

    minCellSize <- as.numeric(config$filterSettings$minCellSize)
    # extract plotting data of original data to return to plot slot later
    plot1_data  <- seurat_obj$nCount_RNA
    # plot 1: histgram of UMIs, hence input is all UMI values, e.g.
    # AAACCCAAGCGCCCAT-1 AAACCCAAGGTTCCGC-1 AAACCCACAGAGTTGG-1
    #               2204              20090               5884  ...
    names(plot1_data) <- rep("u", length(plot1_data))
    #    u    u    u    u    u    u
    # 3483 6019 3892 3729 4734 3244
    plot2_data <- order(seurat_obj$nCount_RNA)
    names(plot2_data) <- rep("rank", length(plot2_data))

    # Check if it is required to compute sensible values. From the function 'generate_default_values_cellSizeDistribution', it is expected
    # to get a list with two elements {minCellSize and binStep}
    if (as.logical(toupper(config$auto)))
        # config not really needed for this one (maybe later for threshold.low/high):
        minCellSize <- generate_default_values_cellSizeDistribution(seurat_obj, config)

    # Check wheter the filter is set to true or false
    # if true overwrite seurat object (side effect!)
    if (as.logical(toupper(config$enabled))) {
        # Information regarding number of UMIs per cells is pre-computed during the 'CreateSeuratObject' function.
        seurat_obj <- subset(seurat_obj, subset = nCount_RNA >= minCellSize)
    }

    # update config
    config$filterSettings$minCellSize <- minCellSize

    # the result object will have to conform to this format: {data, config, plotData : {plot1, plot2}}
    result <- list(
        data = seurat_obj,
        config = config,
        plotData = list(
            cellSizeDistributionHistogram = plot1_data,
            # Q: are both plots updated for this filter?
            # Q: what is the format of plot2?
            # knee-plot: this is on a log-log scale, are logs calucated here or on the UI?
            # cells are ordered on the x-axis according to the number of distinct UMIs observed.
            # The y-axis displays the number of distinct UMIs for each barcode (here barcodes are proxies for cells).
            # cellRank_sorted.json: [{"u": 0, "rank": 17852}, {"u": 1, "rank": 17412},...]
            # plot2 = list(u = seurat_obj$nCount_RNA, rank = order(seurat_obj$nCount_RNA))
            cellSizeDistributionKneePlot = list(plot1_data, plot2_data)
        )
    )

    return(result)
}


data <- read.csv("all_results.csv", header=FALSE, sep="\t")
names <- c("One Point", "Counter-based", "Zero-lengths", "Map of ones")

pdf("plot-bnvar6.pdf")
boxplot(data[1:4], names=names, ylab="Best fitness at the last generation")
points(jitter(rep(1, 50), amount=0.1), data$V1, pch=20, col=rgb(0,0,0,0.2))
points(jitter(rep(2, 50), amount=0.1), data$V2, pch=20, col=rgb(0,0,0,0.2))
points(jitter(rep(3, 50), amount=0.1), data$V3, pch=20, col=rgb(0,0,0,0.2))
points(jitter(rep(4, 50), amount=0.1), data$V4, pch=20, col=rgb(0,0,0,0.2))
dev.off()
pdf("plot-bnvar8.pdf")
boxplot(data[5:8], names=names, ylab="Best fitness at the last generation")
points(jitter(rep(1, 50), amount=0.1), data$V5, pch=20, col=rgb(0,0,0,0.2))
points(jitter(rep(2, 50), amount=0.1), data$V6, pch=20, col=rgb(0,0,0,0.2))
points(jitter(rep(3, 50), amount=0.1), data$V7, pch=20, col=rgb(0,0,0,0.2))
points(jitter(rep(4, 50), amount=0.1), data$V8, pch=20, col=rgb(0,0,0,0.2))
dev.off()
pdf("plot-bnvar10.pdf")
boxplot(data[9:12], names=names, ylab="Best fitness at the last generation")
points(jitter(rep(1, 50), amount=0.1), data$V9, pch=20, col=rgb(0,0,0,0.2))
points(jitter(rep(2, 50), amount=0.1), data$V10, pch=20, col=rgb(0,0,0,0.2))
points(jitter(rep(3, 50), amount=0.1), data$V11, pch=20, col=rgb(0,0,0,0.2))
points(jitter(rep(4, 50), amount=0.1), data$V12, pch=20, col=rgb(0,0,0,0.2))
dev.off()

r <- rep(0, 18)
r[1] <- wilcox.test(data$V1, data$V2)$p.value
r[2] <- wilcox.test(data$V1, data$V3)$p.value
r[3] <- wilcox.test(data$V1, data$V4)$p.value
r[4] <- wilcox.test(data$V2, data$V3)$p.value
r[5] <- wilcox.test(data$V2, data$V4)$p.value
r[6] <- wilcox.test(data$V3, data$V4)$p.value

r[7] <- wilcox.test(data$V5, data$V6)$p.value
r[8] <- wilcox.test(data$V5, data$V7)$p.value
r[9] <- wilcox.test(data$V5, data$V8)$p.value
r[10] <- wilcox.test(data$V6, data$V7)$p.value
r[11] <- wilcox.test(data$V6, data$V8)$p.value
r[12] <- wilcox.test(data$V7, data$V8)$p.value

r[13] <- wilcox.test(data$V9, data$V10)$p.value
r[14] <- wilcox.test(data$V9, data$V11)$p.value
r[15] <- wilcox.test(data$V9, data$V12)$p.value
r[16] <- wilcox.test(data$V10, data$V11)$p.value
r[17] <- wilcox.test(data$V10, data$V12)$p.value
r[18] <- wilcox.test(data$V11, data$V12)$p.value
write.table(r, "pvalues.csv", sep="\t", col.names=FALSE, row.names=FALSE)


#' Function for translating maxdiff option into value
#'
#' @param distM A distance matrixe calculated by one of the functions from
#'   \code{distanceFunctions}.
#'
#' @param maxDist The maxDist option to decide upon.

choose_maxdist_option <- function(distM, maxDist="Inf"){
  # handling maxDist parameters
  # maxDist might be set to "Inf", "auto", "10%" or some specific value
  md_inf  <- grepl("Inf",    maxDist[1], ignore.case=T) | maxDist==Inf
  md_auto <- grepl("^auto$", maxDist[1], ignore.case=T)
  md_perc <- grepl("%$",     maxDist[1])
  md_num  <- is.numeric(maxDist)

  if( all(c(md_inf, md_auto, md_perc, md_num)) ){
    md <- Inf
    warning("No valid argument for 'maxDist' supplied, 'maxDist' set to 'Inf'.")
  }else{
    if( md_inf  ) md <- Inf
    if( md_auto ) md <- stats::quantile(distM, (100-   10       )/100 )
    if( md_perc ){
      md_perc_value  <- stringr::str_replace(maxDist, "%","")
      md_perc_value  <- as.numeric(md_perc_value)
      md             <- stats::quantile(distM, (100-md_perc_value)/100 )
    }
    if( md_num  ) md <- maxDist
  }
  return(md)
}


#script rasterizes land price shapefile
#(code here moved from create_CRAFTY_regionCSV2.0_JM_2018-04-27.r 2018-07-05)

rm(list=ls())

library(raster)
library(sf)

#unzip and read shapefile
unzip(zipfile="Data/LandPrice.zip",exdir="Data/LandPrice")  #unzip
Landprice<- st_read("Data/LandPrice/Native_vegetation.shp")

#read raster files (for rasterization)
lcMap <- raster(paste0("Data/ObservedLCmaps/LandCover",year,"_PastureB_Disagg.asc"))
munis.r <- raster("Data/sim10_BRmunis_latlon_5km.asc")

yrs <- seq(from=2001,to=2017,by=1)

for(year in yrs){

  #year <- 2002

  #rasterise year
  Lpr<-rasterize(Landprice, munis.r, field=paste0("X",year))

  #get max Lpr value for this year to use in re-scale
  Lpr.max <- cellStats(Lpr, max, na.rm=T)

  #re-scale to 0.8-1 for Capital
  Lpr.scaled <- Lpr
  values(Lpr.scaled)= 1-0.2*((round((Lpr.max-(values(Lpr)))/Lpr.max, digits=3)))
  #plot(Lpr.scaled)
  #where land cover is not nature, price should be 1 [not needed if calculating Nature Capital from LandValue in CRAFTY
  #Lpr.scaled[lcMap != 1] <- 1

  #output data
  #writeRaster(Lpr, paste0("Data/LandPrice/LandPrice",year,".asc"), format = 'ascii', overwrite=T)
  writeRaster(Lpr.scaled, paste0("Data/LandPrice/LandPrice_Capital_08_",year,".asc"), format = 'ascii', overwrite=T)
}
#remove unzipped files
unlink("Data/LandPrice", recursive = T)


#Set the path of the working directory
setwd("C:/Users/Krishna/R proj_loan")
# read the files
> train = read.csv("train_loan.csv")
> test = read.csv("test_loan.csv")
> #check dimensions
> dim(train)
[1] 614  12
> dim(test)
[1] 367  11
> #check the variables and their type in train set
> str(train)
'data.frame':	614 obs. of  12 variables:
 $ Gender           : Factor w/ 3 levels "","Female","Male": 3 3 3 3 3 3 3 3 3 3 ...
 $ Married          : Factor w/ 3 levels "","No","Yes": 2 3 3 3 2 3 3 3 3 3 ...
 $ Dependents       : Factor w/ 5 levels "","0","1","2",..: 2 3 2 2 2 4 2 5 4 3 ...
 $ Education        : Factor w/ 2 levels "Graduate","Not Graduate": 1 1 1 2 1 1 2 1 1 1 ...
 $ Self_Employed    : Factor w/ 3 levels "","No","Yes": 2 2 3 2 2 3 2 2 2 2 ...
 $ ApplicantIncome  : int  5849 4583 3000 2583 6000 5417 2333 3036 4006 12841 ...
 $ CoapplicantIncome: num  0 1508 0 2358 0 ...
 $ LoanAmount       : int  NA 128 66 120 141 267 95 158 168 349 ...
 $ Loan_Amount_Term : int  360 360 360 360 360 360 360 360 360 360 ...
 $ Credit_History   : int  1 1 1 1 1 1 1 0 1 1 ...
 $ Property_Area    : Factor w/ 3 levels "Rural","Semiurban",..: 3 1 3 3 3 3 3 2 3 2 ...
 $ Loan_Status      : Factor w/ 2 levels "N","Y": 2 1 2 2 2 2 2 1 2 1 ...
> # find the missing values
> table(is.na(train))

FALSE  TRUE
 7282    86
> table(is.na(test))

FALSE  TRUE
 3997    40
> # Variables in which values are missing
> colSums(is.na(train))
           Gender           Married        Dependents         Education     Self_Employed
                0                 0                 0                 0                 0
  ApplicantIncome CoapplicantIncome        LoanAmount  Loan_Amount_Term    Credit_History
                0                 0                22                14                50
    Property_Area       Loan_Status
                0                 0
> colSums(is.na(test))
           Gender           Married        Dependents         Education     Self_Employed
                0                 0                 0                 0                 0
  ApplicantIncome CoapplicantIncome        LoanAmount  Loan_Amount_Term    Credit_History
                0                 0                 5                 6                29
    Property_Area
                0
> #Distribution Analyses
> # Histogram of ApplicantIncome

> hist(train$Credit_History)

https://github.com/Krishnadhruv/Loan-Status-Prediction-Model-in-R/blob/master/Credit_History_hist.jpeg

> hist(train$LoanAmount)

https://github.com/Krishnadhruv/Loan-Status-Prediction-Model-in-R/blob/master/LoanAmount_hist.jpeg

> hist(train$ApplicantIncome)

https://github.com/Krishnadhruv/Loan-Status-Prediction-Model-in-R/blob/master/ApplicantIncome%20_hist.jpeg

> #Due to extreme values in ApplicantIncome and LoanAmount..data mugging is required
> #now...gender vs applicant income
> library(ggplot2)
> ggplot(train, aes(x= Gender, y = ApplicantIncome)) + geom_point(size = 2.5, color="navy") + xlab("Gender") + ylab("ApplicantIncome") + ggtitle("Gender Disparity Vs ApplicantIncome")

https://github.com/Krishnadhruv/Loan-Status-Prediction-Model-in-R/blob/master/gender%20vs%20applicant%20income.jpeg
> #applicant_income vs Loan_Status
> ggplot(train, aes(x= ApplicantIncome, y = Loan_Status)) + geom_point(size = 2.5, color="navy") + xlab("ApplicantIncome") + ylab("Loan_Status") + ggtitle("Applicant Income Vs Loan Status")

https://github.com/Krishnadhruv/Loan-Status-Prediction-Model-in-R/blob/master/applicant%20income%20vs%20loan%20status.jpeg
> #eliminating the missing values using median

> test$Loan_Status <- 1
> combi <- rbind(train, test)

> combi$Credit_History[is.na(combi$Credit_History)] <- median(combi$Credit_History, na.rm = TRUE)
> combi$LoanAmount[is.na(combi$LoanAmount)] <- median(combi$LoanAmount, na.rm = TRUE)
> combi$Loan_Amount_Term[is.na(combi$Loan_Amount_Term)] <- median(combi$Loan_Amount_Term, na.rm = TRUE)
> table(is.na(combi$Credit_History))

FALSE
  981

> table(is.na(combi$LoanAmount))

FALSE
  981

> table(is.na(combi$Loan_Amount_Term))

FALSE
  981

#Finding the probability of loan_status( Y- Yes  N- No)
> table(train$Loan_Status)/nrow(train)

        N         Y
0.3127036 0.6872964

# Dividing the sample into two parts: developent and validation
sample.ind <- sample(2,
+                      nrow(train),
+                      replace = T,
+                      prob = c(0.6,0.4))
> train.dev <- train[sample.ind==1,]
> train.val <- train[sample.ind==2,]

#Finding the probability of loan_status in Development sample
> table(train.dev$Loan_Status)/nrow(train.dev)

        N         Y
0.3150685 0.6849315

#Finding the probability of loan_status in Validtion Sample
> table(train.val$Loan_Status)/nrow(train.val)

        N         Y
0.3092369 0.6907631

> varNames <- names(train.dev)

# Exclude ID or Response variable
> varNames <- varNames[!varNames %in% c("Loan_Status")]

# add + sign between exploratory variables
> varNames1 <- paste(varNames, collapse = "+")

# Add response variable and convert to a formula object
> rf.form <- as.formula(paste("Loan_Status", varNames1, sep = " ~ "))

#Building Random Forest using R

#Now, we have a sample data and formula for building Random Forest model. Let’s build 500 decision trees using Random Forest.

>library(randomForest)
randomForest 4.6-12
Type rfNews() to see new features/changes/bug fixes.

Attaching package: ‘randomForest’

The following object is masked from ‘package:ggplot2’:

    margin

> train.rf <- randomForest(rf.form,
+                               train.dev,
+                               ntree=500,
+                               importance=T, na.action = na.exclude)

> plot(train.rf)

# 500 decision trees or a forest has been built using the Random Forest algorithm based learning. We can plot the error rate across decision trees. The plot seems to indicate that after 50 decision trees, there is no reduction in error rate.

https://github.com/Krishnadhruv/Loan-Status-Prediction-Model-in-R/blob/master/plot.jpeg

#Predict Response Variable(Loan_Status value using Random Forest)

> train.dev$predicted.response <- predict(train.rf ,train.dev)

#confusionMatrix function from caret package can be used for creating confusion matrix based on actual response variable and predicted value.

> library(e1071)
> library(caret)
Loading required package: lattice

> confusionMatrix(data=train.dev$predicted.response,
+                 reference=train.dev$Loan_Status,
+                 positive='Y')
Confusion Matrix and Statistics

          Reference
Prediction   N   Y
         N  98   0
         Y   1 214

 Accuracy : 0.9968

#It has accuracy of 99.68%, which is fantastic. Now we can predict response for the validation sample and calculate model accuracy for the sample.

> train.val$predicted.response <- predict(train.rf ,train.val)
> confusionMatrix(data=train.val$predicted.response,
+                 reference=train.val$Loan_Status,
+                 positive='Y')
Confusion Matrix and Statistics

          Reference
Prediction   N   Y
         N  30   9
         Y  34 143

               Accuracy : 0.8009
                 95% CI : (0.7414, 0.852)
    No Information Rate : 0.7037
    P-Value [Acc > NIR] : 0.0007909

                  Kappa : 0.4618
 Mcnemar's Test P-Value : 0.0002522

            Sensitivity : 0.9408
            Specificity : 0.4688
         Pos Pred Value : 0.8079
         Neg Pred Value : 0.7692
             Prevalence : 0.7037
         Detection Rate : 0.6620
   Detection Prevalence : 0.8194
      Balanced Accuracy : 0.7048

       'Positive' Class : Y

#Accuracy level has dropped to 80% but still significantly higher.


#' extract_soil_moist.r
#' Extracts soil moisture from the Atlas of the Biosphere product, a MODIS NPP product.
#' Willmott, Cort J., and Matsuura Kenji (2001): Terrestrial Water Budget Data Archive: Monthly Time Series (1950-1999).
#'
#' @param latitude   #vector of latitude in decimal degrees.
#' @param longitude  #vector of longitude in decimal degrees.
#' @param path       #path to soil moisture raster with header file. downloaded here: https://nelson.wisc.edu/sage/data-and-models/atlas/data/soilmoisture.zip
#' @return           #returns a vector of soil moisture values.
#' @export
#'
#' @examples
#' points <- structure(c(-102.644235, -58.015319, 50.508187, -148.2747566, 38.816171, -7.719157, 21.754477, 64.766184), .Dim = c(4L,2L))
#' test.out <- extract_soil_moist(points[,2], points[,1])
extract_soil_moist <- function(latitude, longitude, path = '/fs/data3/caverill/AoB_NPP/soil_moisture_raster/soilmoisture/w001001.adf'){
  #load soil moisture raster
  moist_raster <- raster::raster(path)
  #extract
  points <- cbind(longitude, latitude)
  output <- raster::extract(moist_raster, points)
  return(output)
}


################################################################################################
# Dependencies
#source("Code/get_svc_data.r")
#source("Code/get_raw_data.r")
#source("Code/slopes.r")
#source("Code/past_stat.r")

GetDefaultFeatures <- function(raw.data.name,data,measure) {

	# For a specified dataset, returns a dataset containing default static features derived from
	# a given measure for each subject id.  These features are the max, min, mean, number, sum,
	# and time of first and last visits.
	#
	# Args:
	# 	raw.data.name: name of raw dataset
	#	data: a dataset derived from a "get" function (e.g., GetAlsfrsData) on raw.data.name that has 	#	the columns subject.id, the relevant delta, the measure of interest
	#	measure: name of the measure.  Should be one of: "alsfrs.score", "fvc.liters",
	#	"svc.liters", "weight", "height", "resp.rate", "bp.systolic", "bp.diastolic"
	#
	# Returns:
	#	A dataset in which for each row corresponds to a unique subject.id.
	#	The columns consist of subject.id and features.
	#
	# Example usages:
	#	#source("Code/get_features.R")
	#	svc.features<-GetDefaultFeatures("train",GetSvcData("train"),"svc.liters")
	#	or
	#	data<-GetVitalData("train")
	#	weight<-as.data.frame(data$weight.data)
	# 	weight.features<-GetDefaultFeatures("train",weight,"weight")

	# Add unique subject ids for this raw dataset to features
	features<-GetSubjectIds(raw.data.name)

	# Get the name of the delta variable
	delta<-names(data)[grep("delta",names(data))]

	# Get column index of the delta field
	delta.col<-grep("delta",names(data))

	# Delete all rows where delta>91
	data<-data[data[,delta.col]<=91,]

    # Create a list with one element per subject id containing all data
	split.data<-split(data,data$subject.id)

	# Add maximum past value to features
	features <- merge(features, PastStat(split.data,measure,max,paste("max",measure,sep=".")), by="subject.id", all.x=TRUE)
	# Add minimum past value to features
	features <- merge(features, PastStat(split.data,measure,min,paste("min",measure,sep=".")), by="subject.id", all.x=TRUE)
	# Add latest past value to features
	last.measure<-paste("last",measure,sep=".")
	features <- merge(features, PastStat(split.data,measure,last,last.measure), by="subject.id", all.x=TRUE)
	# Add mean past value to features
	features <- merge(features, PastStat(split.data,measure,mean,paste("mean",measure,sep=".")), by="subject.id", all.x=TRUE)
	# Add number of past values to features
	num.visits<-paste("num",measure,"visits",sep=".")
	features <- merge(features, PastStat(split.data,measure,length,num.visits), by="subject.id", all.x=TRUE)
	# Add sum of past values to features
	features <- merge(features, PastStat(split.data,measure,sum,paste("sum",measure,sep=".")), by="subject.id", all.x=TRUE)
	# Add time of first and last past visits
	first.date<-paste("first",measure,"date",sep=".")
	features <- merge(features, PastStat(split.data,delta,min,first.date), by="subject.id", all.x=TRUE)
	last.date<-paste("last",measure,"date",sep=".")
	features <- merge(features, PastStat(split.data,delta,max,last.date), by="subject.id", all.x=TRUE)
	# Add mean of squared values
	features <- merge(features, PastStat(split.data,measure,meansquares,paste("meansquares",measure,sep=".")), by="subject.id", all.x=TRUE)
	# Add standard deviation of value
	features <- merge(features, PastStat(split.data,measure,stddev,paste("sd",measure,sep=".")), by="subject.id", all.x=TRUE)
	# Get first value (for slope calculation only)
	first.measure<-paste("first",measure,sep=".")
	features <- merge(features, PastStat(split.data,measure,first,first.measure), by="subject.id", all.x=TRUE)
	# Calculate slope
	slope<-(features[,colnames(features)==last.measure]-features[,colnames(features)==first.measure])/
		DaysToMonths(features[,colnames(features)==last.date]-features[,colnames(features)==first.date])

	# Add slope feature
	features<-cbind(features,slope)
	# Drop first measure
	features<-features[,colnames(features)!=first.measure]

	# Rename slope
	names(features)[names(features)=="slope"]<-paste(measure,"slope",sep=".")

	# Add indicator for when there are fewer than 2 observations
#	if (any(is.na(features[,colnames(features)==paste("num",measure,"visits",sep=".")])|features[,colnames(features)==paste("num",measure,"visits",sep=".")]<2)) {
		features<-
cbind(features,lessthan2=as.numeric(is.na(features[,colnames(features)==num.visits])|features[,colnames(features)==num.visits]<2))
		# Rename flag
		names(features)[names(features)=="lessthan2"]<-paste("lessthan2",measure,sep=".")

#	}

	# Add indicator for ids with no data - features$subject.id is the set of all subject.ids and data$subject.id
	# is the set of subject.ids that have measure data
#	if (any(!(features$subject.id %in% data$subject.id))) {
		features <- cbind(features, no.data=as.integer(!(features$subject.id %in% data$subject.id)))
		# Rename indicator
		names(features)[names(features)=="no.data"]<-paste("no",measure,"data",sep=".")
#	}

	return(features)
}

# Mean of squares function
meansquares<-function(data) {
	return(mean(data^2))
}

# Standard deviation function
stddev<-function(data) {
	return(sqrt(mean(data^2)-mean(data)^2))
}

# Last measure function
last<-function(data) {
	return(data[length(data)])
}

# First measure function
first<-function(data) {
	return(data[1])
}


timepoint.list <- c("01", "03", "05", "07", "09", "12", "24", "MM")
timepoint.list <- c("12", "24")
#timepoint.list <- c("01", "05", "24")

#timepoint.list <- c("24")
samples.of.timepoints <- samples[substr(samples, start = 5, stop = 7) %in% timepoint.list]
otus.of.timepoints <- otus.all.records.for.timepoints(workload$otus, timepoint.list)
otus.normalized <- otus.normalize(otus.of.timepoints, 0)
distances.of.timepoints <- distances.calculate(otus.normalized, workload$otus.tree)

# mds
mds <- cmdscale(distances.of.timepoints, eig = F, k = 2)

plots.timepoints(mds[, 1], mds[, 2], samples.of.timepoints, timepoints[timepoints %in% timepoint.list])

#plots.samples(mds[, 1], mds[, 2], samples.of.timepoints, timepoints[timepoints %in% timepoint.list])
#plots.individual(mds[, 1], mds[, 2], samples, timepoints, "011")
#plots.individual(mds[, 1], mds[, 2], samples, timepoints, "016")
#clustering <- time.series.cluster.timepoint(otus.normalized, distances.of.timepoints, timepoint.list)
#plots.classification(mds[, 1], mds[, 2], centroid_allocations = clustering$best.clustering_by_ch)

plots.multi.timepoint.clustering(mds, clusterings)

plots.timepoints(mds[, 1], mds[, 2], samples, timepoints)

#SVM
abc <- as.matrix(distances.of.timepoints)
svm.classifiers[1]

timepoint.chain <- c("01","24")
transition.matrix <- markov.transition.matrix(time.series, timepoint.chain)
plots.network(transition.matrix, timepoint.chain)

time.series[which(time.series[, '24'] == 2), ]


#!/usr/bin/Rscript

library(grid)
library(maptools)
library(surveillance)

Sys.setlocale("LC_TIME", "C") #Needed for identical()
Sys.setlocale("LC_COLLATE", "C")

fl <- file.path('states-shapefile', 'states.shp')

mapst <- readShapePoly(fl, IDvar='STATE_ABBR', proj4string=CRS("+init=epsg:4269"))
map48 <- mapst[!as.character(mapst$STATE_ABBR) %in% c("AK", "HI"),]

tmpf <- function(){
    fn <- file.path('PEDvweeklyreport-state-ts-01-08-14.csv')
    ret <- read.csv(fn)
    ret[1:9, c('CA', 'MD', 'NE', 'WY')] <- 0
    key <- order(colnames(ret)[-c(1:2)])
    ret <- cbind(ret[, c(1:2)], ret[, -c(1:2)][, key])
    ret$Unk <- NULL
    target <- structure(list(week = structure(c(20L, 29L, 32L, 8L, 12L),
  .Label = c("10/13/2013", "10/20/2013", "10/27/2013", "10/6/2013",
  "11/10/2013", "11/17/2013", "11/24/2013", "11/3/2013", "12/1/2013",
  "12/15/2013", "12/22/2013", "12/29/2013", "12/8/2013", "4/15/2013",
  "4/22/2013", "4/29/2013", "5/13/2013", "5/20/2013", "5/27/2013",
  "5/6/2013", "6/10/2013", "6/16/2013", "6/23/2013", "6/3/2013",
  "6/30/2013", "7/14/2013", "7/21/2013", "7/28/2013", "7/7/2013",
  "8/11/2013", "8/18/2013", "8/25/2013", "8/4/2013", "9/1/2013",
  "9/15/2013", "9/22/2013", "9/29/2013", "9/8/2013"), class = "factor"),
  totalNumberSwineAccessions = c(17L, 34L, 26L, 90L, 134L), CA = c(0, 0,
  0, 0, 1), CO = c(1L, 1L, 0L, 0L, 0L), IA = c(8L, 6L, 2L, 38L, 54L), IL
  = c(0L, 1L, 0L, 1L, 14L), IN = c(3L, 2L, 1L, 1L, 3L), KS = c(0L, 4L,
  3L, 6L, 4L), KY = c(0L, 0L, 0L, 0L, 0L), MD = c(0, 0, 0, 0, 0), MI =
  c(0L, 0L, 0L, 2L, 0L), MN = c(1L, 2L, 2L, 7L, 20L), MO = c(0L, 0L, 0L,
  2L, 4L), NC = c(0L, 3L, 4L, 14L, 18L), NE = c(0, 0, 0, 0, 2), NY =
  c(0L, 0L, 0L, 0L, 0L), OH = c(0L, 2L, 1L, 5L, 5L), OK = c(0L, 11L,
  10L, 10L, 2L), PA = c(1L, 0L, 3L, 1L, 0L), SD = c(0L, 0L, 0L, 0L, 3L),
  TN = c(0L, 0L, 0L, 1L, 1L), TX = c(0L, 0L, 0L, 1L, 1L), WI = c(0L, 0L,
  0L, 1L, 0L ), WY = c(0, 0, 0, 0, 1)), .Names = c("week",
  "totalNumberSwineAccessions", "CA", "CO", "IA", "IL", "IN", "KS",
  "KY", "MD", "MI", "MN", "MO", "NC", "NE", "NY", "OH", "OK", "PA",
  "SD", "TN", "TX", "WI", "WY" ), row.names = c(4L, 13L, 20L, 30L, 38L),
  class = "data.frame")
    stopifnot(identical(target, ret[c(4,13,20,30,38),]))
    ret
}
caseData <- tmpf()

tmpf <- function() {
    unwanted <- c('week', 'totalNumberSwineAccessions', 'Unk')
    ind <- which(!colnames(caseData) %in% unwanted)
    observed <- caseData[, ind]
    observed
}
observed <- tmpf()

start <- unlist(isoWeekYear(as.Date(as.character(caseData$week[1]),
                                    format="%m/%d/%Y")))

pedv.sts <- new('sts', epoch=1:nrow(observed), observed=observed,
                start=start, freq=52, map=map48)

make.plot <- function(){
    lab.obs <- ifelse(map48$STATE_ABBR %in% colnames(observed), as.character(map48$STATE_ABBR), "")
    grid.newpage()
    vp.grid <- viewport(layout=grid.layout(3,1))
    pushViewport(vp.grid)
    pal <- ggplot2::scale_fill_gradient(high="#4477AA", low="#DDCC77")$palette(1:13/13)
    plot.panel <- function(tps, row, col){
        pushViewport(viewport(layout.pos.col=col, layout.pos.row=row))
        p <- plot(pedv.sts, type=observed ~ unit, tps=tps, labels=list(labels=lab.obs, cex=.7, font=3),
                  col.regions=pal)
        print(p, newpage=FALSE)
        popViewport()
    }
    plot.panel(1:12, 1, 1)
    plot.panel(13:26, 2, 1)
    plot.panel(27:38, 3, 1)
}

cairo_ps(filename = 'accessions-on-maps.eps', width = 3.5, height = 7)
make.plot()
dev.off()

cairo_pdf(filename = 'accessions-on-maps.pdf', width = 3.5, height = 7)
make.plot()
dev.off()


# [Data yang Digunakan](https://academy.dqlab.id/main/projectcode/245/411/2078)
df_event <- read.csv('https://dqlab-dataset.s3-ap-southeast-1.amazonaws.com/event.csv', stringsAsFactors = F)
dplyr::glimpse(df_event)

# [Mengubah kolom created_at menjadi tipe Timestamp](https://academy.dqlab.id/main/projectcode/245/411/2079)
library(lubridate)

df_event$created_at <- ymd_hms(df_event$created_at)
dplyr::glimpse(df_event)

# [Summary Event](https://academy.dqlab.id/main/projectcode/245/412/2080)
library(dplyr)

df_event %>%
  group_by(nama_event) %>%
  summarise(jumlah_event = n(),
            loan = n_distinct(loan_id),
            investor = n_distinct(investor_id))

# [Event loan di-upload ke marketplace](https://academy.dqlab.id/main/projectcode/245/413/2082)
library(dplyr)

df_marketplace <- df_event %>%
  filter(nama_event == 'loan_to_marketplace') %>%
  select(loan_id, marketplace = created_at)
df_marketplace

# [Event investor melihat detail loan](https://academy.dqlab.id/main/projectcode/245/413/2083)
library(dplyr)

df_view_loan <- df_event %>%
  filter(nama_event == 'investor_view_loan') %>%
  group_by(loan_id, investor_id) %>%
  summarise(jumlah_view = n(),
            pertama_view = min(created_at),
            terakhir_view = max(created_at))
df_view_loan

# [Event investor pesan dan bayar loan](https://academy.dqlab.id/main/projectcode/245/413/2084)
library(dplyr)
library(tidyr)

df_order_pay <- df_event %>%
  filter(nama_event %in% c('investor_order_loan', 'investor_pay_loan')) %>%
  spread(nama_event, created_at) %>%
  select(loan_id,
         investor_id,
         order = investor_order_loan,
         pay = investor_pay_loan)
df_order_pay

# [Gabungan Data Loan Investasi](https://academy.dqlab.id/main/projectcode/245/413/2085)
library(dplyr)

df_loan_invest <- df_marketplace %>%
  left_join(df_view_loan, by = 'loan_id') %>%
  left_join(df_order_pay, by = c('loan_id','investor_id'))
df_loan_invest

# [Melihat hubungan jumlah view dengan order](https://academy.dqlab.id/main/projectcode/245/414/2086)
library(dplyr)
library(tidyr)

df_loan_invest %>%
  mutate(status_order = ifelse(is.na(order),'not_order','order')) %>%
  count(jumlah_view, status_order) %>%
  spread(status_order, n, fill = 0) %>%
  mutate(persen_order = scales::percent(order/(order+not_order)))

# [Berapa lama waktu yang dibutuhkan investor untuk pesan sejak pertama melihat detail loan](https://academy.dqlab.id/main/projectcode/245/414/2087)
library(dplyr)
library(tidyr)

df_loan_invest %>%
  filter(!is.na(order)) %>%
  mutate(lama_order_view = as.numeric(difftime(order, pertama_view, units = "mins"))) %>%
  group_by(jumlah_view) %>%
  summarise_at(vars(lama_order_view), funs(total = n(), min, median, mean, max)) %>%
  mutate_if(is.numeric, funs(round(.,2)))

# [Rata- rata waktu pemesanan sejak loan di-upload setiap minggu nya](https://academy.dqlab.id/main/projectcode/245/414/2088)
library(dplyr)
library(lubridate)
library(ggplot2)

df_lama_order_per_minggu <- df_loan_invest %>%
  filter(!is.na(order)) %>%
  mutate(tanggal = floor_date(marketplace, 'week'),
         lama_order = as.numeric(difftime(order, marketplace, units = "hour"))) %>%
  group_by(tanggal) %>%
  summarise(lama_order = median(lama_order))

ggplot(df_lama_order_per_minggu) +
  geom_line(aes(x = tanggal, y = lama_order)) +
  theme_bw() +
  labs(title = "Rata-rata lama order pada tahun 2020 lebih lama daripada 2019",
       x = "Tanggal",
       y = "waktu di marketplce sampai di-pesan (jam)")

# [Apakah Investor membayar pesanan yang dia buat.](https://academy.dqlab.id/main/projectcode/245/414/2089)
library(dplyr)
library(lubridate)
library(ggplot2)

df_bayar_per_minggu <- df_loan_invest %>%
  filter(!is.na(order)) %>%
  mutate(tanggal = floor_date(marketplace, 'week')) %>%
  group_by(tanggal) %>%
  summarise(persen_bayar = mean(!is.na(pay)))

ggplot(df_bayar_per_minggu) +
  geom_line(aes(x = tanggal, y = persen_bayar)) +
  scale_y_continuous(labels = scales::percent) +
  theme_bw() +
  labs(title = "Sekitar 95% membayar pesanannya. Di akhir mei ada outlier karena lebaran",
       x = "Tanggal",
       y = "Pesanan yang dibayar")

# [Waktu yang dibutuhkan investor untuk membayar pesanan](https://academy.dqlab.id/main/projectcode/245/414/2090)
library(dplyr)
library(lubridate)
library(ggplot2)

df_lama_bayar_per_minggu <- df_loan_invest %>%
  filter(!is.na(pay)) %>%
  mutate(tanggal = floor_date(order, 'week'),
         lama_bayar = as.numeric(difftime(pay, order, units = "hour"))) %>%
  group_by(tanggal) %>%
  summarise(lama_bayar = median(lama_bayar))

ggplot(df_lama_bayar_per_minggu) +
  geom_line(aes(x = tanggal, y = lama_bayar)) +
  theme_bw() +
  labs(title = "Waktu pembayaran trennya cenderung memburuk, 2x lebih lama dari sebelumnya",
       x = "Tanggal",
       y = "waktu di marketplce sampai di-pesan (jam)")

# [Trend Investor Register](https://academy.dqlab.id/main/projectcode/245/415/2092)
library(dplyr)
library(lubridate)
library(ggplot2)

df_investor_register <- df_event %>%
  filter(nama_event == 'investor_register') %>%
  mutate(tanggal = floor_date(created_at, 'week')) %>%
  group_by(tanggal) %>%
  summarise(investor = n_distinct(investor_id))

ggplot(df_investor_register) +
  geom_line(aes(x = tanggal, y = investor)) +
  theme_bw() +
  labs(title = "Investor register sempat naik di awal 2020 namun sudah turun lagi",
       x = "Tanggal",
       y = "Investor Register")

# [Trend Investor Investasi Pertama](https://academy.dqlab.id/main/projectcode/245/415/2093)
library(dplyr)
library(lubridate)
library(ggplot2)

df_investor_pertama_invest <- df_event %>%
  filter(nama_event == 'investor_pay_loan') %>%
  group_by(investor_id) %>%
  summarise(pertama_invest = min(created_at)) %>%
  mutate(tanggal = floor_date(pertama_invest, 'week')) %>%
  group_by(tanggal) %>%
  summarise(investor = n_distinct(investor_id))

ggplot(df_investor_pertama_invest) +
  geom_line(aes(x = tanggal, y = investor)) +
  theme_bw() +
  labs(title = "Ada tren kenaikan jumlah investor invest, namun turun drastis mulai Maret 2020",
       x = "Tanggal",
       y = "Investor Pertama Invest")

# [Cohort Pertama Invest berdasarkan Bulan Register](https://academy.dqlab.id/main/projectcode/245/415/2094)
library(dplyr)
library(lubridate)
library(tidyr)

df_register_per_investor <- df_event %>%
  filter(nama_event == 'investor_register') %>%
  rename(tanggal_register = created_at) %>%
  mutate(bulan_register = floor_date(tanggal_register, 'month'))  %>%
  select(investor_id, tanggal_register, bulan_register)

df_pertama_invest_per_investor <- df_event %>%
  filter(nama_event == 'investor_pay_loan') %>%
  group_by(investor_id) %>%
  summarise(pertama_invest = min(created_at))

df_register_per_investor %>%
  left_join(df_pertama_invest_per_investor, by = 'investor_id') %>%
  mutate(lama_invest = as.numeric(difftime(pertama_invest, tanggal_register, units = "day")) %/% 30) %>%
  group_by(bulan_register, lama_invest) %>%
  summarise(investor_per_bulan = n_distinct(investor_id)) %>%
  group_by(bulan_register) %>%
  mutate(register = sum(investor_per_bulan)) %>%
  filter(!is.na(lama_invest)) %>%
  mutate(invest = sum(investor_per_bulan)) %>%
  mutate(persen_invest = scales::percent(invest/register)) %>%
  mutate(breakdown_persen_invest = scales::percent(investor_per_bulan/invest)) %>%
  select(-investor_per_bulan) %>%
  spread(lama_invest, breakdown_persen_invest)

# [Cohort Retention Invest](https://academy.dqlab.id/main/projectcode/245/415/2095)
library(dplyr)
library(lubridate)
library(tidyr)

df_investasi_per_investor <- df_event %>%
  filter(nama_event == 'investor_pay_loan') %>%
  rename(tanggal_invest = created_at) %>%
  select(investor_id, tanggal_invest)

df_pertama_invest_per_investor %>%
  mutate(bulan_pertama_invest = floor_date(pertama_invest, 'month')) %>%
  inner_join(df_investasi_per_investor, by = 'investor_id') %>%
  mutate(jarak_invest = as.numeric(difftime(tanggal_invest, pertama_invest, units = "day")) %/% 30) %>%
  group_by(bulan_pertama_invest, jarak_invest) %>%
  summarise(investor_per_bulan = n_distinct(investor_id)) %>%
  group_by(bulan_pertama_invest) %>%
  mutate(investor = max(investor_per_bulan)) %>%
  mutate(breakdown_persen_invest = scales::percent(investor_per_bulan/investor)) %>%
  select(-investor_per_bulan) %>%
  spread(jarak_invest, breakdown_persen_invest) %>%
  select(-`0`)

R/Project/Project Data Analysis for Finance Proses Investasi Investor.r


library(Matrix)
library(shff)

rmifthere = function(file) if (file.exists(file)) file.remove(file)

fin = "../inst/exampledata/kg2.mtx"
fout = sub("[.]mtx", ".h5", fin)
rmifthere(fout)
kg2 = Matrix::readMM(fin)
shff::write_shff(kg2, fout)

fin = "../inst/exampledata/kg4.mtx"
fout = sub("[.]mtx", ".h5", fin)
rmifthere(fout)
kg4 = Matrix::readMM(fin)
shff::write_shff(kg4, fout)


"
Написать программу получения вектора из N случайных символо
русского алфавита
Использовать функцию sample().
"
N = 10
# Все заносим в вектор
w <-unlist(strsplit("АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ",""))
result<-sample(w,N)
print(result)


test_that("max_support works", {
  x <- matrix(c(1,1,1,1,1,1,1,0,0,1,0,0,1,1,0,1), nrow = 4)
  y <- c(1,1,1,0)

  e <- 1
  xe <- x[e,]
  ye <- y[e]

  r <- max_support(x, y, xe, ye, complement = FALSE, ws = 1)

  expect_equal(r$sparsity, 1)
  expect_equal(r$alpha, 2)
  expect_equal(r$support, 3)
  expect_equal(r$r, c(1,2,3))

  x2 <- rbind(x, c(0,1,1,1))
  y2 <- c(y,0)
  r2 <- max_support(x2, y2, xe, ye, complement = FALSE, ws = 1)

  expect_equal(r2$sparsity, 2)
  expect_equal(r2$alpha, c(1,2))
  expect_equal(r$support, 3)
  expect_equal(r$r, c(1,2,3))
})


# This is a comment.

a <- seq(100)
b <- a
b[a %% 3 == 0] <- "Fizz"
b[a %% 5 == 0] <- "Buzz"
b[a %% 3 == 0 & a %% 5 == 0] <- "FizzBuzz"
cat(b, sep = "\n")


# Information about code:
# This code corresponds to a chapter in my MSc thesis for
# Chapter 3, the section on Gender analysis: utility  functions.
# adapted from https://github.com/lukeholman/genderGapCode/
# @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

# Set up
source('2019-06-19-jsa-type/subset.r')

# Libraries
library(dplyr)
library(RSQLite)

library(tidyverse)
library(httr)
library(jsonlite)

# Scripts
source('2019-06-19-jsa-type-ch3-gender/analysis1/util.r') # util functions
# source('2019-06-19-jsa-type-ch3-gender/analysis1/data-un.r')
# get data from UN's API and save locally
source('2019-06-19-jsa-type-ch3-gender/analysis1/model.r') # read local/ bee data

dir_data_subf1 = paste0(dir_data_ch3_gender, "time-series-spp/")
dir_data_subf2 = paste0(dir_data_ch3_gender, "time-series-tax/")

if(!dir.exists(dir_data_ch3_gender)) dir.create(dir_data_ch3_gender)
if(!dir.exists(dir_data_subf1)) dir.create(dir_data_subf1)
if(!dir.exists(dir_data_subf2)) dir.create(dir_data_subf2)

# @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
# Section - gender rep - in text fig
# @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
print(paste0(Sys.time(), " --- gender rep - in text fig"))

# % of M, F, U
names(auth_full)
table(auth_full$describer.gender.n)
prop.table(table(auth_full$describer.gender.n))
dim(auth[describer.gender.n!="U"])
table(auth[describer.gender.n!="U"]$describer.gender.n)
prop.table(table(auth[describer.gender.n!="U"]$describer.gender.n))

# Earliest date
min_female <- min(dat[describer.gender.n=="F" ]$date.n)
dat[describer.gender.n=="F" & date.n== min_female]

# @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
# Section - gender rep - run model for taxonomists
# @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
print(paste0(Sys.time(), " --- gender rep - run model for taxonomists"))

# Run model
result <- run_specific_scenario(country="All", position="All", dir_data_subf2, "tax")
min_year <- min(generate_prop_t(country="All")$date.n)
result_summary_tax <- result$summary

result_summary_countries_tax <- lapply(countries[1:6], function(country) {
    run_specific_scenario(country=country, position="All", dir_data_subf2, "tax")$summary
})

outputs <- rbindlist(c(list(result_summary_tax), result_summary_countries_tax))
write.csv(outputs, paste0(dir_data_subf2, "_outputs.csv"), row.names=F)

# generate_prop_t_tax("Germany")
# generate_prop_t_tax("United States of America")

# # Test plotting
# source('2019-06-19-jsa-type-ch3-gender/analysis1/model.r') # read local/ bee data
# prop_t <- generate_prop_t_tax(country="Brazil")
# output <- main(country = "Brazil", position = "All", prop_t)
# save_graph(dir_data_subf2, country="Brazil", position="All", prop_t,
#            output$summary$r, output$summary$c, output$summary$years.to.parity, "tax")

# @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
# Section - gender rep - in text fig on country
# @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
print(paste0(Sys.time(), " --- gender rep - in text fig on country"))

prop_tax <- auth[, .N, c("Country", "describer.gender.n")][order(-N)]
prop_tax <- dcast(prop_tax, Country ~ describer.gender.n, value.var="N")
prop_tax <- prop_tax[!is.na(Country)]; prop_tax[is.na(prop_tax)] <- 0
prop_tax$N <- prop_tax$F + prop_tax$M; prop_tax$prop_F <- prop_tax$F / prop_tax$N
prop_tax <- prop_tax[order(-prop_F)]

median(prop_tax[prop_F>0]$F)
median(prop_tax[prop_F>0]$M)

prop_tax[F+M+U>5][1:10]
len = dim(prop_tax[F+M+U>5])[1]
prop_tax[F+M+U>5][(len-10):len]

write.csv(prop_tax, paste0(dir_data_ch3_gender, "2019-11-15-prop-taxonomist.csv"),
          row.names=F, fileEncoding='UTF-8')

# Proportion of papers (! NOT USED)
# prop_t_countries <- rbindlist(lapply(countries, function(country) {
#     prop <- generate_prop_t(country=country, position="All")
#     if (!is.null(prop)) data.frame(Country=country, M=sum(prop$nMales), F=sum(prop$nFemales))
# }))

# prop_t_countries <- prop_t_countries[!is.na(Country)]
# prop_t_countries[is.na(prop_t_countries)] <- 0
# prop_t_countries$N <- prop_t_countries$F + prop_t_countries$M
# prop_t_countries$prop_F <- prop_t_countries$F / prop_t_countries$N
# prop_t_countries <- prop_t_countries[order(-prop_F)]

# write.csv(prop_t_countries, paste0(dir_data_ch3_gender, "2019-11-15-prop-taxonomist-spp.csv"),
#           row.names=F, fileEncoding='UTF-8')

############### NOT USED IN MAIN TEXT ###############

# @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
# Section - gender rep - run model for species
# @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
print(paste0(Sys.time(), " --- gender rep - run model for species"))

#################
# By Position
#################

result_summary_all_prop <- generate_prop_t(country="All")

spp_sum <- dat[, .N, by=c("describer.gender.n")]
spp_sum[describer.gender.n=="U"]$N/sum(spp_sum$N)*100
spp_sum <- spp_sum[describer.gender.n != "U"]; sum(spp_sum$N)
prop.table(spp_sum[,2])*100

result_summary_all <- lapply(c("All", "First", "Last", "First_s", "Last_s"), function(pos) {
    run_specific_scenario(country="All", position=pos, dir_data_subf1)$summary
})

#################
# By Country
#################

# countries <- c("United States of America", "Germany", "Brazil", "France", "United Kingdom", "Japan")

result_summary_countries <- lapply(countries[1:6], function(country) {
    run_specific_scenario(country=country, position="All", dir_data_subf1)$summary
})
# usa, germany, brazil, france, united kingdom, japan [top 6 countries]
# as case studies; they have more than 30 taxonomists across the years
# and potentially have interesting stories to tell

outputs <- rbindlist(c(result_summary_all, result_summary_countries))
write.csv(outputs, paste0(dir_data_subf1, "_outputs.csv"), row.names=F)

# Testing
# print(result_summary[[1]])
# rbindlist(result_summary)

# generate_prop_t("Germany", "All")
# generate_prop_t("France", "All")

# @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
# Section - gender rep - if UN factors affect gender propo
# @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
print(paste0(Sys.time(), " --- gender rep - if UN factors affect gender proportion"))

# Modelling taxonomists
prop_tax_mdf <- merge(prop_tax, df_r, by="Country", all.x=T, all.y=F)
prop_tax_mdf <- prop_tax_mdf[N!=0]
prop_tax_mdf$F_yn <- factor(ifelse(prop_tax_mdf$F > 0, "Y", "N"), levels=c("N", "Y"))
names(prop_tax_mdf)

prop_tax_mdf[is.na(country)]
prop_tax_mdf <- prop_tax_mdf[!is.na(country)]

ggplot(prop_tax_mdf, aes(x=F_yn, y=schl_f)) + geom_boxplot()
ggplot(prop_tax_mdf, aes(x=F_yn, y=gnip_f)) + geom_boxplot()
ggplot(prop_tax_mdf, aes(x=F_yn, y=gdip_a)) + geom_boxplot()

var <- unlist(lapply(prop_tax_mdf, is.numeric))
cor(prop_tax_mdf[, ..var])
heatmap(cor(prop_tax_mdf[, ..var]), Colv = NA, Rowv = NA)

# note: it did not look promising


## Explore width of confidence intervals, checking that it is zero
## at the median of the single predictor

require(rms)
set.seed(1)
a <- 1 : 100
dd <- datadist(a); options(datadist='dd')
S <- Surv(a + 100 * runif(100))
f <- cph(S ~ a)
ab <- list(v = median(a))
plot(Predict(f), abline=ab)
f <- cph(S ~ pol(a, 2))
plot(Predict(f), abline=ab)
plot(Predict(f, ref.zero=TRUE), abline=ab)

b <- sample(1:100) + 100
dd <- datadist(a, b)
f <- cph(S ~ pol(a, 2) + b)
plot(Predict(f), abline=ab)
plot(Predict(f, ref.zero=TRUE), abline=list(v=c(median(a),median(b))))