################################################################
## Title: Data Science For Database Professionals
## Description:: Main R file
## Author: Microsoft
################################################################

####################################################################################################
##Compute context
####################################################################################################
connection_string <- "Driver=SQL Server;Server=.;Database=telcoedw2;Trusted_Connection=yes;"
sql <- RxInSqlServer(connectionString = connection_string, autoCleanup = FALSE, consoleOutput = TRUE)
local <- RxLocalParallel()
rxOptions(reportProgress = 0)

####################################################################################################
##Connect to the data
####################################################################################################
rxSetComputeContext(local)

##SQL data source
myDataTb <- RxSqlServerData(
  connectionString = connection_string,
  table = "edw_cdr",
  colInfo = col_info)

trainDataTb <- RxSqlServerData(
  connectionString = connection_string,
  table = "edw_cdr_train",
  colInfo = col_info)

testDataTb <- RxSqlServerData(
  connectionString = connection_string,
  table = "edw_cdr_test",
  colInfo = col_info)

rxGetInfo(myDataTb, getVarInfo = T)
rxGetInfo(trainDataTb, getVarInfo = T)
rxGetInfo(testDataTb, getVarInfo = T)

##Data frame
myData <- rxDataStep(myDataTb, overwrite = TRUE)
trainData <- rxDataStep(trainDataTb, overwrite = TRUE)
testData <- rxDataStep(testDataTb, overwrite = TRUE)
str(myData)
str(trainData)
str(testData)

####################################################################################################
##Data exploration and visualization on the data frame myData
####################################################################################################
#impact of callfailure rate (%) on churn
myData %>%
   group_by(month, callfailurerate) %>%
   summarize(countofchurn = sum(as.numeric(churn))) %>%
   ggplot(aes(x = month,
              y = countofchurn,
              group = factor(callfailurerate),
              fill = factor(callfailurerate))) +
  geom_bar(stat = "identity", position = position_dodge()) +
  labs(x = "month",
       y = "Counts of churn") +
  theme_minimal()

####################################################################################################
##Data exploration and visualization on the SQL data source myDataTb
####################################################################################################
rxSetComputeContext(sql)

#Counts of churned customer by age and state (Interactive HeatMap)
tmp <- rxCrossTabs(N(churn) ~ F(age):state, myDataTb, means = FALSE)
Results_df <- rxResultsDF(tmp, output = "sums")
colnames(Results_df) <- substring(colnames(Results_df), 7)
library(Rcpp)
library(d3heatmap)
d3heatmap(data.matrix(Results_df[, -1]), scale = "none", labRow = Results_df[, 1], dendrogram = "none",
          color = cm.colors(255))

####################################################################################################
## Extreme gradient boost with xgboost on the data frame trainData & testData
####################################################################################################

##Step 1- Train Model
library(Matrix)
library(xgboost)
system.time(
xgboost_model <- xgboost(data = dtrainData$data, label = dtrainData$label, max.depth = 32, eta = 1, nthread = 2, nround = 2, objective = "binary:logistic")
)
importance <- xgb.importance(feature_names = dtrainData$data@Dimnames[[2]], model = xgboost_model)
library(Ckmeans.1d.dp)
xgb.plot.importance(importance)

##Step 2- Score Model
predictions <- predict(xgboost_model, dtestData$data)
threshold <- 0.5
xgboost_Probability <- predictions
xgboost_Prediction <- ifelse(xgboost_Probability > threshold, 1, 0)
testPredData <- cbind(testData[, -27], dtestData$label, xgboost_Prediction, xgboost_Probability)
names(testPredData)[names(testPredData) == "dtestData$label"] <- "churn"
head(testPredData)

##Step 3- Evaluate Model
xgboost_metrics <- evaluate_model(data = testPredData,
                                  observed = "churn",
                                  predicted = "xgboost_Prediction")
xgboost_metrics

threshold = 0.5
S = testPredData$xgboost_Probability
Y = testPredData$churn
roc.curve(s = threshold)
ROC.curve = Vectorize(roc.curve)
M.ROC.xgboost = ROC.curve(s = seq(0, 1, by = .01))
library(AUC)
library(pROC)
xgboost.auc <- auc(testPredData$xgboost_Prediction, testPredData$churn)
plot(M.ROC.xgboost[1,], M.ROC.xgboost[2,], main = "ROC Curves for Xgboost", col = "blue", lwd = 4, type = "l", xlab = "False Positive Rate", ylab = "True Positive Rate")
text(0.5, 0, paste("AUC=", round(xgboost.auc, 2)))

####################################################################################################
## Decision forest with rxDForest on SQL data source trainDataTb & testDataTb
####################################################################################################

##Step 1- Train Model
rxSetComputeContext(sql)
train_vars <- rxGetVarNames(trainDataTb)
train_vars <- train_vars[!train_vars %in% c("churn")]
temp <- paste(c("churn", paste(train_vars, collapse = "+")), collapse = "~")
formula <- as.formula(temp)

system.time(
  rx_forest_model <- rxDForest(formula = formula,
                            data = trainDataTb,
                            nTree = 8,
                            maxDepth = 32,
                            mTry = 2,
                            minBucket = 1,
                            replace = TRUE,
                            importance = TRUE,
                            seed = 8,
                            parms = list(loss = c(0, 4, 1, 0))))
rx_forest_model
plot(rx_forest_model)
rxVarImpPlot(rx_forest_model)

##Step 2- Score Model
rxSetComputeContext(local)
system.time(
  predictions <- rxPredict(modelObject = rx_forest_model,
                           data = testData,
                           type = "prob",
                           overwrite = TRUE))
threshold <- 0.5
predictions$X0_prob <- NULL
predictions$churn_Pred <- NULL
names(predictions) <- c("Forest_Probability")
predictions$Forest_Prediction <- ifelse(predictions$Forest_Probability > threshold, 1, 0)
predictions$Forest_Prediction <- factor(predictions$Forest_Prediction, levels = c(1, 0))
testPredData <- cbind(testData, predictions)
head(testPredData)

##Step 3- Evaluate Model
rx_forest_metrics <- evaluate_model(data = testPredData,
                                 observed = "churn",
                                 predicted = "Forest_Prediction")
rx_forest_metrics

roc_curve(data = testPredData,
          observed = "churn",
          predicted = "Forest_Probability")


# NOTE: Run 1-Clean-Join.r in the same R session before running 2-Train-Test.r

################################################
# Split out Training and Test Datasets
################################################

# split out the training data

airWeatherTrainDF <- airWeatherDF %>% filter(Year < 2012)
airWeatherTrainDF <- airWeatherTrainDF %>% sdf_register("flightsweathertrain")

# split out the testing data

airWeatherTestDF <- airWeatherDF %>% filter(Year == 2012 & Month == 1)
airWeatherTestDF <- airWeatherTestDF %>% sdf_register("flightsweathertest")

# Create ScaleR data source objects

colInfo <- list(
  ArrDel15 = list(type="numeric"),
  CRSArrTime = list(type="integer"),
  Year = list(type="factor"),
  Month = list(type="factor"),
  DayOfMonth = list(type="factor"),
  DayOfWeek = list(type="factor"),
  Carrier = list(type="factor"),
  OriginAirportID = list(type="factor"),
  DestAirportID = list(type="factor")
)

finalData <- RxHiveData(table = "flightsweather", colInfo = colInfo)
colInfoFull <- rxCreateColInfo(finalData)

trainDS <- RxHiveData(table = "flightsweathertrain", colInfo = colInfoFull)
testDS <- RxHiveData(table = "flightsweathertest", colInfo = colInfoFull)

################################################
# Train and Test a Logistic Regression model
################################################

formula <- as.formula(ArrDel15 ~ Month + DayOfMonth + DayOfWeek + Carrier + OriginAirportID +
                        DestAirportID + CRSDepTime + CRSArrTime + RelativeHumidityOrigin +
                        AltimeterOrigin + DryBulbCelsiusOrigin + WindSpeedOrigin +
                        VisibilityOrigin + DewPointCelsiusOrigin + RelativeHumidityDest +
                        AltimeterDest + DryBulbCelsiusDest + WindSpeedDest + VisibilityDest +
                        DewPointCelsiusDest
)

# Use the scalable rxLogit() function

logitModel <- rxLogit(formula, data = trainDS)

summary(logitModel)

save(logitModel, file = "logitModelSubset.RData")

# Predict over test data (Logistic Regression).

logitPredict <- RxXdfData(file.path(dataDir, "logitPredictSubset"))

# Use the scalable rxPredict() function

rxPredict(logitModel, data = testDS, outData = logitPredict,
          extraVarsToWrite = c("ArrDel15"),
          type = 'response', overwrite = TRUE)

# Calculate ROC and Area Under the Curve (AUC).

logitRoc <- rxRoc("ArrDel15", "ArrDel15_Pred", logitPredict)
logitAuc <- rxAuc(logitRoc)
# 0.645261

plot(logitRoc)

#####################################
# rxEnsemble of fastTrees
#####################################

trainers <- list(fastTrees(numTrees = 50))

fastTreesEnsembleModelTime <- system.time(
  fastTreesEnsembleModel <- rxEnsemble(formula, data = trainDS,
    type = "regression", trainers = trainers, modelCount = 16, splitData = TRUE)
)

summary(fastTreesEnsembleModel)

save(fastTreesEnsembleModel, file = "fastTreesEnsembleModelSubset.RData")

# Test
fastTreesEnsemblePredict <- RxXdfData(file.path(dataDir, "fastTreesEnsemblePredictSubset"))

# Experimental feature to parallelize rxPredict when using a MicrosoftML model
assign("predictMethod", "useDataStep", envir = MicrosoftML:::rxHashEnv)

fastTreesEnsemblePredictTime <- system.time(
  rxPredict(fastTreesEnsembleModel, data = testDS, outData = fastTreesEnsemblePredict,
          extraVarsToWrite = c("ArrDel15"),
          overwrite = TRUE)
)

# Calculate ROC and Area Under the Curve (AUC).

fastTreesEnsembleRoc <- rxRoc("ArrDel15", "Score", fastTreesEnsemblePredict)
fastTreesEnsembleAuc <- rxAuc(fastTreesEnsembleRoc)
# 0.6662082

plot(fastTreesEnsembleRoc)

rxSparkDisconnect(cc)

# Note - Restart R to switch to default HDFS settings:
#
# rxOptions(hdfsHost = "default")
# rxOptions(fileSystem = RxNativeFileSystem())

# See the following blog post for more sparklyr/rsparkling/H2O interop examples:
#
# https://blogs.msdn.microsoft.com/microsoftrservertigerteam/2017/04/19/new-features-in-9-1-microsoft-r-server-with-sparklyr-interoperability
#


## compare effects of normalisation across all samples and within cell type.
## use metrics from original wateRmelon paper to do comparision

args<-commandArgs(trailingOnly = TRUE)
source(args[1])

library(bigmelon)

setwd(dataDir)
normgdsFile<-sub("\\.gds", "Norm.gds", gdsFile)
gfile<-openfn.gds(normgdsFile, readonly = FALSE)

normbetas<-index.gdsn(gfile, "normbeta")[,]
celltypenormbeta<-index.gdsn(gfile, "celltypenormbeta")[,]
rawbetas<-betas(gfile)[,]

## remove NAs
rawbetas<-na.omit(rawbetas)
normbetas<-na.omit(normbetas)
celltypenormbeta<-na.omit(celltypenormbeta)

QCmetrics<-read.gdsn(index.gdsn(gfile, "QCdata"))
QCmetrics<-QCmetrics[match(colnames(rawbetas), QCmetrics$Basename),]

## apply wateRmelon metrics to compare normalisation
matOut<-matrix(data = NA, nrow = 3,ncol = 3)
rownames(matOut)<-c("raw", "normTog", "normSep")
colnames(matOut)<-c("iDMR", "genki", "seabi")

if(length( grep("rs", rownames(rawbetas))) > 0){
	matOut[1,2]<-mean(genki(rawbetas))
}
if(length( grep("rs", rownames(normbetas))) > 0){
	matOut[2,2]<-mean(genki(normbetas))
}
if(length( grep("rs", rownames(celltypenormbeta))) > 0){
	matOut[3,2]<-mean(genki(celltypenormbeta))
}

## filter to common probes
probes<-intersect(intersect(rownames(rawbetas), rownames(normbetas)), rownames(celltypenormbeta))
rawbetas<-rawbetas[probes,]
normbetas<-normbetas[probes,]
celltypenormbeta<-celltypenormbeta[probes,]

probeAnno<-fData(gfile)
probeAnno<-probeAnno[probes,]
x.probes<-probeAnno$chr == "chrX"

idmr<-intersect(iDMR(), rownames(rawbetas))

matOut[1,1]<-dmrse_row(rawbetas, idmr)
matOut[2,1]<-dmrse_row(normbetas, idmr)
matOut[3,1]<-dmrse_row(celltypenormbeta, idmr)

matOut[1,3]<-seabi(rawbetas, sex = QCmetrics$Sex, X = x.probes)
matOut[2,3]<-seabi(normbetas, sex = QCmetrics$Sex, X = x.probes)
matOut[3,3]<-seabi(celltypenormbeta, sex = QCmetrics$Sex, X = x.probes)

write.csv(matOut, paste0(qcOutFolder, "CompareNormalisationStrategies.csv"))

pheno<-QCmetrics

qualDat.tog<-qual(rawbetas, normbetas)
qualDat.sep<-qual(rawbetas, celltypenormbeta)

cellCols<-c("orange", "darkblue", "darkmagenta", "deeppink", "darkgray") ## assumes celltypes are order alphabetically

## look at normalisation effects
pdf(paste0(qcOutFolder, "CompareNormalisationStrategies.pdf"), height = 6, width = 10)
par(mfrow = c(1,2))
boxplot(qualDat.tog$rmsd ~ QCmetrics$Cell.type, ylab = "root mean square error", main = "Normalised together", xlab = "Cell type")
boxplot(qualDat.sep$rmsd ~ QCmetrics$Cell.type, ylab = "root mean square error", main = "Normalised separately", xlab = "Cell type")

## look at distribution of beta values
densityPlot(normbetas, sampGroups = QCmetrics$Cell.type,pal = cellCols)
densityPlot(celltypenormbeta, sampGroups = QCmetrics$Cell.type)
dev.off()

## reextract cell norm corrected betas to save in bespoke DNAm data object
celltypenormbeta<-index.gdsn(gfile, "celltypenormbeta")[,]
closefn.gds(gfile)

## remove cross-hybridising & snp probes
crosshyb<-read.table(paste(refFiles, "/EPICArray/CrossHydridisingProbes_McCartney.txt", sep = ""), stringsAsFactors = FALSE)
snpProbes<-read.table(paste(refFiles, "/EPICArray/SNPProbes_McCartney.txt", sep = ""), stringsAsFactors = FALSE, header = TRUE)
crosshyb2<-read.csv(paste(refFiles, "/EPICArray/Pidsley_SM1.csv", sep = ""), stringsAsFactors = FALSE)
snpProbes2<-read.csv(paste(refFiles, "/EPICArray/Pidsley_SM4.csv", sep = ""), stringsAsFactors = FALSE)
snpProbes3<-read.csv(paste(refFiles, "/EPICArray/Pidsley_SM5.csv", sep = ""), stringsAsFactors = FALSE)
snpProbes4<-read.csv(paste(refFiles, "/EPICArray/Pidsley_SM6.csv", sep = ""), stringsAsFactors = FALSE)
snpProbes<-snpProbes[which(snpProbes$DIST_FROM_MAPINFO < 10 & snpProbes$AF > 0.01),]
snpProbes2<-snpProbes2[which(snpProbes2$AF > 0.01),]
snpProbes3<-snpProbes3[which(snpProbes3$AF > 0.01),]
snpProbes4<-snpProbes4[which(snpProbes4$AF > 0.01),]

dist<-cbind(abs(snpProbes4$VARIANT_END - snpProbes4$MAPINFO), abs(snpProbes4$VARIANT_START - snpProbes4$MAPINFO))
dist<-apply(dist, 1, min)
snpProbes4<-snpProbes4[which(dist <=10),]

remove<-intersect(rownames(celltypenormbeta),unique(c(crosshyb[,1], snpProbes$IlmnID, snpProbes2$PROBE, snpProbes3$PROBE, snpProbes4$PROBE)))

celltypenormbeta<-celltypenormbeta[!rownames(celltypenormbeta) %in% remove,]

save(celltypenormbeta, pheno, file = normData)