## BY ZHAO TIANXIAO

set.seed(1919)
library(dplyr)
library(ggplot2)
library(caret)
library(mlbench)
library(ROCR)
library(nnet)
library(randomForest)
library(Rtsne)
library(plotly)

## Data Import $ Process
raw_dat <- read.table("SCnorm_Combat_Exp_Matrix.txt", header = T, row.names = 1, sep = "\t", stringsAsFactors = F)
raw_dat[,1:ncol(raw_dat)] <- lapply(raw_dat[,1:ncol(raw_dat)], as.numeric)
raw_dat<- scale(raw_dat)
raw_dat <- as.data.frame(t(raw_dat))
raw_dat$names <- rownames(raw_dat)
raw_dat <- arrange(raw_dat, names)
rownames(raw_dat) <- raw_dat$names
raw_dat <- raw_dat[,-ncol(raw_dat)]

## Label of Samples
sample_dat <- read.table("scirep_classes.txt", header = T, sep = ",", stringsAsFactors = F)
sample_class <- as.factor(arrange(sample_dat, sample_id)$label)

## RFE
subsets = c(1:10, 20, 30, 40, 50)
ctrl= rfeControl(functions = rfFuncs, method = "cv",verbose = FALSE, returnResamp = "final")
Profile = rfe(raw_dat, sample_class, sizes = subsets, rfeControl = ctrl)
rfe_dat <- raw_dat[,Profile$optVariables]

Profile
Profile$optVariables

## Data Output
write.table(rfe_dat, "RFE_data.txt", col.names = T, row.names = T, sep = "\t")

## t-SNE after Feature Selection(2 Dimension)
p <- Rtsne(rfe_dat, dims = 2, pca = FALSE)
tSNE_Vis <- as.data.frame(cbind(sample_class, p$Y))
names(tSNE_Vis) <- c("class", "X", "Y")
tSNE_Vis$class <- factor(tSNE_Vis$class)
s <- ggplot(data = tSNE_Vis, aes(x = X, y = Y, col = class)) + geom_point()
s

## t-SNE after Feature Selection(3 Dimension)
p <- Rtsne(rfe_dat, dims = 3)
p$Y <- p$Y / 20
tSNE_Vis_3 <- as.data.frame(cbind(sample_class, p$Y))
names(tSNE_Vis_3) <- c("class", "X", "Y", "Z")
tSNE_Vis_3$class <- factor(tSNE_Vis_3$class)
plot_ly(x = tSNE_Vis_3$X, y = tSNE_Vis_3$Y, z = tSNE_Vis_3$Z, type = "scatter3d", mode = "markers", color = tSNE_Vis_3$class)

## t-SNE before Feature Selection
p <- Rtsne(raw_dat, dims = 2, initial_dims = 100)
tSNE_Vis_before <- as.data.frame(cbind(sample_class, p$Y))
names(tSNE_Vis_before) <- c("class", "X", "Y")
tSNE_Vis_before$class <- factor(tSNE_Vis_before$class)
s <- ggplot(data = tSNE_Vis_before, aes(x = X, y = Y, col = class)) + geom_point(size = 3)
s

## Prepare for Logistic Regression
merged_dat <- cbind(sample_class, rfe_dat)
merged_dat$sample_class = factor(merged_dat$sample_class)
temp <- colnames(merged_dat)
temp[2] <- 'piR_hsa_23317'
colnames(merged_dat) <- temp

## Divide Train & Test in Random Forests
n_samples <- nrow(rfe_dat)
n_train <- floor(n_samples * 0.8)
indices <- sample(1:n_samples)
indices <- indices[1:n_train]
RF_train_sample <- rfe_dat[indices,]
RF_train_sample_class <- sample_class[indices]
RF_test_sample <- rfe_dat[-indices,]
RF_test_sample_class <- sample_class[-indices]

## Find Best mtry in RF
for(i in 1:8){
    rf_classifier = randomForest(x = RF_train_sample, y = RF_train_sample_class,  ntree = 400, mtry = i)
    print(mean(rf_classifier$err.rate))
}

## RF
rf_classifier = randomForest(x = RF_train_sample, y = RF_train_sample_class,  ntree = 400, mtry = 7)
rf_classifier

## Test in RF
predicted_classes <- predict(rf_classifier, RF_test_sample)
predicted_probs <- predict(rf_classifier, RF_test_sample, type = 'prob')
table(predicted_classes, RF_test_sample_class)

positive_class <- 'Healthy Control'

test_labels <- vector('integer', length(test_sample_class))
test_labels[test_sample_class != positive_class] <- 0
test_labels[test_sample_class == positive_class] <- 1
pred <- prediction(predicted_probs[, positive_class], test_labels)
roc <- performance(pred, 'tpr', 'fpr')
plot(roc, main = 'ROC Curve')
auc <- performance(pred, 'auc')
cat('auc =', auc@y.values[[1]], '\n')

## Divide Train & Test in Logistic Regression
n_samples <- nrow(merged_dat)
n_train <- floor(n_samples * 0.8)
indices <- sample(1:n_samples)
indices <- indices[1:n_train]
train_merged_sample <- merged_dat[indices,]
#train_sample_class <- sample_class[indices]
test_merged_sample <- merged_dat[-indices,]
#test_sample_class <- sample_class[-indices]

## Multinom Logistic Regression
mult_train <- multinom(sample_class ~ piR_hsa_23317+ENST00000536684.2+ENST00000626826.1+ENST00000623130.1+ENST00000385273.1+
                       ENST00000516053.2+ENST00000384010.1+ENST00000365699.4+ENST00000362154.1+ENST00000384981.3+ENST00000600213.3+
                       ENST00000383861.1+ENST00000385012.1+ENST00000383858.1+ENST00000384898.1+ENST00000383869.1+ENST00000362162.1+
                       ENST00000384278.1+ENST00000615842.1+ENST00000613023.1, data=train_merged_sample)
step_train <- step(mult_train)

# Test on train_data
train_pred <- predict(step_train)
table(train_merged_sample$sample_class, train_pred)

# Test on test_data
test_pred <- predict(mult_train, newdata = test_merged_sample)
table(test_merged_sample$sample_class, test_pred)


if (!require("pacman")) install.packages("pacman")
packages<-c("shiny","shinythemes","DT","DataExplorer",
            "glmnet","leaps","e1071","tibble",
            "rpart","randomForest","xgboost","Matrix","JOUSBoost","solitude",
            "class","arulesCBA","ROCR","tidyverse")
pacman::p_load(char=packages)

ui <- fluidPage(theme = shinythemes::shinytheme("cerulean"),
                navbarPage(p(strong("Data Science and Analysis")),
                           tabPanel("Upload Datasets",
                                    fileInput("upload", "Choose a file", buttonLabel = "Upload...",accept = ".csv",multiple = T),
                                    checkboxInput("header", "Header", T),
                                    radioButtons("sep", "Separator",
                                                 choices = c(Comma = ",",
                                                             Semicolon = ";",
                                                             Tab = "\t"),
                                                 selected = ","),
                                    DT::dataTableOutput("dataset"),
                                    style="overflow-x: scroll"),
                           tabPanel("Exploratory Data Analysis",
                                    h1("Basic Stats"),
                                    plotOutput("PlotIntro"),
                                    h1("Missing Data Profile"),
                                    plotOutput("PlotMissing"),
                                    h1("Univariate Distributions"),
                                    h2("Bar Charts"),
                                    plotOutput("Bars"),
                                    h2("Histograms"),
                                    plotOutput("Histograms"),
                                    h1("Correlation Analysis"),
                                    plotOutput("Correlation"),
                                    style="overflow-y: scroll"),
                           tabPanel("Modelling",
                                    sidebarPanel(uiOutput("Target"),
                                                 selectInput("Models", "Choose a Model:",
                                                             list("Linear" = c("logistic","ridge","lasso","bestsubset","svm","oneclasssvm"),
                                                                  "Tree" = c("decisiontree","randomforest","xgboost","adaboost","isolationforest"),
                                                                  "Non-linear"=c("knn","naivebayes","rulebased")),
                                                             selected = "logistic"),
                                                 numericInput("Trainsplit","Enter training split percentage (0-1):",
                                                              min = 0,max = 1,value = 0.7,step = 0.1),
                                                 numericInput("Seed","Random Seed:",
                                                              min = 0,max = 10000000000,value = 1),
                                                 actionButton("Build","Build Model!",width = "100%",icon=icon("hammer"),class="btn btn-primary"),
                                                 h3("Hyperparameter Tuning"),
                                                 uiOutput("param1"),
                                                 uiOutput("param2"),
                                                 uiOutput("param3"),
                                                 uiOutput("param4"),
                                                 uiOutput("param5"),
                                                 uiOutput("param6"),
                                                 uiOutput("param7")),
                                    mainPanel(h1("Accuracy Metrics"),
                                              h2("Confusion Matrix"),
                                              plotOutput("ConfusionMatrix"),
                                              h2("ROC Curve"),
                                              plotOutput("ROC"))),
                           tabPanel("Model Leaderboard",
                                    DT::dataTableOutput("leaderboard")),
                           tabPanel("Make New Prediction",
                                    fileInput("newdata", "Choose a file", buttonLabel = "Upload...",accept = ".csv"),
                                    DT::dataTableOutput("newpreview"),
                                    downloadButton("downloadPreds", "Download Predictions"),
                                    actionButton("newpreds","Make New Predictions",icon=icon("search"),class="btn btn-primary"),
                                    style="overflow-x: scroll")
                )
)

server <- function(input, output, session) {

  #initialize leaderboard#

  bd<-data.frame(Model=character(),
                 Logloss=numeric(),
                 AUC=numeric(),
                 Accuracy=numeric(),
                 TPR=numeric(),
                 FPR=numeric())
  v<-reactiveValues(df=bd)
  updated<-reactive({
    input$Build
    isolate({
      v$df<-rbind.data.frame(v$df,calculate()$insert,make.row.names = F)
    })
  })

  #read input file as reactive data
  data<-reactive({
    req(input$upload)
    df <- read.csv(input$upload$datapath,
                   header = input$header,
                   sep = input$sep)
    return(df)
  })

  #preview input file
  output$dataset <- DT::renderDataTable({
    return(data())
  })

  #exploratory data analysis
  output$PlotIntro<-renderPlot({
    DataExplorer::plot_intro(data())
  })
  output$PlotMissing<-renderPlot({
    DataExplorer::plot_missing(data())
  })
  output$Bars<-renderPlot({
    DataExplorer::plot_bar(data())
  })
  output$Histograms<-renderPlot({
    DataExplorer::plot_histogram(data())
  })
  output$Correlation<-renderPlot({
    DataExplorer::plot_correlation(data())
  })

  #modelling
  output$Target <- renderUI({
    req(data())
    df <- data()
    selectInput("Target", "Select a variable as target:", choices= names(df))
  })
  output$param1<-renderUI({
    req(data())
    req(input$Trainsplit)
    df <- data()
    n <- nrow(df)
    RNGkind(sample.kind = "Rounding")
    set.seed(input$Seed)
    train <- sample(n,input$Trainsplit*n)
    if(input$Models=="logistic"){
      numericInput("significance","Significant Level (alpha):",
                   min = 0.01,max = 0.1,value = 0.05)
    }
    else if(input$Models=="ridge"){
      numericInput("lambdaA","Number of Lambda Values to Try (default: 100):",
                   min = 1,max = 1000,value = 100)
    }
    else if(input$Models=="lasso"){
      numericInput("lambdaB","Number of Lambda Values to Try (default: 100):",
                   min = 1,max = 1000,value = 100)
    }
    else if(input$Models=="bestsubset"){
      numericInput("nvmax","Maximum Size of Subsets:",
                   min = 1,max = ncol(df)-1,value = ncol(df)-1)
    }
    else if(input$Models=="svm"){
      selectInput("svmkernel","Select kernel:",
                  choices = c("linear","polynomial","radial","sigmoid"),selected = "linear")
    }
    else if(input$Models=="oneclasssvm"){
      selectInput("oneclasskernel","Select kernel:",
                  choices = c("linear","polynomial","radial","sigmoid"),selected = "linear")
    }
    else if(input$Models=="decisiontree"){
      numericInput("minsplit","Minimum Observations for a Split",
                   min = 1,max=100,value=20,step = 1)
    }
    else if(input$Models=="randomforest"){
      numericInput("ntrees","Number of Trees to Grow:",
                   min=100,max=1000,value=500)
    }
    else if(input$Models=="xgboost"){
      numericInput("nrounds","Maximum Number of Boosting Iterations:",
                   min=100,max=1000,value=500)
    }
    else if(input$Models=="adaboost"){
      numericInput("adanrounds","Maximum Number of Boosting Iterations:",
                   min=100,max=1000,value=500)
    }
    else if(input$Models=="isolationforest"){
      numericInput("ratio","Percentage of Anomalies",
                   min=round(sum(df[train,which(names(df) %in% input$Target)])/length(train),2),max=0.99,
                   value=round(sum(df[train,which(names(df) %in% input$Target)])/length(train),2),step = .01)
    }
    else if(input$Models=="knn"){
      numericInput("neighbours","Number of Nearest Neighbours, K:",
                   min=1, max=20,value = 20)
    }
    else if(input$Models=="rulebased"){
      numericInput("support","Support Level",
                   min=0.01,max=0.99,value=0.01)
    }

  })
  output$param2<-renderUI({
    req(input$Models)
    df <- data()
    if(input$Models=="bestsubset"){
      selectInput("bsmethod","Selection Method:",
                  choices = c("exhaustive","backward","forward"),selected = "exhaustive")
    }
    else if(input$Models=="decisiontree"){
      numericInput("maxdepth","Maximum Depth of Tree",
                   min = 1,max=30,value=30,step = 1)
    }
    else if(input$Models=="randomforest"){
      numericInput("mtry","Number of Variables to use each split:",
                   min=1, max=ncol(df)-1,value=floor(sqrt(ncol(df)-1)))
    }
    else if(input$Models=="xgboost"){
      numericInput("earlystop","Number of Early Stopping Rounds:",
                   min=0,max=10,value=5)
    }
    else if(input$Models=="adaboost"){
      numericInput("adamaxdepth","Maximum Depth of Tree",
                   min = 1,max=3,value=2,step = 1)
    }
    else if(input$Models=="knn"){
      radioButtons("knnsample","Sampling:",
                   choices = c("cross","bootstrap"),
                   selected = "cross")
    }
    else if(input$Models=="rulebased"){
      numericInput("confidence","Confidence Level",
                   min=0.01,max=0.99,value=0.8)
    }
  })
  output$param3<-renderUI({
    req(data())
    req(input$Models)
    if(input$Models=="bestsubset"){
      radioButtons("bsmetric","Metric:",
                   choices = c(BIC="bic",AIC="aic",AdjR2="adjr2"),selected = "bic")
    }
    else if(input$Models=="randomforest"){
      radioButtons("sampling","Bootstrap Sampling?",
                   choices = c("T","F"),selected = "T")
    }
    else if(input$Models=="xgboost"){
      numericInput("eta","Learning Rate:",
                   min=0.01,max=0.99,value = 0.3)
    }
  })
  output$param4<-renderUI({
    req(data())
    req(input$Models)
    if(input$Models=="xgboost"){
      numericInput("xgbmaxdepth","Maximum Depth of Trees:",
                   min=2,max=30,value=6)
    }
  })
  output$param5<-renderUI({
    req(data())
    req(input$Models)
    if(input$Models=="xgboost"){
      numericInput("xgboostalpha","L1 Regularization",
                   min=0,max=1,value = 0)
    }
  })
  output$param6<-renderUI({
    req(data())
    req(input$Models)
    if(input$Models=="xgboost"){
      numericInput("xgboostlambda","L2 Regularization",
                   min=0,max=1,value = 0)
    }
  })
  output$param7<-renderUI({
    req(data())
    req(input$Models)
    if(input$Models=="xgboost"){
      radioButtons("xgboostmetrics","Metrics:",
                   choices = c("Logloss"="logloss",
                               "Classification Error"="error",
                               "AUC"="auc"),
                   selected = "logloss")
    }
  })

  calculate<-eventReactive(input$Build,{
    req(data())
    df <- data()
    n <- nrow(df)
    RNGkind(sample.kind = "Rounding")
    set.seed(input$Seed)
    train <- sample(n,input$Trainsplit*n)
    form <- as.formula(paste0(input$Target,"~."))
    if(input$Models=="logistic"){
      model <- glm(form,data = df[train,],family = binomial)
      summ<-summary(model)
      coeftable<-as.data.frame(summ$coefficients[-1,])
      coeftable<-coeftable[coeftable$`Pr(>|z|)`<=input$significance,]
      accepted<-c(rownames(coeftable),input$Target)
      filtered_df<-df[,which(names(df)%in%accepted)]
      newmodel<-glm(form,data = filtered_df[train,],family = binomial)
      preds <- predict(newmodel,filtered_df[-train,],type="response")
    }
    else if(input$Models=="ridge"){
      x<-model.matrix(form,df[train,])[,-1]
      y<-df[train,which(names(df)%in%input$Target)]
      new.x<-model.matrix(form,df[-train,])[,-1]
      model<-glmnet::glmnet(x,y,alpha = 0,family = 'binomial',nlambda = input$lambdaA)
      cv<-glmnet::cv.glmnet(x,y,alpha=0, family = 'binomial')
      bestlamb<-cv$lambda.min
      preds<-predict(model,s=bestlamb, newx = new.x,type = 'response')
    }
    else if(input$Models=="lasso"){
      x<-model.matrix(form,df[train,])[,-1]
      y<-df[train,which(names(df)%in%input$Target)]
      new.x<-model.matrix(form,df[-train,])[,-1]
      model<-glmnet::glmnet(x,y,alpha = 1,family = 'binomial',nlambda = input$lambdaB)
      cv<-glmnet::cv.glmnet(x,y,alpha=1, family = 'binomial')
      bestlamb<-cv$lambda.min
      preds<-predict(model,s=bestlamb, newx = new.x,type = 'response')
    }
    else if(input$Models=="bestsubset"){
      model <- leaps::regsubsets(form,df[train,],nvmax=input$nvmax,method=input$bsmethod)
      summ<-summary(model)
      if(input$bsmetric=="bic"){
        b<-which.min(summ$bic)
      }
      else if(input$bsmetric=="aic"){
        b<-which.min(summ$aic)
      }
      else if(input$bsmetric=="adjr2"){
        b<-which.max(summ$adjr2)
      }
      coefs<-coef(model,b)[-1]
      predictor<-paste(names(coefs),collapse = "+")
      new_form<-as.formula(paste0(input$Target,"~",predictor))
      newmodel <- glm(new_form,df[train,],family = binomial)
      preds <- predict(newmodel,df[-train,],type="response")
    }
    else if(input$Models=="svm"){
      model <- e1071::svm(form,df[train,],type="C-classification",kernel=input$svmkernel,probability=T)
      preds <- attributes(predict(model,df[-train,],probability=T))$probabilities[,2]
    }
    else if(input$Models=="oneclasssvm"){
      filtered_df <- df[df[,which(names(df)%in%input$Target)]==1,]
      newtrain<-sample(nrow(filtered_df),input$Trainsplit*nrow(filtered_df))
      model <-e1071::svm(form,filtered_df[newtrain,],type="one-classification",kernel=input$oneclasskernel)
      PredictedLabels <- as.numeric(predict(model,df[-train,]))
      cm<-tibble::as_tibble(table(actual=df[-train,which(names(df) %in% input$Target)],
                                  predicted=PredictedLabels))
      acc<-round(sum(cm[c(1,4),3])/sum(cm[,3]),5)
      tpr<-round(unlist(cm[4,3]/sum(cm[c(2,4),3])),5)
      fpr<-round(unlist(cm[3,3]/sum(cm[c(1,3),3])),5)
      insert<-data.frame(Model=input$Models,Logloss=NA,AUC=NA,Accuracy=acc,TPR=tpr,FPR=fpr)
      return(list(cm=cm,insert=insert))
    }
    else if(input$Models=="decisiontree"){
      df[,which(names(df) %in% input$Target)] <- as.factor(df[,which(names(df) %in% input$Target)])
      model <- rpart::rpart(form,data = df,subset = train,parms = rpart::rpart.control(minsplit = input$minsplit,maxdepth = input$maxdepth))
      pruned <- rpart::prune(model,model$cptable[which.min(model$cptable[,"xerror"]),"CP"])
      preds <- predict(pruned,df[-train,])[,2]
    }
    else if(input$Models=="randomforest"){
      df[,which(names(df) %in% input$Target)] <- as.factor(df[,which(names(df) %in% input$Target)])
      if(input$sampling=="T"){
        model <- randomForest::randomForest(form,df,subset=train,ntree=input$ntrees,mtry=input$mtry)
      }
      else if(input$sampling=="F"){
        model <- randomForest::randomForest(form,df,subset=train,ntree=input$ntrees,mtry=input$mtry,replace=F)
      }
      preds <- predict(model,df[-train,],type="prob")[,2]
    }
    else if(input$Models=="xgboost"){
      output.vector=as.numeric(df[train,which(names(df) %in% input$Target)]==1)
      output.vector.test=as.numeric(df[-train,which(names(df) %in% input$Target)]==1)
      dtrain=xgboost::xgb.DMatrix(Matrix::sparse.model.matrix(form,df)[train,-1],label=output.vector)
      dtest=xgboost::xgb.DMatrix(Matrix::sparse.model.matrix(form,df)[-train,-1],label=output.vector.test)
      parameter=list(eta=input$eta,max_depth=input$xgbmaxdepth,alpha=input$xgboostalpha,lambda=xgboostlambda)
      watchlist=list(train=dtrain,test=dtest)
      model <- xgboost::xgb.train(data=dtrain,nrounds=input$nrounds,early_stopping_rounds=input$earlystop,
                                  watchlist=watchlist,params = parameter,objective="binary:logistic",
                                  eval.metric = input$xgboostmetrics,verbose=0)
      preds <- predict(model,dtest)
    }
    else if(input$Models=="adaboost"){
      x<-as.matrix(df[,-which(names(df) %in% input$Target)])
      y_train<-as.numeric(df[train,which(names(df) %in% input$Target)]==1)
      y_train<-ifelse(y_train==0,-1,y_train)
      model <-JOUSBoost::adaboost(x[train,],y_train,n_rounds = input$adanrounds,tree_depth = input$adamaxdepth)
      preds <- predict(model,x[-train,],type="prob")
    }
    else if(input$Models=="isolationforest"){
      model=solitude::isolationForest$new(sample_size = length(train))
      model$fit(dataset=df[train,-which(names(df) %in% input$Target)])
      preds<-unlist(model$predict(df[-train,-which(names(df) %in% input$Target)])[,3])
      rate<-1-input$ratio
      PredictedLabels<-ifelse(preds>quantile(preds,rate),1,0)
      cm <- tibble::as_tibble(table(actual=df[-train,which(names(df) %in% input$Target)],
                                    predicted=PredictedLabels))
      acc<-round(sum(cm[c(1,4),3])/sum(cm[,3]),5)
      tpr<-round(unlist(cm[4,3]/sum(cm[c(2,4),3])),5)
      fpr<-round(unlist(cm[3,3]/sum(cm[c(1,3),3])),5)
      insert<-data.frame(Model=input$Models,Logloss=NA,AUC=NA,Accuracy=acc,TPR=tpr,FPR=fpr)
      return(list(cm=cm,insert=insert))
    }
    else if(input$Models=="knn"){
      df[,which(names(df) %in% input$Target)] <- as.factor(df[,which(names(df) %in% input$Target)])
      tuner<-e1071::tune.knn(df[train,-which(names(df) %in% input$Target)],df[train,which(names(df) %in% input$Target)],k=1:input$neighbours,tunecontrol=e1071::tune.control(sampling=input$knnsample),cross=10)
      model<-class::knn(df[train,-which(names(df) %in% input$Target)],df[-train,-which(names(df) %in% input$Target)],df[train,which(names(df) %in% input$Target)],k=tuner$best.parameter,prob = T)
      preds<-attributes(model)$prob
    }
    else if(input$Models=="naivebayes"){
      model <- e1071::naiveBayes(form,df[train,])
      preds <- predict(model,df[-train,],type="raw")[,2]
    }
    else if(input$Models=="rulebased"){
      df[,which(names(df) %in% input$Target)] <- as.factor(df[,which(names(df) %in% input$Target)])
      model<-CBA(form,df[train,],parameter = list(support=input$support,confidence=input$confidence))
      PredictedLabels<-predict(model,df[-train,])
      cm <- tibble::as_tibble(table(actual=df[-train,which(names(df) %in% input$Target)],
                                    predicted=PredictedLabels))
      acc<-round(sum(cm[c(1,4),3])/sum(cm[,3]),5)
      tpr<-round(unlist(cm[4,3]/sum(cm[c(2,4),3])),5)
      fpr<-round(unlist(cm[3,3]/sum(cm[c(1,3),3])),5)
      insert<-data.frame(Model=input$Models,Logloss=NA,AUC=NA,Accuracy=acc,TPR=tpr,FPR=fpr)
      return(list(cm=cm,insert=insert))
    }
    p <- ROCR::prediction(preds,df[-train,which(names(df) %in% input$Target)])
    acc.perf = ROCR::performance(p, measure = "acc")
    ind = which.max(slot(acc.perf, "y.values")[[1]])
    cutoff = slot(acc.perf, "x.values")[[1]][ind]
    PredictedLabels<-ifelse(preds>cutoff,1,0)
    cm <- tibble::as_tibble(table(actual=df[-train,which(names(df) %in% input$Target)],
                                  predicted=PredictedLabels))
    logloss.perf=ROCR::performance(p,measure = "mxe")
    auc.perf=ROCR::performance(p,measure = "auc")
    roc.perf = ROCR::performance(p, measure = "tpr", x.measure = "fpr")
    logloss=round(slot(logloss.perf,"y.values")[[1]],5)
    auc=round(slot(auc.perf,"y.values")[[1]],5)
    acc<-round(sum(cm[c(1,4),3])/sum(cm[,3]),5)
    tpr<-round(unlist(cm[4,3]/sum(cm[c(2,4),3])),5)
    fpr<-round(unlist(cm[3,3]/sum(cm[c(1,3),3])),5)
    insert<-data.frame(Model=input$Models,Logloss=logloss,AUC=auc,Accuracy=acc,TPR=tpr,FPR=fpr)
    return(list(cm=cm,insert=insert,roc=roc.perf))
  })
  output$ConfusionMatrix<-renderPlot({
    cvms::plot_confusion_matrix(calculate()$cm,target_col = "actual",
                                prediction_col = "predicted",
                                counts_col = "n")
  })
  output$ROC<-renderPlot({
    createplot=try(plot(calculate()$roc,colorize=TRUE,print.cutoffs.at=seq(0,1,by=0.1)),silent=T)
    if(class(createplot)!="try-error"){
      plot(calculate()$roc,colorize=TRUE,print.cutoffs.at=seq(0,1,by=0.1))
      abline(a=0, b= 1)
    }
  })

  #render the model leaderboard which updates based on models built
  output$leaderboard <- DT::renderDataTable({
    return(updated()%>%dplyr::arrange(desc(Accuracy)))
  })

  #make new predictions and preview new predictions
  calculatenewpreds<-eventReactive(input$newpreds,{
    req(data())
    req(input$newdata)
    df <- data()
    new_data<-read.csv(input$newdata$datapath,
                       header = input$header,
                       sep = input$sep)
    form <- as.formula(paste0(input$Target,"~."))
    if(input$Models=="logistic"){
      model <- glm(form,data = df,family = binomial)
      summ<-summary(model)
      coeftable<-as.data.frame(summ$coefficients[-1,])
      coeftable<-coeftable[coeftable$`Pr(>|z|)`<=input$significance,]
      accepted<-c(rownames(coeftable),input$Target)
      filtered_df<-df[,which(names(df)%in%accepted)]
      newmodel<-glm(form,data = filtered_df,family = binomial)
      preds <- predict(newmodel,new_data,type="response")
    }
    else if(input$Models=="ridge"){
      x<-model.matrix(form,df)[,-1]
      y<-df[,which(names(df)%in%input$Target)]
      new.x<-model.matrix(form,new_data)[,-1]
      model<-glmnet::glmnet(x,y,alpha = 0,family = 'binomial',nlambda = input$lambdaA)
      cv<-glmnet::cv.glmnet(x,y,alpha=0, family = 'binomial')
      bestlamb<-cv$lambda.min
      preds<-predict(model,s=bestlamb, newx = new.x,type = 'response')
    }
    else if(input$Models=="lasso"){
      x<-model.matrix(form,df)[,-1]
      y<-df[,which(names(df)%in%input$Target)]
      new.x<-model.matrix(form,new_data)[,-1]
      model<-glmnet::glmnet(x,y,alpha = 1,family = 'binomial',nlambda = input$lambdaB)
      cv<-glmnet::cv.glmnet(x,y,alpha=1, family = 'binomial')
      bestlamb<-cv$lambda.min
      preds<-predict(model,s=bestlamb, newx = new.x,type = 'response')
    }
    else if(input$Models=="bestsubset"){
      model <- leaps::regsubsets(form,df,nvmax=input$nvmax,method=input$bsmethod)
      summ<-summary(model)
      if(input$bsmetric=="bic"){
        b<-which.min(summ$bic)
      }
      else if(input$bsmetric=="aic"){
        b<-which.min(summ$aic)
      }
      else if(input$bsmetric=="adjr2"){
        b<-which.max(summ$adjr2)
      }
      coefs<-coef(model,b)[-1]
      predictor<-paste(names(coefs),collapse = "+")
      new_form<-as.formula(paste0(input$Target,"~",predictor))
      newmodel <- glm(new_form,df,family = binomial)
      preds <- predict(newmodel,new_data,type="response")
    }
    else if(input$Models=="decisiontree"){
      df[,which(names(df) %in% input$Target)] <- as.factor(df[,which(names(df) %in% input$Target)])
      model <- rpart::rpart(form,data = df,parms = rpart::rpart.control(minsplit = input$minsplit,maxdepth = input$maxdepth))
      pruned <- rpart::prune(model,model$cptable[which.min(model$cptable[,"xerror"]),"CP"])
      preds <- predict(pruned,new_data)[,2]
    }
    else if(input$Models=="randomforest"){
      df[,which(names(df) %in% input$Target)] <- as.factor(df[,which(names(df) %in% input$Target)])
      if(input$sampling=="T"){
        model <- randomForest::randomForest(form,df,ntree=input$ntrees,mtry=input$mtry)
      }
      else if(input$sampling=="F"){
        model <- randomForest::randomForest(form,df,ntree=input$ntrees,mtry=input$mtry,replace=F)
      }
      preds <- predict(model,new_data,type="prob")[,2]
    }
    else if(input$Models=="xgboost"){
      output.vector=as.numeric(df[,which(names(df) %in% input$Target)]==1)
      dtrain=xgboost::xgb.DMatrix(Matrix::sparse.model.matrix(form,df)[,-1],label=output.vector)
      dtest=xgboost::xgb.DMatrix(Matrix::sparse.model.matrix(form,df)[,-1])
      parameter=list(eta=input$eta,max_depth=input$xgbmaxdepth,alpha=input$xgboostalpha,lambda=xgboostlambda)
      watchlist=list(train=dtrain,test=dtest)
      model <- xgboost::xgb.train(data=dtrain,nrounds=input$nrounds,early_stopping_rounds=input$earlystop,
                                  watchlist=watchlist,params = parameter,
                                  eval.metric=input$xgboostmetrics,objective="binary:logistic",verbose=0)
      preds <- predict(model,dtest)
    }
    else if(input$Models=="adaboost"){
      x<-as.matrix(df[,-which(names(df) %in% input$Target)])
      y<-as.numeric(df[,which(names(df) %in% input$Target)]==1)
      y<-ifelse(y==0,-1,y)
      new_data<-as.matrix(new_data[,-which(names(df) %in% input$Target)])
      model <-JOUSBoost::adaboost(x,y,n_rounds = input$adanrounds,tree_depth = input$adamaxdepth)
      preds <- predict(model,new_data,type="prob")
    }
    else if(input$Models=="isolationforest"){
      model=solitude::isolationForest$new(sample_size = nrow(df))
      model$fit(dataset=df[,-which(names(df) %in% input$Target)])
      preds<-unlist(model$predict(new_data[,-which(names(df) %in% input$Target)])[,3])
      rate<-1-input$ratio
      new_data$PredictedLabels<-ifelse(preds>quantile(preds,rate),1,0)
      return(new_data)
    }
    else if(input$Models=="svm"){
      model <- e1071::svm(form,df[train,],type="C-classification",kernel=input$svmkernel,probability=T)
      preds <- attributes(predict(model,df[-train,],probability=T))$probabilities[,2]
    }
    else if(input$Models=="oneclasssvm"){
      filtered_df <- df[df[,which(names(df)%in%input$Target)]==1,]
      model <-e1071::svm(form,filtered_df,type="one-classification",kernel=input$oneclasskernel)
      new_data$PredictedLabels <- as.numeric(predict(model,new_data))
      return(new_data)
    }
    else if(input$Models=="knn"){
      df[,which(names(df) %in% input$Target)] <- as.factor(df[,which(names(df) %in% input$Target)])
      tuner<-e1071::tune.knn(df[,-which(names(df) %in% input$Target)],df[,which(names(df) %in% input$Target)],k=1:input$neighbours,tunecontrol=e1071::tune.control(sampling=input$knnsample),cross=10)
      model<-class::knn(df[,-which(names(df) %in% input$Target)],new_data[,-which(names(df) %in% input$Target)],df[,which(names(df) %in% input$Target)],k=tuner$best.parameter,prob = T)
      preds<-attributes(model)$prob
    }
    else if(input$Models=="naivebayes"){
      df[,which(names(df) %in% input$Target)] <- as.factor(df[,which(names(df) %in% input$Target)])
      model <- e1071::naiveBayes(form,df)
      preds <- predict(model,new_data,"raw")[,2]
    }
    else if(input$Models=="rulebased"){
      df[,which(names(df) %in% input$Target)] <- as.factor(df[,which(names(df) %in% input$Target)])
      new_data[,which(names(df) %in% input$Target)] <- as.factor(new_data[,which(names(df) %in% input$Target)])
      model<-CBA(form,df,parameter = list(support=input$support,confidence=input$confidence))
      new_data$PredictedLabels<-predict(model,new_data)
      return(new_data)
    }
    p <- ROCR::prediction(preds,df[,which(names(df) %in% input$Target)])
    acc.perf = ROCR::performance(p, measure = "acc")
    ind = which.max(slot(acc.perf, "y.values")[[1]])
    cutoff = slot(acc.perf, "x.values")[[1]][ind]
    new_data$PredictedLabels<-ifelse(preds>cutoff,1,0)
    return(new_data)
  })
  output$newpreview <- DT::renderDataTable({
    req(calculatenewpreds())
    return(calculatenewpreds())
  })
  output$downloadPreds <- downloadHandler(
    filename = "new_predictions.csv",
    content = function(file) {
      write.csv(calculatenewpreds(), file, row.names = FALSE)
    }
  )

}

shinyApp(ui,server)


setClass("circle",
   representation(
      radius="numeric",
      centre="numeric"),
   prototype(
      radius=1,
      centre=c(0,0)))
#Instantiate class with some arguments
circS4 <- new("circle", radius=5.5)
#Set other data slots (properties)
circS4@centre <- c(3,4.2)

#Define a method
setMethod("plot", #signature("circle"),
   signature(x="circle", y="missing"),
   function(x, ...)
   {
      t <- seq(0, 2*pi, length.out=200)
      #Note the use of @ instead of $
      plot(x@centre[1] + x@radius*cos(t),
         x@centre[2] + x@radius*sin(t),
         type="l", ...)
   })
plot(circS4)


######################## FUNCIONES BÁSICAS DE CÁLCULO DE LOS DIV ########################
# Cálculos de los DIV
# Método americano:

calculaDIV_ModeloAmericano_HR <- function(temperaturas, HR, matrizDIV, umbralHR = 85, dataSamplingTime = 30)
{
	# temperaturas: un vector numérico con los valores de temperaturas (en ºC), pueden estar medidos en cualquier formato temporal
	# HR: vector numérico con los valores de humedar relativa (en tanto por ciento 0 a 100), en el mismo formato temporal que "temperaturas"
	# matrizDIV: matriz de DIV según modelo americano
	# dataSamplingTime = valor numérico que indica la granularidad de los datos, en minutos, si la estacion mide en horarios= 60, semihorarios = 30, quinceminutales = 15
	# umbralHR: valor numérico, indica el valor de HR por encima del cual se considera que hay agua libre en la atmósfera

	# Totalizar horas humectacion y redondearlas a un entero
	horasHumec <- round(sum(ifelse(HR > umbralHR, dataSamplingTime/60, 0)), digits = 0)
	# Calcular media temperaturas en horas en las que hay humectación
	tempMediaHumec <- round(mean(temperaturas[which(HR >  umbralHR)]), digits = 1)

	# Establecer qué valor de la matrizDIV corresponde a esa humectacion y a esa temperatura
	escalaFarenheit <- c(seq(from = 60, to = 94, by = 1), 95)
	escalaCelsius <- (escalaFarenheit-32) * 5/9

	if(tempMediaHumec < 15.2 || tempMediaHumec > 36 || horasHumec == 0)
	{
		DIV = 0
	}else
	{
		columnaTemperatura <- which.min(abs(escalaCelsius - tempMediaHumec))
		filaHumectacion <- (24 - horasHumec + 1)

		DIV = matrizDIV[filaHumectacion, columnaTemperatura]
	}

	return(list(DIV_HR = DIV,
				temperatura_HR = tempMediaHumec,
				horasHumectacion_HR = horasHumec))
}

calculaDIV_ModeloAmericano_HumectUmbral <- function(temperaturas, humectaciones, matrizDIV, valorHumectacionMinimo, dataSamplingTime = NULL)
{
	# temperaturas: un vector numérico con los valores de temperaturas (en ºC), pueden estar medidos en cualquier formato temporal
	# humectaciones: vector numérico con los valores de humectación (en minutos o porcentaje, ver "unidadesHumectacion"), en el mismo formato temporal que "temperaturas"
	# matrizDIV: matriz de DIV según modelo americano
	# valorHumectacionMinimo: Puede ser un tiempo, un porcentaje, etc, que indique qué valor ha de superarse para considerarse que el período de tiempo es húmedo
	# dataSamplingTime: no es necesario, pero si no se da se considera que el tiempo de medida es horario. Si se usa es de forma análoga a la función calculaDIV_ModeloAmericano_HR()

	# Totalizar horas humectacion y redondearlas a un entero
	if(is.null(dataSamplingTime))
	{
		horasHumec <- round(sum(humectaciones[humectaciones > valorHumectacionMinimo]/60), digits = 0)
	}else
	{
		horasHumec <- round(sum(ifelse(humectaciones > valorHumectacionMinimo, dataSamplingTime/60, 0)), digits = 0)
	}
	# Calcular media temperaturas en horas humectación
	tempMediaHumec <- round(mean(temperaturas[which(humectaciones > valorHumectacionMinimo)]), digits = 1)

	# Establecer qué valor de la matrizDIV corresponde a esa humectacion y a esa temperatura

	escalaFarenheit <- c(seq(from = 60, to = 94, by = 1), 95)
	escalaCelsius <- (escalaFarenheit-32) * 5/9

	if(tempMediaHumec < 15.28 || tempMediaHumec > 35.28 || horasHumec == 0)
	{ # por encima de estos valores o con cero humectacion no hay riesgo
		DIV = 0
	}else
	{
		columnaTemperatura <- which.min(abs(escalaCelsius - tempMediaHumec))
		filaHumectacion <- (24 - horasHumec + 1)

		DIV = matrizDIV[filaHumectacion, columnaTemperatura]
	}

	return(list(DIV_HumectUmbral = DIV,
				temperatura_HumectUmbral = tempMediaHumec,
				horasHumectacion_HumectUmbral = horasHumec))
}

# Método Horario, modelo Rioja:
CalculaDIV_Horario_ModeloRioja <- function(temperaturas, humectaciones, vectorDIVHorario, valorUmbralMinimo, dataSamplingTime, na.rm = TRUE)
{
	# temperaturas: un vector numérico con los valores de temperaturas (en ºC), su período de tiempo viene dado por dataSamplingTime ejemplo: dataSamplingTime = 60 ==> 1 hora => datos horarios
	# humectaciones: un vector numérico con los valores de humectación (en minutos) ó humedad relativa (en tanto por ciento 0-100), idem temperaturas para dataSamplingTime
	# valorUmbralMinimo: Puede ser un tiempo p.ej: valorUmbralMinimo = 5; o un porcentaje de HR, p. ej. valorUmbralMinimo = 85, que indique qué valor ha de superarse para considerarse que el período de tiempo es húmedo
	# dataSamplingTime: valor numérico que indica la granularidad de los datos, en minutos, la tabla de DIV usada es horaria, si el dataSampling time es diferente se hace una regla de tres
	# vectorDIVHorario: vector de DIV según modelo Rioja

	df.TempHumect <- data.frame(temperaturas = temperaturas, humectaciones = humectaciones, check.rows = FALSE)

	# Obtener qué horas han tenido humectación por encima del umbral
	df.TempHumect$hayHumectacion <- df.TempHumect$humectaciones > valorUmbralMinimo

	# Establecer qué valor del vector de DIV corresponde a esa humectacion y a esa temperatura

	# Generamos escala de temperaturas de acuerdo a intervalos a artículo Sheng and Teng (1989)
	escalaFarenheit <- c(seq(from = 60, to = 94, by = 1), 95)
	escalaCelsius <- (escalaFarenheit-32) * 5/9

	df.TempHumect$DIVHorario <- 0
	for(fila in 1:nrow(df.TempHumect))
	{
		if(df.TempHumect$temperaturas[fila] > escalaCelsius[1] &&
			df.TempHumect$temperaturas[fila] < (last(escalaCelsius) + 0.5) &&
			df.TempHumect$hayHumectacion[fila])
		{
			df.TempHumect$DIVHorario[fila] <- vectorDIVHorario$DIVHorario[which.min(abs(escalaCelsius - df.TempHumect$temperaturas[fila]))] * dataSamplingTime/60 #dataSamplingTime/60 corrección a horas
		}
	}

	if(any(is.na(temperaturas)) | any(is.na(humectaciones)))
	{
		if(!na.rm) stop("Algún NA en vector temperaturas o humectaciones, na.rm = TRUE")
		warning(paste("Algún NA en vector temperaturas o humectaciones, DIV puede ser no valido en posiciones",
				which(is.na(temperaturas)), "vector temperaturas, o", which(is.na(humectaciones)), "vector humectaciones"))
	}

	return(list(DIV_Horario_Acumulado = sum(df.TempHumect$DIVHorario, na.rm = TRUE),
				DIV_Horario = df.TempHumect$DIVHorario,
				 df.TempHumect = df.TempHumect))
}
# # TEST
## Distintas temperaturas en los límites del vectorDIVHorario
# CalculaDIV_Horario_ModeloRioja(temperaturas = c(15, 16.5, 16, 36, 16, 0), humectaciones = c(30, 30, 0, 30, 30, 30),
# 						vectorDIVHorario, valorUmbralMinimo = 5, dataSamplingTime = 60)
## Error, vectores temperaturas, humectaciones no igual longitud; temperaturas más largo
# CalculaDIV_Horario_ModeloRioja(temperaturas = c(15, 16.5, 16, 36, 16, 0, 26), humectaciones = c(30, 30, 0, 30, 30, 30),
# 						vectorDIVHorario, valorUmbralMinimo = 5, dataSamplingTime = 60)
## Actuación ante vectores con NA.Error, vectores temperaturas, humectaciones incluyen algún NA
## Temperaturas
# CalculaDIV_Horario_ModeloRioja(temperaturas = c(15, 16.5, NA, 36, 16, 0, 26), humectaciones = c(30, 30, 0, 0, 30, 30, 30),
# 						vectorDIVHorario, valorUmbralMinimo = 5, dataSamplingTime = 60)
## Humectaciones
# CalculaDIV_Horario_ModeloRioja(temperaturas = c(15, 16.5, 16, 36, 16, 0, 26), humectaciones = c(30, 30, 0, NA, 30, 30, 30),
# 						vectorDIVHorario, valorUmbralMinimo = 5, dataSamplingTime = 60)

######################## FUNCIONES AUXILIARES PARA GENERAR OBJETOS CON LOS RESULTADOS CALCULADOS USANDO DISTINTOS MÉTODOS Y MÉTRICAS ########################
calculaDIVAcum <- function(DIV){ # Se usa en ambos modelos (Americano y Rioja), para sumar el DIV diario de ayer y hoy
	res <- rep(NA, length(DIV)) # <- c()
	res[1] = DIV [1]

	for(posicion in 2:length(DIV))
	{
		res[posicion] = DIV [posicion] + DIV [posicion - 1]
	}
	return(res)
}

# Función para obtener un objeto (data.frame) con todos los resultados según el modelo americano
calculaRiesgoDIV_MODELO_AMERICANO <- function(datosClimaticos, diasCalculo, estacion, matrizDIV, horaInicio, offsetHR, dataSamplingTime, valorHumectacionMinimo)
{
	# horaInicio = "10", hora solar a la que se inician los cálculos
	# offsetHR = 0 por defecto se calcula el modelo con umbrales de HR de 80 a 92.5%. offsetHR permite modifificar los umbrales, por ejemplo offset = - 5 haría los cálculosa 75, 80 y 85% de umbral

	# Generar una data.frame igual a la que vamos a construir después en el for (Inicializar variable)
	DIV <- data.frame(fecha = as.POSIXct(character()),
					estacion = numeric(),
					DIV_HumectUmbral = numeric(), T_HumectUmbral = numeric(), HorasHumectacion_HumectUmbral = numeric(),
					DIV_HR80 = numeric(), T_HR80 = numeric(), HorasHumectacion_HR80 = numeric(),
					DIV_HR82.5 = numeric(), T_HR82.5 = numeric(), HorasHumectacion_HR82.5 = numeric(),
					DIV_HR85 = numeric(), T_HR85 = numeric(), HorasHumectacion_HR85 = numeric(),
					DIV_HR87.5 = numeric(), T_HR87.5 = numeric(), HorasHumectacion_HR87.5 = numeric(),
					DIV_HR90 = numeric(), T_HR90 = numeric(), HorasHumectacion_HR90 = numeric(),
					DIV_HR92.5 = numeric(), T_HR92.5 = numeric(), HorasHumectacion_HR92.5 = numeric()
					)

	DIV.names <- names(DIV)

	# Calcular el DIV para cada día de los solicitados
	for (dia in diasCalculo)
	{
		dia <- as.POSIXct(dia, origin = "1970-01-01")
		datos <- datosClimaticos[datosClimaticos$fecha > dia & datosClimaticos$fecha <= dia + 3600*24,] # extraer datos para el día de cálculo

		if(nrow(datos) < (1440/dataSamplingTime - 288/dataSamplingTime)) next # dia Incompleto, se acepta la pérdida del 20% de datos

		res <- data.frame(fecha = dia + 3600*24, estacion = estacion,
					calculaDIV_ModeloAmericano_HumectUmbral(datos$temperatura, datos$humectacion, matrizDIV, valorHumectacionMinimo, dataSamplingTime),
					calculaDIV_ModeloAmericano_HR(datos$temperatura, datos$HR, matrizDIV, umbralHR = 80 - offsetHR, dataSamplingTime),
					calculaDIV_ModeloAmericano_HR(datos$temperatura, datos$HR, matrizDIV, umbralHR = 82.5 - offsetHR, dataSamplingTime),
					calculaDIV_ModeloAmericano_HR(datos$temperatura, datos$HR, matrizDIV, umbralHR = 85 - offsetHR, dataSamplingTime),
					calculaDIV_ModeloAmericano_HR(datos$temperatura, datos$HR, matrizDIV, umbralHR = 87.5 - offsetHR, dataSamplingTime),
					calculaDIV_ModeloAmericano_HR(datos$temperatura, datos$HR, matrizDIV, umbralHR = 90 - offsetHR, dataSamplingTime),
					calculaDIV_ModeloAmericano_HR(datos$temperatura, datos$HR, matrizDIV, umbralHR = 92.5 - offsetHR, dataSamplingTime)
					) # calcular DIV

		DIV <- rbind(DIV, res) # unir
	}

	names(DIV) <- DIV.names

	# Insertar el DIV Acumulado
	DIV <- data.frame(fecha = DIV$fecha,
						estacion = DIV$estacion,
						T_HumectUmbral = DIV$T_HumectUmbral, HorasHumectacion_HumectUmbral = DIV$HorasHumectacion_HumectUmbral,
						DIV_HumectUmbral =  DIV$DIV_HumectUmbral,  DIV_HumectUmbralAcum = calculaDIVAcum(DIV$DIV_HumectUmbral),
						T_HR80 = DIV$T_HR80, HorasHumectacion_HR80 = DIV$HorasHumectacion_HR80,
						DIV_HR80 = DIV$DIV_HR80, DIV_HR80Acum = calculaDIVAcum(DIV$DIV_HR80),
						T_HR82.5 = DIV$T_HR82.5, HorasHumectacion_HR82.5 = DIV$HorasHumectacion_HR82.5,
						DIV_HR82.5 = DIV$DIV_HR82.5, DIV_HR82.5Acum = calculaDIVAcum(DIV$DIV_HR82.5),
						T_HR85 = DIV$T_HR85, HorasHumectacion_HR85 = DIV$HorasHumectacion_HR85,
						DIV_HR85 = DIV$DIV_HR85, DIV_HR85Acum = calculaDIVAcum(DIV$DIV_HR85),
						T_HR87.5 = DIV$T_HR87.5, HorasHumectacion_HR87.5 = DIV$HorasHumectacion_HR87.5,
						DIV_HR87.5 = DIV$DIV_HR87.5, DIV_HR87.5Acum = calculaDIVAcum(DIV$DIV_HR87.5),
						T_HR90 = DIV$T_HR90, HorasHumectacion_HR90 = DIV$HorasHumectacion_HR90,
						DIV_HR90 = DIV$DIV_HR90, DIV_HR90Acum = calculaDIVAcum(DIV$DIV_HR90),
						T_HR92.5 = DIV$T_HR92.5, HorasHumectacion_HR92.5 = DIV$HorasHumectacion_HR92.5,
						DIV_HR92.5 = DIV$DIV_HR92.5, DIV_HR92.5Acum = calculaDIVAcum(DIV$DIV_HR92.5)
						)

	return(DIV)
}

# Función para obtener un objeto (dos data.frames) con los resultados según el modelo Horario, un objeto permite comparar el resultado con el modelo americano
# el otro es el valor del DIV calculado para cada hora
calculaRiesgoDIV_MODELO_RIOJA  <- function(datosClimaticos, diasCalculo, estacion, vectorDIVHorario, offsetHR, dataSamplingTime, valorHumectacionMinimo)
{
	# GENERA DOS OBJETOS:
	# DIV, que es una data.frame con valores DIARIOS, es un remedo del DIV Americano, aunque no tiene mucho sentido, es sólo por hacer equiparables los conceptos, se calcula a horaInicio (que viene prefijado en diasCalculo)
	# DIV_Horario, que es una data.frame con valores HORARIOS, y tiene más sentido que lo anterior y permite integrar los cálculos del DIV para cada hora posteriormente

	# Generar data.frames iguales a las que vamos a construir después en el for
	DIV <- data.frame(fecha = as.POSIXct(character()),
					estacion = numeric(),
					DIV_HumectUmbral = numeric(),
					DIV_HR80 = numeric(),
					DIV_HR82.5 = numeric(),
					DIV_HR85 = numeric(),
					DIV_HR87.5 = numeric(),
					DIV_HR90 = numeric(),
					DIV_HR92.5 = numeric()
					)

	DIV.names <- names(DIV)

	DIV_Horario <- data.frame(DIV_Horario_HumectUmbral = numeric(),
								DIV_Horario_HR80 = numeric(),
								DIV_Horario_HR82.5 = numeric(),
								DIV_Horario_HR85 = numeric(),
								DIV_Horario_HR87.5 = numeric(),
								DIV_Horario_HR90 = numeric(),
								DIV_Horario_HR92.5 = numeric()
								)

	DIV_Horario.names <- names(DIV_Horario)

	for(dia in diasCalculo)  #[dias > first(datosClimaticos$fecha)]){
	{
		dia <- as.POSIXct(dia, origin = "1970-01-01")
		datos <- datosClimaticos[datosClimaticos$fecha > dia & datosClimaticos$fecha <= dia + 3600*24,] # extraer datos para el día de cálculo	(dia es un posixct con la hora de inicio del modelo incluida)

		if(nrow(datos) == 0) next

		DIV_HumectUmbral = CalculaDIV_Horario_ModeloRioja(datos$temperatura, datos$humectacion, vectorDIVHorario, valorUmbralMinimo = valorHumectacionMinimo, dataSamplingTime)
		DIV_HR80 = CalculaDIV_Horario_ModeloRioja(datos$temperatura, datos$HR, vectorDIVHorario, valorUmbralMinimo = 80 - offsetHR, dataSamplingTime)
		DIV_HR82.5 = CalculaDIV_Horario_ModeloRioja(datos$temperatura, datos$HR, vectorDIVHorario, valorUmbralMinimo = 82.5 - offsetHR, dataSamplingTime)
		DIV_HR85 = CalculaDIV_Horario_ModeloRioja(datos$temperatura, datos$HR, vectorDIVHorario, valorUmbralMinimo = 85 - offsetHR, dataSamplingTime)
		DIV_HR87.5 = CalculaDIV_Horario_ModeloRioja(datos$temperatura, datos$HR, vectorDIVHorario, valorUmbralMinimo = 87.5 - offsetHR, dataSamplingTime)
		DIV_HR90 = CalculaDIV_Horario_ModeloRioja(datos$temperatura, datos$HR, vectorDIVHorario, valorUmbralMinimo = 90 - offsetHR, dataSamplingTime)
		DIV_HR92.5 = CalculaDIV_Horario_ModeloRioja(datos$temperatura, datos$HR, vectorDIVHorario, valorUmbralMinimo = 92.5 - offsetHR, dataSamplingTime)

		res <- data.frame(fecha = dia + 3600*24, estacion = estacion,
					DIV_HumectUmbral$DIV_Horario_Acumulado,
					DIV_HR80$DIV_Horario_Acumulado,
					DIV_HR82.5$DIV_Horario_Acumulado,
					DIV_HR85$DIV_Horario_Acumulado,
					DIV_HR87.5$DIV_Horario_Acumulado,
					DIV_HR90$DIV_Horario_Acumulado,
					DIV_HR92.5$DIV_Horario_Acumulado
				)

		DIV <- rbind(DIV, res)

		res2 <- data.frame(DIV_HumectUmbral$DIV_Horario,
							DIV_HR80$DIV_Horario,
							DIV_HR82.5$DIV_Horario,
							DIV_HR85$DIV_Horario,
							DIV_HR87.5$DIV_Horario,
							DIV_HR90$DIV_Horario,
							DIV_HR92.5$DIV_Horario
						)

		DIV_Horario <- rbind(DIV_Horario, res2)
	}

	names(DIV) <- DIV.names
	names(DIV_Horario) <- DIV_Horario.names

	# Insertar el DIV Acumulado
	DIV <- data.frame(fecha = DIV$fecha,
						estacion = DIV$estacion,
						DIV_HumectUmbral =  DIV$DIV_HumectUmbral,  DIV_HumectUmbralAcum = calculaDIVAcum(DIV$DIV_HumectUmbral),
						DIV_HR80 = DIV$DIV_HR80, DIV_HR80Acum = calculaDIVAcum(DIV$DIV_HR80),
						DIV_HR82.5 = DIV$DIV_HR82.5, DIV_HR82.5Acum = calculaDIVAcum(DIV$DIV_HR82.5),
						DIV_HR85 = DIV$DIV_HR85, DIV_HR85Acum = calculaDIVAcum(DIV$DIV_HR85),
						DIV_HR87.5 = DIV$DIV_HR87.5, DIV_HR87.5Acum = calculaDIVAcum(DIV$DIV_HR87.5),
						DIV_HR90 = DIV$DIV_HR90, DIV_HR90Acum = calculaDIVAcum(DIV$DIV_HR90),
						DIV_HR92.5 = DIV$DIV_HR92.5, DIV_HR92.5Acum = calculaDIVAcum(DIV$DIV_HR92.5)
						)

	return(list(DIV = DIV, DIV_Horario = DIV_Horario))
}

# Función que acumula los valores de DIV para un número de registros = numDatos
# IMPORTANTE: Los valores de temperaturas, humectación y umbral humectación NO SE USAN
# se pasan sólo por si acaso en el futuro se implementan reseteos en el modelo de acumulación
calculaDIVAcumHorario <- function(DIV, temperatura, humectacion, umbralHumectacion,  offsetHR = 0, numDatos = 2 * 24, numHorasReseteo = NA, dataSamplingTime)
{
	DIVAcumHorario <- rep(NA, length(DIV))
	numHorasDIVesNulo <- rep(NA, length(DIV))

	numDatos = numDatos * 60/dataSamplingTime # Corrección para considerar el número de registros en cálculos no horarios

	for(posicion in 1:length(DIV))
	{
		if(DIV[posicion] == 0){# Para cada registro si el DIV es cero se acumulan las horas donde DIV == 0
			numHorasDIVesNulo[posicion] <- dataSamplingTime/60 + if(posicion > 1) numHorasDIVesNulo[posicion - 1] else 0
		}else{ # cuando es DIV != 0 se resetea la cuenta
			numHorasDIVesNulo[posicion] = 0
		}

		if(posicion >= numDatos){# Superado el número de datos mínimo se hace el cálculo del DIV
			origen = posicion - numDatos
			extracto <- data.frame(temperatura = temperatura,
									humectacion = humectacion,
									numHorasDIVesNulo = numHorasDIVesNulo,
									DIV = DIV)

			extracto <- extracto[origen:posicion, ]

			if(!is.na(numHorasReseteo)){ # este parámetro puede no estar definido
				# Comprobación por temperaturas extremas #!!!
					#if(any(extracto$temperatura) > umbralMaximo) etc
				# Comprobación por humectaciones bajas extremas #!!!
				# Comprobación por número de horas DIV > 0
				if(any(extracto$numHorasDIVesNulo == numHorasReseteo)){ # Si no hay reseteo la fórmula es como la de antes
					posicionReseteo <- last(which(extracto$numHorasDIVesNulo == nummHorasReseteo)) # Last() por si hay más de un reseteo
					extracto <- extracto[posicionReseteo:nrow(extracto),] # Detrás del reseteo se pueden acumular más horas secas pero solo se acumula DIV de ahí en adelante
				}
			}
			DIVAcumHorario[posicion] <- sum(extracto$DIV, na.rm = TRUE)
		}
	}

	return(DIVAcumHorario)
}

# Función que devuelve un vector de valores lógicos TRUE/FALSE que indican si la lluvia acumulada se considera efectiva o no.
esLluviaEfectiva <- function(PAcum)
{
	lluviaEfectiva <- logical() # Inicializar variable

	lluviaEfectivaHoraria = 1 * 60 / dataSamplingTime  # Si llueve más de un litro cada hora = 2 litros a la hora, la lluvia se considera efectiva
	lluviaEfectivaPorAcumulacion = 0.2 * 60 / dataSamplingTime # Si llueve en algo en una hora y también la siguiente, aunque sea poca cantidad, se considera efectiva
	lluviaEfectivaPorAcumulacion2HorasPrevias = 0.4  # Si llueve en esta hora y ha llovido más de 0.4 en las dos horas anteriores, se considera efectiva

	for(posicion in 1:length(PAcum))
	{
		lluviaEfectiva[posicion] = FALSE

		if(!is.na(PAcum[posicion]) & posicion < length(PAcum)) # si no es NA | En la última posición no se hace el cálculo
		{
			if(PAcum[posicion] >= lluviaEfectivaHoraria)
			{# Si llueve más de un litro cada media hora = 2 litros a la hora, la lluvia se considera efectiva
				lluviaEfectiva[posicion] = TRUE
				next
			}
			if(PAcum[posicion] > lluviaEfectivaPorAcumulacion & sum(PAcum[posicion + 1] > lluviaEfectivaPorAcumulacion))
			{# Si llueve más de un litro cada media hora = 2 litros a la hora, la lluvia se considera efectiva
				lluviaEfectiva[posicion] = TRUE
				next
			}
			if(posicion > 2) # No se puede ejecutar este análisis en las dos primeras posiciones del vector de lluvias
			{# Si llueve en esta hora y ha llovido más de 0.4 en las dos horas anteriores, se considera efectiva
				if( PAcum[posicion] > 0 & (PAcum[posicion - 1] +  PAcum[posicion - 2]) > 0.4)
				{
					lluviaEfectiva[posicion] = TRUE
					next
				}
			}
		}
	}

	return(lluviaEfectiva)
}

# Función que devuelve un vector de valores lógicos TRUE/FALSE que indican si la temperatura registrada se considera efectiva o no.
hayTemperaturaEfectiva <- function(temperatura, umbralTempMinima, umbralTempMaxima)
{
	hayTemperaturaEfectiva <- ifelse(temperatura >= umbralTempMinima & temperatura < umbralTempMaxima, TRUE, FALSE)
	return(hayTemperaturaEfectiva)
}

# Función que devuelve un vector de valores lógicos TRUE/FALSE que indican si la temperatura registrada está entre 10 y 13ºC
estaTemperaturaEntre10y13Grados <- function(temperatura)
{
	hayTemperaturaEfectiva <- ifelse(temperatura >= 10 & temperatura < 13 , TRUE, FALSE)
	return(hayTemperaturaEfectiva)
}

# Función para obtener un objeto (data.frame) con los resultados de las fechas que cumplen infección para ello se consideran los siguientes parámetros:
# umbralTempMinima ==> mínima temperatura necesaria para que se considere a la espora activa para infectar (13 ºC según bibliografía)
# umbralTempMaxima ==> máxima temperatura que la espora permite para mantener su poder infetivo (35 ºC según bibliografía)
# horasAcumuladasParaAparicionInfeccion  => horas necesarias para que la germinación sea satisfactoria y la infección se produzca
calculaMomentosInfeccion <-function(fecha, temperatura, humectacion, umbralHumectacion, umbralTempMinima = 13, umbralTempMaxima = 35, horasAcumuladasParaAparicionInfeccion = 8){
	res <- data.frame(fecha, temperatura, humectacion, stringsAsFactors = FALSE)

	res$hayHumectacion = ifelse(humectacion > umbralHumectacion, TRUE, FALSE)
	res$hayTemperaturaOptima = ifelse(temperatura >= umbralTempMinima & temperatura <= umbralTempMaxima, TRUE, FALSE)

	res$horasAcumuladas[1] = if(res$hayHumectacion[1] & res$hayTemperaturaOptima[1]) 1 else 0
	for(posicion in 2:nrow(res)){ # Si se dan condiciones de Humectación y temperatura en esta variable almaceno, para cada registro, el número de horas de condiciones apropiadas
		res$horasAcumuladas[posicion] = if(res$hayHumectacion[posicion] & res$hayTemperaturaOptima[posicion]) 1 + res$horasAcumuladas[posicion-1] else 0
	}

	fechasInfeccion = res$fecha[which(res$horasAcumuladas >= horasAcumuladasParaAparicionInfeccion)]

	calculaDiasHastaInfeccion <- function(tempMediaPosterior){ # esta funcion ofrece valores de 1 para T = 30 y 20 para T = 10, de forma  lineal
		if(tempMediaPosterior > 30) tempMediaPosterior = 30
		if(tempMediaPosterior < 10) tempMediaPosterior = NA
		tempMediaPosterior <- round(tempMediaPosterior, 0)
		diasHastaInfeccion = 30 - tempMediaPosterior + 1
		return(diasHastaInfeccion)
	}
	#calculaDiasHastaInfeccion(32); calculaDiasHastaInfeccion(30); calculaDiasHastaInfeccion(20); calculaDiasHastaInfeccion(10); calculaDiasHastaInfeccion(9)

	tempMediaPosterior = numeric()
	diasHastaInfeccion = integer()
	for(fecha in fechasInfeccion){
		temperaturasPosterioresInfeccion <- res$temperatura[res$fecha > fecha]

		if(length(temperaturasPosterioresInfeccion) > 20*24) temperaturasPosterioresInfeccion = temperaturasPosterioresInfeccion[1:20*24] # Eliminamos más allá de 20 días de datos
		tempMediaPosterior = c(tempMediaPosterior, mean(temperaturasPosterioresInfeccion))
		diasHastaInfeccion = if(length(temperaturasPosterioresInfeccion) > 0) calculaDiasHastaInfeccion(last(tempMediaPosterior)) else NA
	}

	return(data.frame(fechasInfeccion, tempMediaPosterior, diasHastaInfeccion))
}

######################## FUNCION PRINCIPAL REALIZA TODO EL CONTROL DEL PROCESO DE CÁLCULO DE VALORES DIV Y RIESGO ########################
###
### LLAMA A LAS DISTINTAS FUNCIONES AUXILIARES Y GENERA OBJETO DE RESPUESTA CON TODA LA INFORMACIÓN OBTENIDA
###
###########################################################################################################################################
calculaRiesgoDIV_V20 <- function(estacion, fechaInicio, fechaFin,
									matrizDIV, vectorDIVHorario,
									horaInicio = "10", offsetHR = 0,
									sensorHumect = "THumecta1",
									origenDato = "SWClima",
									nombreEstacion = NA,
									...)
{

# horaInicio = "10", hora solar a la que se inician los cálculos
# offsetHR = 0 por defecto se calcula el modelo con umbrales de HR de 85 y 90. offsetHR permite modifificar los umbrales, por ejemplo offset = - 5 haría los cálculosa 75, 80 y 85% de umbral
# sensorHumect = "THumecta1", solo aplicable a datos tipo "SWClima"; es previsible que se elimine, en la actualidad se extraen los dos sensores de humectacion del SIAR, el que se especifica queda marcado como el sensor 1 en el proceso, es un error lógico
# origenDato = "SWClima", "CESENS", etc

	# EXTRAER DATOS CLIMÁTICOS
	res <- extraeDatosClima(estacion, origenDato, fechaInicio, fechaFin)

	res <- fromJSON(res)

	attach(res)

	# Formatear variables
	datosClimaticos <- as.data.frame(datosClimaticos)
	datosClimaticos$fecha <- as.POSIXct(datosClimaticos$fecha, origin = "1970-01-01")

	if(!is.na(nombreEstacion)) nombreEstacionCalculada = nombreEstacion # se da prioridad a lo que traiga esta variable, CESENS no tiene una buena trazabilidad de los nombres ligados a los códigos de estaciones

	# Calcular el DIV para cada día entre fechaInicio y fechaFin
	# Obtener secuencia de los días a calcular
	# por convenio en modelos nunca empezamos el día en las 00:00 sino en una hora que agrícolamente tenga sentido, generalmente entre las 8 y las 10 UTC (Hora solar en España)
	diasCalculo <- seq.POSIXt(from = as.POSIXct(strftime(paste0(fechaInicio, " ", horaInicio, ":00"), tz = "UTC")),
						to = as.POSIXct(strftime(paste0(fechaFin, " ", horaInicio, ":00"), tz = "UTC")),
						by = "day")

	diasCalculo <- diasCalculo[-length(diasCalculo)] # 	quitamos el último día

	diasCalculo <- diasCalculo[diasCalculo > first(datosClimaticos$fecha)] # y también quitamos los días donde no haya datos procedentes de la estación

	DIV_AMERICANO <- calculaRiesgoDIV_MODELO_AMERICANO(datosClimaticos, diasCalculo, estacion, matrizDIV, horaInicio, offsetHR, dataSamplingTime, valorHumectacionMinimo)

	DIV_HORARIO <- calculaRiesgoDIV_MODELO_RIOJA(datosClimaticos, diasCalculo, estacion, vectorDIVHorario, offsetHR, dataSamplingTime, valorHumectacionMinimo)

	DIV <- DIV_HORARIO$DIV
	DIV_Horario <- DIV_HORARIO$DIV_Horario

	datosClimaticos$lluviaEfectiva <- esLluviaEfectiva(datosClimaticos$PAcum)
	datosClimaticos$temperaturaEfectiva <- hayTemperaturaEfectiva(datosClimaticos$temperatura, umbralTempMinima = 13, umbralTempMaxima = 35)
	datosClimaticos$temperaturaEntre10y13 <- estaTemperaturaEntre10y13Grados(datosClimaticos$temperatura)

	# Recortar datos climáticos
	datosClimaticos <- datosClimaticos[datosClimaticos$fecha > DIV$fecha[1]-24*3600,]
	datosClimaticos <- datosClimaticos[datosClimaticos$fecha <= last(DIV$fecha),]

	DIV_Horario <- data.frame(fecha = datosClimaticos$fecha,
							estacion = rep(estacion, length(datosClimaticos$fecha)),
							#####################
							DIV_Horario_HumectUmbral = DIV_Horario$DIV_Horario_HumectUmbral,
							DIV_HumectUmbral.2dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HumectUmbral, datosClimaticos$temperatura,
																			datosClimaticos$humectacion, umbralHumectacion = valorHumectacionMinimo,
																			offsetHR = offsetHR, numDatos = 2 * 24,
																			numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HumectUmbral.7dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HumectUmbral, datosClimaticos$temperatura,
																			datosClimaticos$humectacion, umbralHumectacion = valorHumectacionMinimo,
																			offsetHR = offsetHR, numDatos = 7 * 24,
																			numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HumectUmbral.14dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HumectUmbral, datosClimaticos$temperatura,
																			datosClimaticos$humectacion, umbralHumectacion = valorHumectacionMinimo,
																			offsetHR = offsetHR, numDatos = 14 * 24,
																			numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HumectUmbral.21dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HumectUmbral, datosClimaticos$temperatura,
																			datosClimaticos$humectacion, umbralHumectacion = valorHumectacionMinimo,
																			offsetHR = offsetHR, numDatos = 21 * 24,
																			numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HumectUmbral.28dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HumectUmbral, datosClimaticos$temperatura,
																			datosClimaticos$humectacion, umbralHumectacion = valorHumectacionMinimo,
																			offsetHR = offsetHR, numDatos = 28 * 24,
																			numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							#####################
							DIV_Horario_HR80 = DIV_Horario$DIV_Horario_HR80,
							DIV_HR80.2dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR80, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 80, offsetHR = offsetHR,
																	numDatos = 2 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR80.7dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR80, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 80, offsetHR = offsetHR,
																	numDatos = 7 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR80.14dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR80, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 80, offsetHR = offsetHR,
																	numDatos = 14 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR80.21dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR80, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 80, offsetHR = offsetHR,
																	numDatos = 21 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR80.28dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR80, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 80, offsetHR = offsetHR,
																	numDatos = 28 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							#####################
							DIV_Horario_HR82.5 = DIV_Horario$DIV_Horario_HR82.5,
							DIV_HR82.5.2dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR82.5, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 82.5, offsetHR = offsetHR,
																	numDatos = 2 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR82.5.7dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR82.5, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 82.5, offsetHR = offsetHR,
																	numDatos = 7 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR82.5.14dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR82.5, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 82.5, offsetHR = offsetHR,
																	numDatos = 14 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR82.5.21dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR82.5, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 82.5, offsetHR = offsetHR,
																	numDatos = 21 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR82.5.28dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR82.5, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 82.5, offsetHR = offsetHR,
																	numDatos = 28 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							#####################
							DIV_Horario_HR85 = DIV_Horario$DIV_Horario_HR85,
							DIV_HR85.2dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR85, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 85, offsetHR = offsetHR,
																	numDatos = 2 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR85.7dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR85, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 85, offsetHR = offsetHR,
																	numDatos = 7 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR85.14dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR85, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 85, offsetHR = offsetHR,
																	numDatos = 14 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR85.21dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR85, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 85, offsetHR = offsetHR,
																	numDatos = 21 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR85.28dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR85, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 85, offsetHR = offsetHR,
																	numDatos = 28 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							#####################
							DIV_Horario_HR87. = DIV_Horario$DIV_Horario_HR87.5,
							DIV_HR87.5.2dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR87.5, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 87.5, offsetHR = offsetHR,
																	numDatos = 2 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR87.5.7dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR87.5, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 87.5, offsetHR = offsetHR,
																	numDatos = 7 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR87.5.14dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR87.5, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 87.5, offsetHR = offsetHR,
																	numDatos = 14 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR87.5.21dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR87.5, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 87.5, offsetHR = offsetHR,
																	numDatos = 21 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR87.5.28dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR87.5, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 87.5, offsetHR = offsetHR,
																	numDatos = 28 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							#####################
							DIV_Horario_HR90 = DIV_Horario$DIV_Horario_HR90,
							DIV_HR90.2dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR90, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 90, offsetHR = offsetHR,
																	numDatos = 2 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR90.7dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR90, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 90, offsetHR = offsetHR,
																	numDatos = 7 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR90.14dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR90, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 90, offsetHR = offsetHR,
																	numDatos = 14 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR90.21dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR90, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 90, offsetHR = offsetHR,
																	numDatos = 21 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR90.28dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR90, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 90, offsetHR = offsetHR,
																	numDatos = 28 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							#####################
							DIV_Horario_HR92.5 = DIV_Horario$DIV_Horario_HR92.5,
							DIV_HR92.5.2dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR92.5, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 92.5, offsetHR = offsetHR,
																	numDatos = 2 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR92.5.7dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR92.5, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 92.5, offsetHR = offsetHR,
																	numDatos = 7 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR92.5.14dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR92.5, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 92.5, offsetHR = offsetHR,
																	numDatos = 14 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR92.5.21dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR92.5, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 92.5, offsetHR = offsetHR,
																	numDatos = 21 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime),
							DIV_HR92.5.28dias = calculaDIVAcumHorario(DIV_Horario$DIV_Horario_HR92.5, datosClimaticos$temperatura,
																	datosClimaticos$HR, umbralHumectacion = 92.5, offsetHR = offsetHR,
																	numDatos = 28 * 24, numHorasReseteo = NA, dataSamplingTime = dataSamplingTime)
							)

	fechasInfeccionHR95.8horas <- calculaMomentosInfeccion(datosClimaticos$fecha, datosClimaticos$temperatura,
								datosClimaticos$HR, umbralHumectacion = 95, horasAcumuladasParaAparicionInfeccion = 8)
	fechasInfeccionHR95.6horas <- calculaMomentosInfeccion(datosClimaticos$fecha, datosClimaticos$temperatura,
								datosClimaticos$HR, umbralHumectacion = 95, horasAcumuladasParaAparicionInfeccion = 6)
	fechasInfeccionHR90.8horas <- calculaMomentosInfeccion(datosClimaticos$fecha, datosClimaticos$temperatura,
								datosClimaticos$HR, umbralHumectacion = 90, horasAcumuladasParaAparicionInfeccion = 8)
	fechasInfeccionHR90.6horas <- calculaMomentosInfeccion(datosClimaticos$fecha, datosClimaticos$temperatura,
								datosClimaticos$HR, umbralHumectacion = 90, horasAcumuladasParaAparicionInfeccion = 6)

	fechasInfeccionHumectacion.8horas <- calculaMomentosInfeccion(datosClimaticos$fecha, datosClimaticos$temperatura , datosClimaticos$humectacion, umbralHumectacion = 50)
	fechasInfeccionHumectacion.6horas <- calculaMomentosInfeccion(datosClimaticos$fecha, datosClimaticos$temperatura , datosClimaticos$humectacion, umbralHumectacion = 50, horasAcumuladasParaAparicionInfeccion = 6)

	variablesConfiguracion <- data.frame(valorDIV = 1, nombre = 'Sin Riesgo',  color = "khaki", stringsAsFactors = FALSE)
	variablesConfiguracion <- rbind(variablesConfiguracion, list(valorDIV = 2, nombre = 'Inicio Riesgo',  color =  "greenyellow"))
	variablesConfiguracion <- rbind(variablesConfiguracion,	list(valorDIV = 3, nombre = 'Riesgo Leve',  color = "yellowgreen"))
	variablesConfiguracion <- rbind(variablesConfiguracion,	list(valorDIV = 4, nombre = 'Riesgo Medio',  color = "orange"))
	variablesConfiguracion <- rbind(variablesConfiguracion,	list(valorDIV = 5, nombre = 'Riesgo Moderado',  color = "sienna1"))
	variablesConfiguracion <- rbind(variablesConfiguracion,	list(valorDIV = 6, nombre = 'Riesgo Alto',  color = "tomato1"))
	variablesConfiguracion <- rbind(variablesConfiguracion,	list(valorDIV = NA, nombre = 'Riesgo muy Alto',  color = "red1"))
	variablesConfiguracion <- rbind(variablesConfiguracion,	list(valorDIV = 7, nombre = 'Infección segura',  color = "red3"))

	row.names(variablesConfiguracion) = c('DIV.SinRiesgo', 'DIV1.InicioRiesgo', 'DIV.RiesgoLeve', 'DIV.RiesgoMedio',
										'DIV.RiesgoModerado', 'DIV.RiesgoAlto', 'DIV.RiesgoMuyAlto', 'DIV.InfeccionSegura')

	# Generar objeto respuesta
	objetoRespuesta = list(datosClimaticos = datosClimaticos[datosClimaticos$fecha > diasCalculo[1] & datosClimaticos$fecha <= last(diasCalculo) + 3600*24,],
				DIV = DIV,
				DIV_AMERICANO = DIV_AMERICANO,
				DIV_Horario = DIV_Horario,
				fechasInfeccion = list(HR95.8horas = fechasInfeccionHR95.8horas, HR95.6horas = fechasInfeccionHR95.6horas,
									HR90.8horas = 	fechasInfeccionHR90.8horas, HR90.6horas = 	fechasInfeccionHR90.6horas,
									humectacion.8horas = fechasInfeccionHumectacion.8horas, humectacion.6horas = fechasInfeccionHumectacion.6horas),
				variablesConfiguracion = variablesConfiguracion,
				fechaUltimoDato = tail(DIV_Horario$fecha, 1),
				origenDato = origenDato,
				estacion = estacion,
				nombreEstacion = nombreEstacionCalculada)

	detach(res)

	return(objetoRespuesta)
}

# Test
#
# estacion = 505
# fechaInicio = as.POSIXct("2018-06-01", tz = "UTC")
# fechaFin =  as.POSIXct("2018-10-01", tz = "UTC") #Sys.time()
 # matrizDIV <- read.csv("Matriz_DIV.csv", row.names = 1)
 # vectorDIVHorario <- read.csv("Vector_DIVHorario.csv")
# DIV505_2018 <- calculaRiesgoDIV_V20(estacion, fechaInicio, fechaFin, matrizDIV, vectorDIVHorario)
 # head(DIV505_2018[,c(1,19, 21)])
  # tail(DIV505_2018[,c(1,19, 21)])
  # summary(DIV505_2018[,c(1,19, 21)])


#' Calculate statistics for a BayesODM model
#'
#' This function calculates statistics for a BayesODM model.
#' @param mcmc MCMC object from \code{trainBayesODM}.
#' @param focusModel SpatialPolygonsDataFrame with BayesODM model output.
#' @param rhat Maximum value of rhat by which to conclude a model parameter is sufficiently converged.
#' @param ... Arguments to pass to \code{rhatStats}.
#' @return
#' @examples
#' @export
bayesODMStats <- function(mcmc, focusModel, rhat = 1.1, ...) {

	meta <- attr(focusModel, 'meta')

	# input stats
	detects <- focusModel@data[ , meta$detect]
	efforts <- focusModel@data[ , meta$effort]

	# output stats
	totalSamples <- (meta$niter - meta$nburnin) / meta$thin
	totalParams <- nrow(mcmc$summary$all.chains)
	proportConverged <- sum(mcmc$summary$all.chains[ , 'rhat'] < rhat, na.rm=TRUE) / totalParams

	stats <- data.frame(

		totalCounties = nrow(focusModel),
		occupiedCounties = sum(detects > 0, na.rm=TRUE),
		countiesWithNonZeroEffort = sum(efforts > 0, na.rm=TRUE),
		meanDetectsToEfforts = mean(detects / efforts, na.rm=TRUE),
		maxDetections = max(detects, na.rm=TRUE),
		maxEfforts = max(efforts, na.rm=TRUE),

		meanPsi = mean(focusModel@data$psi, na.rm=TRUE),
		meanPsi95CI = mean(focusModel@data$psi95CI, na.rm=TRUE),
		meanP = mean(focusModel@data$p, na.rm=TRUE),
		meanP95CI = mean(focusModel@data$p95CI, na.rm=TRUE),

		niter=meta$niter,
		nburnin=meta$nburnin,
		nchains=meta$nchains,
		thin=meta$thin,
		totalSamples=totalSamples,

		proportConverged = proportConverged,
		rhat = rhat,
		totalParams = totalParams

	)

	stats

}


# Clase 01-03

help("source")

getwd() # == pwd
search()
library()
# Eg Estimador máximo verosimil
library()
.Machine$integer.max
.Machine$double.xmax

# Tema 2
## Tabla de tipos de datos:
## tipo \ dim     1D       2D         n-D
## homogéneo    vector   matrix      array
## heterogéneo  list     data frame

# Nota: vector es atómico, unidad básica.
x <- c(0, 1, 2, 3)
y <- x == 0:3
Reduce("&", y)
## TRUE
a <- c(-1, x, 3)
a
z <- c("aiodn", "pqow")
q <- c(a, z, x)
q
# Implicit type conversion
rep(1:5, times = seq(1, by = 2, length.out = 5))
rep(1:5, each = 2)
rep(1:3, each = 5, times = 3)


#  James Rekow

identifySubgroupsTest = function(M = 40, numSubgroups = 2, N = 20, iStrength = 1, univ = 1, sigmaMax = 0.1,
                                 thresholdMult = 10 ^ (-1), maxSteps = 10 ^ 4, tStep = 10 ^ (-2),
                                 intTime = 1, interSmplMult = 0.01, lambda = 0, returnParams = FALSE,
                                 conGraph = NULL, rollRange = 0.025){

  #  ARGS: numSubgroups - number of subgroups in the cohort
  #        rollRange - the maximum difference in overlap between two DOC points for which the two points
  #                    are still considered close enough that they are included in each others local
  #                    dissimilarity profiles (e.g. in computing rolling mean, etc.)
  #
  #  RETURNS:

  source("subgroupsAbdListCreator.r")
  source("DOCProcedure.r")

  #  default indices of the 2 subgroups created from subgroupsAbdListCreator
  subgroup1Ix = 1:20
  subgroup2Ix = 21:40

  #  create abdList with desired number of subgroups
  abdList = subgroupsAbdListCreator(M = M, numSubgroups = numSubgroups, N = N, iStrength = iStrength,
                                    univ = univ, sigmaMax = sigmaMax, thresholdMult = thresholdMult,
                                    maxSteps = maxSteps, tStep = tStep, intTime = intTime,
                                    interSmplMult = interSmplMult, lambda = lambda,
                                    returnParams = returnParams, conGraph = conGraph)

  #  compute DOC
  doc = DOCProcedure(abdList)

  #  make DOC a data frame (by default a doc is a named list)
  doc = data.frame(over = doc$x, diss = doc$y)

  cutoffSelector = function(x){

    #  ARGS: x - overlap input value
    #
    #  RETURNS: cutoffMult - multiplier to determine the cutoff dissimilarity value for DOC points with
    #                        overlap of x

    cutoffMult = 0.5

    return(cutoffMult)

  } #  end cutoffSelector function

  rollDissCutoff = function(docPoint){

    #  ARGS: docPoint - vector of the form c(over, diss)
    #
    #  RETURNS: localDissMid - midpoint of local dissimilarities (unweighted, not the same as the mean)

    #  extract overlap of DOC point
    over = docPoint[1]

    #  identify data frame row indices of DOC points with similar overlap
    similarOver = abs(doc[[1]] - over) < rollRange

    #  create vector of dissimilarities of all DOC points with similar overlap to input docPoint
    localDiss = doc[[2]][similarOver]

    #  compute the midpoint of the local dissimilarities
    localDissCutoff = cutoffSelector(over) * {max(localDiss) + min(localDiss)}

    return(localDissCutoff)

  } #  end rollDissCutoff function

  #  compute local dissimilarity midpoint for each DOC point in data frame
  dissRollCutoff = apply(doc, 1, rollDissCutoff)

  #  add dissRollMid as a column to doc data frame
  doc$rollDissCutoff = dissRollCutoff

  #  add a column identifying whether or not a DOC point has dissimilarity less than the local midpoint
  doc$lowDiss = doc$diss < doc$rollDissCutoff

  #  matrix of unique combinations of sample indices
  ixMat = combn(M, 2)

  #  add columns identifying sample indices to doc
  doc$ix1 = ixMat[1, ]
  doc$ix2 = ixMat[2, ]

  #  add column identifying DOC points with high overlap
  doc$highOver = doc$over > 0.5

  return(doc)

  ####

  # docHighOver = subset(doc, highOver == TRUE)
  #
  # docHighOverLowDiss = subset(docHighOver, lowDiss == TRUE)
  # ixVec1 = c(docHighOverLowDiss$ix1, docHighOverLowDiss$ix2)
  # lowerInfo = sort(unique(ixVec1))
  #
  # docHighOverHighDiss = subset(docHighOver, lowDiss == FALSE)
  # ixVec2 = c(docHighOverHighDiss$ix1, docHighOverHighDiss$ix2)
  # upperInfo = sort(unique(ixVec2))
  # # try lower half of low diss points for over > 0.5?

  ####

  # f = function(n){
  #
  #   docSimDiss = subset(doc, simDiss == TRUE)
  #
  #   keep = (docSimDiss$ix1 == n) | (docSimDiss$ix2 == n)
  #
  #   docSimDissIxOnly = docSimDiss[keep, ]
  #
  #   ixVec = unique(c(docSimDissIxOnly$ix1, docSimDissIxOnly$ix2))
  #
  #   return(ixVec)
  #
  # } #  end f function
  #
  # f1 = f(1)
  #
  # g = function(n){
  #
  #   numSharedIx = sum(f(n) %in% f1)
  #
  #   return(numSharedIx)
  #
  # } #  end g function
  #
  # closeVec = sapply(1:M, g)
  #
  # firstTwo = sort(closeVec, index.return = TRUE)$ix[M - 1, M]
  #
  # subgroup1Guess = c(1, firstTwo)
  #
  # meanMatch = mean()
  #
  # remainingIx = (1:M)[-subgroup1Guess]
  #
  # h = function(ix1, ix2){
  #
  #   numSharedIx = sum(f(ix1) %in% f(ix2))
  #
  #   return(numSharedIx)
  #
  # } #  end g function
  #
  # addNewIx = function(x = NULL){
  #
  #   ii = 1
  #
  #   while(ii < length(remainingIx)){
  #
  #     currentMean =
  #
  #   } #  end while
  #
  # } #  end addNewIx function
  #
  #
  # sortedCloseVecList = sort(closeVec, index.return = TRUE)
  #
  # cutoffIx = which(diff(sortedCloseVecList$x) == max(diff(sortedCloseVecList$x)))
  #
  # subgroup1Guess = sort(sortedCloseVecList$ix[cutoffIx:length(sortedCloseVecList$ix)])
  #
  # return(subgroup1Guess)

} #  end identifySubgroupsTest function


#Data Source: Pulickamadhom Sreedhar, Sreehari, 2021,
#"Student and Educator Perceptions of Online Classes"
#https://doi.org/10.7910/DVN/2AAVSX, Harvard Dataverse, V1

#@michaelGRU

library(stringr)
library(utils)

mode <- function(v) {
  uniqv <- unique(v)
  uniqv[which.max(tabulate(match(v, uniqv)))]
}

#find the length of a particular string pattern
count_pattern <- function(str, vector) {
  return(length(vector[stringr::str_detect(vector, str)]))
}

df <- read.csv("data/Student and Educator Perceptions of Online Classes - Base data.csv")

#quick summary of the df
num_subjects <- dim(df)
feature <- colnames(df)

#student vs. educator analysis
#number of students
students <- subset(df, df$Are.you.a.student.or.an.educator. == "Student")
count_studnets <- nrow(students)

#number of professors and their experience
educators<- subset(df, df$Are.you.a.student.or.an.educator. == "Educator")
count_educator <- nrow(educators)
exp_boxplot <- boxplot(educators$If.an.educator..for.how.many.years.have.you.been.an.educator.)

#where are you currently employed at
unique_employee_loc_count <- length(unique(df$Where.are.you.currently.employed.enrolled))

#How many are at university vs school
uni_count <-
  length(df$Where.are.you.currently.employed.enrolled[stringr::str_detect(df$Where.are.you.currently.employed.enrolled, "/")])
school_count <-
  length(df$Where.are.you.currently.employed.enrolled[stringr::str_detect(df$Where.are.you.currently.employed.enrolled, "oo")])

#extract the last 2 chars
last_two_letters_extract <- stringr::str_sub(df$Where.are.you.currently.employed.enrolled, start = -2)
###

#group by students vs educators
tapply(df$How.do.you.rate.yourself.on.your.ability.to.use.virtual.meeting.platforms..on.a.scale.of.1.10., df$Are.you.a.student.or.an.educator., mean)
tapply(df$How.would.you.rate.your.internet.connectivity.on.a.scale.of.1.10., df$Are.you.a.student.or.an.educator., mean)
tapply(df$How.effective.do.you.think.online.classes.are.in.communicating.content.and.intent.in.a.classroom..on.a.scale.of.1.10., df$Are.you.a.student.or.an.educator., mean)
tapply(df$How.would.you.rate.your.ability.to.concentrate.during.online.classes..on.a.scale.of.1.10., df$Are.you.a.student.or.an.educator., mean)

#answer to do long hours in a virtual classroom cause discomfort
pain_count <-
  length(df$Do.long.hours.in.a.virtual.classroom.cause.discomfort.such.as.headaches..sleep.disturbances..back.pain.[stringr::str_detect(df$Do.long.hours.in.a.virtual.classroom.cause.discomfort.such.as.headaches..sleep.disturbances..back.pain., "Yes")])
no_pain_count <-
  length(df$Do.long.hours.in.a.virtual.classroom.cause.discomfort.such.as.headaches..sleep.disturbances..back.pain.[stringr::str_detect(df$Do.long.hours.in.a.virtual.classroom.cause.discomfort.such.as.headaches..sleep.disturbances..back.pain., "No")])

#add a column that converts the binary pain ans
df$pain_binary <-
  ifelse(df$Do.long.hours.in.a.virtual.classroom.cause.discomfort.such.as.headaches..sleep.disturbances..back.pain.== "Yes", 1, 0)
#percentage of people who reported pain
percentage_pain <- mean(df$pain_binary)
#group by students vs. educator
tapply(df$pain_binary, df$Are.you.a.student.or.an.educator., mean)

##create type
df$type <- NA

df$type[df$How.would.you.identify.yourself. == "Female"
        & df$Are.you.a.student.or.an.educator. == "Student"] <- "FemaleStudent"
df$type[df$How.would.you.identify.yourself. == "Female"
        & df$Are.you.a.student.or.an.educator. == "Educator"] <- "FemaleEducator"
df$type[df$How.would.you.identify.yourself. == "Male"
        & df$Are.you.a.student.or.an.educator. == "Student"] <- "MaleStudent"
df$type[df$How.would.you.identify.yourself. == "Male"
        & df$Are.you.a.student.or.an.educator. == "Educator"] <- "MaleEducator"
df$type[df$How.would.you.identify.yourself. != "Male" & df$How.would.you.identify.yourself. != "Female"
        & df$Are.you.a.student.or.an.educator. == "Educator"] <- "OtherEducator"
df$type[df$How.would.you.identify.yourself. != "Male" & df$How.would.you.identify.yourself. != "Female"
        & df$Are.you.a.student.or.an.educator. == "Student"] <- "OtherStudent"

table(df$type)
tapply(df$How.do.you.rate.yourself.on.your.ability.to.use.virtual.meeting.platforms..on.a.scale.of.1.10.,
                df$type, mean)
tapply(df$How.would.you.rate.your.internet.connectivity.on.a.scale.of.1.10., df$type, mean)
tapply(df$How.effective.do.you.think.online.classes.are.in.communicating.content.and.intent.in.a.classroom..on.a.scale.of.1.10.,
                df$type, mean)
tapply(df$How.would.you.rate.your.ability.to.concentrate.during.online.classes..on.a.scale.of.1.10.,
                df$type, mean)


fec=factor(c("Male","Female","Male","Female","Male","Female"))
fec
table(fec)

f=factor(c("small","XS","large","small","DoubleXL","XL"))
f
lel=factor(f,levels = c("small","Large","ExtreaLarge"))
lel

levels(f)
nlevels(f)

v1=c("B","AB","O","A")
v2=c("O","O","A","B")

ff=factor(v1,v2)
nlevels(ff)

vi=c(1:5)
vc=c("A","B","C","E","F")
vl=c(TRUE,FALSE,TRUE,TRUE,FALSE)
df=data.frame(vi,vc,vl,stringsAsFactors = FALSE)
df

df[1,3]
str(df)

nrow(df)
ncol(df)
head(df)

age=c(10,21,16,18,25)
height=c(150,180,195,157,160)
weight=c(60,45,68,90,39)
gender=c("Male","Female","Male","Female","Male")
human=data.frame(age,height,weight,gender,stringsAsFactors = FALSE)
human
typeof(human)
class(human)

data_org=data.frame(Orange)
data_org
nrow(data_org)
ncol(data_org)
head(data_org)
typeof(data_org)
class(data_org)


library("rstan")

rstan_options(auto_write = TRUE)
options(mc.cores = parallel::detectCores())

data <- list(N = 5,
             n = 12,
             Tsums = 6,
             Tinds = 2,
             ts_inds_inds = c(4,6),
             ts_sums = c(3,5,7,10,13,15),
             t0 = 0,
             odds = structure(c(1,0,3,1,1,1,1,3,0,1), .Dim = c(5,2)),
             Vsums = structure(c(0.0636679167,0.0661274167,0.0987616667,0.16010675,0.25829375,0.280966,0.0574364167,0.0799836667,0.1146740833,0.2577545833,0.41375175,0.4119126667,0.0589646667,0.0776658333,0.1201630833,0.27822025,0.5145295,0.557941,0.0544568333,0.08331,0.1326801667,0.35862575,0.5359255,0.523286,0.0503110833,0.0921101667,0.1695063333,0.4100345833,0.5936558333,0.6179516667), .Dim = c(5,6)),
             Vsumstds = structure(c(0.009479858,0.016532594,0.0242550332,0.0714584987,0.0963189337,0.0344588741,0.0073424551,0.0101382147,0.0258780892,0.0847120964,0.0766670382,0.0301724037,0.0056577373,0.0083716803,0.0113536203,0.0565088006,0.0929378678,0.0378267744,0.0077258534,0.0156706135,0.0118896548,0.0923792651,0.1044882296,0.0394104073,0.0080204573,0.0246143359,0.0285837478,0.1238795509,0.1385946846,0.0198155617), .Dim = c(5,6)),
             V1 = structure(c(0.99,0.98,0.56,0.45,0.32,0.18,0.12,0.06,0.00,0.00), .Dim = c(5,2)),
             V1stds = structure(c(0.001,0.01,0.01,0.05,0.02,0.01,0.01,0.01,0.001,0.001), .Dim = c(5,2)),
             V2 = structure(c(0.00,0.00,0.43,0.53,0.67,0.80,0.87,0.92,0.99,0.97), .Dim = c(5,2)),
             V2stds = structure(c(0.001,0.001,0.01,0.05,0.02,0.01,0.01,0.01,0.001,0.01), .Dim = c(5,2)))

data_hd <- list(Ntrain = 4,
              Ntest = 1,
             n = 12,
             Tsums = 6,
             Tinds = 2,
             ts_inds_inds = c(4,6),
             ts_sums = c(3,5,7,10,13,15),
             t0 = 0,
             odds = structure(c(1,0,3,1,1,1,1,3), .Dim = c(4,2)),
             Vsums = structure(c(0.0636679167,0.0661274167,0.0987616667,0.16010675,0.25829375,0.280966,0.0574364167,0.0799836667,0.1146740833,0.2577545833,0.41375175,0.4119126667,0.0589646667,0.0776658333,0.1201630833,0.27822025,0.5145295,0.557941,0.0544568333,0.08331,0.1326801667,0.35862575,0.5359255,0.523286), .Dim = c(4,6)),
             Vsumstds = structure(c(0.009479858,0.016532594,0.0242550332,0.0714584987,0.0963189337,0.0344588741,0.0073424551,0.0101382147,0.0258780892,0.0847120964,0.0766670382,0.0301724037,0.0056577373,0.0083716803,0.0113536203,0.0565088006,0.0929378678,0.0378267744,0.0077258534,0.0156706135,0.0118896548,0.0923792651,0.1044882296,0.0394104073), .Dim = c(4,6)),
             V1 = structure(c(0.99,0.98,0.56,0.45,0.32,0.18,0.12,0.06), .Dim = c(4,2)),
             V1stds = structure(c(0.001,0.01,0.01,0.05,0.02,0.01,0.01,0.01), .Dim = c(4,2)),
             V2 = structure(c(0.00,0.00,0.43,0.53,0.67,0.80,0.87,0.92), .Dim = c(4,2)),
             V2stds = structure(c(0.001,0.001,0.01,0.05,0.02,0.01,0.01,0.01), .Dim = c(4,2)),
             hdodds = structure(c(0,1), .Dim = c(1,2)),
             hdVsums = structure(c(0.0503110833,0.0921101667,0.1695063333,0.4100345833,0.5936558333,0.6179516667), .Dim = c(1,6)),
             hdVsumstds = structure(c(0.0080204573,0.0246143359,0.0285837478,0.1238795509,0.1385946846,0.0198155617), .Dim = c(1,6)),
             hdV1 = structure(c(0.00,0.00), .Dim = c(1,2)),
             hdV1stds = structure(c(0.001,0.001), .Dim = c(1,2)),
             hdV2 = structure(c(0.99,0.97), .Dim = c(1,2)),
             hdV2stds = structure(c(0.001,0.01), .Dim = c(1,2)))

fit <- stan(file = 'real_model_hd.stan', data = data_hd, iter = 10000, chains = 4)
plot(fit)
print(fit)

library("loo")

logliks = extract_log_lik(fit, parameter_name="LL")

loo1=loo(logliks)

sumlogliks = rowSums(logliks);

hist(sumlogliks, breaks=50)
hist(exp(sumlogliks), breaks=50)

fit_gomp <- stan(file = 'real_model_gomp_hd.stan', data = data_hd, iter = 10000, chains = 4)
plot(fit_gomp)
print(fit_gomp)

logliks_gomp = extract_log_lik(fit_gomp, parameter_name="LL")

loo_gomp=loo(logliks_gomp)

sumlogliks_gomp = rowSums(logliks_gomp);

hist(sumlogliks_gomp, breaks=50)
hist(exp(sumlogliks_gomp), breaks=50)

compare(loo1, loo_gomp)

rr = extract(fit, "theta[1]")
rr=unlist(rr, use.names=FALSE)
write.csv(rr, "rr.csv", row.names=FALSE)

kr = extract(fit, "theta[2]")
kr=unlist(kr, use.names=FALSE)
write.csv(rr, "kr.csv", row.names=FALSE)

lr = extract(fit, "theta[3]")
lr=unlist(lr, use.names=FALSE)
write.csv(rr, "lr.csv", row.names=FALSE)

rc = extract(fit, "theta[4]")
rc=unlist(rc, use.names=FALSE)
write.csv(rr, "rc.csv", row.names=FALSE)

kc = extract(fit, "theta[5]")
kc=unlist(kc, use.names=FALSE)
write.csv(rr, "kc.csv", row.names=FALSE)

lc = extract(fit, "theta[6]")
lc=unlist(lc, use.names=FALSE)
write.csv(rr, "lc.csv", row.names=FALSE)

sig = extract(fit, "sigma")
sig=unlist(sig, use.names=FALSE)
write.csv(sig, "sig.csv", row.names=FALSE)

v0 = extract(fit, "V0")
v0=unlist(v0, use.names=FALSE)
write.csv(v0, "v0.csv", row.names=FALSE)

#####

rr = extract(fit_gomp, "theta[1]")
rr=unlist(rr, use.names=FALSE)
write.csv(rr, "rr.csv", row.names=FALSE)

kr = extract(fit_gomp, "theta[2]")
kr=unlist(kr, use.names=FALSE)
write.csv(rr, "kr.csv", row.names=FALSE)

lr = extract(fit_gomp, "theta[3]")
lr=unlist(lr, use.names=FALSE)
write.csv(rr, "lr.csv", row.names=FALSE)

rc = extract(fit_gomp, "theta[4]")
rc=unlist(rc, use.names=FALSE)
write.csv(rr, "rc.csv", row.names=FALSE)

kc = extract(fit_gomp, "theta[5]")
kc=unlist(kc, use.names=FALSE)
write.csv(rr, "kc.csv", row.names=FALSE)

lc = extract(fit_gomp, "theta[6]")
lc=unlist(lc, use.names=FALSE)
write.csv(rr, "lc.csv", row.names=FALSE)

sig = extract(fit_gomp, "sigma")
sig=unlist(sig, use.names=FALSE)
write.csv(sig, "sig.csv", row.names=FALSE)

v0 = extract(fit_gomp, "V0")
v0=unlist(v0, use.names=FALSE)
write.csv(v0, "v0.csv", row.names=FALSE)


#Here we first familiarize ourselves with the basic layout of the Shiny user interface. It is important to note, that while we set-up interactivity, user interactivity is not included within this first shiny App activity.

#ui.R
#	1. After initially loading the shiny library and relevant data, the overall UI is wrapped within the shinyUI function
#	2. Next, we define a page that is fluid (fluidPage)--that can change based on the user's input. For this page, we name it with a title (titlePanel)
#	3. The set-up of the page is one based on a template (sidebarLayout): a sidebar (sidebarPanel; on the left, from which the user will make their selections); and a main Panel (mainPanel) which is changes based on the user's input in the left side-bar panel
#	4. The mainPanel will display the PCA of the metrics, which is identified as "pcaplot". This object is created/assigned within the server.R script.

#server.R
#	1. The shiny library and relevant data is first loaded
#	2. We define the server for the Shiny app as something with both objects that are input (from the ui.R) and output (from the server.R)
#	3. We create a reactive Shiny plot that is output from server.R to ui.R with the function renderPlot. renderPlot is an reactive function that can take input data from the ui.R script and feed it into the server.R script. It then actively updates the information within its function. We name the object that has the renderPlot function to plot the PCAs as "pcaplot". "pcaplot" is then output and displayed through the ui.R within the plotOutput function.

library(shiny)	#First load shiny library
load("../pcas.RDATA")	#Load data

#Define a server for the Shiny app
shinyServer(function(input, output) {

	#Create a reactive Shiny plot to send to the ui.r called "pcaplot"
	output$pcaplot <- renderPlot({
		#Render the scatterplot of PCA
		plot(PC2~PC1, data=foo)
  })
})
#TASKS:
#1. Change the plot's x- and y-axis label names to "PC1" and "PC2".
#2. Instead of plotting points, plot the metrics as text points instead

#HINTS:
#1. use "xlab" and "ylab" within the function "plot" to change the axes labels
#2. For the function "plot", enter the parameter "type="n"" to create a blank plot that maintains the axes labels and plotting parameters:
#	plot(PC2 ~ PC1, data=foo, type="n", xlab="PC1", ylab="PC2")
#Next use the function "text" to plot the text values. Use "foo$metric" as the label values
#	text(PC2 ~ PC1, data=foo, labels=foo$metric)


abs2spec <- function(abs.df, frame, np=256) {
  nres <- as.numeric(abs.df[frame,13])
  vtp <- as.numeric(abs.df[frame,13:(13+(nres*3))])
  vts <- 20 * log10(0.001 + vtfn2(vtp, np=np))
  vts
}


# CART Implmentation in R ###############################
#
# this file provides the general approach for,
# (1) k-fold cross validation
# (2) parameter tuning in CART classification

library(rpart)
library(caret)

# library(rattle)

round.down <- function(samples){
	return (round(samples/10+1/2))
}

mean.re <- function(actual, predict){
	return (abs(actual - predict)/actual)
}

# build CART
buildCart <- function(train){
	# step 1: stop criteria setting
	min.split <- 4
	min.bucket <- 2

	samples <- nrow(train)
	if(samples <= 100){
		min.bucket <- round.down(samples)
		min.split <- 2*min.bucket
	}else{
		min.split <- round.down(samples)
		min.bucket <- min.split/2
	}
	if(min.split<4){
		min.split <- 4
	}
	if(min.bucket<2){
		min.bucket <- 2
	}
	# cat("[min.split]:", min.split, ", [min.bucket]:", min.bucket, "\n")

	features.size <- length(colnames(train)) - 1
	if(features.size >= 30){
		features.size <- 30
	}

	# step 2: model building
	outCart <- rpart(
		Performance ~ ., # modify #
		train,
		method = "anova",
		control = rpart.control(
				minsplit = min.split,
				minbucket = min.bucket,
				maxdepth = features.size,
				cp=0,
				usesurrogate=0,
				maxsurrogate=0)
		)

	# return model
	# plot(outCart)
	# text(outCart)
	return (outCart)
}

# evaluate CART
evaluateCART <- function(train, test){
	outCart <- buildCart(train)
	results <- predict(
		outCart,
		test
	)
	return (results)

}

# for each dataset
forDataset <- function(path){
	data <- read.csv(path, header=TRUE, sep=",")
	set.seed(0)
	folds <- createFolds(y=data$Performance, k=10) # modify #
	# folds is a list of vector, folds[[i]] means selected index in the i-th fold.

	for(kf in 1:10){

		# cat("### The ", kf, "-th Prediction Result ###\n")
		train <- data[-folds[[kf]],]
		test <- data[folds[[kf]],]

		actuals <- data[folds[[kf]],40] # modify #
		#print(data[folds[[kf]],40])

		predicts <- evaluateCART (train, test)
		# print(nrow(test))
		# sum <- 0.0
		for(i in 1:nrow(test)){
			# sum <- sum + mean.re(actuals[i], predicts[[i]])
			# cat(" actuals:", actuals[i], "predicted:", predicts[[i]], "\n")
			output.file <- file("my.txt", "a")
			lines <- paste(actuals[i], ",", predicts[[i]])
			writeLines(lines, output.file)
			close(output.file)
		}
		# acc <- 1-sum/nrow(test)
		# print(acc)
	}

}

# main body #############################################

forDataset("SQL_AllMeasurements.csv")
# train <- read.csv("HSMGP_num.csv")
# outCart <- buildCart(train)
# plot(outCart)
# text(outCart)

# print(train)
# print(summary(train))
# print(nrow(train))

# print(round(3.14))
# print(2.4/5)


# Generates a plot of a the residual of a linear model of brightness from a time, flux that uses a 2nd
# degree polynomial. Allows for restriction of data to account for jumps in flux values.

args = commandArgs(trailingOnly=TRUE)

file_in = args[1]
first_index = strtoi(args[2])
last_index = strtoi(args[3])

data = read.csv(file_in, header=FALSE)
time = data$V1[first_index:last_index]
flux = data$V2[first_index:last_index]
time_squared = time * time

model = lm(flux ~ time + time_squared)
model_predictions = predict(model)
resid = flux - model_predictions

# Plot
X11()
plot(time, resid)
invisible(readLines("stdin", n=1))