#' @title
#' Calculate the ordering of events
#'
#' @description
#' For each event, we generate distributions of time of event occurance using profiles within clusters. These distributions are then pair wise compared and the results of all comparisons are represented in the graph space, where events are the graph nodes, and the directional edges represent that the source node event occurs significantly early than the target node. This graph is then utilized to generate the ordering.
#'
#' @param list_Tc List of matrices, where each matrix contains time course data for each 'ome'.
#' @param list_clusters List of vectors, one for each 'ome', where the order of the 'ome' should be similar to that in list_Tc. Each of these vectors contains a cluster label (assumed to be numeric and starting from 1). The length and order of the genes in these clusters should also be similar to the order in the matricies provided in list_Tc.
#' @param list_events List of matricies, where each matrix contains the time regions (and events for the centroid) generated by running the \code{calcEvents} function.
#' @param list_timeMap List of vectors, one for each 'ome', where each vector indicates the time point at which each of the 'omic' data sets were measured. For example, if a phosphoproteomics data set was measured at basal, 2minutes and 5minutes, and a proteomics data set was measured at basal, 3minutes and 5 minutes, then list_timeMap=[c(0,1,3), c(0,2,3)] (phosphoproteomics, then proteomics).
#' @param test The test used to compare the event time distributions. The choice is between a parametric or a non-parametric test:
#' \describe{
#' 		\item{\code{wilcox}}{Choosing this will result in event times being compared using the Mann Whitney U test}
#' 		\item{\code{t-test}}{Choosing this will result in event times being compared using the Students t-test}
#' }
#' @param fdrSignif The significance cutoff for FDR correction, performed after pairwise comparisons of the event times.
#' @param incrEventTh Value between 0 and 1, to define the threshold at which a phosphorylation (or increasing) event occurs. Here, a threshold of 0 corresponds to the minimum value within an interval. (Such an event is designated as 1).
#' @param decrEventTh Value between 0 and 1, to define the threshold at which a dephosphorylation (or decreasing) event occurs. A threshold of 0 corresponds to the maximum value within an interval. (Such an event is designated as -1).
#'
#'
#' @return A list with four named objects ($mat_events_withOrder, $individEventOrder, $signifs, $test) is returned, which encodes the order of the events and the clusters.
#'
#'
#' @importFrom methods is
#' @importFrom stats p.adjust wilcox.test t.test
#' @importFrom nem transitive.reduction
#' @importFrom igraph graph_from_adjacency_matrix adjacent_vertices V are.connected vertex_connectivity
#'
#' @seealso \code{\link[e1071]{cmeans}} for clustering time profiles, \code{\link{calcEvents}} for identifying events.
#'
#' @export
calculateOrder_combined <- function(list_Tc, list_clusters, list_events, list_timeMap, test="wilcox", fdrSignif=0.05, incrEventTh=0.5, decrEventTh=0.5){

	# stopifnot(is(list_Tc, "list"), length(list_Tc) > 0, (length(clusters) == nrow(Tc)), is(mat_events, "matrix"), (fdrSignif >0 && fdrSignif <= 1 ), (incrEventTh >= 0 && incrEventTh <= 1), (decrEventTh >= 0 && decrEventTh <= 1))

	if (!(test == eventOrderTest$param) && !(test == eventOrderTest$nonParam)){
		stop(paste("Test ", test, " not recognized.", sep=""))
	}

	list_list_distributions = list()
	events_combined = list_events[[1]]

	for (i in 1:length(list_Tc)){
		# 1. split into sub matricies
		list_splitMat = splitIntoSubMatrices(list_Tc[[i]], list_clusters[[i]])

		# 2. getDistOfAllEvents
		list_distributions = getDistOfAllEvents_v3(list_events[[i]], list_splitMat, incrEventTh, decrEventTh, list_timeMap[[i]])

		# 3. Combine all distributions
		list_list_distributions = c(list_list_distributions, list_distributions)

		# 4. Renumber and combine mat_events.
		if (i == 1){
			events_combined[,Col_events$combinedDatasetNum] <- rep(i, nrow(events_combined))
		}
		else {
			# add dataset number
			list_events[[i]][,Col_events$combinedDatasetNum] <-rep(i, nrow(list_events[[i]]))

			# adjust the cluster numbers
			list_events[[i]][,Col_events$clus] <- list_events[[i]][,Col_events$clus] + max(events_combined[,Col_events$clus])

			# add to the events matrix.
			events_combined <- rbind(events_combined, list_events[[i]])
		}
	}

	# 5. Run

	list_pVal_stat <- list()

	if (test==eventOrderTest$nonParam){
		print ("Running wilcoxon test.")
		list_pVal_stat <- performWilcoxonSignedRankTabular(list_list_distributions)

		title_testType = "(Non-parametric)"
	}
	else {
		print("Running t-test.")
		list_pVal_stat <- performTtestsTabular(list_list_distributions)

		title_testType = "(Parametric)"
	}

	# FDR adjustment for multiple testing.
	mat_pValsFDR <- matrix(stats::p.adjust(as.vector(list_pVal_stat[[1]]), method='fdr'), ncol=nrow(events_combined))

	# Convert to adjacency matrix.
	signifs <- mat_pValsFDR < fdrSignif
	statistic_t <- list_pVal_stat[[2]]
	statistic_t[!signifs] <- NA

	statistic_t[statistic_t > 0] <- NA
	statistic_t[is.na(statistic_t)] <- 0
	statistic_t[statistic_t < 0] <- 1

	# library(nem) # for trasitive reduction
	# library(igraph) # for adjacency matrix
	reducted <- nem::transitive.reduction(statistic_t)
	net = igraph::graph_from_adjacency_matrix(reducted, mode="directed")

	list_eventsOrder <- getEventsOrderInGraph(reducted, net) # computing the order of the events in the mat_events based on a bfs search.
	list_eventsOrder <- adjustEvents(list_eventsOrder, signifs)

	mat_events_withOrder <- appendOrder(events_combined, list_eventsOrder)

	res <- list(mat_events_withOrder, list_eventsOrder, signifs, test)
	names(res) <- c("mat_events_withOrder", "individEventOrder", "signifs", "test")
	return (res)

}

#' @title
#' Visualize the order of events for a multiomics data set.
#'
#' @description
#' A plot depicting the temporal order of events is generated. The order is shown using two visualizations, event maps (top) and event sparklines (bottom). The event sparkline is a summary of the event map.
#'
#' @param theOrder A list containing information regarding the order of events and clusters generated via the \code{calculateOrder} function.
#'
#'
#' @return A plot containing the ordered clusters by occurance of first event is generated (see description).
#'
#'
#' @importFrom methods is
#' @importFrom graphics plot segments axis rect text lines
#' @importFrom shape Arrows
#'
#' @seealso \code{\link{calculateOrder}}
#'
#' @export
visualizeOrder_combined <- function(theOrder){
# Visualise the ordering of events

	stopifnot(is(theOrder, "list"), length(theOrder) == 4)

	mat_events_withOrder <- theOrder$mat_events_withOrder
	list_eventsOrder <- theOrder$individEventOrder
	signifs <- theOrder$signifs
	test <- theOrder$test

	title_testType = ""
	## Getting other things ready for plotting

	if (test==eventOrderTest$nonParam){
		title_testType = "(Non-parametric)"
	}
	else {
		title_testType = "(Parametric)"
	}

	# plotting constants
	sigEventsDiff_x = 0.5
	nonSigEventsDiff_x = 0.25

	eventPtGraph_y = -1
	yLabelInit = -1.8
	yLabelSpace = 0.5

	lineDiff_y = 1

	# graphXStart = -1
	eventStart_x = 0

	blockSpacingFmEvent_x = sigEventsDiff_x/2
	blockStart_x = eventStart_x - blockSpacingFmEvent_x

	#x_lineStart, y_lineStart, y_lineDecr, x_incr_sig, x_incr_nonSig

	yPos_eventPts = -1

	# plotting values

	list_blocks <- getRectBlock(list_eventsOrder, signifs)
	# print(list_blocks)

	mat_eventPoints <- getTheClusLines(mat_events_withOrder, list_eventsOrder, signifs, list_blocks, eventStart_x, sigEventsDiff_x, nonSigEventsDiff_x, lineDiff_y)

	eventEnd_x = max(as.numeric(mat_eventPoints[,cols_matFifty$col_x])) #  + blockSpacingFmEvent_x
	blockEnd_x = eventEnd_x + blockSpacingFmEvent_x

	mat_bgRects <- getRectPoints(mat_eventPoints, list_blocks, blockStart_x, blockSpacingFmEvent_x)

	# mat_eventPoints <- adjustByBgRects(mat_bgRects, list_eventsOrder, mat_eventPoints)

	mat_grayLines <- getGrayLines(mat_eventPoints, signifs)

	mat_grayLines_v2 <- getGrayLines_v2(list_eventsOrder, mat_eventPoints, signifs)

	mat_clusConnLines <- getClusConnLines(mat_eventPoints, blockStart_x, blockEnd_x)

	# make all the down clusConnLines to opaque
	mat_clusConnLines <- makeDecrBarOpaque(mat_clusConnLines, TRUE)

	# a set of points to set up the graph.
	# print(mat_eventPoints)
	graphics::plot(mat_eventPoints[,cols_matFifty$col_x], mat_eventPoints[,cols_matFifty$col_y], asp=NA, yaxt="n", lwd=0.25, col=colors_orderedEvents$incr, pch=".", xlab="Temporal order", ylab="Clusters",  main=paste("Temporal order of events in clusters", title_testType, sep=""), xlim=c(eventStart_x, eventEnd_x), ylim=c(-4, max(as.numeric(mat_eventPoints[,cols_matFifty$col_clus]))), xaxt="n", bty="n", cex.main = 0.8) #,
	# print("over here..")
	# background gray rectangles.
	if (nrow(mat_bgRects) > 0){
		for (rowNum in 1:nrow(mat_bgRects)){
			if (rowNum%%2 == 1){
				graphics::rect(mat_bgRects[rowNum,1], lineDiff_y/2, mat_bgRects[rowNum,2], max(as.numeric(mat_eventPoints[,cols_matFifty$col_clus])) + (lineDiff_y/2), col = "#ededed", border=NA)
			}

		}
	}

	graphics::segments(x0=as.numeric(mat_grayLines[,cols_clusPlotObjs$col_x0]), y0=as.numeric(mat_grayLines[,cols_clusPlotObjs$col_y0]), x1=as.numeric(mat_grayLines[,cols_clusPlotObjs$col_x1]), y1=as.numeric(mat_grayLines[,cols_clusPlotObjs$col_y1]), col="#808080", lty="dotted", lwd=0.5)
	# C99999

	# rect(-0.5, 0, 0.5, 17.5, col = "yellow", border="#ededed")

	# the cluster lines
	graphics::segments(x0=as.numeric(mat_clusConnLines[,cols_clusPlotObjs$col_x0]), y0=as.numeric(mat_clusConnLines[,cols_clusPlotObjs$col_y0]), x1=as.numeric(mat_clusConnLines[,cols_clusPlotObjs$col_x1]), y1=as.numeric(mat_clusConnLines[,cols_clusPlotObjs$col_y1]), col=mat_clusConnLines[,cols_clusPlotObjs$col_col], lwd=16, lend=2)

	# the events (arrows) within a graph

	# print(mat_events_withOrder)
	# print(max(mat_events_withOrder[,Col_events$combinedDatasetNum]))
	# print(mat_eventPoints)
	# return ()

	# gray lines in events points maps
	straightGrayLines = mat_grayLines_v2[mat_grayLines_v2[,cols_grayLines_v2$col_isSemiCirc] == FALSE,]
	graphics::segments(x0=as.numeric(straightGrayLines[,cols_grayLines_v2$col_x0]), y0=rep(yPos_eventPts, length(straightGrayLines)), x1=as.numeric(straightGrayLines[,cols_grayLines_v2$col_x1]), y1=rep(yPos_eventPts, length(straightGrayLines)), lwd=1, col="#A2A2A2") #, lty="dotted")

	# gray curves in events points map
	mat_curvePoints = mat_grayLines_v2[mat_grayLines_v2[,cols_grayLines_v2$col_isSemiCirc] == TRUE,,drop=FALSE]

	if (length(mat_curvePoints) > 0 && nrow(mat_curvePoints) > 0){
		for (i in 1:nrow(mat_curvePoints)){
			list_pts = calcCurves(mat_curvePoints[i, cols_grayLines_v2$col_x0], mat_curvePoints[i, cols_grayLines_v2$col_x1], -1)
			graphics::lines(list_pts[[1]], list_pts[[2]], col="#A2A2A2")
		}
	}

	## plotting arrows in event map & event sparkline.

	# printing up and down events (in arc events map)
	y_adjust = 0.15

	for (i in 1:length(Color_multiomics)) {

		mat_upEvents = mat_eventPoints[mat_eventPoints[,cols_matFifty$col_dir] == Color_multiomics[[i]]$incr,]

		mat_downEvents = mat_eventPoints[mat_eventPoints[,cols_matFifty$col_dir] == Color_multiomics[[i]]$decr,]

		### Event map.
		## arrow bottoms
		shape::Arrows(x0=as.numeric(mat_upEvents[,cols_matFifty$col_x]), x1=as.numeric(mat_upEvents[,cols_matFifty$col_x]), y0=as.numeric(mat_upEvents[,cols_matFifty$col_y])-0.01-0.2,  y1=as.numeric(mat_upEvents[,cols_matFifty$col_y])-0.01, arr.type="triangle", arr.length=0.01, arr.width=0.01, col=Color_multiomics[[i]]$incr, lwd=2, lend=2, arr.adj=0)

		shape::Arrows(x0=as.numeric(mat_downEvents[,cols_matFifty$col_x]), x1=as.numeric(mat_downEvents[,cols_matFifty$col_x]), y0=as.numeric(mat_downEvents[,cols_matFifty$col_y])+0.25,  y1=as.numeric(mat_downEvents[,cols_matFifty$col_y])+0.25-0.2, arr.type="triangle", arr.length=0.01, arr.width=0.01, col=Color_multiomics[[i]]$decr, lwd=2, lend=2, arr.adj=0)

		## arrow bottoms
		shape::Arrows(x0=as.numeric(mat_upEvents[,cols_matFifty$col_x]), x1=as.numeric(mat_upEvents[,cols_matFifty$col_x]), y0=as.numeric(mat_upEvents[,cols_matFifty$col_y])-0.01-0.2,  y1=as.numeric(mat_upEvents[,cols_matFifty$col_y])-0.01, arr.type="triangle", arr.length=0.01, arr.width=0.01, col=Color_multiomics[[i]]$incr, lwd=2, lend=2, arr.adj=0)

		shape::Arrows(x0=as.numeric(mat_downEvents[,cols_matFifty$col_x]), x1=as.numeric(mat_downEvents[,cols_matFifty$col_x]), y0=as.numeric(mat_downEvents[,cols_matFifty$col_y])+0.25,  y1=as.numeric(mat_downEvents[,cols_matFifty$col_y])+0.25-0.2, arr.type="triangle", arr.length=0.01, arr.width=0.01, col=Color_multiomics[[i]]$decr, lwd=2, lend=2, arr.adj=0)

		## sharp arrow heads
		shape::Arrows(x0=as.numeric(mat_upEvents[,cols_matFifty$col_x]), x1=as.numeric(mat_upEvents[,cols_matFifty$col_x]), y0=as.numeric(mat_upEvents[,cols_matFifty$col_y])-0.01-0.2,  y1=as.numeric(mat_upEvents[,cols_matFifty$col_y])-0.01, arr.type="triangle", arr.length=0.13, arr.width=0.15, col=Color_multiomics[[i]]$incr, arr.adj=0, segment=FALSE)

		shape::Arrows(x0=as.numeric(mat_downEvents[,cols_matFifty$col_x]), x1=as.numeric(mat_downEvents[,cols_matFifty$col_x]), y0=as.numeric(mat_downEvents[,cols_matFifty$col_y])+0.25,  y1=as.numeric(mat_downEvents[,cols_matFifty$col_y])+0.25-0.2, arr.type="triangle", arr.length=0.13, arr.width=0.15, col=Color_multiomics[[i]]$decr, arr.adj=0, segment=FALSE)

		### Event sparkline

		## arrow bottom lines
		shape::Arrows(x0=as.numeric(mat_upEvents[,cols_matFifty$col_x]), x1=as.numeric(mat_upEvents[,cols_matFifty$col_x]), y0=rep(-1.2, nrow(mat_upEvents)), y1=rep(-1, nrow(mat_upEvents)), arr.type="triangle", arr.length=0.01, arr.width=0.01, col=Color_multiomics[[i]]$incr, lwd=2, lend=2, arr.adj=0)

		shape::Arrows(x0=as.numeric(mat_downEvents[,cols_matFifty$col_x]), x1=as.numeric(mat_downEvents[,cols_matFifty$col_x]), y0=rep(-0.8, nrow(mat_downEvents)), y1=rep(-1, nrow(mat_downEvents)), arr.type="triangle", arr.length=0.01, arr.width=0.01, col=Color_multiomics[[i]]$decr, lwd=2, lend=2, arr.adj=0)

		## sharp arrow heads
		shape::Arrows(x0=as.numeric(mat_upEvents[,cols_matFifty$col_x]), x1=as.numeric(mat_upEvents[,cols_matFifty$col_x]), y0=rep(-1.2, nrow(mat_upEvents)), y1=rep(-1, nrow(mat_upEvents)), arr.type="triangle", arr.length=0.13, arr.width=0.15, col=Color_multiomics[[i]]$incr, arr.adj=0, segment=FALSE)

		shape::Arrows(x0=as.numeric(mat_downEvents[,cols_matFifty$col_x]), x1=as.numeric(mat_downEvents[,cols_matFifty$col_x]), y0=rep(-0.8, nrow(mat_downEvents)), y1=rep(-1, nrow(mat_downEvents)), arr.type="triangle", arr.length=0.13, arr.width=0.15, col=Color_multiomics[[i]]$decr, arr.adj=0, segment=FALSE)
	}

	vec_labels <- getYaxisLabels(mat_eventPoints)
	mat_labels <- adjustLabelsByDataset(mat_events_withOrder, vec_labels)

	# axis labels on sides 2 and 4.
	Map(axis, side=2, at=seq(1,nrow(mat_labels)), col.axis=rev(mat_labels[,Col_labels$color]), labels=rev(mat_labels[,Col_labels$label]), lwd=0, las=1)
	graphics::axis(2,at=seq(1,nrow(mat_labels)),labels=FALSE, col=NA)

	Map(axis, side=4, at=seq(1,nrow(mat_labels)), col.axis=rev(mat_labels[,Col_labels$color]), labels=rev(mat_labels[,Col_labels$label]), lwd=0, las=1)
	graphics::axis(4,at=seq(1,nrow(mat_labels)),labels=FALSE, col=NA)

	# graphics::axis(side=4, las=1, at=seq(1,length(vec_labels)), labels=rev(vec_labels), cex=0.02,  col = NA ) #, col.ticks = 1)

	# x label text.
	mat_xLabelsClus <- getXaxisLabels(list_eventsOrder, mat_eventPoints, signifs, list_blocks, eventStart_x, sigEventsDiff_x, nonSigEventsDiff_x, yLabelInit, yLabelSpace);
	print(as.numeric(mat_xLabelsClus[,3]))

	mat_xLabels <- adjustLabelsByDataset(mat_events_withOrder, as.numeric(mat_xLabelsClus[,3]))

	mat_xLabelsClus[,3] <- mat_xLabels[,Col_labels$label]

	graphics::text(x=as.numeric(mat_xLabelsClus[,1]), y=as.numeric(mat_xLabelsClus[,2]), labels=mat_xLabelsClus[,3], offset=0, cex=0.5, col=mat_xLabelsClus[,4])

}

adjustLabelsByDataset_forMat <- function(mat_events_withOrder, vec_labels){
	mat_labels = matrix(ncol=2, nrow=length(vec_labels))

	for (i in 1:length(vec_labels)){
		# print(vec_labels[i])
		datasetNums <- mat_events_withOrder[mat_events_withOrder[,Col_events$clus] == vec_labels[i],Col_events$combinedDatasetNum]

		dsNum = datasetNums[1]

		if (dsNum > 1) {
			theRows <- mat_events_withOrder[,Col_events$combinedDatasetNum] == (dsNum - 1)

			maxClusNumOfPrev <- max(mat_events_withOrder[theRows, Col_events$clus])

			adjustedClusNum <- vec_labels[i] - maxClusNumOfPrev

			mat_labels[i, Col_labels$label] = adjustedClusNum
			mat_labels[i, Col_labels$color] = Color_multiomics[[dsNum]]$incr

			# print(paste(vec_labels[i], dsNum, maxClusNumOfPrev, adjustedClusNum))

		}
		else{
			mat_labels[i, Col_labels$label] = vec_labels[i]
			mat_labels[i, Col_labels$color] = Color_multiomics[[dsNum]]$incr

		}

	}

	return(mat_labels)
}

adjustLabelsByDataset <- function(mat_events_withOrder, vec_labels){
	mat_labels = matrix(ncol=2, nrow=length(vec_labels))

	for (i in 1:length(vec_labels)){
		# print(vec_labels[i])
		datasetNums <- mat_events_withOrder[mat_events_withOrder[,Col_events$clus] == vec_labels[i],Col_events$combinedDatasetNum]

		dsNum = datasetNums[1]

		if (dsNum > 1) {
			theRows <- mat_events_withOrder[,Col_events$combinedDatasetNum] == (dsNum - 1)

			maxClusNumOfPrev <- max(mat_events_withOrder[theRows, Col_events$clus])

			adjustedClusNum <- vec_labels[i] - maxClusNumOfPrev

			mat_labels[i, Col_labels$label] = adjustedClusNum
			mat_labels[i, Col_labels$color] = Color_multiomics[[dsNum]]$incr

			# print(paste(vec_labels[i], dsNum, maxClusNumOfPrev, adjustedClusNum))

		}
		else{
			mat_labels[i, Col_labels$label] = vec_labels[i]
			mat_labels[i, Col_labels$color] = Color_multiomics[[dsNum]]$incr

		}

	}

	return(mat_labels)
}

#############################

getDistOfAllEvents_v3 <- function(mat_fiftyPoints, list_matrices, phosTh, dephosTh, timeMap){
	list_distributions <- list()

	for (eventNum in 1:nrow(mat_fiftyPoints)){
		# print(paste("Eventnum ", eventNum, "--------------------------------------------------------------------"))
		startTp <- mat_fiftyPoints[eventNum, cols_matFifty_v2$startTp]
		endTp <- mat_fiftyPoints[eventNum, cols_matFifty_v2$endTp]
		dist <- genDistForEvent_v2(list_matrices[[mat_fiftyPoints[eventNum,cols_matFifty_v2$clus]]], mat_fiftyPoints[eventNum, cols_matFifty_v2$dir], mat_fiftyPoints[eventNum, cols_matFifty_v2$startTp], mat_fiftyPoints[eventNum, cols_matFifty_v2$endTp], phosTh, dephosTh, timeMap)

		list_distributions[[length(list_distributions) + 1]] <-  dist
	}

	return(list_distributions)
}

genDistForEvent_v2 <- function(clusMat, dir, startTp, endTp, phosTh, dephosTh, timeMap){
	mat_distribution <- matrix(ncol=4)

	for (profNum in 1:nrow(clusMat)){

		if ((dir == 1 && clusMat[profNum, startTp] < clusMat[profNum, endTp]) || (dir == -1 && clusMat[profNum, startTp] > clusMat[profNum, endTp])){
			# direction holds; do calculation, and save.
			# print(clusMat[profNum, startTp:endTp])

			crossPt <- calcCrossing_v4(clusMat[profNum, startTp:endTp], dir, (startTp -1), phosTh, dephosTh, timeMap)

			mat_distribution <- addToMatrix(mat_distribution, profNum, crossPt[1], crossPt[2], dir)

		}
		else{
			mat_distribution <- addToMatrix(mat_distribution, profNum, NA, NA, dir)
		}
	}

	mat_distribution <- mat_distribution[-1,, drop=FALSE]
	return (mat_distribution)
}

calcCrossing_v4 <- function(region, dir, offset, phosTh, dephosTh, timeMap){

	x_50 <- -1 # initial time
	y_50 <- -1 # initial th_point

	y_max <- max(region)
	y_min <- min(region)

	if (dir == 1){
		y_10Percent <- (y_max - y_min) * phosTh
		y_50 <- y_min + y_10Percent
	}
	else{
		y_10Percent <- (y_max - y_min) * (1- dephosTh)
		y_50 <- y_min + y_10Percent
	}

	e = 0.0001 # due to calculation some round error when threshold is 0.
	# find intervals and store
	for (j in 2:length(region)){

		if (dir == 1 && ( (y_50 >= region[j-1] && y_50 <= region[j]) || abs(y_50 - region[j-1]) < e  || abs(y_50 - region[j]) < e )){
			# 50 is crossed here in phos direction
			# print(paste("Orig", (offset+j-1), " ", offset+j))
			x_50 <- getMidX_v2(timeMap[(offset+j-1)], region[j-1], timeMap[offset+j], region[j], y_50)
			# mat_fiftyPoints <- addToMatrix(mat_fiftyPoints, clusNum, x_50, y_50, 1)
		}
		else if (dir == -1 && ( (y_50 <= region[j-1] && y_50 >=region[j]) || abs(y_50 - region[j-1]) < e  || abs(y_50 - region[j]) < e ) ){
			# 50 is crossed here in dephos direction
			# getMidX()
			# print(paste("Orig", (offset+j-1), " " , offset+j))
			x_50 <- getMidX_v2(timeMap[(offset+j-1)], region[j-1], timeMap[offset+j], region[j], y_50)
			# mat_fiftyPoints <- addToMatrix(mat_fiftyPoints, clusNum, x_50, y_50, -1)

		}
	}

	return (c(x_50, y_50))
}

getMidX_v2 <- function(x1, y1, x2, y2, y_50){

	m <- (y2 - y1)/(x2 - x1)
	x_50 <- x1 + ((y_50 - y1)/m)

	# print(paste(x1, " ", x2, " ", x_50))
	return (x_50)
}


library('ape')

sink("intervals_nu2.0_tau.1_ns20.txt")
for (n in 1:10000)
{
system("./ms 20 1 -eN .025 .5 -T > tree.tre", intern = FALSE, wait = TRUE, input = NULL)
MyTree <- read.tree("tree.tre")
ints = coalescent.intervals(MyTree)
line = ints[2][[1]]
cat(line)
cat("\n")
}
sink()


predictors1 = c("funder","installer","management",
               "region","lga","population",
               "latitude","longitude","gps_height",
               "scheme_management",
               "public_meeting","permit",
               "water_quality","quantity",
               "payment_type","source","source_class",
               "basin","extraction_type","waterpoint_type"
               )

predictors2 = c("funder_p","installer_p","management",
               "region","lga","population",
               "latitude","longitude",
               "gps_height",
               "construction_year","amount_tsh",
               "scheme_management",
               "public_meeting","permit",
               "water_quality","quantity",
               "payment_type","source","source_class",
               "basin","extraction_type","waterpoint_type","subvillage_p",
               "ward_p"
)
target = "status_group"
d2$status_group <- '                                   '

h2o.init(nthreads = -1)
full_data <- rbind(d1, d2)
write.table(full_data[full_data$train==1,], gzfile('/Users/mauropelucchi/Desktop/Work/University/Master_BI_2016/Pump_it_waterpoint/transformed_train.csv.gz'),quote=F,sep=',',row.names=F)
write.table(full_data[full_data$train==0,], gzfile('/Users/mauropelucchi/Desktop/Work/University/Master_BI_2016/Pump_it_waterpoint/transformed_test.csv.gz'),quote=F,sep=',',row.names=F)
train.hex <- h2o.uploadFile('/Users/mauropelucchi/Desktop/Work/University/Master_BI_2016/Pump_it_waterpoint/transformed_train.csv.gz', destination_frame='p_ex_train')
test.hex <- h2o.uploadFile('/Users/mauropelucchi/Desktop/Work/University/Master_BI_2016/Pump_it_waterpoint/transformed_test.csv.gz', destination_frame='p_ex_test')

rfHex1 = h2o.randomForest(
  x = predictors1,
  y = target,
  training_frame = train.hex,
  model_id = "rf_1",
  ntrees = 1000, mtries = 10,
  seed = 45678)

rfHex2 = h2o.randomForest(
  x = predictors2,
  y = target,
  training_frame = train.hex,
  model_id = "rf_2",
  ntrees = 1000, mtries = 10,
  seed = 45678)

#+
h2o.confusionMatrix(rfHex1)
h2o.confusionMatrix(rfHex2)

out = as.data.frame(h2o.predict(rfHex2,test.hex))[,1]
sub <- data.frame(id = d2$id, status_group= out)
write.csv(sub, file = "/Users/mauropelucchi/Desktop/Work/University/Master_BI_2016/Pump_it_waterpoint/sub_rf2.csv", row.names = F)


#Title: Fitting decay curve 6time
#Auther: Naoto Imamachi
#ver: 1.0.0
#Date: 2014-08-29

#Time############################
args <- commandArgs(trailingOnly = T)
filename <- args[1]
hour_list <- args[2]
#hour_list <- "0,1,2,4,8,12"
hour <- unlist(strsplit(hour_list,","))
hour <- as.numeric(hour)
first_sample <- 5 - 1
last_sample <- 5 + length(hour) - 1 - 1

fitting_optim_siRNA <- function(i){
fname <- paste(i,"_rel_normalized.fpkm_table",sep="")
output <- paste(i,"_rel_normalized_cal.fpkm_table",sep="")
all_data <- read.table(fname,row.names=1,header=T,sep="\t")
sample_id <- row.names(all_data)

cat("id","value","model1","cor1","a_1","half1_1","half1_2","AIC1","model2","cor2","a_2","b_2","half2",
      "AIC2","model3","cor3","a_3","b_3","c_3","half3","AIC3",sep="\t",file=output)
cat("\n",file=output,append=T)

for(x in sample_id){
	mRNA <- all_data[x,]
	mRNA <- as.numeric(mRNA)
	mRNA <- mRNA[first_sample:last_sample]
	dat <- data.frame(hour,mRNA)
	dat <- dat[dat$mRNA > 0,]
	dat_point <- length(dat$mRNA)
	cat(x,"\t",sep="",file=output,append=T)

   if(mRNA[1] >= 1){
	if(dat_point >= 3){
		cat("ok","\t",sep="",file=output,append=T)
		size <- length(dat[,"mRNA"])

		#model1:y = exp(-a * t)
		optim1 <- function(x){
			mRNA_exp <- exp(-x * dat[,"hour"])
			sum((dat[,"mRNA"]-mRNA_exp)^2)
		}

		out1 <- optim(1,optim1)
		min1 <- out1$value
		a_1 <- out1$par[1]
		half1_1 <- log(2) / a_1

		model1_pred <- function(x){
			mRNA_exp <- exp(-x * dat[,"hour"])
			(cor(mRNA_exp,dat[,"mRNA"],method="pearson"))^2
		}
		cor1 <- model1_pred(a_1)

		model1_half <- function(x){
			mRNA_half <-  exp(- a_1 * x)
			(mRNA_half - 0.5)^2
		}

		out1 <- optim(1,model1_half)
		half1_2 <- out1$par
		mRNA_pred <- exp(- a_1 * dat[,"hour"])
		s2 <-  sum((dat[,"mRNA"] - mRNA_pred )^2 )/ size
		AIC1 <- size * log(s2)+ 2 * 0

		cat(min1,cor1,a_1,half1_1,half1_2,AIC1,sep="\t",file=output,append=T)
		cat("\t",file=output,append=T)

		#model2:y = A * exp(-b * t) + c
		optim2 <- function(x){
			mRNA_exp <- (1.0 - x[2]) * exp(-x[1] * dat[,"hour"]) + x[2]
			sum((dat[,"mRNA"]-mRNA_exp)^2)
		}

		out2 <- optim(c(1,0),optim2)
		min2 <- out2$value
		a_2 <-  out2$par[1]
		b_2 <-  out2$par[2]

		model2_pred <- function(a,b){
			mRNA_exp <- (1- b) * exp(-a * dat[,"hour"]) + b
			(cor(mRNA_exp,dat[,"mRNA"],method="pearson"))^2
		}

		cor2 <- model2_pred(a_2,b_2)

		model2_half <- function(x){
			mRNA_half <-  (1 - b_2) * exp(- a_2 * x) + b_2
			(mRNA_half - 0.5)^2
		}

		out2 <- optim(1,model2_half)
		half2 <- out2$par

        if(b_2 >= 0.5){
         half2 <- Inf
        }

        mRNA_pred <- (1 - b_2) * exp(- a_2 * dat[,"hour"]) + b_2
        s2 <-  sum((dat[,"mRNA"] - mRNA_pred )^2 )/ size
        AIC2 <- size * log(s2)+ 2 * 1

		cat(min2,cor2,a_2,b_2,half2,AIC2,sep="\t",file=output,append=T)
		cat("\t",file=output,append=T)

		#model3:y = A * exp(-b * t) + (1 - A) * exp (-c * t)

		optim3 <- function(x){
			mRNA_exp <- x[3] * exp(-x[1] * dat[,"hour"]) + (1 - x[3]) * exp(- x[2] * dat[,"hour"])
			sum((dat[,"mRNA"]-mRNA_exp)^2)
		}

		out3 <- optim(c(1,1,0.1),optim3)
		min3 <- out3$value
		a_3 <- out3$par[1]
		b_3 <- out3$par[2]
		c_3 <- out3$par[3]

		model3_pred <- function(a,b,c){
			mRNA_exp <- c * exp(-a * dat[,"hour"]) + (1 - c) * exp(- b * dat[,"hour"])
			(cor(mRNA_exp,dat[,"mRNA"],method="pearson"))^2
		}

		cor3 <- model3_pred(a_3,b_3,c_3)

		model3_half <- function(x){
			mRNA_half <- c_3 * exp(- a_3 * x) +(1 - c_3) * exp(- b_3  * x)
			(mRNA_half - 0.5)^2
		}

		out3 <- optim(1,model3_half)
		half3 <- out3$par
		mRNA_pred <- c_3 * exp(- a_3 * dat[,"hour"]) + (1 - c_3) * exp(- b_3 * dat[,"hour"])
		s2 <-  sum((dat[,"mRNA"] - mRNA_pred )^2 )/ size
		AIC3 <- size * log(s2)+ 2 * 2

		cat(min3,cor3,a_3,b_3,c_3,half3,AIC3,sep="\t",file=output,append=T)
		cat("\n",file=output,append=T)

		} else {
			cat("few_data","\n",sep="",file=output,append=T)
			next
		}
		}else{
			cat("low_expresion","\n",sep="",file=output,append=T)
			next;
		}

}

}

fitting_optim_siRNA(filename)


add.surrogate.variables <- function(beta, sites, samples,
                                    most.variable,
                                    variable, covariates,
                                    winsorize.pct,
                                    outlier.iqr.factor,
                                    random.seed, isva, sva, smartsva, n.sv, smartsva.alpha=0.25, verbose=F) {

    stopifnot(length(samples) == length(variable))
    stopifnot(is.null(covariates) || nrow(covariates) == length(samples))

    meffil:::msg("Calculating CpG variance", verbose = verbose)
    var.sites <- meffil.most.variable.cpgs(beta, most.variable, sites, samples, winsorize.pct, outlier.iqr.factor)

    if (is.matrix(beta)) {
        beta <- beta[var.sites,,drop=F]
        if (!is.null(samples))
            beta <- beta[,samples,drop=F]
    }
    else {
        beta <- retrieve.gds.methylation(beta, var.sites, samples)
    }
    beta <- meffil.handle.outliers(beta, winsorize.pct, outlier.iqr.factor)
    beta <- meffil:::impute.matrix(beta, margin=1)

    if (!is.null(covariates)) {
        cov.frame <- model.frame(~., data.frame(covariates, stringsAsFactors=F), na.action=na.pass)
        mod0 <- model.matrix(~., cov.frame)
    }
    else
        mod0 <- matrix(1, ncol=1, nrow=length(variable))
    mod <- cbind(mod0, variable)

    covariate.sets <- list()
    last.ret <- NULL
    if (isva) {
        meffil:::msg("ISVA.", verbose=verbose)
        set.seed(random.seed)
        isva.ret <- isva(beta, mod, ncomp=n.sv, verbose=verbose)
        if (!is.null(covariates))
            covariate.sets$isva <- data.frame(covariates, isva.ret$isv, stringsAsFactors=F)
        else
            covariate.sets$isva <- as.data.frame(isva.ret$isv)
        last.ret <- isva.ret
        cat("\n")
    }

    if (sva) {
        meffil:::msg("SVA.", verbose=verbose)
        set.seed(random.seed)
        sva.ret <- sva(beta, mod=mod, mod0=mod0, n.sv=n.sv)
        if (!is.null(covariates))
            covariate.sets$sva <- data.frame(covariates, sva.ret$sv, stringsAsFactors=F)
        else
            covariate.sets$sva <- as.data.frame(sva.ret$sv)
        last.ret <- sva.ret
        cat("\n")
    }

    if (smartsva) {
        meffil:::msg("smartSVA.", verbose=verbose)
        set.seed(random.seed)
        if (is.null(n.sv)) {
            beta.res <- t(resid(lm(t(beta) ~ ., data=as.data.frame(mod))))
            n.sv <- EstDimRMT(beta.res, FALSE)$dim + 1
        }
        smartsva.ret <- smartsva.cpp(beta, mod=mod, mod0=mod0, n.sv=n.sv, alpha=smartsva.alpha)
        if (!is.null(covariates))
            covariate.sets$smartsva <- data.frame(covariates, smartsva.ret$sv, stringsAsFactors=F)
        else
            covariate.sets$smartsva <- as.data.frame(smartsva.ret$sv)
        last.ret <- smartsva.ret
        cat("\n")
    }

    list(sets=covariate.sets, last=last.ret)
}


" Пусть вектор w создан из значений разного типа
Выяснить правило, по которому выполняется преобразование данных разных типов,
хранящихся в векторе. Для этого последовательно создать вектора с данными одного
типа, двух типов, трех типов и т.д. Перебрать все возможные сочетания типов."

w <- c(2,TRUE, "char", 3.4)
#Правило:
#Logical -> integer -> double ->  character


Reading into Eigen vector...
log_omega0_c1       4.4
log_omega0_c2       3.7
log_sd_in_c1        4.6
log_sd_in_c2        2.3
log_zeta            -1.6

Reading into Eigen vector...
omega0              80
sd_in               100
zeta                0.2
sd_obs              0.05

Reading into Eigen vector...
x1                  0
x2                  0

it              lt0             lt_diff         q_diff
0               6161.36         -               -               SDE has stable fixed points for c=0, c_light, c_deep
100             6167.78         1.78945         -0.977755       SDE has stable fixed points for c=0, c_light, c_deep
200             6166.55         -1.33171        1.6072          SDE has stable fixed points for c=0, c_light, c_deep
300             6168.09         3.65324         -2.78453        SDE has stable fixed points for c=0, c_light, c_deep
400             6167.77         -3.49427        2.32659         SDE has stable fixed points for c=0, c_light, c_deep
500             6166.76         -0.703634       0.579129        SDE has stable fixed points for c=0, c_light, c_deep
600             6167.87         -2.22508        1.55985         SDE has stable fixed points for c=0, c_light, c_deep
700             6168.79         -3.00289        2.28211         SDE has stable fixed points for c=0, c_light, c_deep
800             6163.34         -2.11927        1.96512         SDE has stable fixed points for c=0, c_light, c_deep
900             6166.06         -2.03608        1.52879         SDE has stable fixed points for c=0, c_light, c_deep
1000            6167.45         0.593645        -0.255105       SDE has stable fixed points for c=0, c_light, c_deep

Acceptance rate : 0.765


######
# Generates predicted (counterfactual) time series of arrivals for
# greylisted countries had they NOT been greylisted
# Uses GBM and past arrivals data for predictions
# Includes estimated std errors for OPE estimates of value of greylisting
######

library(gbm)
library(ggplot2)
library(reshape2)

##########################
# read in files + preprocess
##########################

# read in SAMPLE full data
dat <- read.csv("../sample_data.csv")

# convert types, remove everything on/after 11/1 (end of CF analysis)
dat$date_entry <- as.Date(dat$date_entry, format = "%Y-%m-%d")
dat <- dat[dat$date_entry <= as.Date("2020-11-01", format = "%Y-%m-%d"),]
dat$to_test <- as.integer(as.character(dat$to_test) %in% c("true", "flag"))
dat$sent_for_test <- as.integer(!is.na(dat$sent_for_test) | dat$test_result %in% c("positive", "undefined"))

# subset vars of interest: country, arrivals & info for estimating show rate
arrivals <- dat[, c("country", "date_entry", "to_test", "sent_for_test")]
arrivals$count <- 1
arrivals <- aggregate(arrivals[,c("count", "to_test", "sent_for_test")],
                      by = list(arrivals$country, arrivals$date_entry), FUN = sum)
names(arrivals) <- c("country", "date", "plf", "to_test", "sent_for_test")

# identify countries as white/black/grey
ctry_white_list <- read.csv("https://raw.githubusercontent.com/ovelixasterix/greek_project/master/countries_allowed.csv", header = FALSE)
arrivals$white <- as.logical(as.character(arrivals$country) %in% ctry_white_list[,1])
grey_list_se <- read.csv("https://raw.githubusercontent.com/ovelixasterix/greek_project/master/grey_list_start_end.csv")
grey_list_se$start_date <- as.Date(grey_list_se$start_date, format = "%Y-%m-%d")
grey_list_se$end_date <- as.Date(grey_list_se$end_date, format = "%Y-%m-%d")
grey_list_se[is.na(grey_list_se$end_date),]$end_date <- as.Date("2022-01-01")
arrivals$grey <- FALSE
for(i in 1:nrow(arrivals)){
  ind <- which(grey_list_se$country == as.character(arrivals$country)[i])
  if(length(ind) > 0){
    arrivals$grey[i] <- as.logical(arrivals$date[i] >= grey_list_se[ind,]$start_date &
                                     arrivals$date[i] <= grey_list_se[ind,]$end_date)
  }
}

# smooth arrivals time series in a 7-day window, but only if same grey status
# smooth showup time series similarly
arrivals$sm_plf <- NA
arrivals$showup <- NA
for(i in 1:nrow(arrivals)){
  ind <- which(arrivals$country == arrivals$country[i] & arrivals$grey == arrivals$grey[i] &
                 abs(arrivals$date - arrivals$date[i]) <= 3)
  arrivals$sm_plf[i] <- mean(arrivals[ind,]$plf)
  arrivals$showup[i] <- mean(arrivals[ind,]$sent_for_test/arrivals[ind,]$to_test, na.rm = TRUE)
}

# add features on # arrivals in each category
arrivals$tot_white <- NA
arrivals$tot_black <- NA
for(i in 1:nrow(arrivals)){
  arrivals$tot_white[i] <- sum(arrivals[arrivals$date == arrivals$date[i] & arrivals$white,]$sm_plf)
  arrivals$tot_black[i] <- sum(arrivals[arrivals$date == arrivals$date[i] & !arrivals$white,]$sm_plf)
}
arrivals$white <- as.integer(arrivals$white)

arrivals$country <- as.factor(arrivals$country)

##########################
# predict greylist counterfactual arrivals
##########################

# test data
test <- arrivals[arrivals$grey,]
test$date <- as.integer(test$date - min(arrivals$date))

# train + validation set on non-grey
tmp <- arrivals[!arrivals$grey,]
tmp$date <- as.integer(tmp$date - min(arrivals$date))

# randomly split into train and validation set
n <- round(nrow(tmp)*.7)
ind <- sample(1:nrow(tmp))[1:n]
train <- tmp[ind,]
val <- tmp[-ind,]

# fit GBM model on train and predict on validation set
fit <- gbm(sm_plf ~ country + date + white + tot_white + tot_black, data = train, distribution = "gaussian", n.trees = 500,
           bag.fraction = .75, cv.folds = 5, interaction.depth = 9)
pred_val <- predict(fit, newdata = val)
summary(fit)

# get standard deviation of residuals on validation set
residuals <- pred_val-val$sm_plf
hist(residuals)
sd_val <- sd(residuals)

# retrain on entire dataset (train + val)
fit <- gbm(sm_plf ~ country + date + white + tot_white + tot_black, data = rbind(train, val), distribution = "gaussian", n.trees = 500,
           bag.fraction = .75, cv.folds = 5, interaction.depth = 9)

# test set predictions
pred_grey <- predict(fit, newdata = test)
test <- cbind(test, "pred_arr" = pred_grey, "sd_arr" = sd_val)

# predict on past data
grey <- unique(as.character(test$country))
dat <- arrivals[(as.character(arrivals$country) %in% grey) & !arrivals$grey,]
dat$date <- as.integer(dat$date - min(arrivals$date))
dat$pred_arr <- predict(fit, newdata = dat)
dat$sd_arr <- sd_val

# combine with test set
dat <- dat[,c("country", "date", "sm_plf", "pred_arr", "sd_arr", "showup")]
dat <- rbind(dat, test[,c("country", "date", "sm_plf", "pred_arr", "sd_arr", "showup")])
dat$date <- as.Date(dat$date + min(arrivals$date))

# scale arrivals, predictions & sd by showup rates
dat$showup <- pmin(dat$showup, 1)
dat$pred_arr <- dat$pred_arr * dat$showup
dat$sm_plf <- dat$sm_plf * dat$showup
dat$sd_arr <- dat$sd_arr * dat$showup

# make sure arrivals are non-negative
dat$pred_arr <- pmax(dat$pred_arr, 0)

# make sure counterfactual arrivals is below observed prevalence
# i.e., requiring negative-PCR pretest cannot increase arrivals
dat$pred_arr <- pmax(dat$pred_arr, dat$sm_plf)

write.csv(dat, "../OPE_outputs/grey_predarr.csv")


library(eNetXplorer)

dn.enet = "results/Soma_70genes/"
dn.fig = str_replace(dn.enet, "results", "figures")
dir.create(dn.fig, showWarnings = F, recursive = T)
fn.run = file.path(dn.enet, "enet_data.Rdata")

load(fn.run, verbose = T)

a = 0
ai = which.min(abs(result$alpha - a))
albl = paste0("a",a)

feature = result$feature

freq.mean = result$feature_freq_mean[,ai]
freq.sd = result$feature_freq_sd[,ai]
freq.pval = result$feature_freq_model_vs_null_pval[,ai]
coef.mean = result$feature_coef_wmean[,ai]
coef.sd = result$feature_coef_wsd[,ai]
coef.pval = result$feature_coef_model_vs_null_pval[,ai]
DF.model = data.frame(feature, freq.mean, freq.sd, freq.pval, coef.mean, coef.sd, coef.pval, model="model")

freq.mean = result$null_feature_freq_mean[,ai]
freq.sd = result$null_feature_freq_sd[,ai]
coef.mean = result$null_feature_coef_wmean[,ai]
coef.sd = result$null_feature_coef_wsd[,ai]
DF.null = data.frame(feature, freq.mean, freq.sd, freq.pval, coef.mean, coef.sd, coef.pval, model="null")

DF.stat = rbind(DF.model, DF.null) %>%
  mutate(model = factor(model, levels=c("null","model"))) %>%
  mutate(feature = factor(feature, levels=sort(unique(feature), decreasing=T)))

# scatter plot of predictin performance
DF.plot = data.frame(
  sample = rownames(result$predictor),
  measured = result$response,
  pred_mean = result$predicted_values[[ai]][,1],
  pred_sd = result$predicted_values[[ai]][,2]
) %>%
  separate(sample, c("subject","visit"), sep="_", remove=F)

df.cor = data.frame(x=Inf, y=-Inf,
                    label=sprintf("Pearson correlation: %.2g (p = %.3g)",
                                  result$model_QF_est[albl], result$QF_model_vs_null_pval[albl]))

ggplot(DF.plot, aes(measured, pred_mean, col=visit)) +
  geom_point() +
  geom_errorbar(aes(ymin=pred_mean-pred_sd, ymax=pred_mean+pred_sd), width=0.1) +
  geom_smooth(method="lm", alpha=0.2, col="red", lty=2) +
  # geom_text(aes(label=sub("s","",subject)), hjust=-0.3, size=3) +
  geom_text(data=df.cor, aes(x,y,label=label), hjust=1.1, vjust=-1, inherit.aes = F) +
  xlab("Actual GA") +
  ylab("Out-of-bag Predicted GA") +
  theme_bw()
fn.fig = file.path(dn.fig, sprintf("eNet_%s_scatter", albl))
ggsave(file=paste0(fn.fig, ".png"), w=6, h=5)
ggsave(file=paste0(fn.fig, ".pdf"), w=6, h=5, useDingbats=FALSE)


#' Metabolite set enrichment analysis (MSEA) using pathway knowledge curated by Metabolon
#'
#' A function that returns the pathway enrichment score for all perturbed metabolites in a patient's full metabolomic profile.
#' @param allSimMatrices - A list of all similarity matrices, across all k for a given graph, or across many graphs.
#' @export mle.getMinPtDistance
#' @examples
#' # Get patient distances
#' data_mx.pvals = apply(data_mx, c(1,2), function(i) 2*pnorm(abs(i), lower.tail = FALSE))
#' res = list()
#' t = list(ncd=matrix(NA, nrow=ncol(data_mx), ncol=ncol(data_mx)))
#' rownames(t$ncd) = colnames(data_mx)
#' colnames(t$ncd) = colnames(data_mx)
#' for (i in 1:kmx) {
#'   res[[i]] = t
#' }
#' for (pt in 1:ncol(data_mx)) {
#'   print(pt)
#'   ptID = colnames(data_mx)[pt]
#'   for (pt2 in pt:ncol(data_mx)) {
#'     ptID2 = colnames(data_mx)[pt2]
#'     tmp = mle.getPtSim(ptBSbyK[[ptID]], ptID, ptBSbyK[[ptID2]], ptID2, data_mx, ranks)
#'     for (k in 1:kmx) {
#'       res[[k]]$ncd[ptID, ptID2] = tmp$NCD[k]
#'       res[[k]]$ncd[ptID2, ptID] = tmp$NCD[k]
#'     }
#'   }
#' }
#' patientSimilarity = mle.getMinPtDistance(res)
mle.getMinPtDistance = function(allSimMatrices) {
  ptSim = matrix(1000, nrow=nrow(allSimMatrices[[1]]), ncol=ncol(allSimMatrices[[1]]))
  for (ind in 1:length(allSimMatrices)) {
    for (n1 in 1:nrow(allSimMatrices[[ind]])) {
      for (n2 in 1:ncol(allSimMatrices[[ind]])) {
        ptSim[n1, n2] = min(ptSim[n1, n2], allSimMatrices[[ind]][n1, n2])
      }
    }
  }

  return(ptSim)
}


# Fit the ovarian and prostate cancer model by Aki,
# using cmdstanr (as opposed to the functions in cmdStanTools.R,
# as is done in the ovarian.r script).

rm(list = ls())
gc()
set.seed(1954)

# modelName <- "bernoulli_logit_glm_ela"
# modelName <- "skim_logit_ela"
modelName <- "skim_logit"

setwd("~/Desktop/Code/laplace_approximation/Script/")
.libPaths("~/Rlib")

# Setting for habenero cluster
# setwd("/rigel/home/ccm2172/laplace_approximation/Script")
# .libPaths("/rigel/home/ccm2172/Rlib")

scriptDir <- getwd()
modelDir <- file.path(scriptDir, "models3")
dataDir <- file.path(scriptDir, "data")
outDir <- file.path(scriptDir, "deliv", modelName)
delivDir <- file.path("deliv", modelName)

# dataFile <- "prostate_full.data.R"
dataFile <- "prostate_200.data.R"
# dataFile <- "ovarian_reduced.data.R"

library(rstan)
library(cmdstanr)
set_cmdstan_path("~/Desktop/Code/laplace_approximation/cmdStan/")
# set_cmdstan_path("/rigel/home/ccm2172/laplace_approximation/cmdStan")
library(parallel)
source(file.path("tools", "cmdStanTools.r"))
source(file.path("tools", "stanTools.r"))

## Take a look at the data
data <- read_rdump(file.path(dataDir, dataFile))
## faster with just 100 covariates
## (for ovarian, we include the most relevant one)
# Comment out to fit the full data set.

if(FALSE) {
  data$x <- data$x[, (data$d - 99):data$d]

  # If we only retain a subset of x, we need to adjust tau and d.
  data$p <- ncol(data$x)
  p0 <- 5
  sigma <- with(data, sqrt(1 / mean(y) / (1 - mean(y))))
  data$scale_global <- with(data, p0 / (p - p0) * sigma / sqrt(n))
  data$d <- ncol(data$x)

  # Update the Rdump file
  dataFile <- "prostate.data.R"
  with(data, stan_rdump(ls(data), file.path(dataDir, dataFile)))
}

# compile model using cmdstanr
if (TRUE) {
  file <- file.path(modelDir, modelName, paste0(modelName, ".stan"))
  mod <- cmdstan_model(file)
}

nChains <- 2
num_cores <- min(nChains, detectCores())

fit <- mod$sample(
  data = data, num_chains = nChains, num_cores = num_cores,
  num_warmup = 500, num_samples = 500, seed = 123,
  adapt_delta = 0.8, term_buffer = 10)

# CHECK -- do we need to create an rstan fit object?
stanfit <- read_stan_csv(fit$output_files())
saveRDS(stanfit, file = file.path(outDir, paste(modelName, "200_Fit.Rsave", sep = "")))
check_div(stanfit)

parms <- c("log_lambda[1]", "log_lambda[2]", "log_lambda[3]",
           "tau", "caux")

pdf(file = file.path(delivDir, paste(modelName,"Plots%03d.pdf",  sep = "")),
    width = 6, height = 6, onefile = F)

mcmcHistory(stanfit, parms)
mcmcDensity(stanfit, parms, byChain = TRUE)
mcmcDensity(stanfit, parms)
# pairs(fit, parms)

dev.off()

ptable <- parameterTable(stanfit, parms)
time <- sum(colSums(get_elapsed_time(stanfit)))
eff <- ptable[, 9] / time
eff_bulk <- ptable[, 21] / time
eff_tail <- ptable[, 22] / time
ptable <- cbind(ptable, eff, eff_bulk, eff_tail)

write.csv(ptable, file = file.path(delivDir, paste(modelName,
          "ParameterTable.csv", sep = "")))

ptable[, c(1:3, 21, 22, 24, 25)]

ptable_standard <- ptable
ptable_standard[, c(1:3, 21, 22, 24, 25)]


context("Checks and errors")

# ------------------------------------------------------------------------------
test_that("Error passing arguents", {
  fun0 <- function(x) {}
  fun1 <- function(x, a) {}
  fun2 <- function(x, a, b) {}

  expect_error(MCMC(fun0, initial = 1, nsteps = 10000, a=1), "not present in -fun")
  expect_error(MCMC(fun1, initial = 1, nsteps = 10000), "has extra arguments")
  expect_error(MCMC(fun2, initial = 1, nsteps = 10000, a=1), "requires more arguments")

})

# test_that("Checking errors", {
#
#   ll <- function(p) {
#     ans <- sum(log(dnorm(y - p[1] - x*p[2], sd = p[3])))
#     if (!is.finite(ans))
#       return(-.Machine$double.xmax*1e-10)
#     ans
#   }
#
#   expect_error(MCMC(ll, initial = 1, nsteps = 2000), "must be a number")
#   expect_error(MCMC(ll, initial = 1, nsteps = 2000), "must be of length")
# })

# ------------------------------------------------------------------------------
test_that("Check of initial values", {

  init <- c(.4, .1)
  expect_equivalent(check_initial(init, 1), matrix(init, nrow=1))
  expect_equivalent(
    suppressWarnings(check_initial(init, 2)), matrix(init, nrow=2, ncol=2, byrow=TRUE)
    )

  init <- matrix(1:9, ncol=3)
  expect_equivalent(check_initial(init, 3), init)
  ## Not run:

  expect_error(check_initial(init, 2), "number of rows") # Returns an error

})


# define string formatting
`%--%` <- function(x, y)
  # from stack exchange:
  # https://stackoverflow.com/questions/46085274/is-there-a-string-formatting-operator-in-r-similar-to-pythons
{
  do.call(sprintf, c(list(x), y))
}

results <- data.frame(matrix(0, ncol = 6, nrow = 3))
colnames(results) <- c("BART-Int", "BART-Int-se", "GPBQ", "GPBQ-se", "MI", "MI-se")
dims = c(30, 40, 50)
l = 1
for (dim in dims) {
  bart = c()
  gp = c()
  mi = c()
  for (num_cv in 1:20) {
    df <- read.csv("results/rares/3/portfolio_lossDim%sExponential_%s.csv" %--% c(dim, num_cv))
    bart = c(bart, df$BARTMean)
    gp = c(gp, df$GPMean)
    mi = c(mi, df$MIMean)
  }
  if (dim == 1) {actual<-1e-05}
  if (dim == 3) {actual <- 1e-05}
  if (dim == 5) {actual <- 0.0171328}
  if (dim == 10) {actual<-0.0681249}
  if (dim == 20) {actual<-0.068942}
  if (dim == 30) {actual<-0.068855}
  results[l, 1] = signif(mean(abs(bart - actual) / actual), 3)
  results[l, 2] = signif(sd(abs(bart - actual) / actual) / sqrt(20), 3)
  results[l, 3] = signif(mean(abs(gp - actual) / actual), 3)
  results[l, 4] = signif(sd(abs(gp - actual) / actual) / sqrt(20), 3)
  results[l, 5] = signif(mean(abs(mi - actual) / actual), 3)
  results[l, 6] = signif(sd(abs(mi - actual) / actual) / sqrt(20),3)

  l = l+1
}
print(results)
write.csv(results, "results/rares/rares.csv")


#' Draw meanfield model attractor
#'
#' @param model
#' @param times
#' @param parms
#' @param method
#' @param rho
#' @param colors
#'
#' @return
#' @import deSolve
#' @export
#' @examples
#'
#' plot_meanfield(livestock)
#'
plot_meanfield <- function(
  model,
  func = model$meanfield,
  parms = model$parms,
  times = c(0,1000),
  method = "ode45",
  rho_x = seq(0,1,length = 100),
  col = c("#000000","#009933"),
  new = FALSE
  ) {

    # open new base plot if none exists
    if(dev.cur() == 1 | new == TRUE) plot_base()

    # draw functions of mortality and growth
    lines(rho_x, mortality(ini_rho(rho_x), parms), col = col[1], lwd = 2)
    lines(rho_x, growth(ini_rho(rho_x), parms), col = col[2], lwd = 2)

    eq <- get_equilibria(y = model$template, func = func, parms = parms)

    # draw points
    points(c(eq$lo[1],eq$hi[1]), growth(ini_rho(c(eq$lo[1],eq$hi[1]), c(eq$lo[1],eq$hi[1])), parms), xpd = TRUE, pch = 20, cex = 2)
    points(eq$mid[1],growth(ini_rho(eq$mid[1],eq$mid[1]),parms), xpd = TRUE, pch = 21, cex = 1.5, bg = "white")

}


library(tidyverse)

data <- read.csv('C:/Users/Harol/Downloads/ALL_DATA_2.csv')

# removing outliers
summary(data)

data$bike[data$bike < 0] <- 0
data$bike[data$bike >1000] <- 0

data$lorry[data$lorry < 0] <- 0
data$lorry[data$lorry >1000] <- 0

data$pedestrian[data$pedestrian < 0] <- 0
data$pedestrian[data$pedestrian >1000] <- 0

data$car[data$car < 0] <- 0
data$car[data$car >1000] <- 0

data$bucket0[data$bucket0 < 0] <- 0
data$bucket0[data$bucket0 >1000] <- 0

data$bucket1[data$bucket1 < 0] <- 0
data$bucket1[data$bucket1 >1000] <- 0

data$bucket2[data$bucket2 < 0] <- 0
data$bucket2[data$bucket2 >1000] <- 0

data$bucket3[data$bucket3 < 0] <- 0
data$bucket3[data$bucket3 >1000] <- 0

data$bucket4[data$bucket4 < 0] <- 0
data$bucket4[data$bucket4 >1000] <- 0

data$bucket5[data$bucket5 < 0] <- 0
data$bucket5[data$bucket5 >1000] <- 0

data$bucket6[data$bucket6 < 0] <- 0
data$bucket6[data$bucket6 >1000] <- 0

data$bucket7[data$bucket7 < 0] <- 0
data$bucket7[data$bucket7 >1000] <- 0

data$pct_up[data$pct_up < 0] <- 0
data$pct_up[data$pct_up > 1] <- 0
summary(data)

outlier_remover <- function(input_data){
  start_value <- grep("bike", colnames(input_data))
  for(i in start_value:ncol(input_data)){
  f <- fivenum(data[,i])
  f
  IQR <- f[4]-f[2]
  data[,i][data[,i] >f[4] + 5*IQR | data[,i] <f[2] - 5*IQR]
  }
}
outlier_remover(data)

summary(data)


# This code assumes you've downloaded and unzipped the file
#   exdata-data-NEI_data.zip in your working directory.  If you haven't it's
#   easy enough to write the code to check using file.exists etc

## This first line will likely take a few seconds. Be patient!
NEI <- readRDS("summarySCC_PM25.rds")
SCC <- readRDS("Source_Classification_Code.rds")

# Plot 6
# Subset as before, this time for motor vehicles
# Gather the subset of the NEI data which corresponds to vehicles
cars <- grepl("vehicle",
              SCC$SCC.Level.Two,
              ignore.case = TRUE)

carsSCC <- SCC[cars,]$SCC

carsNEI <- NEI[NEI$SCC %in% carsSCC,]

# Get Baltimore data...

BaltCars <- carsNEI[carsNEI$fips == "24510",]

# Add a city to BaltCars
BaltCars$city <- "Baltimore City"

# Now subset LA motor vehicle data
LACars <- carsNEI[carsNEI$fips == "06037",]
LACars$city <- "Los Angeles County"

# Bind both LA and Baltimore together

LA.Balt <- rbind(LACars, BaltCars)

library(ggplot2)

png(filename = "plot6.png",
    width = 640,
    height = 480)

ggplot(LA.Balt,aes(factor(year), Emissions, fill = "city")) +
  geom_bar(stat = "identity", fill = "grey") +
  theme_bw() +
  guides(fill = FALSE) +
  facet_grid(scales = "free", space = "free", . ~ city) +
  labs(x = "Year", y = expression("Total PM"[2.5]*" Emission (Tons)")) +
  ggtitle(expression(atop("Plot 6: PM"[2.5]*" Motor Vehicle Related Source Emissions 1999-2008",
                          atop("Baltimore City and LA County"))))
dev.off()


# Copyright (c) MAQ Software.  All rights reserved.

# Third Party Programs. This software enables you to obtain software applications from other sources.
# Those applications are offered and distributed by third parties under their own license terms.
# MAQ Software is not developing, distributing or licensing those applications to you, but instead,
# as a convenience, enables you to use this software to obtain those applications directly from
# the application providers.
# By using the software, you acknowledge and agree that you are obtaining the applications directly
# from the third party providers and under separate license terms, and that it is your responsibility to locate,
# understand and comply with those license terms.
# Microsoft grants you no license rights for third-party software or applications that is obtained using this software.

#
# WARNINGS:
#
# CREATION DATE: 06/12/2017
#
# LAST UPDATE: --/--/---
#
# VERSION: 3.0.0
#
# R VERSION TESTED: 3.4.2
#
# AUTHOR: MAQ Software

source('./r_files/flatten_HTML.r')
# graphics libraries
libraryRequireInstall("ggplot2");
libraryRequireInstall("plotly");
#clustering libraries
libraryRequireInstall("dbscan");

############################################

#optics clustering
version<-packageVersion("dbscan")

tryCatch({

##################################################
xdataFrame<-data.frame(Value1)
ydataFrame<-data.frame(Value2)
##################################################
nColumnsY<-NCOL(ydataFrame)
nColumnsX<-NCOL(xdataFrame)
nRowsY<-NROW(ydataFrame)
nRowsX<-NROW(xdataFrame)

ynumericCheck<-sapply(ydataFrame, is.numeric)
xnumericCheck<-sapply(xdataFrame, is.numeric)

epsilon<-1
if(exists("clusterSettings_epsilon") && clusterSettings_epsilon > 1)
{
  epsilon<-clusterSettings_epsilon
}

minptsClust<-10
if(exists("clusterSettings_minptsClust") && clusterSettings_minptsClust > 1)
{
  minptsClust<-clusterSettings_minptsClust
}

steepThres<-0.08
if(exists("clusterSettings_steepThres") && clusterSettings_steepThres > 0 && clusterSettings_steepThres < 1)
{
  steepThres<-clusterSettings_steepThres
}

steepThres <- as.numeric(steepThres)
####################################################
plotColor<-"#FFFFFF"
if(exists("plotSettings_plotColor"))
{
  plotColor<-plotSettings_plotColor
}
###############################
### x axis settings######

xTitle <- names(xdataFrame)[1]
if(exists("xaxisSettings_xTitle") && xaxisSettings_xTitle!= '')
{
    xTitle<-xaxisSettings_xTitle
}

if(nColumnsX > 1) {
  xTitle<- paste(xTitle, "(PCA 1)", sep=" ")
}

xZeroline<-TRUE
if(exists("xaxisSettings_xZeroline"))
{
    xZeroline<-xaxisSettings_xZeroline
}

xLabels<-TRUE
if(exists("xaxisSettings_xLabels"))
{
    xLabels<-xaxisSettings_xLabels
}

xGrid<-TRUE
if(exists("xaxisSettings_xGrid"))
{
    xGrid<-xaxisSettings_xGrid
}

xGridCol<-"#BFC4C5"
if(exists("xaxisSettings_xGridCol"))
{
    xGridCol<-xaxisSettings_xGridCol
}

xGridWidth<-0.1
if(exists("xaxisSettings_xGridWidth") && xaxisSettings_xGridWidth <= 5 && xaxisSettings_xGridWidth >= 0.1)
{
    xGridWidth<-xaxisSettings_xGridWidth
}

xAxisBaseLine<-TRUE
if(exists("xaxisSettings_xAxisBaseLine"))
{
    xAxisBaseLine<-xaxisSettings_xAxisBaseLine
}

xAxisBaseLineCol<-"#000000"
if(exists("xaxisSettings_xAxisBaseLineCol"))
{
    xAxisBaseLineCol<-xaxisSettings_xAxisBaseLineCol
}

xAxisBaseLineWidth<-4
if(exists("xaxisSettings_xAxisBaseLineWidth") && xaxisSettings_xAxisBaseLineWidth <= 11 && xaxisSettings_xAxisBaseLineWidth >= 1)
{
    xAxisBaseLineWidth<-xaxisSettings_xAxisBaseLineWidth
}

##############################
####y axis settings ########

yTitle <- names(ydataFrame)[1]
if(exists("yaxisSettings_yTitle") && yaxisSettings_yTitle!='')
{
    yTitle<-yaxisSettings_yTitle
}
if(nColumnsY > 1) {
  yTitle<- paste(yTitle, "(PCA 1)", sep=" ")
}

yZeroline<-TRUE
if(exists("yaxisSettings_yZeroline"))
{
    yZeroline<-yaxisSettings_yZeroline
}

yLabels<-TRUE
if(exists("yaxisSettings_yLabels"))
{
    yLabels<-yaxisSettings_yLabels
}

yGrid<-TRUE
if(exists("yaxisSettings_yGrid"))
{
    yGrid<-yaxisSettings_yGrid
}

yGridCol<-"#BFC4C5"
if(exists("yaxisSettings_yGridCol"))
{
    yGridCol<-yaxisSettings_yGridCol
}

yGridWidth<-0.1
if(exists("yaxisSettings_yGridWidth") && yaxisSettings_yGridWidth <= 5 && yaxisSettings_yGridWidth >= 0.1)
{
    yGridWidth<-yaxisSettings_yGridWidth
}

yAxisBaseLine<-TRUE
if(exists("yaxisSettings_yAxisBaseLine"))
{
    yAxisBaseLine<-yaxisSettings_yAxisBaseLine
}

yAxisBaseLineCol<-"#000000"
if(exists("yaxisSettings_yAxisBaseLineCol"))
{
    yAxisBaseLineCol<-yaxisSettings_yAxisBaseLineCol
}

yAxisBaseLineWidth<-4
if(exists("yaxisSettings_yAxisBaseLineWidth") && yaxisSettings_yAxisBaseLineWidth <= 11 && yaxisSettings_yAxisBaseLineWidth >= 1)
{
    yAxisBaseLineWidth<-yaxisSettings_yAxisBaseLineWidth
}
############################################################
############################################################
###################plot setting lists#############

xAesthetics <- list(
  title = xTitle,
  zeroline = xZeroline,
  showticklabels = xLabels,
  showgrid = xGrid,
  gridcolor = toRGB(xGridCol),
  gridwidth = xGridWidth,
  showline = xAxisBaseLine,
  linecolor=toRGB(xAxisBaseLineCol),
  linewidth=xAxisBaseLineWidth
)
yAesthetics <- list(
  title = yTitle,
  zeroline = yZeroline,
  showticklabels = yLabels,
  showgrid = yGrid,
  gridcolor = toRGB(yGridCol),
  gridwidth = yGridWidth,
  showline = yAxisBaseLine,
  linecolor=toRGB(yAxisBaseLineCol),
  linewidth=yAxisBaseLineWidth
)

############################################################
############################################################
############################################################
###################methods to handle missing values and tooltips#########

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

getTooltips<- function(){
  xInfo1<-Value1[1]
  yInfo1<-Value2[1]
  colnames(xInfo1)<-c("X")
  colnames(yInfo1)<-c("Y")
  xInfo1<-data.frame(xInfo1)
  yInfo1<-data.frame(yInfo1)
  if(exists("Tooltip"))
  {
    tooltip1<-Tooltip
    x <- cbind(
      x = finalXvector,
      y = finalYvector,
      tooltip=tooltip1,
      xInfo=xInfo1,
      yInfo=yInfo1
    )
  }
  else{
    x <- cbind(
      x = finalXvector,
      y = finalYvector,
      xInfo=xInfo1,
      yInfo=yInfo1
    )
  }

  return (x)
}

dataScaling <- function (dataFrame)
{
  nMin<--3
  nMax<-3
  min<-min(dataFrame)
  max<-max(dataFrame)
  nX = nMin + (nMax - nMin) * (dataFrame - min)/(max - min)
  return(nX)
}

###############################################################
#handle missing values and generalize different formats of data

for(iCounter in 1:nColumnsY)
{
  if(ynumericCheck[iCounter]==FALSE)
  {
    modeValue <- getmode(ydataFrame[,iCounter])
    for(jCounter in 1:nRowsY)
    {
      if(is.na(ydataFrame[jCounter,iCounter]))
      {
        ydataFrame[jCounter,iCounter]<-modeValue
      }
    }
    uniqueLevels<-levels(ydataFrame[,iCounter])
    levels(ydataFrame[,iCounter])<-1:NROW(uniqueLevels)
    ydataFrame[,iCounter] <- as.numeric(as.character(ydataFrame[,iCounter]))
  }

  if(ynumericCheck[iCounter]==TRUE)
  {
    meanValue <- mean(ydataFrame[,iCounter], trim =0 , na.rm=TRUE)
    for(jCounter in 1:nRowsY)
    {
      if(is.na(ydataFrame[jCounter,iCounter]))
      {
        ydataFrame[jCounter,iCounter]<-meanValue
      }
    }
  }
}

for(iCounter in 1:nColumnsX)
{
  if(xnumericCheck[iCounter]==FALSE)
  {
    xModeValue <- getmode(xdataFrame[,iCounter])
    for(jCounter in 1:nRowsX)
    {
      if(is.na(xdataFrame[jCounter,iCounter]))
      {
        xdataFrame[jCounter,iCounter]<-xModeValue
      }
    }
    uniqueLevels<-levels(xdataFrame[,iCounter])
    levels(xdataFrame[,iCounter])<-1:NROW(uniqueLevels)
    xdataFrame[,iCounter] <- as.numeric(as.character(xdataFrame[,iCounter]))
  }

  if(xnumericCheck[iCounter]==TRUE)
  {
    xMeanValue <- mean(xdataFrame[,iCounter], trim =0 , na.rm=TRUE)
    for(jCounter in 1:nRowsX)
    {
      if(is.na(xdataFrame[jCounter,iCounter]))
      {
        xdataFrame[jCounter,iCounter]<-xMeanValue
      }
    }
  }
}

############################################################
############################################################
############################################################
###################data Scaling#############################

if (exists("clusterSettings_scaling") && clusterSettings_scaling) {
  scaledYdata<-ydataFrame;
  scaledXdata<-xdataFrame;
  for (iCounter in 1:nColumnsY) {
    tempF<-dataScaling(scaledYdata[,iCounter])
    scaledYdata[,iCounter]<-tempF
  }
  for (iCounter in 1:nColumnsX) {
    tempF<-dataScaling(scaledXdata[,iCounter])
    scaledXdata[,iCounter]<-tempF
  }
} else {
  maxYData<-max(ydataFrame)
  maxXData<-max(xdataFrame)
  maxXYData<-max(c(maxYData, maxXData))

  epsilon<-epsilon * ((maxXYData * 5) / 100)

  scaledYdata<-ydataFrame
  scaledXdata<-xdataFrame
}

scaledYdata<-data.frame(scaledYdata)
scaledXdata<-data.frame(scaledXdata)

############################################################
############################################################
############################################################
###PCA for dimensions both axis in case dimensions are >2###

if(NCOL(scaledYdata)>1)
{
  yVectorPCA<-prcomp(t(scaledYdata))
  yVectorPCA<-yVectorPCA$rotation
  yVectorPCA<-data.frame(yVectorPCA)
  yVectorPCA<-yVectorPCA[1]
}
if(NCOL(scaledXdata)>1)
{
  xVectorPCA<-prcomp(t(scaledXdata))
  xVectorPCA<-xVectorPCA$rotation
  xVectorPCA<-data.frame(xVectorPCA)
  xVectorPCA<-xVectorPCA[1]
}

############################################################
############################################################
############################################################
#################data binding###############################
if(NCOL(scaledYdata)>1)
{
finalYvector<-yVectorPCA
}
if(NCOL(scaledXdata)>1)
{
finalXvector<-xVectorPCA
}
if(NCOL(scaledYdata)==1)
{
  finalYvector<-scaledYdata
}
if(NCOL(scaledXdata)==1)
{
  finalXvector<-scaledXdata
}

colnames(finalYvector)<-c("y")
colnames(finalXvector)<-c("x")

#Data binding
x <- cbind(
    x = finalXvector,
    y = finalYvector
)

############################################################
############################################################
############################################################
#########clustering and plotting implementations############

# generating color palette for clusters by using Power BI Colors
colPalette<-c("#DFBFDF","#3599B8","#A66999","#FE9666","#8AD4EB","#F2C80F","#FD625E","#01B8AA")

############################################################
if(version<1){
  # handling for older libraries (used in Power BI app sevice)
res <- optics(x, eps = epsilon, minPts = minptsClust)
res <- opticsXi(res, xi = steepThres)
############################################################
}
else{
  # handling for newer libraries (Power BI desktop)
  res <- optics(x, eps = epsilon, minPts = minptsClust)
  res <- extractXi(res, xi = steepThres)
}

########## Function for hull plot ############
cl<-res
col<-colPalette
cex = 0.5
hull_lwd = 1
hull_lty = 1
solid = TRUE
alpha = .2
main = "OPTICS"

### extract clustering (keep hierarchical xICSXi structure)
if(is(cl, "xics") || "clusters_xi" %in% names(cl)) {
  clusters_xi <- cl$clusters_xi
  cl_order <- cl$order
} else clusters_xi <- NULL

if(is.list(cl)) cl <- cl$cluster
if(!is.numeric(cl)) stop("Could not get any cluster assigned as per the values and parameters entered.")

if(is.null(col)) col <- palette()
if(max(cl)+1L > length(col)) warning("Not enough colors to display clusters. Some colors may get reused.")

if(is.null(hull_lwd) || is.na(hull_lwd) || hull_lwd == 0) {
  hull_lwd <- 1
  border <- NA
}

if(is(cl, "xics") || "clusters_xi" %in% names(cl)) {
  ## this is necessary for larger datasets: Ensure largest is plotted first
  clusters_xi <- clusters_xi[order(-(clusters_xi$end-clusters_xi$start)),] # Order by size (descending)
  ci_order <- clusters_xi$cluster_id
} else { ci_order <- 1:max(cl) }

pointCol<-col[cl%%length(col) +1L]
p<-ggplot()

col_poly <- adjustcolor(col)
border <- col

for(i in 1:length(ci_order)) {

### use all the points for xICSXi's hierarchical structure
  if(is.null(clusters_xi)) {
    d <- x[cl==i,]
  }
  else {
    d <- x[cl_order[clusters_xi$start[i] : clusters_xi$end[i]],]
  }

    ch <- chull(d)
    ch <- c(ch, ch[1])

    polyCol<-col_poly[ci_order[i] %% length(col_poly) +1L]
    borderCol<-border[ci_order[i] %% length(col_poly) +1L]

     p<-p+geom_polygon(data=d[ch,], aes(x=x, y=y), fill= polyCol, colour=borderCol, alpha=0.2)

}
x<-getTooltips()
if(exists("Tooltip")){
  p<-p+geom_point(data = x, aes(x =x,y = y, xTooltip =X, yTooltip=Y, userTooltip=Tooltip), colour = pointCol)
  p<-ggplotly(p, tooltip=c('xTooltip','yTooltip','userTooltip'))%>%
  layout(title = '',
         xaxis = xAesthetics,
         yaxis = yAesthetics,
         margin = list(l = 50,
                       r=0,
                       t=50,
                       b=50),
         plot_bgcolor=plotColor
  )
}
else{
  p<-p+geom_point(data = x, aes(x =x,y = y, xTooltip =X, yTooltip=Y), colour = pointCol)
  p<-ggplotly(p, tooltip=c('xTooltip','yTooltip'))%>%
  layout(title = '',
         xaxis = xAesthetics,
         yaxis = yAesthetics,
         margin = list(l = 50,
                       r=0,
                       t=50,
                       b=50),
         plot_bgcolor=plotColor
  )
}

############################################################

#printing the plot on visual device
internalSaveWidget(config(p, collaborate = FALSE, displaylogo=FALSE), 'out.html');
quit()
},
error=function(e)
{
  #catching error and displaying message
  xAesthetics <- list(
     title = sprintf("Invalid parametric values/essential fields missing. %s",e),
     zeroline = FALSE,
     showline = FALSE,
     showticklabels = FALSE,
     showgrid = FALSE
     )
     yAesthetics <- list(
     title = "",
     zeroline = FALSE,
     showline = FALSE,
     showticklabels = FALSE,
     showgrid = FALSE
     )
     p <- plot_ly() %>%
     layout(title = '',
                     xaxis = xAesthetics,
                     yaxis = yAesthetics)
     internalSaveWidget(p, 'out.html');
     quit()
}
)