#Seed number for cross validation
SEED=2014

#Loading Required Libraries
library(RWeka)#for PrincipalComponentAnalysis filter
library(wavelets)#for discret wavelet transforms
library(nnet)#training simple layer neural network
library(matrixStats)#calculate std of columns
library(pls)#multivariate regression
library(monmlp)#training multilayer perceptron
library(e1071)#training SVM
library(prospectr)#preprocessing
library(kernlab)# training gaussian process
library(sqldf)#used for sampling dataset and cross validation split

RMSE=function(real,pred)
{
	nr=nrow(real)
	sm1=sqrt((1/nr)*(sum((real[,1]-pred[,1])^2)))
	return (sm1)
}

#Discrete Wavelet Transforms using Haar Algorithm
#DF1: input matrix for transform
#nTimes: number of iterations
HaarTransform=function(DF1,nTimes=1)
{
	w =function(k)
	{
		s1=dwt(k, filter="haar")
		return (s1@V[[1]])
	}
	Smt=DF1
	for (i in 1:nTimes)
	{
		Smt=t(apply(Smt,1,w))
	}
	return (data.frame(Smt))
}

#Getting Derivatives
#DF1: input matrix for transform
#D: Order
Derivative=function(DF1,D=1)
{
	df1=t(diff(t(DF1), differences = D))
	return(df1)
}

#train MLP on train and then predict test using weights gained by train
#train: train data frame for training
#test: test data frame to predict
#Other parameters are passed into monmlp function
#Result is predicted values for test
GetMLPPreds=function(train,test,Labels,Iters=100,Hidden1=5,Hidden2=5,IWeights=0.5,N.ensemble=10,LTh = tansig, LTo = linear,LTh.prime = tansig.prime, LTo.prime = linear.prime,Seed=1)
{
	gc()
	set.seed(Seed)
	m1=monmlp.fit(as.matrix(train),as.matrix(Labels),scale.y=T,n.trials = 1, hidden1=Hidden1, hidden2=Hidden2, n.ensemble=N.ensemble,Th = LTh, To = LTo,
	 Th.prime = LTh.prime, To.prime = LTo.prime,iter.max=Iters,monotone=NULL, bag=F, init.weights = c(-(IWeights),IWeights),max.exceptions = 10,silent = T)
	pr1=monmlp.predict(as.matrix(test),weights=m1)
	rm(m1)
	gc()
	return (data.frame(pr1))
}

#train simple layer neural network on train and then predict test using model gained by train
#train: train data frame for training
#test: test data frame to predict
#Other parameters are passed into nnet function
#Result is predicted values for test
GetNNETPreds=function(train,test,Labels,Size=10,Rang=0.5,Decay=0.1,Iters=100,MaxWts=1500)
{
	set.seed(1)
	g1=nnet((Labels)~.,data=train,size=Size,linout=T,skip =T, rang = Rang, decay = Decay,MaxNWts = MaxWts, maxit = Iters,trace=F)
	pr1=predict(g1,test)
	rm(g1)
	gc()
	return (data.frame(pr1))
}

#train SVM on train and then predict test using model gained by train
#train: train data frame for training
#test: test data frame to predict
#Other parameters are passed into SVM function in e1071 library
#Result is predicted values for test
GetSVMPreds=function(train,test,Labels,Cost=10000)
{
	set.seed(1)
	s1=svm(data.frame(train),Labels,scale = F,cost = Cost)
	pr1=(predict(s1,data.frame(test)))
	return (data.frame(pr1))
}

#train GaussianProcess on train and then predict test using model gained by train
#train: train data frame for training
#test: test data frame to predict
#Other parameters are passed into gausspr function in kernlab library
#Result is predicted values for test
GetGaussPreds=function(train,test,Labels,Kernel='rbfdot',Kpar='automatic',Tol=0.05,Var=0.01)
{
	set.seed(1)
	v1=gausspr(data.frame(train), (Labels),type= NULL, kernel=Kernel,
	          kpar=Kpar, var=Var, variance.model = T, tol=Tol, cross=0, fit=F)
	pr1=(predict(v1,data.frame(test)))
	rm(v1)
	gc()
	return (data.frame(pr1))
}

#train MVR on train and then predict test using model gained by train
#train: train data frame for training
#test: test data frame to predict
#Other parameters are passed into mvr function in pls library
#Result is predicted values for test
GetMVRPreds=function(train,test,Labels,Ncomp=120,Scale=True)
{
	set.seed(1)
	v1=mvr(Labels~.,data=data.frame(train),ncomp=Ncomp, method = pls.options()$pcralg,scale = T)
	pr1=data.frame(predict(v1,data.frame(test)))
	pr1=data.frame(rowMeans(pr1))
	rm(v1)
	gc()
	return (data.frame(pr1))
}

#Seprate data sets based on "Depth" variable and then train two seperate mlp models and then combine results
#train: train data frame for training
#test: test data frame to predict
#Other parameters are passed into monmlp function
#Result is predicted values for test
GetMLPDepthPreds=function(train,test,Labels,Iters=100,Hidden1=5,Hidden2=5,IWeights=0.5,N.ensemble=10,LTh = tansig, LTo = linear,LTh.prime = tansig.prime, LTo.prime = linear.prime,Seed=1)
{
	trainD1=train[train[,'Depth']==1,]
	trainD2=train[train[,'Depth']==2,]
	testD1=test[test[,'Depth']==1,]
	testD2=test[test[,'Depth']==2,]
	prD1=GetMLPPreds(trainD1,testD1,MyTarget[train[,'Depth']==1],Iters=Iters,Hidden1=Hidden1,Hidden2=Hidden2,IWeights=IWeights,N.ensemble=N.ensemble,LTh = LTh, LTo = LTo,LTh.prime = LTh.prime, LTo.prime = LTo.prime,Seed=Seed)
	colnames(prD1)[1]='pr'
	prD2=GetMLPPreds(trainD2,testD2,MyTarget[train[,'Depth']==2],Iters=Iters,Hidden1=Hidden1,Hidden2=Hidden2,IWeights=IWeights,N.ensemble=N.ensemble,LTh = LTh, LTo = LTo,LTh.prime = LTh.prime, LTo.prime = LTo.prime,Seed=Seed)
	colnames(prD2)[1]='pr'
	prD=rbind(prD1,prD2)
	prD[test[,'Depth']==1,1]=prD1
	prD[test[,'Depth']==2,1]=prD2
	return (data.frame(prD))
}

#Seprate data sets based on "Depth" variable and then train two seperate svm models and then combine results
#train: train data frame for training
#test: test data frame to predict
#Other parameters are passed into svm function
#Result is predicted values for test
GetSVMDepthPreds=function(train,test,Labels,Cost=10000)
{
	train=train
	test=test
	trainD1=train[train[,'Depth']==1,-ncol(train)]
	trainD2=train[train[,'Depth']==2,-ncol(train)]
	testD1=test[test[,'Depth']==1,-ncol(train)]
	testD2=test[test[,'Depth']==2,-ncol(train)]
	prD1=GetSVMPreds(trainD1,testD1,MyTarget[train[,'Depth']==1],Cost=Cost)
	colnames(prD1)[1]='pr'
	prD2=GetSVMPreds(trainD2,testD2,MyTarget[train[,'Depth']==2],Cost=Cost)
	colnames(prD2)[1]='pr'
	prD=rbind(prD1,prD2)
	prD[test[,'Depth']==1,1]=prD1
	prD[test[,'Depth']==2,1]=prD2
	return (data.frame(prD))
}

#Seprate data sets based on "Depth" variable and then train two seperate gaussian process models and then combine results
#train: train data frame for training
#test: test data frame to predict
#Other parameters are passed into gausspr function
#Result is predicted values for test
GetGaussDepthPreds=function(train,test,Labels,Kernel='rbfdot',Kpar='automatic',Tol=0.05,Var=0.01)
{
	train=train
	test=test
	trainD1=train[train[,'Depth']==1,-ncol(train)]
	trainD2=train[train[,'Depth']==2,-ncol(train)]
	testD1=test[test[,'Depth']==1,-ncol(train)]
	testD2=test[test[,'Depth']==2,-ncol(train)]
	prD1=GetGaussPreds(trainD1,testD1,MyTarget[train[,'Depth']==1],Kernel=Kernel,Kpar=Kpar,Tol=Tol,Var=Var)
	colnames(prD1)[1]='pr'
	prD2=GetGaussPreds(trainD2,testD2,MyTarget[train[,'Depth']==2],Kernel=Kernel,Kpar=Kpar,Tol=Tol,Var=Var)
	colnames(prD2)[1]='pr'
	prD=rbind(prD1,prD2)
	prD[test[,'Depth']==1,1]=prD1
	prD[test[,'Depth']==2,1]=prD2
	return (data.frame(prD))
}

#Seprate data sets based on "Depth" variable and then train two seperate mvr process models and then combine results
#train: train data frame for training
#test: test data frame to predict
#Other parameters are passed into mvr function
#Result is predicted values for test
GetMVRDepthPreds=function(train,test,Labels,Ncomp=120,Scale=True)
{
	train=train
	test=test
	trainD1=train[train[,'Depth']==1,-ncol(train)]
	trainD2=train[train[,'Depth']==2,-ncol(train)]
	testD1=test[test[,'Depth']==1,-ncol(train)]
	testD2=test[test[,'Depth']==2,-ncol(train)]
	prD1=GetMVRPreds(trainD1,testD1,MyTarget[train[,'Depth']==1],Ncomp=Ncomp,Scale=Scale)
	colnames(prD1)[1]='pr'
	prD2=GetMVRPreds(trainD2,testD2,MyTarget[train[,'Depth']==2],Ncomp=Ncomp,Scale=Scale)
	colnames(prD2)[1]='pr'
	prD=rbind(prD1,prD2)
	prD[test[,'Depth']==1,1]=prD1
	prD[test[,'Depth']==2,1]=prD2
	return (data.frame(prD))
}

#Calcule PCA using Weka PrincipalComponents filter
#df: input data frame
#var: variance parameter for PCA
WekPCA=function(df,var)
{
	pc=make_Weka_filter('weka/filters/unsupervised/attribute/PrincipalComponents')
	d1=pc(df[,1]~.,data=df[,-1],control=c('-R',var))
	return (d1[,-ncol(d1)])
}

#Combine train and test and then get rank of features based on their standard deviation
#trainDF:train data frame
#testDF:train data frame
#result is rank of features
GetRanksBySD=function(trainDF,testDF)
{
	TAT=rbind(trainDF,testDF)
	rnk=rank(colSds(as.matrix(TAT)))
	return (rnk)
}

#Reading Dataset
TrainAndTestM=read.csv('training.csv')
TrainAndTestM[,3595]=as.numeric(TrainAndTestM[,3595])
#################
#################
#Sampling Dataset based on TMAP variable
TMAP=sqldf('select distinct TMAP from TrainAndTestM order by TMAP')
set.seed(SEED)
TMAPS=data.frame(TMAP[sample(nrow(TMAP)),])
TMAPS=cbind(1:nrow(TMAPS),TMAPS)
colnames(TMAPS)[1]='Ord'
colnames(TMAPS)[2]='TMAP'
ttt=sqldf('select i.*,j.Ord from TrainAndTestM i left join TMAPS j on (i.TMAP=j.TMAP)')
TrainAndTest=TrainAndTestM[order(ttt[,'Ord']),]
#calcule partial PCs of combined data set
#devide data set into 30 sub frames and then getting PCs
#the combine sub-frames
PC=list()
for (i in 1:30)
{
	j1=(i-1)*119+2
	j2=(i)*119+1
	if (i==30)
	{
		j2=3579
	}
	temp1=TrainAndTest[,j1:j2]
	flush.console()
	PC[[i]]=WekPCA(cbind(TrainAndTest['Ca'],temp1),0.999)
}
PComponents=PC[[1]]
for (i in 2:30)
{
	PComponents=cbind(PComponents,PC[[i]])
}

#Multiple Scatter Correction on spectral features(two phases)
TrainAndTestReduced=msc(as.matrix(TrainAndTest[,2:3579]))
TrainAndTestReduced=msc(as.matrix(TrainAndTestReduced))

#First Derivatives
TrainAndTestReduced=Derivative(TrainAndTestReduced,1)

#Original data set(without transformation)
TrainAndTestOriginal=TrainAndTest[2:3600]

#Reduced Dataset(PCA,DWT)
TrainAndTestReduced=cbind(PComponents,data.frame(HaarTransform(TrainAndTestReduced,9)),TrainAndTest[,3580:3600])

#Creating data frame for submission
#submission=data.frame(PIDN=TestDataSet['PIDN'],Ca=1:nrow(TestDataSet),P=1:nrow(TestDataSet),pH=1:nrow(TestDataSet),SOC=1:nrow(TestDataSet),Sand=1:nrow(TestDataSet))
#k=2#Counter of submission columns
msm=0
nf=5
cat('Seed Number:',SEED,'\n')
for (TheTarget in c('Ca','P','pH','SOC','Sand'))
#for (TheTarget in c('pH'))
{
	cvsm=0
	cat (TheTarget,'.....................................................................\n')
	for (cv in 1:nf)
	{
		cat('CV',cv,':-------------------------------------\n')
		nd=floor(nrow(TrainAndTestReduced)/nf)
		testindexes=((cv-1)*nd+1):(cv*nd)
		#Retriving train and test data frames from original data set
		trainOriginal=TrainAndTestOriginal[-(testindexes),]
		testOriginal=TrainAndTestOriginal[(testindexes),]
		tstTRG=testOriginal[TheTarget]
		#Retriving train and test data frames from reduced data set
		trainReduced=TrainAndTestReduced[-(testindexes),]
		testReduced=TrainAndTestReduced[(testindexes),]

		ThisTarget=trainOriginal[,TheTarget]
		MyTarget=trainOriginal[,TheTarget]

		#Saturation and log transform for "P" target
		if (TheTarget=='P')
		{
			MyTarget=ifelse(MyTarget>6,6,MyTarget)
			MyTarget=log(1+MyTarget)
		}

		trainReduced=trainReduced[,!colnames(trainReduced)%in% c('Ca','P','pH','SOC','Sand')]
		testReduced=testReduced[,!colnames(testReduced)%in% c('Ca','P','pH','SOC','Sand')]
		trainOriginal=trainOriginal[,!colnames(trainOriginal)%in% c('Ca','P','pH','SOC','Sand')]
		testOriginal=testOriginal[,!colnames(testOriginal)%in% c('Ca','P','pH','SOC','Sand')]

		#Training and Prediction phase for "Ca" target
		if (TheTarget=='Ca')
		{
			flush.console()
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			MyTrain=savitzkyGolay(MyTrain, p = 3, w = 21, m = 0)#savitzkyGolay filter from prospectr library
			MyTest=savitzkyGolay(MyTest, p = 3, w = 21, m = 0)
			MyTrain=cbind(MyTrain,trainOriginal[c(3583,3586,3587,3588,3589,3591,3594)])
			MyTest=cbind(MyTest,testOriginal[c(3583,3586,3587,3588,3589,3591,3594)])
			Ca_SVM_Preds1=GetSVMPreds(MyTrain,MyTest,MyTarget,1000)
			cat('Ca_SVM_Preds1:',RMSE(data.frame(tstTRG),Ca_SVM_Preds1),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			Ca_SVM_Preds2=GetSVMPreds(trainOriginal,testOriginal,MyTarget,Cost=10000)
			cat('Ca_SVM_Preds2:',RMSE(data.frame(tstTRG),Ca_SVM_Preds2),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			Ca_SVM_Preds3=GetSVMPreds(trainOriginal,testOriginal,MyTarget,5000)
			cat('Ca_SVM_Preds3:',RMSE(data.frame(tstTRG),Ca_SVM_Preds3),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal
			MyTest=testOriginal
			SSS=(rbind(MyTrain,MyTest))
			#get first 2000 features order by their standard deviation
			ordr=colnames(SSS)[order(colSds(as.matrix(SSS)),decreasing=T)]
			MyTrain=MyTrain[,ordr[1:2000]]
			MyTest=MyTest[,ordr[1:2000]]
			MyTrain=HaarTransform(Derivative(MyTrain),3)
			MyTest=HaarTransform(Derivative(MyTest),3)
			Ca_SVM_Preds4=GetSVMPreds(MyTrain,MyTest,MyTarget,10000)
			cat('Ca_SVM_Preds4:',RMSE(data.frame(tstTRG),Ca_SVM_Preds4),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			#Get 2500 features with highest standard deviation
			rnk=GetRanksBySD(MyTrain,MyTest)
			MyTrain=MyTrain[,rnk<2500]
			MyTest=MyTest[,rnk<2500]
			MyTrain=cbind(HaarTransform(MyTrain,4),trainOriginal[c(3579:3581)])
			MyTest=cbind(HaarTransform(MyTest,4),testOriginal[c(3579:3581)])
			#Get average of 10 different mlp model with different seed numbers
			Ca_MLP_Preds1=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=150,Hidden1=4,Hidden2=4,IWeights=0.5,Seed=1,N.ensemble=2)
			CNT=10
			for (sd in 2:CNT)
			{
				Ca_MLP_Preds1=Ca_MLP_Preds1+GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=150,Hidden1=4,Hidden2=4,IWeights=0.5,Seed=sd,N.ensemble=2)
				flush.console()
			}
			Ca_MLP_Preds1=Ca_MLP_Preds1/CNT
			cat('Ca_MLP_Preds1:',RMSE(data.frame(tstTRG),Ca_MLP_Preds1),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			MyTrain=savitzkyGolay(MyTrain, p = 3, w = 11, m = 0)
			MyTest=savitzkyGolay(MyTest, p = 3, w = 11, m = 0)
			MyTrain=cbind(HaarTransform(MyTrain,4),trainOriginal[c(3579:3581)])
			MyTest=cbind(HaarTransform((MyTest),4),testOriginal[c(3579:3581)])
			Ca_MLP_Preds2=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=150,Hidden1=4,Hidden2=4,IWeights=0.5,Seed=1,N.ensemble=10)
			cat('Ca_MLP_Preds2:',RMSE(data.frame(tstTRG),Ca_MLP_Preds2),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=cbind(HaarTransform(trainOriginal[,1:3578],5),trainOriginal[,c(3579,3581)])
			MyTest=cbind(HaarTransform(testOriginal[,1:3578],5),testOriginal[,c(3579,3581)])
			Ca_MLP_Preds3=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=100,Hidden1=5,Hidden2=5,IWeights=0.5)
			cat('Ca_MLP_Preds3:',RMSE(data.frame(tstTRG),Ca_MLP_Preds3),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=cbind(HaarTransform(Derivative(trainOriginal[,1:3578]),7),trainOriginal[,c(3579:3581)])
			MyTest=cbind(HaarTransform(Derivative(testOriginal[,1:3578]),7),testOriginal[,c(3579:3581)])
			Ca_MLP_Preds4=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=150,Hidden1=3,Hidden2=20,IWeights=0.6)
			cat('Ca_MLP_Preds4:',RMSE(data.frame(tstTRG),Ca_MLP_Preds4),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=cbind(Derivative(HaarTransform(trainOriginal,4)),trainOriginal[,c(3579:3581,3594)])
			MyTest=cbind(Derivative(HaarTransform(testOriginal,4)),testOriginal[,c(3579:3581,3594)])
			Ca_MLP_Preds5=GetMLPDepthPreds(MyTrain,MyTest,MyTarget,Iters=100,Hidden1=5,Hidden2=5,IWeights=0.5)
			cat('Ca_MLP_Preds5:',RMSE(data.frame(tstTRG),Ca_MLP_Preds5),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=cbind(HaarTransform(trainOriginal,5),trainOriginal[,c(3579:3581,3594)])
			MyTest=cbind(HaarTransform(testOriginal,5),testOriginal[,c(3579:3581,3594)])
			Ca_MLP_Preds6=GetMLPDepthPreds(MyTrain,MyTest,MyTarget,Iters=100,Hidden1=5,Hidden2=5,IWeights=0.5)
			cat('Ca_MLP_Preds6:',RMSE(data.frame(tstTRG),Ca_MLP_Preds6),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=cbind(HaarTransform(trainOriginal[,1:3578],4),trainOriginal[,c(3579:3582)])
			MyTest=cbind(HaarTransform(testOriginal[,1:3578],4),testOriginal[,c(3579:3582)])
			Ca_MLP_Preds7=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=150,Hidden1=5,Hidden2=5,IWeights=0.5)
			cat('Ca_MLP_Preds7:',RMSE(data.frame(tstTRG),Ca_MLP_Preds7),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=cbind(HaarTransform(trainOriginal[,1:3578],3),trainOriginal[,c(3579:3582)])
			MyTest=cbind(HaarTransform(testOriginal[,1:3578],3),testOriginal[,c(3579:3582)])
			Ca_MLP_Preds8=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=150,Hidden1=5,Hidden2=5,IWeights=0.5)
			cat('Ca_MLP_Preds8:',RMSE(data.frame(tstTRG),Ca_MLP_Preds8),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			Ca_Gauss_Preds1=GetGaussPreds(trainOriginal,testOriginal,MyTarget,Kernel='rbfdot',Tol=0.05,Var=0.01)
			cat('Ca_Gauss_Preds1:',RMSE(data.frame(tstTRG),Ca_Gauss_Preds1),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			Ca_Gauss_Preds2=GetGaussPreds(trainReduced,testReduced,MyTarget,Kernel='rbfdot',Tol=0.05,Var=0.01)
			cat('Ca_Gauss_Preds2:',RMSE(data.frame(tstTRG),Ca_Gauss_Preds2),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			Ca_Gauss_Preds3=GetGaussPreds(trainOriginal,testOriginal,MyTarget,Kernel='polydot',Tol=0.001,Var=0.1)
			cat('Ca_Gauss_Preds3:',RMSE(data.frame(tstTRG),Ca_Gauss_Preds3),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal
			MyTest=testOriginal
			SSS=(rbind(MyTrain,MyTest))
			ordr=colnames(SSS)[order(colSds(as.matrix(SSS)),decreasing=T)]
			MyTrain=MyTrain[,ordr[1:2000]]
			MyTest=MyTest[,ordr[1:2000]]
			Ca_MVR_Preds1=GetMVRPreds(MyTrain,MyTest,MyTarget,120,True)
			cat('Ca_MVR_Preds1:',RMSE(data.frame(tstTRG),Ca_MVR_Preds1),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			Ca_MVR_Preds2=GetMVRPreds(trainOriginal,testOriginal,MyTarget,100,True)
			cat('Ca_MVR_Preds2:',RMSE(data.frame(tstTRG),Ca_MVR_Preds2),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=HaarTransform(trainOriginal,5)
			MyTest=HaarTransform(testOriginal,5)
			Ca_NNET_Preds1=GetNNETPreds(MyTrain,MyTest,MyTarget,Size=10,Rang=0.5,Decay=0.1,Iters=100)
			cat('Ca_NNET_Preds1:',RMSE(data.frame(tstTRG),Ca_NNET_Preds1),'   ')
			flush.console();gc();cat('\n');

			#Combining predictions
			ThisPred=(100*Ca_SVM_Preds1+100*Ca_MLP_Preds1+100*Ca_MLP_Preds2+15*Ca_Gauss_Preds1+30*Ca_SVM_Preds2+100*Ca_SVM_Preds3+45*Ca_Gauss_Preds2+10*Ca_Gauss_Preds3+15*Ca_MVR_Preds1+10*Ca_SVM_Preds4+150*Ca_MLP_Preds3+50*Ca_MLP_Preds4+10*Ca_NNET_Preds1+5*Ca_MVR_Preds2+30*Ca_MLP_Preds5+30*Ca_MLP_Preds6+150*Ca_MLP_Preds7+50*Ca_MLP_Preds8)/1000
			cat('Ca_Ensemble:',RMSE(data.frame(tstTRG),ThisPred),' \n  ')

			flush.console();gc();cat('\n');
		}

		#Training and Prediction phase for "P" target
		if (TheTarget=='P')
		{
			flush.console()
			MyTrain=((trainOriginal[,1:3578]))
			MyTest=((testOriginal[,1:3578]))
			MyTrain=continuumRemoval(MyTrain, type='R',method='substraction')#continuumRemoval from prospectr library
			MyTest=continuumRemoval(MyTest, type='R',method='substraction')
			MyTrain=ifelse(is.na(MyTrain),1,MyTrain)
			MyTest=ifelse(is.na(MyTest),1,MyTest)
			MyTrain=cbind(MyTrain,trainOriginal[c(3579,3582)])
			MyTest=cbind(MyTest,testOriginal[c(3579,3582)])
			P_SVM_Preds1=GetSVMPreds(MyTrain,MyTest,MyTarget,5000)
			P_SVM_Preds1[,1]=exp(P_SVM_Preds1[,1])-1
			cat('P_SVM_Preds1:',RMSE(data.frame(tstTRG),P_SVM_Preds1),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=cbind(trainOriginal[,1:3578],trainOriginal[,3579:3594])
			MyTest=cbind(testOriginal[,1:3578],testOriginal[,3579:3594])
			P_SVM_Preds2=GetSVMPreds(MyTrain,MyTest,MyTarget,5000)
			P_SVM_Preds2[,1]=exp(P_SVM_Preds2[,1])-1
			cat('P_SVM_Preds2:',RMSE(data.frame(tstTRG),P_SVM_Preds2),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=cbind(HaarTransform(trainOriginal[,1:3578],1),trainOriginal[c(3583,3594)])
			MyTest=cbind(HaarTransform(testOriginal[,1:3578],1),testOriginal[c(3583,3594)])
			P_SVM_Preds3=GetSVMDepthPreds(MyTrain,MyTest,MyTarget,Cost=1000)
			P_SVM_Preds3[,1]=exp(P_SVM_Preds3[,1])-1
			cat('P_SVM_Preds3:',RMSE(data.frame(tstTRG),P_SVM_Preds3),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=((trainOriginal[,1:3578]))
			MyTest=((testOriginal[,1:3578]))
			MyTrain=savitzkyGolay(MyTrain, p = 4, w = 11, m = 1)
			MyTest=savitzkyGolay(MyTest, p = 4, w = 11, m = 1)
			rnk=GetRanksBySD(MyTrain,MyTest)
			MyTrain=MyTrain[,rnk<3000]
			MyTest=MyTest[,rnk<3000]
			MyTrain=cbind(HaarTransform(MyTrain,4),trainOriginal[c(3579:3581,3594)])
			MyTest=cbind(HaarTransform(MyTest,4),testOriginal[c(3579:3581,3594)])
			P_MLP_Preds1=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=150,Hidden1=5,Hidden2=0,IWeights=0.5)
			P_MLP_Preds1[,1]=exp(P_MLP_Preds1[,1])-1
			cat('P_MLP_Preds1:',RMSE(data.frame(tstTRG),P_MLP_Preds1),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			MyTrain=savitzkyGolay(MyTrain, p = 4, w = 11, m = 1)
			MyTest=savitzkyGolay(MyTest, p = 4, w = 11, m = 1)
			rnk=GetRanksBySD(MyTrain,MyTest)
			MyTrain=MyTrain[,rnk<2500]
			MyTest=MyTest[,rnk<2500]
			MyTrain=cbind(HaarTransform(MyTrain,4),trainOriginal[c(3579:3581,3594)])
			MyTest=cbind(HaarTransform(MyTest,4),testOriginal[c(3579:3581,3594)])
			P_MLP_Preds2=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=150,Hidden1=4,Hidden2=4,IWeights=0.6,Seed=1,N.ensemble=5)
			P_MLP_Preds2[,1]=exp(P_MLP_Preds2[,1])-1
			cat('P_MLP_Preds2:',RMSE(data.frame(tstTRG),P_MLP_Preds2),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=cbind(Derivative(HaarTransform(trainOriginal,4)),trainOriginal[,c(3579:3581,3594)])
			MyTest=cbind(Derivative(HaarTransform(testOriginal,4)),testOriginal[,c(3579:3581,3594)])
			P_MLP_Preds3=GetMLPDepthPreds(MyTrain,MyTest,MyTarget,Iters=100,Hidden1=5,Hidden2=5,IWeights=0.5)
			P_MLP_Preds3[,1]=exp(P_MLP_Preds3[,1])-1
			cat('P_MLP_Preds3:',RMSE(data.frame(tstTRG),P_MLP_Preds3),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=HaarTransform(trainOriginal,5)
			MyTest=HaarTransform(testOriginal,5)
			P_MLP_Preds4=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=50,Hidden1=5,Hidden2=5,IWeights=0.6)
			P_MLP_Preds4[,1]=exp(P_MLP_Preds4[,1])-1
			cat('P_MLP_Preds4:',RMSE(data.frame(tstTRG),P_MLP_Preds4),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			MyTrain=cbind(HaarTransform(Derivative(MyTrain),2),trainOriginal[,c(3579,3593)])
			MyTest=cbind(HaarTransform(Derivative(MyTest),2),testOriginal[,c(3579,3593)])
			SSS=(rbind(MyTrain,MyTest))
			ordr=colnames(SSS)[order(colSds(as.matrix(SSS)),decreasing=T)]
			MyTrain=MyTrain[,ordr[1:450]]
			MyTest=MyTest[,ordr[1:450]]
			P_MLP_Preds5=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=50,Hidden1=5,Hidden2=5,IWeights=0.6)
			P_MLP_Preds5[,1]=exp(P_MLP_Preds5[,1])-1
			cat('P_MLP_Preds5:',RMSE(data.frame(tstTRG),P_MLP_Preds5),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			rnk=GetRanksBySD(MyTrain,MyTest)
			MyTrain=MyTrain[,rnk<2500]
			MyTest=MyTest[,rnk<2500]
			MyTrain=cbind(Derivative(HaarTransform(MyTrain,4)),trainOriginal[c(3579:3581)])
			MyTest=cbind(Derivative(HaarTransform(MyTest,4)),testOriginal[c(3579:3581)])
			P_MLP_Preds6=GetMLPPreds(MyTrain[],MyTest,MyTarget,Iters=100,Hidden1=5,Hidden2=5,IWeights=0.5)
			P_MLP_Preds6[,1]=exp(P_MLP_Preds6[,1])-1
			cat('P_MLP_Preds6:',RMSE(data.frame(tstTRG),P_MLP_Preds6),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			rnk=GetRanksBySD(MyTrain,MyTest)
			MyTrain=MyTrain[,rnk<2500]
			MyTest=MyTest[,rnk<2500]
			MyTrain=cbind(Derivative(HaarTransform(MyTrain,4)),trainOriginal[c(3579:3581,3594)])
			MyTest=cbind(Derivative(HaarTransform(MyTest,4)),testOriginal[c(3579:3581,3594)])
			P_MLP_Preds7=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=100,Hidden1=5,Hidden2=5,IWeights=0.5)
			P_MLP_Preds7[,1]=exp(P_MLP_Preds7[,1])-1
			cat('P_MLP_Preds7:',RMSE(data.frame(tstTRG),P_MLP_Preds7),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			MyTrain=cbind(HaarTransform(MyTrain,4),trainOriginal[c(3579:3581)])
			MyTest=cbind(HaarTransform((MyTest),4),testOriginal[c(3579:3581)])
			P_MVR_Preds1=GetMVRPreds(MyTrain,MyTest,MyTarget,Ncomp=200,Scale=True)
			P_MVR_Preds1[,1]=exp(P_MVR_Preds1[,1])-1
			cat('P_MVR_Preds1:',RMSE(data.frame(tstTRG),P_MVR_Preds1),'   ')
			flush.console();gc();cat('\n');

			ThisPred=(70*P_SVM_Preds1+70*P_MVR_Preds1+70*P_MLP_Preds1+100*P_MLP_Preds3+70*P_SVM_Preds2+70*P_SVM_Preds3+50*P_MLP_Preds4+50*P_MLP_Preds5+50*P_MLP_Preds6+200*P_MLP_Preds7)/800
			cat('P_Ensemble:',RMSE(data.frame(tstTRG),ThisPred),'\n   ')

		}

		#Training and Prediction phase for "pH" target
		if(TheTarget=='pH')
		{
			flush.console()
			MyTrain=cbind(HaarTransform(trainOriginal[,1:3578],1),trainOriginal[c(3583,3594)])
			MyTest=cbind(HaarTransform(testOriginal[,1:3578],1),testOriginal[c(3583,3594)])
			pH_SVM_Preds1=GetSVMDepthPreds(MyTrain,MyTest,MyTarget,Cost=1000)
			cat('pH_SVM_Preds1:',RMSE(data.frame(tstTRG),pH_SVM_Preds1),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=cbind(trainOriginal[,1:3578],trainOriginal[,3579:3594])
			MyTest=cbind(testOriginal[,1:3578],testOriginal[,3579:3594])
			pH_SVM_Preds2=GetSVMPreds(MyTrain,MyTest,MyTarget,5000)
			cat('pH_SVM_Preds2:',RMSE(data.frame(tstTRG),pH_SVM_Preds2),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=cbind(HaarTransform(trainOriginal[,1:3578],5),trainOriginal[,c(3579,3581)])
			MyTest=cbind(HaarTransform(testOriginal[,1:3578],5),testOriginal[,c(3579,3581)])
			pH_MLP_Preds1=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=100,Hidden1=5,Hidden2=5,IWeights=0.5)
			cat('pH_MLP_Preds1:',RMSE(data.frame(tstTRG),pH_MLP_Preds1),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=cbind(Derivative(HaarTransform(trainOriginal,4)),trainOriginal[,c(3579:3581,3594)])
			MyTest=cbind(Derivative(HaarTransform(testOriginal,4)),testOriginal[,c(3579:3581,3594)])
			pH_MLP_Preds2=GetMLPDepthPreds(MyTrain,MyTest,MyTarget,Iters=100,Hidden1=5,Hidden2=5,IWeights=0.5)
			cat('pH_MLP_Preds2:',RMSE(data.frame(tstTRG),pH_MLP_Preds2),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=cbind(HaarTransform(trainOriginal[,1:3578],4),trainOriginal[,c(3579:3582)])
			MyTest=cbind(HaarTransform(testOriginal[,1:3578],4),testOriginal[,c(3579:3582)])
			pH_MLP_Preds3=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=150,Hidden1=5,Hidden2=5,IWeights=0.5)
			cat('pH_MLP_Preds3:',RMSE(data.frame(tstTRG),pH_MLP_Preds3),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			rnk=GetRanksBySD(MyTrain,MyTest)
			MyTrain=MyTrain[,rnk<2500]
			MyTest=MyTest[,rnk<2500]
			MyTrain=cbind(Derivative(HaarTransform(MyTrain,4)),trainOriginal[c(3579:3581)])
			MyTest=cbind(Derivative(HaarTransform(MyTest,4)),testOriginal[c(3579:3581)])
			pH_MLP_Preds4=GetMLPPreds(MyTrain[],MyTest,MyTarget,Iters=100,Hidden1=5,Hidden2=5,IWeights=0.5)
			cat('pH_MLP_Preds4:',RMSE(data.frame(tstTRG),pH_MLP_Preds4),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			rnk=GetRanksBySD(MyTrain,MyTest)
			MyTrain=MyTrain[,rnk<2500]
			MyTest=MyTest[,rnk<2500]
			MyTrain=cbind(Derivative(HaarTransform(MyTrain,4)),trainOriginal[c(3579:3581,3594)])
			MyTest=cbind(Derivative(HaarTransform(MyTest,4)),testOriginal[c(3579:3581,3594)])
			pH_MLP_Preds5=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=100,Hidden1=5,Hidden2=5,IWeights=0.5)
			cat('pH_MLP_Preds5:',RMSE(data.frame(tstTRG),pH_MLP_Preds5),'   ')
			flush.console();gc();cat('\n');

			ThisPred=(70*pH_MLP_Preds1+70*pH_MLP_Preds2+50*pH_SVM_Preds1+50*pH_MLP_Preds3+50*pH_SVM_Preds2+70*pH_MLP_Preds4+70*pH_MLP_Preds5)/430
			cat('pH_Ensemble:',RMSE(data.frame(tstTRG),ThisPred),'\n   ')

		}

		#Training and Prediction phase for "SOC" target
		if (TheTarget=='SOC')
		{
			flush.console()
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			MyTrain=cbind(MyTrain,trainOriginal[c(3581,3590,3591)])
			MyTest=cbind(MyTest,testOriginal[c(3581,3590,3591)])
			SOC_SVM_Preds1=GetSVMPreds(MyTrain,MyTest,MyTarget,10000)
			cat('SOC_SVM_Preds1:',RMSE(data.frame(tstTRG),SOC_SVM_Preds1),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=cbind(trainOriginal[,1:3578],trainOriginal[,3579:3594])
			MyTest=cbind(testOriginal[,1:3578],testOriginal[,3579:3594])
			SOC_SVM_Preds2=GetSVMPreds(MyTrain,MyTest,MyTarget,5000)
			cat('SOC_SVM_Preds2:',RMSE(data.frame(tstTRG),SOC_SVM_Preds2),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			MyTrain=savitzkyGolay(MyTrain, p = 3, w = 11, m = 0)
			MyTest=savitzkyGolay(MyTest, p = 3, w = 11, m = 0)
			rnk=GetRanksBySD(MyTrain,MyTest)
			MyTrain=MyTrain[,rnk<2500]
			MyTest=MyTest[,rnk<2500]
			MyTrain=cbind(HaarTransform(MyTrain,3),trainOriginal[c(3579:3581,3594)])
			MyTest=cbind(HaarTransform(MyTest,3),testOriginal[c(3579:3581,3594)])
			SOC_MLP_Preds1=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=150,Hidden1=3,Hidden2=3,IWeights=0.5,Seed=1,N.ensemble=20)
			cat('SOC_MLP_Preds1:',RMSE(data.frame(tstTRG),SOC_MLP_Preds1),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			MyTrain=savitzkyGolay(MyTrain, p = 3, w = 11, m = 0)
			MyTest=savitzkyGolay(MyTest, p = 3, w = 11, m = 0)
			MyTrain=cbind(HaarTransform(MyTrain,3),trainOriginal[c(3579:3581,3594)])
			MyTest=cbind(HaarTransform(MyTest,3),testOriginal[c(3579:3581,3594)])
			SOC_MLP_Preds2=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=150,Hidden1=3,Hidden2=3,IWeights=0.5,Seed=1,N.ensemble=10)
			cat('SOC_MLP_Preds2:',RMSE(data.frame(tstTRG),SOC_MLP_Preds2),'   ')
			flush.console();gc();cat('\n');

			flush.console();
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			MyTrain=savitzkyGolay(MyTrain, p = 3, w = 11, m = 0)
			MyTest=savitzkyGolay(MyTest, p = 3, w = 11, m = 0)
			rnk=GetRanksBySD(MyTrain,MyTest)
			MyTrain=MyTrain[,rnk<2500]
			MyTest=MyTest[,rnk<2500]
			MyTrain=cbind(HaarTransform(MyTrain,4),trainOriginal[c(3579:3581)])
			MyTest=cbind(HaarTransform(MyTest,4),testOriginal[c(3579:3581)])
			SOC_MLP_Preds3=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=150,Hidden1=4,Hidden2=4,IWeights=0.5,Seed=1,N.ensemble=10)
			cat('SOC_MLP_Preds3:',RMSE(data.frame(tstTRG),SOC_MLP_Preds3),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=cbind(HaarTransform(Derivative(trainOriginal[,1:3578]),6),trainOriginal[,c(3579:3581)])
			MyTest=cbind(HaarTransform(Derivative(testOriginal[,1:3578]),6),testOriginal[,c(3579:3581)])
			SOC_MLP_Preds4=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=100,Hidden1=4,Hidden2=0,IWeights=0.5)
			cat('SOC_MLP_Preds4:',RMSE(data.frame(tstTRG),SOC_MLP_Preds4),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=HaarTransform(trainOriginal,5)
			MyTest=HaarTransform(testOriginal,5)
			SOC_MLP_Preds5=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=50,Hidden1=5,Hidden2=5,IWeights=0.6)
			cat('SOC_MLP_Preds5:',RMSE(data.frame(tstTRG),SOC_MLP_Preds5),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			rnk=GetRanksBySD(MyTrain,MyTest)
			MyTrain=MyTrain[,rnk<2500]
			MyTest=MyTest[,rnk<2500]
			MyTrain=cbind(Derivative(HaarTransform(MyTrain,4)),trainOriginal[c(3579:3581)])
			MyTest=cbind(Derivative(HaarTransform(MyTest,4)),testOriginal[c(3579:3581)])
			SOC_MLP_Preds6=GetMLPPreds(MyTrain[],MyTest,MyTarget,Iters=100,Hidden1=5,Hidden2=5,IWeights=0.5)
			cat('SOC_MLP_Preds6:',RMSE(data.frame(tstTRG),SOC_MLP_Preds6),'   ')
			flush.console();gc();cat('\n');

			ThisPred=(100*SOC_SVM_Preds1+50*SOC_MLP_Preds3+50*SOC_MLP_Preds2+50*SOC_MLP_Preds1+70*SOC_SVM_Preds2+100*SOC_MLP_Preds4+60*SOC_MLP_Preds5+20*SOC_MLP_Preds6)/500
			cat('SOC_Ensemble:',RMSE(data.frame(tstTRG),ThisPred),'\n   ')
		}

		#Training and Prediction phase for "Sand" target
		if (TheTarget=='Sand')
		{
			flush.console()
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			MyTrain=savitzkyGolay(MyTrain, p = 3, w = 11, m = 0)
			MyTest=savitzkyGolay(MyTest, p = 3, w = 11, m = 0)
			MyTrain=cbind(MyTrain,trainOriginal[c(3581,3583,3585,3586,3588,3590,3591:3592,3594)])
			MyTest=cbind(MyTest,testOriginal[c(3581,3583,3585,3586,3588,3590,3591:3592,3594)])
			Sand_SVM_Preds1=GetSVMPreds(MyTrain,MyTest,MyTarget,5000)
			cat('Sand_SVM_Preds1:',RMSE(data.frame(tstTRG),Sand_SVM_Preds1),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			Sand_SVM_Preds2=GetSVMPreds(trainOriginal,testOriginal,MyTarget,Cost=10000)#OK
			cat('Sand_SVM_Preds2:',RMSE(data.frame(tstTRG),Sand_SVM_Preds2),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal
			MyTest=testOriginal
			SSS=(rbind(MyTrain,MyTest))
			MyTrain=SSS[(1:nrow(trainOriginal)),]
			MyTest=SSS[-(1:nrow(trainOriginal)),]
			ordr=colnames(SSS)[order(colSds(as.matrix(SSS)),decreasing=T)]
			MyTrain=MyTrain[,ordr[1:2000]]
			MyTest=MyTest[,ordr[1:2000]]
			MyTrain=HaarTransform(Derivative(MyTrain),3)
			MyTest=HaarTransform(Derivative(MyTest),3)
			Sand_SVM_Preds3=GetSVMPreds(MyTrain,MyTest,MyTarget,10000)
			cat('Sand_SVM_Preds3:',RMSE(data.frame(tstTRG),Sand_SVM_Preds3),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			SSS=(rbind(MyTrain,MyTest))
			MyTrain=SSS[(1:nrow(trainOriginal)),]
			MyTest=SSS[-(1:nrow(trainOriginal)),]
			ordr=colnames(SSS)[order(colSds(as.matrix(SSS)),decreasing=T)]
			MyTrain=MyTrain[,ordr[1:1500]]
			MyTest=MyTest[,ordr[1:1500]]
			MyTrain=HaarTransform(Derivative(MyTrain),3)
			MyTest=HaarTransform(Derivative(MyTest),3)
			Sand_SVM_Preds4=GetSVMPreds(MyTrain,MyTest,MyTarget,10000)
			cat('Sand_SVM_Preds4:',RMSE(data.frame(tstTRG),Sand_SVM_Preds4),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=HaarTransform(trainOriginal[,1:3578],4)
			MyTest=HaarTransform(testOriginal[,1:3578],4)
			MyTrain=savitzkyGolay(MyTrain, p = 2, w = 3, m = 1)
			MyTest=savitzkyGolay(MyTest, p = 2, w = 3, m = 1)
			MyTrain=cbind(MyTrain,trainOriginal[c(3579,3593)])
			MyTest=cbind(MyTest,testOriginal[c(3579,3593)])
			Sand_MLP_Preds1=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=150,Hidden1=4,Hidden2=4,IWeights=0.6,Seed=1,N.ensemble=10)
			cat('Sand_MLP_Preds1:',RMSE(data.frame(tstTRG),Sand_MLP_Preds1),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			MyTrain=HaarTransform(MyTrain,4)
			MyTest=HaarTransform(MyTest,4)
			MTT=rbind(MyTrain,MyTest)
			MTT=WekPCA(MTT,0.9995)
			MyTrain=MTT[1:nrow(MyTrain),]
			MyTest=MTT[-(1:nrow(MyTrain)),]
			MyTrain=cbind(MyTrain,trainOriginal[c(3579:3581,3594)])
			MyTest=cbind(MyTest,testOriginal[c(3579:3581,3594)])
			Sand_MLP_Preds2=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=200,Hidden1=5,Hidden2=5,IWeights=0.5,Seed=1,N.ensemble=30)
			cat('Sand_MLP_Preds2:',RMSE(data.frame(tstTRG),Sand_MLP_Preds2),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=HaarTransform(trainOriginal,5)
			MyTest=HaarTransform(testOriginal,5)
			Sand_MLP_Preds3=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=50,Hidden1=4,Hidden2=0,IWeights=0.5)
			cat('Sand_MLP_Preds3:',RMSE(data.frame(tstTRG),Sand_MLP_Preds3),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=HaarTransform(trainOriginal,5)
			MyTest=HaarTransform(testOriginal,5)
			Sand_MLP_Preds4=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=50,Hidden1=5,Hidden2=5,IWeights=0.6)
			cat('Sand_MLP_Preds4:',RMSE(data.frame(tstTRG),Sand_MLP_Preds4),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal[,1:3578]
			MyTest=testOriginal[,1:3578]
			MyTrain=cbind(HaarTransform(Derivative(MyTrain),2),trainOriginal[,c(3579,3593)])
			MyTest=cbind(HaarTransform(Derivative(MyTest),2),testOriginal[,c(3579,3593)])
			SSS=(rbind(MyTrain,MyTest))
			MyTrain=SSS[(1:nrow(trainOriginal)),]
			MyTest=SSS[-(1:nrow(trainOriginal)),]
			ordr=colnames(SSS)[order(colSds(as.matrix(SSS)),decreasing=T)]
			MyTrain=MyTrain[,ordr[1:450]]
			MyTest=MyTest[,ordr[1:450]]
			Sand_MLP_Preds5=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=50,Hidden1=5,Hidden2=5,IWeights=0.6)
			cat('Sand_MLP_Preds5:',RMSE(data.frame(tstTRG),Sand_MLP_Preds5),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=cbind(Derivative(HaarTransform(trainOriginal,4)),trainOriginal[,c(3579:3581,3594)])
			MyTest=cbind(Derivative(HaarTransform(testOriginal,4)),testOriginal[,c(3579:3581,3594)])
			Sand_MLP_Preds6=GetMLPDepthPreds(MyTrain,MyTest,MyTarget,Iters=100,Hidden1=5,Hidden2=5,IWeights=0.5)
			cat('Sand_MLP_Preds6:',RMSE(data.frame(tstTRG),Sand_MLP_Preds6),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=cbind(HaarTransform(trainOriginal[,1:3578],4),trainOriginal[,c(3579:3582)])
			MyTest=cbind(HaarTransform(testOriginal[,1:3578],4),testOriginal[,c(3579:3582)])
			Sand_MLP_Preds7=GetMLPPreds(MyTrain,MyTest,MyTarget,Iters=150,Hidden1=5,Hidden2=5,IWeights=0.5)
			cat('Sand_MLP_Preds7:',RMSE(data.frame(tstTRG),Sand_MLP_Preds7),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			Sand_Gauss_Preds1=GetGaussPreds(trainOriginal,testOriginal,MyTarget,Kernel='rbfdot',Tol=0.05,Var=0.01)
			cat('Sand_Gauss_Preds1:',RMSE(data.frame(tstTRG),Sand_Gauss_Preds1),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			Sand_Gauss_Preds2=GetGaussPreds(trainReduced,testReduced,MyTarget,Kernel='rbfdot',Tol=0.05,Var=0.01)
			cat('Sand_Gauss_Preds2:',RMSE(data.frame(tstTRG),Sand_Gauss_Preds2),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			Sand_Gauss_Preds3=GetGaussPreds(trainOriginal,testOriginal,MyTarget,Kernel='polydot',Tol=0.001,Var=0.1)
			cat('Sand_Gauss_Preds3:',RMSE(data.frame(tstTRG),Sand_Gauss_Preds3),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=trainOriginal
			MyTest=testOriginal
			SSS=(rbind(MyTrain,MyTest))
			ordr=colnames(SSS)[order(colSds(as.matrix(SSS)),decreasing=T)]
			MyTrain=MyTrain[,ordr[1:2000]]
			MyTest=MyTest[,ordr[1:2000]]
			Sand_MVR_Preds1=GetMVRPreds(MyTrain,MyTest,MyTarget,120,True)
			cat('Sand_MVR_Preds1:',RMSE(data.frame(tstTRG),Sand_MVR_Preds1),'   ')
			flush.console();gc();cat('\n');

			flush.console()
			MyTrain=HaarTransform(trainOriginal,5)
			MyTest=HaarTransform(testOriginal,5)
			Sand_NNET_Preds1=GetNNETPreds(MyTrain,MyTest,MyTarget,Size=10,Rang=0.5,Decay=0.1,Iters=100)
			cat('Sand_NNET_Preds1:',RMSE(data.frame(tstTRG),Sand_NNET_Preds1),'   ')
			flush.console();gc();cat('\n');

			ThisPred=(15*Sand_Gauss_Preds1+30*Sand_SVM_Preds2+10*Sand_Gauss_Preds2+20*Sand_Gauss_Preds3+15*Sand_MVR_Preds1+50*Sand_SVM_Preds3+50*Sand_SVM_Preds4+10*Sand_MLP_Preds3+10*Sand_NNET_Preds1+70*Sand_MLP_Preds4+120*Sand_MLP_Preds5+30*Sand_MLP_Preds6+60*Sand_MLP_Preds7+100*Sand_SVM_Preds1+100*Sand_MLP_Preds2+100*Sand_MLP_Preds1)/790
			cat('Sand_Ensemble:',RMSE(data.frame(tstTRG),ThisPred),'   ')
		}

		ThisPred[,1]=ifelse(ThisPred[,1]<min(ThisTarget),min(ThisTarget),ThisPred[,1])
		ThisPred[,1]=ifelse(ThisPred[,1]>max(ThisTarget),max(ThisTarget),ThisPred[,1])
		flush.console()
		cvsm=cvsm+RMSE(data.frame(tstTRG),ThisPred)
		cat('\n')
	}
	cat('  CV:',cvsm/nf,'\n')
	msm=msm+cvsm/nf
	flush.console();gc();
}

cat('OverallCV:',msm/5)


# Estatística Básica

# Parte 5 - Gráficos

# Graficos em R - BarPlot, Pie Chart, Line Chart, Scatter Plot, Histograma e Treemap
# http://www.r-graph-gallery.com/

# Mais detalhes no Curso Visualização de Dados e Design de Dashboards
# https://www.datascienceacademy.com.br/pages/todos-os-cursos-dsa

# Definindo a pasta de trabalho
# Substitua o caminho abaixo pela pasta no seu computador
setwd("C:/Users/dmpm/Documents/PowerBI/Cap12")
getwd()

# Dados
vetor_total_resultados = c(3, 12, 5, 18, 45)
names(vetor_total_resultados) = c("A", "B", "C", "D", "E")
vetor_total_resultados

##### Barplot #####

?barplot
barplot(vetor_total_resultados)
barplot(vetor_total_resultados, col = c(1,2,3,4,5))

# Salvando o gráfico em disco
png("barplot.png", width = 480, height = 480 )
barplot(vetor_total_resultados,
        col = rgb(0.5,0.1,0.6,0.6),
        xlab = "Categorias",
        ylab = "Valores",
        main = "Barplot em R",
        ylim = c(0,60) )
dev.off()

# Ggplot2
library(ggplot2)
View(mtcars)

# Barplot
ggplot(mtcars, aes(x = as.factor(cyl) )) +
  geom_bar()

ggplot(mtcars, aes(x = as.factor(cyl), fill = as.factor(cyl) )) +
  geom_bar( ) +
  scale_fill_manual(values = c("red", "green", "blue"))

# Criando dados dummy (fictícios)
dados = data.frame(group = c("A ","B ","C ","D ") , value = c(33,62,56,67))
View(dados)

# Barplot
ggplot(dados, aes(x = group, y = value ,fill = group )) +
  geom_bar(width = 0.85, stat = "identity")

##### Pie Chart #####

fatias <- c(4, 12, 14, 16, 8)
paises <- c("Brasil", "Estados Unidos", "Alemanha", "Reino Unido", "Espanha")
?pie
pie(fatias, labels = paises, main = "Leitura de Livros Por Pessoa/Ano")

# Pie Chart 3D
install.packages("plotrix")
library(plotrix)

fatias <- c(4, 12, 14, 16, 8)
paises <- c("Brasil", "Estados Unidos", "Alemanha", "Reino Unido", "Espanha")
?pie3D
pie3D(fatias, labels = paises, explode = 0.1, main = "Leitura de Livros Por Pessoa/Ano")

##### Line Chart #####

# Dados
carros <- c(1, 3, 6, 4, 9)
caminhoes <- c(2, 5, 4, 5, 12)

# Plot
plot(carros, type = "o", col = "blue", ylim = c(0,12))

lines(caminhoes, type = "o", pch = 22, lty = 2, col = "red")

title(main = "Produção de Veículos", col.main = "red", font.main = 4)

##### Boxplot #####

library(ggplot2)
View(mpg)

# Plot
ggplot(mpg, aes(x = reorder(class, hwy), y = hwy, fill = class)) +
  geom_boxplot() +
  xlab("class") +
  theme(legend.position = "none")

##### Scatter Plot #####

library(ggplot2)
data = data.frame(cond = rep(c("condition_1", "condition_2"), each=10),
                  my_x = 1:100 + rnorm(100,sd=9), my_y = 1:100 + rnorm(100,sd=16))

View(data)

ggplot(data, aes(x=my_x, y=my_y)) +
  geom_point(shape=1)

# Adiciona linha de regressão
ggplot(data, aes(x=my_x, y=my_y)) +
  geom_point(shape=1) +
  geom_smooth(method = lm , color="red", se=FALSE)

# Adiciona smooth
ggplot(data, aes(x=my_x, y=my_y)) +
  geom_point(shape=1) +
  geom_smooth(method=lm , color="red", se=TRUE)

##### Treemap #####

install.packages("treemap")
library(treemap)

# Dados
grupo = c(rep("grupo-1",4), rep("grupo-2",2), rep("grupo-3",3))
subgrupo = paste("subgroup", c(1,2,3,4,1,2,1,2,3), sep = "-")
valor = c(13,5,22,12,11,7,3,1,23)
dados = data.frame(grupo, subgrupo, valor)
View(dados)

# Labels
?treemap
treemap(dados,
        index = c("grupo", "subgrupo"),
        vSize = "valor",
        type = "index",
        fontsize.labels = c(15,12),
        fontcolor.labels = c("white", "orange"),
        fontface.labels = c(2,1),
        bg.labels = 220,
        align.labels = list(c("center", "center"), c("right", "bottom")),
        overlap.labels = 0.5,
        inflate.labels = F)

# Customizando
treemap(dados,
        index = c("grupo", "subgrupo"),
        vSize = "valor",
        type = "index",
        border.col = c("black", "white"),
        border.lwds = c(7,2))

##### Histograma #####

# Gerando valores para x
x <- mtcars$mpg

# Criando o histograma
?hist
h <- hist(x,
          breaks = 10,
          col = "red",
          xlab = "Milhas Por Galão",
          main = "Histograma com Curva de Distribuição")

# Customizando o histograma
xfit <- seq(min(x), max(x), length = 40)
yfit <- dnorm(xfit, mean = mean(x), sd = sd(x))
yfit <- yfit*diff(h$mids[1:2])*length(x)
lines(xfit, yfit, col = "blue", lwd = 2)

# Usando o ggplot2
library(ggplot2)

# dataset
dados = data.frame(value = rnorm(10000))
View(dados)

# Tamanho das colunas
ggplot(dados, aes(x=value)) +
  geom_histogram(binwidth = 0.05)

# Cor uniforme
ggplot(dados, aes(x=value)) +
  geom_histogram(binwidth = 0.2, color="white", fill=rgb(0.2,0.7,0.1,0.4) )

# Cor proporcional
ggplot(dados, aes(x=value)) +
  geom_histogram(binwidth = 0.2, aes(fill = ..count..) )


library(tidyverse)
library(xts)
library(zoo)

####CHAPTER_1

####Prolog
#the xts constructor
#xts(x = NULL, order.by = index(x),frequency = NULL,unique = NULL,tzone = Sys.getenv("TZ"))
#xts = matrix + index
x <- matrix(1:4, ncol = 2, nrow = 2)
idx <- as.Date(c("2018-11-01", "2018-12-01"))
#an xts example
X <- xts(x, order.by = idx)
X
#Deconstructing xts
coredata(X, fmt = FALSE)
index(X)
#####

####More than a matrix####
# View the structure of ex_matrix
str(ex_matrix)
# Extract the 3rd observation of the 2nd column of ex_matrix
ex_matrix[3, 2]
# Extract the 3rd observation of the 2nd column of core
core[3, 2]
####

####Your first xts object####
?rnorm
# Create the object data using 5 random numbers
data <- rnorm(5, mean = 0, sd = 1)
# Create dates as a Date class object starting from 2016-01-01
dates <- seq(as.Date("2016-01-01"), length = 5, by = "days")
# Use xts() to create smith
smith <- xts(x = data, order.by = dates)
# Create bday (1899-05-08) using a POSIXct date class object
bday <- as.POSIXct("1899-05-08")
# Create hayek and add a new attribute called born
hayek <- xts(x = data, order.by = dates, born = bday)
####

####Deconstructing xts####
# Extract the core data of hayek
hayek_core <- coredata(hayek)
# View the class of hayek_core
class(hayek_core)
# Extract the index of hayek
hayek_index <- index(hayek)
# View the class of hayek_index
class(hayek_index)
####

####Time based indices####
# Create an object of 5 dates called dates starting at "2016-01-01".
dates <- as.Date("2016-01-01") + 0:4
# Create ts_a  using the numbers 1 through 5 as your data, and dates as your order.by index
ts_a <- xts(x = 1:5, order.by = dates)
# Create ts_b  using the numbers 1 through 5 as your data, and the same dates, but as POSIXct objects.
ts_b <- xts(x = 1:5, order.by = as.POSIXct(dates))
# Extract the rows of ts_a using the index of ts_b
ts_a[index(ts_b)]
# Extract the rows of ts_b using the index of ts_a
ts_b[index(ts_a)]
####

####################################################
####Importing, exporting and converting time series#### <- video
#load data from R datasets
data("sunspots")
class(sunspots)
sunspots_xts <- as.xts(sunspots)
class(sunspots_xts)
head(sunspots); head(sunspots_xts)
#export xts from R
setwd("C:/Users/Ghozy Haqqoni/Documents/!Bahan Data Science Ghozy/DS Courses/DATACAMP/Time_Series_with_R_Track/1_Manipulating_Time_Series_Data_in_R_with_xts_&_zoo")
getwd()
write.zoo(sunspots_xts, "belajar_XTS")
saveRDS(sunspots_xts, "belajar_XTS")
####################################################

####Converting xts objects####
#as.xts()
data("austres")
# Convert austres to an xts object called au
au <- as.xts(austres)
# Then convert your xts object (au) into a matrix am
am <- as.matrix(au)
# Inspect the head of am
head(am)
# Convert the original austres into a matrix am2
am2 <- as.matrix(austres)
# Inspect the head of am2
head(am2)
####

####Importing data####
# Create dat by reading tmp_file using read.csv()
dat <- read.csv(tmp_file)
# Convert dat into xts constructor
xts(dat, order.by = as.Date(rownames(dat), "%m/%d/%Y"))
# Read tmp_file using read.zoo
dat_zoo <- read.zoo(tmp_file, index.column = 0, sep = ",", format = "%m/%d/%Y")
# Convert dat_zoo to xts
dat_xts <- as.xts(dat_zoo)
####

####Exporting xts objects####
# Convert sunspots to xts using as.xts().
sunspots_xts <- as.xts(sunspots)
# Get the temporary file name
tmp <- tempfile()
# Write the xts object using zoo to tmp
write.zoo(sunspots_xts, sep = ",", file = tmp)
# Read the tmp file. FUN = as.yearmon converts strings such as Jan 1749 into a proper time class
sun <- read.zoo(tmp, sep = ",", FUN = as.yearmon)
# Convert sun into xts. Save this as sun_xts
sun_xts <- as.xts(sun)
####

####CHAPTER_2

####################################################
####Introducing time based queries#### <-video
#### <- video
#load data
data(edhec, package = "PerformanceAnalytics")
head(edhec)
head(edhec["2007-01", 1])
# January 2007 to March 2007
#this format
head(edhec["2007-01/2007-03",1])
#or this
head(edhec["200701/03", 1])
#Time Support
# YYYYMMDDTHHMM format
iday["20160808T2213"] #T, use to seperate the date and time
#repeating intraday interval
iday["T05:30/T06:30"]
####################################################

####Querying for dates####
# Select all of 2016 from x
x_2016 <- x["2016"]
# Select January 1, 2016 to March 22, 2016
jan_march <- x["2016-01-01/2016-03-22"]
# Verify that jan_march contains 82 rows
82 == length(jan_march)
####

####Extracting recurring intraday intervals####
# Extract all data from irreg between 8AM and 10AM
morn_2010 <- irreg["T08:00/T10:00"]
# Extract the observations in morn_2010 for January 13th, 2010
morn_2010["2010-01-13"]
####

####################################################
####Alternative extraction techniques#### <-video
#Row selection w time
  #integer indexing
  x[c(1,2,3),]
  #logical vectors
  x[index(x)] > "2016-08-20"
  #date objects (Date, POSIXct, etc.)
  dates <- as.POSIXct(c("2016-06-25", "2016-06-27"))
  x[dates]
  x["2007-06-26/2007-06-28"]
#Modifying time series
index <- x["2007-06-26/2007-06-28", which.i = TRUE]
index
####################################################

####Row selection with time objects####
# Subset x using the vector dates
x[dates]
# Subset x using dates as POSIXct
dates <- as.POSIXct(dates)
x[dates]
####

####Update and replace elements####
# Replace the values in x contained in the dates vector with NA
x[dates] <- NA
#Replace all values in x for dates (not referring to the vector) from June 9, 2016 onward with 0. Use ISO-8601 style replacement.
x["2016-06-09/2016-06-30"] <- 0
# Verify that the value in x for June 11, 2016 is now indeed 0
x["2016-06-11"]
####

####Find the first or last period of time####
#fromvid
first(edhec[, "Funds of Funds"], "4 months")
last(edhec[, "Funds of Funds"], "1 year")
#
# Create lastweek using the last 1 week of temps
lastweek <- last(temps, "1 week")
# Print the last 2 observations in lastweek
last(lastweek, n=2)
# Extract all but the first two days of lastweek
first(lastweek, "-2 days")
####

####Combining first and last####
#fromvid
first(last(edhec[, "Merger Arbitrage"], "2 year"), "5 months")
#
temps
# Last 3 days of first week
last(first(temps, "1 week"), "3 days")
# Extract the first three days of the second week of temps
first(last(first(temps, "2 weeks"), "1 week"), "3 days")
####

####Matrix arithmetic - add, subtract, multiply, and divide in time!####
# Add a and b
a + b
# Add a with the numeric value of b
as.numeric(b) + a
####

####Math with non-overlapping indexes####
# Add a to b, and fill all missing rows of b with 0
a + merge(b, index(a), fill = 0)
# Add a to b and fill NAs with the last observation
a + merge(b, index(a), fill = na.locf)
####


#' BSA
#'
#' Calculate the Body Surface Area by using anthropometric features (height and weight).
#'
#' @param  h numeric Body height in cm.
#' @param  w numeric Body weight in kg.
#'
#' @return BSA index
#'
#' @author    Istituto per la Bioeconomia CNR Firenze Italy  Alfonso Crisci \email{alfonso.crisci@@ibe.cnr.it}
#'
#' @keywords  Body Surface Area
#' @export
#'
#'
#'
#'

BSA=function(h,w)  {
  ct$assign("h", as.array(h))
  ct$assign("w", as.array(w))
  ct$eval("var res=[]; for(var i=0, len=h.length; i < len; i++){ res[i]=BSA(h[i],w[i])};")
  res=ct$get("res")
  return(res)
}


cube <- function(x) {
 x^3
}


#' Seasonal Factors for Initial Unemployment Claims, weekly (automatic outlier identification, TC outlier specified)
#'
#' A time series object with seasonal factors generated for weekly initial unemployment
#' claims from a model that includes automatically identified outliers with a temporary
#' change outlier (TC) specified for the 13th week of 2020
#'
#' @format A tis time series object from February 1, 2003 to January 30, 2021
"ic_sf_tc"


library(igraph)
setwd("xxx")
datable <- read.csv("AdjacencyMatrix A.csv")
the_wordgraph <- graph_from_adjacency_matrix(datable, weighted = TRUE, mode = "lower")
net_clusters <- cluster_walktrap(the_wordgraph, weights = E(graph)$weight, steps = 4,
merges = TRUE, modularity = TRUE, membership = TRUE)
cluster_results <- cbind(V(the_wordgraph)$name, net_clusters$membership)
write.csv(cluster_results, file ="ClusterResults A, walktrap.csv")
net_clusters

#SPINGLASS
net_clusters <- cluster_spinglass(the_wordgraph, weights = NULL, vertex = NULL, spins = 25,
parupdate = FALSE, start.temp = 1, stop.temp = 0.01, cool.fact = 0.99,
update.rule = c("config", "random", "simple"), gamma = 1,
implementation = c("orig", "neg"), gamma.minus = 1)
cluster_results <- cbind(V(the_wordgraph)$name, net_clusters$membership)
write.csv(cluster_results, file ="ClusterResults A, spinglass.csv")
net_clusters

#OPTIMAL METHOD
net_clusters <- cluster_optimal(the_wordgraph, weights = NULL)
cluster_results <- cbind(V(the_wordgraph)$name, net_clusters$membership)
write.csv(cluster_results, file ="ClusterResults A, optimal.csv")
net_clusters

#INFOMAP
net_clusters <- cluster_infomap(the_wordgraph, e.weights = NULL, v.weights = NULL, nb.trials = 10,
modularity = TRUE)
cluster_results <- cbind(V(the_wordgraph)$name, net_clusters$membership)
write.csv(cluster_results, file ="ClusterResults A, infomap.csv")
net_clusters

#EDGE BETWEENNESS
net_clusters <- cluster_edge_betweenness(the_wordgraph, weights = E(graph)$weight, directed = TRUE,
edge.betweenness = TRUE, merges = TRUE, bridges = TRUE,
modularity = TRUE, membership = TRUE)
cluster_results <- cbind(V(the_wordgraph)$name, net_clusters$membership)
write.csv(cluster_results, file ="ClusterResults A, edgebetween.csv")
net_clusters


 C02ABJ Example Program Results

 Basic Problem

  i    z                      conv  berr      cond
 -----------------------------------------------------
  1  (  1.15E+00,  7.36E-01)    3   5.37E-18  1.34E+01
  2  ( -1.67E+00,  3.25E-01)    3   6.34E-18  2.20E+01
  3  (  3.79E-01, -1.25E+00)    3   2.98E-18  1.02E+01
  4  ( -1.67E+00, -3.25E-01)    3   4.57E-18  2.20E+01
  5  (  1.15E+00, -7.36E-01)    3   1.04E-17  1.34E+01
  6  (  3.79E-01,  1.25E+00)    2   1.66E-18  1.02E+01


cleanup()
a<-Read.summary.data()
head(a)

aa<-tapply(a$F,list(a$Year,a$Age),sum)
bb<-tapply(a$F,list(a$Year),sum)

a<-t(aa/rep(bb,dim(aa)[2]))
barplot(a,main='Exploitation pattern',legend = rownames(a))


a = 0
b = 1
for(i in seq(1, 20)) {
  cat(i, b, '\n')
  c = a + b
  a = b
  b = c
}


# Use relative file paths as in ../data/mydata.Rdata to keep your project portable

# read in data
mydata <- read.table("../data/mydata.txt", sep="", header = TRUE)

# do some analysis, such as LR
fm <- lm(y ~ x + I(x^2), data = mydata)
summary(fm)

# do some basic plotting
newdat <- seq(min(mydata$x), max(mydata$x), length = 100)
preds <- predict(fm, newdata = data.frame("x" = newdat), se.fit = TRUE)

# open pdf connection
pdf("../results/myplot.pdf", width = 10, height = 10)
# adjust some graphical parameters
par(mar=c(3,2.5,1,1), mgp=c(1.8,0.1,0), tcl= 0.3, pty="s", las = 1, cex.axis = 1.3, cex.lab = 1.3)
with(mydata, plot(y ~ x, xlab= "predictorname", ylab="responsename"))
lines(newdat, preds$fit, lwd= 2)
lines(newdat, preds$fit + 2 * preds$se.fit, lty = 2, lwd= 2, col = "gray50")
lines(newdat, preds$fit - 2 * preds$se.fit, lty = 2, lwd= 2, col = "gray50")
legend("topleft", legend=c("LR", "95% CI"), col = c("black", "gray50"), lty=c(1,2), lwd=2, bty="n")

# close pdf connection
dev.off()


# random forest and naive bayes

library( randomForest )
library( e1071 )
library( caTools )

setwd( '/path/to/showofhands/data' )

data = read.csv( 'train.csv' )

# which columns are not factors?

cols = colnames( data )

for ( i in 1:length( cols )) {
    col_class = class( data[,i] )
    if ( col_class != 'factor' ) {
        cat( cols[i], col_class, "\n" )
    }
}

"
UserID integer
YOB integer
Happy integer
votes integer
"

# clean-up

drops = c( 'UserID' )
data = data[, !( names( data ) %in% drops )]

data$Happy = as.factor( data$Happy )

# clean up YOB

data$YOB[data$YOB < 1930] = 0
data$YOB[data$YOB > 2004] = 0
data$YOB[is.na(data$YOB)] = 0

# train / test split

p_train = 0.8
n = nrow( data )
train_len = round( n * p_train )
test_start = train_len + 1

i = sample.int( n )
train_i = i[1:train_len]
test_i = i[test_start:n]

train = data[train_i,]
test = data[test_i,]

# random forest

y_test = as.factor( test$Happy )
ntree = 100

rf = randomForest( as.factor( Happy ) ~ ., data = train, ntree = ntree, do.trace = 10 )
p <- predict( rf, test, type = 'prob' )
probs =  p[,2]

auc = colAUC( probs, y_test )
auc = auc[1]
cat( "Random forest AUC:", auc )

varImpPlot( rf, n.var = 20 )

# naive bayes

nb = naiveBayes( Happy ~ ., data = train )

# for predicting
drops = c( 'Happy' )
x_test = test[, !( names( test ) %in% drops )]

p = predict( nb, x_test, type = 'raw' )
probs =  p[,2]

auc = colAUC( probs, y_test )
auc = auc[1]

cat( "\n\n" )
cat( "Naive Bayes AUC:", auc, "\n" )


setwd('~/Code/UGRU/non_rectangles/')

# this is a file with the text from a short story by Isaac Asimov:
# 'The last question'
multivac = 'asimov_the_last_question.txt'

#it gets confused because we told it to read a csv, but there are just random
#commas interspersed throughout the lines...
csv_try = read.csv(multivac)

#this works, it just reads the data in line by line
# and stores the contents as a list of strings
lines = readLines(multivac)

summary(lines)
is.vector(lines)

#first two members of vector
lines[1:2]
#last member of vector
lines[length(lines)]

#####################
#Questions to answer:
#####################

#####################
# 1. how many lines of dialogue are there?:
# hint: look at lines 27, 29, 36, 90
# efficiency hint: can you write a generic function to answer this and question 2?
i= 27
lines[i]
grepl("\"" , lines)

dialouge = 0
for(i in 1:length(lines)){
  if(grepl("\"" , lines[i])){
    dialouge = dialouge + 1
  }
}

dialouge

dialouge_list = grepl("\\?", lines)
dialouge_list

#####################
# 2. a. what is the first question in the text?
q_list = grepl("\\?", lines)
q_list

is_question =  lines[q_list == TRUE]
is_question[1]
lines[29]
# b. what is the last question?
is_question[length(is_question)]

rev(is_question)[1]

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

WordCount = function(str){
  words = strsplit(str, "\\s+")[[1]]
  return(length(words))#int
}

wc = lapply(lines, function(x){WordCount(x)})
unlist(wc)

# 3. build a dataframe with the following columns (and data types)
#Line	is_dialogue	is_question	word_count	text
#int	Bool		    Bool		    int			    string

data.frame(is_dialogue = )

seq_along(lines)
seq(1,length(lines))
seq(1,10,2)

question_df = data.frame(line= 1:length(lines),
                         is_dialouge = unlist(dialouge_list),
                         is_question = unlist(question_bool),
                         word_count = unlist(wc),
                         text = lines)

head(question_df)
question_df$is_dialouge

#####################
# 4. finally answer the following:
# The Hemingway-Kafka index is a measure of how long an author's sentences are.
# It is a simply the average number of words in a sentence from a given text.
	# For the purpose of today's exercise, lines of dialogue are counted as a single sentence.

# a. What is the HK-index for 'The Last Question'?

# 24 years after writing 'The Last Question', our boy Isaac wrote another short story
# titled 'The Last Answer' which is found in the following text file:

last_answer = readLines('asimov_the_last_answer.txt')

# b. Given the HK-index of the two texts, is there statistical evidence of Isaac Asimov
# getting more long winded with age?


 DGGESX Example Program Results

 Matrix A
             1          2          3          4
 1      3.9000    12.5000   -34.5000    -0.5000
 2      4.3000    21.5000   -47.5000     7.5000
 3      4.3000    21.5000   -43.5000     3.5000
 4      4.4000    26.0000   -46.0000     6.0000

 Matrix B
             1          2          3          4
 1      1.0000     2.0000    -3.0000     1.0000
 2      1.0000     3.0000    -5.0000     4.0000
 3      1.0000     3.0000    -4.0000     3.0000
 4      1.0000     3.0000    -4.0000     4.0000

 Number of eigenvalues for which SELCTG is true =    2
 (dimension of deflating subspaces)

 Selected generalized eigenvalues
    1     (  2.000,  0.000)
    2     (  4.000,  0.000)

 Reciprocals of left and right projection norms onto
 the deflating subspaces for the selected eigenvalues
 RCONDE(1) =  1.9E-01, RCONDE(2) =  1.8E-02

 Reciprocal condition numbers for the left and right
 deflating subspaces
 RCONDV(1) =  5.4E-02, RCONDV(2) =  9.0E-02

 Approximate asymptotic error bound for selected eigenvalues    =  1.1E-13
 Approximate asymptotic error bound for the deflating subspaces =  2.4E-13


## Aggregate Table Script

dataset <- read.csv("data/neoplasm/neoplasms_data.csv",
                    stringsAsFactors = FALSE)

# finds average YLLs (Years of Life Lost), average Deaths,
# and average DALYs (Disability-Adjusted Life Years) per
# country by percent (1990-2017)

aggregate <- function(dataset) {

  #finding average percent YYLs by location
  years_lost <- dataset %>%
    group_by(location) %>%
    filter(measure == "YLLs (Years of Life Lost)"
           & metric == "Percent") %>%
    summarise(mean_YYLs = mean(val))

  #finding average percent deaths by location
  deaths <- dataset %>%
    group_by(location) %>%
    filter(measure == "Deaths"
           & metric == "Percent") %>%
    summarise(mean_deaths = mean(val))

  #finding average percent DALYs by location
  disability_adjusted <- dataset %>%
    group_by(location) %>%
    filter(measure == "DALYs (Disability-Adjusted Life Years)"
           & metric == "Percent") %>%
    summarise(mean_DALYs = mean(val))

  #combining dataframes
  table <- left_join(years_lost, deaths) %>%
    left_join(disability_adjusted)

  #turning dataframe into table
  kable(table, col.names = c("Location", "Years of Life Lost",
  "Deaths", "Disability-Adjusted Life Years"))
}

aggregate_table <- aggregate(dataset)


## ----echo = FALSE----------------------------------------------------------------------
knitr::opts_chunk$set(
  echo=TRUE,
  message = FALSE,
  warning = FALSE,
  error = FALSE,
  collapse = TRUE,
  comment = "",
  fig.height = 4,
  fig.width = 8,
  fig.align = "center",
  fig.retina = 3,
  cache = FALSE
 )

## ----echo=FALSE------------------------------------------------------------------------
library(tidyverse)
library(lubridate)
library(GGally)
# remotes::install_github("ggobi/tourr")
library(tourr)
library(plotly)
library(palmerpenguins)
# remotes::install_github("ropenscilabs/ochRe")
library(ochRe)

## ----penguins, echo=TRUE, eval=FALSE, fig.show='hide'----------------------------------
## ggplot(penguins,
##    aes(x=flipper_length_mm,
##        y=body_mass_g,
##        colour=species,
##        shape=species)) +
##   geom_point(alpha=0.7,
##              size=2) +
##   scale_colour_ochre(
##     palette="nolan_ned") +
##   theme(aspect.ratio=1,
##   legend.position="bottom")

## ----ref.label='penguins', echo=FALSE, fig.width=5, fig.height=5, out.width="100%"-----

## ----echo=TRUE, eval=FALSE-------------------------------------------------------------
## clrs <- ochre_pal(
##   palette="nolan_ned")(3)
## col <- clrs[
##   as.numeric(
##     penguins$species)]
## animate_xy(penguins[,3:6],
##            col=col,
##            axes="off",
##            fps=15)

## ----eval=FALSE, echo=FALSE------------------------------------------------------------
## # This code was used to make the animated gif
## set.seed(20200622)
## clrs <- ochre_pal(palette="nolan_ned")(3)
## col <- clrs[as.numeric(penguins$species)]
## penguins <- penguins %>%
##   rename(bl = bill_length_mm,
##          bd = bill_depth_mm,
##          fl = flipper_length_mm,
##          bm = body_mass_g)
## render_gif(penguins[,3:6], grand_tour(),
##            display_xy(col=col, axes="bottomleft"),
##            "penguins2d.gif", frames=100, width=300, height=300)

## ----reading axes, eval=FALSE, echo=FALSE----------------------------------------------
## # Generate a plotly animation to demonstrate
## library(plotly)
## library(htmltools)
##
## # Standardise data
## scale2 <- function(x) {(x-mean(x))/sd(x)}
## penguins_s <- penguins %>%
##   mutate_if(is.numeric, scale2)
##
## # Generate sequence of bases
## # set.seed(3)
## set.seed(4)
## random_start <- basis_random(4)
## bases <- save_history(penguins[,3:6], grand_tour(2),
##     start=random_start, max = 5)
## bases[,,1] <- random_start # something needs fixing
## tour_path <- interpolate(bases, 0.1)
## d <- dim(tour_path)
##
## # Make really big data of all projections
## penguins_d <- NULL; penguins_axes <- NULL
## for (i in 1:d[3]) {
##   fp <- as.matrix(penguins_s[,3:6]) %*%
##     matrix(tour_path[,,i], ncol=d[2])
##   fp <- tourr::center(fp)
##   colnames(fp) <- c("d1", "d2")
##   penguins_d <- rbind(penguins_d, cbind(fp, rep(i+10, nrow(fp))))
##   fa <- cbind(matrix(0, d[1], d[2]),
##               matrix(tour_path[,,i], ncol=d[2]))
##   colnames(fa) <- c("origin1", "origin2", "d1", "d2")
##   penguins_axes <- rbind(penguins_axes,
##                          cbind(fa, rep(i+10, nrow(fa))))
## }
## colnames(penguins_d)[3] <- "indx"
## colnames(penguins_axes)[5] <- "indx"
##
## df <- as_tibble(penguins_d) %>%
##   mutate(species = rep(penguins_s$species, d[3]))
## dfaxes <- as_tibble(penguins_axes) %>%
##   mutate(labels=rep(colnames(penguins_s[,3:6]), d[3]))
## dfaxes_mat <- dfaxes %>%
##   mutate(xloc = rep(max(df$d1)+1, d[3]*d[1]),
##          yloc=rep(seq(-1.2, 1.2, 0.8), d[3]),
##          coef=paste(round(dfaxes$d1, 2), ", ",
##                     round(dfaxes$d2, 2)))
## p <- ggplot() +
##        geom_segment(data=dfaxes,
##                     aes(x=d1*2-5, xend=origin1-5,
##                         y=d2*2, yend=origin2,
##                         frame = indx), colour="grey70") +
##        geom_text(data=dfaxes, aes(x=d1*2-5, y=d2*2, label=labels,
##                                   frame = indx), colour="grey70") +
##        geom_point(data = df, aes(x = d1, y = d2, colour=species,
##                                  frame = indx), size=1) +
##        scale_colour_ochre(palette="nolan_ned") +
##        geom_text(data=dfaxes_mat, aes(x=xloc, y=yloc,
##                                   label=coef, frame = indx)) +
##        theme_void() +
##        coord_fixed() +
##   theme(legend.position="none")
## pg <- ggplotly(p, width=700, height=400) %>%
##   animation_opts(200, redraw = FALSE,
##                  easing = "linear", transition=0)
## save_html(pg, file="penguins.html")

## ----runthis13, fig.width=4, fig.height=4, out.width="90%"-----------------------------
ggplot(penguins,
   aes(x=flipper_length_mm,
       y=bill_depth_mm,
       colour=species,
       shape=species)) +
  geom_point(alpha=0.7,
             size=2) +
  scale_colour_ochre(
    palette="nolan_ned") +
  theme(aspect.ratio=1,
  legend.position="bottom")

## ----runthis14, fig.width=4, fig.height=4, out.width="90%"-----------------------------
ggplot(penguins,
   aes(x=bill_length_mm,
       y=body_mass_g,
       colour=species,
       shape=species)) +
  geom_point(alpha=0.7,
             size=2) +
  scale_colour_ochre(
    palette="nolan_ned") +
  theme(aspect.ratio=1,
  legend.position="bottom")

## ----eval=FALSE, echo=FALSE------------------------------------------------------------
## clrs <- ochre_pal(
##   palette="nolan_ned")(3)
## col <- clrs[
##   as.numeric(
##     penguins$species)]
## set.seed(20200622)
## render_gif(penguins[,3:6], guided_tour(lda_pp(penguins$species)),
##            display_xy(col=col, axes="bottomleft"),
##            "penguins2d_guided.gif",
##            frames=17, width=300, height=300, loop=FALSE)

## ----runthis15, eval=FALSE, echo=FALSE-------------------------------------------------
## animate_xy(penguins[,3:6], grand_tour(),
##            axes = "bottomleft", col=col)
## animate_xy(penguins[,3:6], guided_tour(lda_pp(penguins$species)),
##            axes = "bottomleft", col=col)
## best_proj <- matrix(c(0.940, 0.058, -0.253, 0.767,
##                       -0.083, -0.393, -0.211, -0.504), ncol=2,
##                     byrow=TRUE)

## ----eval=FALSE, echo=FALSE------------------------------------------------------------
## mtour1 <- manual_tour(basis = best_proj, manip_var = 3)
## render_manual(penguins_s[,3:6], mtour1, "penguins_manual_fl.gif", col=col, dir = "images/manual1/")
## mtour2 <- manual_tour(basis = best_proj, manip_var = 1)
## render_manual(penguins_s[,3:6], mtour2, "penguins_manual_bl.gif", col=col, dir = "images/manual2")

## ----eval=FALSE, echo=FALSE------------------------------------------------------------
## render_gif(penguins[,3:6], local_tour(start=best_proj, 0.9),
##            display_xy(col=col, axes="bottomleft"),
##            "penguins2d_local.gif",
##            frames=200, width=300, height=300)

## ----runthis16, eval=FALSE, echo=FALSE-------------------------------------------------
## animate_xy(penguins[,3:6], local_tour(start=best_proj, 0.9),
##            axes = "bottomleft", col=col)

## ----eval=FALSE, echo=FALSE------------------------------------------------------------
## render_gif(penguins[,3:6], grand_tour(),
##            display_dist(half_range=1.3),
##            "penguins1d.gif",
##            frames=100, width=400, height=300)
## render_gif(penguins[,3:6], grand_tour(),
##            display_density2d(col=col, axes="bottomleft"),
##            "penguins2d_dens.gif",
##            frames=100, width=300, height=300)

## ----runthis17, eval=FALSE, echo=FALSE-------------------------------------------------
## animate_dist(penguins[,3:6], half_range=1.3)
## animate_density2d(penguins[,3:6], col=col, axes="bottomleft")

## ----eval=FALSE------------------------------------------------------------------------
## library(tourr)
## data(flea)
## ?animate_xy
## # On a Mac, you may need to start a quartz graphics window
## # quartz()
## # On windows, you may need to start an X11 graphics window
## # X11()
## animate_xy(flea[, 1:6])
## # If you want to use your RStudio graphics window, it might show up better
## # if you reduce the frame rate for drawing.
## animate_xy(flea[, 1:6], fps=10)

## ----echo=FALSE------------------------------------------------------------------------
countdown::countdown(2,0)


require(jsonlite)
require(dplyr)
require(ggplot2)
require(readr)
require(coin)
library(resample)

require(rcompanion)
require(multcompView)
library(FSA)
require(DescTools)

require(tibble)
library(broom)
library(cluster)
library(ggdendro)
require(tidyverse, quietly = TRUE, warn.conflicts = FALSE)
require(PMCMR)

colorder <- c( "blue", "green", "orange", "red")

data_spreadind <- read_csv("data/dataframe_spreading.data")
data_spreadind$algorithm = factor(data_spreadind$algorithm, levels=c("GreedyTotal","GreedyAdditional","ARTMaxMin","Genetic"))
data_group_spreadind <- read_csv("data/dataframe_group_spreading.data")
data_group_spreadind$algorithm = factor(data_group_spreadind$algorithm, levels=c("GreedyTotal","GreedyAdditional","ARTMaxMin","Genetic"))

summary(data_apfd)
summary(data_spreadind)
summary(data_group_spreadind)

data_spreadind %>%
    filter(spreading > 0, covLevel == "statement") %>%
    mutate(project = paste(project,"(stmt-cov)", sep="")) %>%
    ggplot(aes(y=spreading, fill=algorithm)) +
    geom_boxplot(aes(x = version),outlier.colour="red")+
    ylab("Spreading")+
    xlab("Versions")+
    scale_fill_manual(values=colorder,name="Algorithms")+
    facet_wrap(~project, scales = "free")

data_spreadind %>%
    filter(spreading > 0) %>%
    ggplot(aes(x=spreading, color=algorithm)) +
    geom_density() +
    facet_wrap(~project)

data_group_spreadind %>%
  filter(gspreading > 0, covLevel == "statement") %>%
  mutate(version = substr(version,0, 6)) %>%
  mutate(project = paste(project,"(stmt-cov)", sep="")) %>%
  ggplot(aes(y=gspreading, fill=algorithm)) +
  geom_boxplot(aes(x = version),outlier.colour="red")+
  ylab("Group-Spreading")+
  xlab("Versions")+
  scale_fill_manual(values=colorder,name="Algorithms")+
  facet_wrap(~project, scales = "free")

data_group_spreadind %>%
  filter(gspreading > 0) %>%
  ggplot(aes(x=gspreading, color=algorithm)) +
  geom_density() +
  facet_wrap(~project)

for(proj in unique(data_group_spreadind$project)){
  dataTest <- data_group_spreadind %>%
    filter(covLevel == "statement", project==proj) %>%
    mutate(algorithm = factor(algorithm, levels=unique(algorithm)))
  kruskal.test(gspreading ~ algorithm, data=dataTest)
  PT = dunnTest(gspreading ~ algorithm, data=dataTest, method = "bh")
  PT = PT$res
  result <- cldList(comparison = PT$Comparison,
                    p.value = PT$P.adj,
                    threshold = 0.05)
  print(proj)
  print(result)
}
dataTest <- data_group_spreadind %>%
  filter(covLevel == "statement")
beanplot(gspreading ~ algorithm, data=dataTest, log="",col="white",method="jitter")

data_spreadind %>%
    filter(spreading > 0, covLevel == "method") %>%
    mutate(version = substr(version,0, 6)) %>%
    mutate(project = paste(project,"(meth-cov)", sep="")) %>%
    ggplot(aes(y=spreading, fill=algorithm)) +
    geom_boxplot(aes(x = version),outlier.colour="red")+
    ylab("Spreading")+
    xlab("Versions")+
    scale_fill_manual(values=colorder,name="Algorithms")+
    theme(axis.text.x = element_text(angle=45, hjust = 0.5, vjust = 0.5))+
    facet_wrap(~project, scales = "free")

for(proj in unique(data_spreadind$project)){
  dataTest <- data_spreadind %>%
    filter(covLevel == "statement", project==proj) %>%
    mutate(algorithm = factor(algorithm, levels=unique(algorithm)))
  kruskal.test(spreading ~ algorithm, data=dataTest)
  PT = dunnTest(spreading ~ algorithm, data=dataTest, method = "bh")
  PT = PT$res
  result <- cldList(comparison = PT$Comparison,
          p.value = PT$P.adj,
          threshold = 0.05)
  print(proj)
  print(result)
}
dataTest <- data_spreadind %>%
  filter(covLevel == "statement")
beanplot(spreading ~ algorithm, data=dataTest, log="",col="white",method="jitter")

# Calcular IC

result_spreading = data.frame(project=character(),
                              algorithm=character(),
                              X2.5.=double(),
                              x97.5.=double(),
                              stringsAsFactors = FALSE)

for(proj in unique(data_spreadind$project)){
  for(alg in unique(data_spreadind$algorithm)){
    result <- data_spreadind %>%
      filter(covLevel == "statement", project==proj, algorithm==alg) %>%
      select(spreading) %>%
      resample::bootstrap(mean(spreading), R = 5000) %>%
      CI.percentile(probs = c(.025, .975))
    result <- data.frame(result)
    result$algorithm = alg
    result$project = proj
    result_spreading <- rbind(result_spreading, result)
  }
}

result_spreading$algorithm = factor(result_spreading$algorithm, levels=c("GreedyTotal","GreedyAdditional","ARTMaxMin","Genetic"))
result_spreading %>%
  ggplot(aes(x = algorithm, ymin = X2.5., ymax = X97.5., color=algorithm))+
  geom_errorbar(width = .4) +
  scale_color_manual(values=colorder,name="Algorithms")+
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank())+
  facet_wrap(~project, scales = "free")

result_group_spreading = data.frame(project=character(),
                              algorithm=character(),
                              X2.5.=double(),
                              x97.5.=double(),
                              stringsAsFactors = FALSE)

for(proj in unique(data_group_spreadind$project)){
  for(alg in unique(data_group_spreadind$algorithm)){
    result <- data_group_spreadind %>%
      filter(covLevel == "statement", project==proj, algorithm==alg, gspreading > 0) %>%
      select(gspreading) %>%
      resample::bootstrap(mean(gspreading), R = 5000) %>%
      CI.percentile(probs = c(.025, .975))
    result <- data.frame(result)
    result$algorithm = alg
    result$project = proj
    result_group_spreading <- rbind(result_group_spreading, result)
  }
}

result_group_spreading$algorithm = factor(result_group_spreading$algorithm, levels=c("GreedyTotal","GreedyAdditional","ARTMaxMin","Genetic"))
result_group_spreading %>%
  ggplot(aes(x = algorithm, ymin = X2.5., ymax = X97.5., color=algorithm))+
  geom_errorbar(width = .4) +
  scale_color_manual(values=colorder,name="Algorithms")+
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank())+
  facet_wrap(~project, scales = "free")

#Análise descritiva

data_spreadind %>%
  filter(spreading > 0, covLevel=="statement") %>%
  ggplot(aes(x=project, fill=project))+
  theme(axis.text.x=element_text(angle = 45, hjust = 1),
        axis.ticks.x=element_blank())+
  labs(x="Projects", y="Number of Faults")+
  scale_fill_grey()+
  geom_bar()


# Vizualizacija

# funkcija ki pretvori datum rojstva v starost osebe
datum_v_starost <- function(datum_rojstva, trenutni_datum){
  starost <- year(trenutni_datum) - year(datum_rojstva) - 1
  docakal_rd <- 0
  if (month(trenutni_datum) > month(datum_rojstva))
    docakal_rd <- 1
  if (month(trenutni_datum) == month(datum_rojstva) & mday(trenutni_datum) >= mday(datum_rojstva))
    docakal_rd <- 1
  starost <- starost + docakal_rd
  return(starost)
}

Tabela20 <- read_csv2("podatki/Tabela20.csv", locale=locale(encoding="Windows-1250")) %>%
  select(-X1) %>%
  mutate(Starost =  datum_v_starost(Rojstvo, Sys.Date()))

# BIO
# delez moskih in zensk ####################################################

tabelaBIO <- Tabela20 %>% select(ImePriimek, Spol, Premozenje, Vir, Starost)

delez <- tabelaBIO %>% count(Spol)

df <- delez %>% mutate(Percent=n/sum(n))
df[is.na(df)] <- "Family" #nastavil NA na vrednost

blank_theme <- theme_minimal()+
  theme(
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    panel.border = element_blank(),
    panel.grid=element_blank(),
    axis.ticks = element_blank()
  )

pie_spol <- ggplot(df, aes(x="", y=n, fill=Spol)) +
  geom_bar(width = 1, stat = "identity") +
  coord_polar("y", start=0) +
  scale_fill_manual(values=c("#E69F00","#999999", "#56B4E9" )) +
  blank_theme +
  theme(axis.text.x=element_blank()) +
  geom_text(data = df %>% filter(n >= 10), aes(y = n/2 + c(0, cumsum(n)[-length(n)]),
                label = percent(Percent)), size=5)+
  labs(title="Delež moških in žensk")

# izris povprecnega premozenja za dolocneo starost #############################
povprecje <- tabelaBIO %>% group_by(Starost) %>%
  summarise(PovprecnoPremozenje = median(Premozenje, na.rm = FALSE))

ggBio_leta <- ggplot(data=povprecje, aes(x=Starost, y=PovprecnoPremozenje)) +
  geom_bar(stat = "identity", fill="deepskyblue3", color="black") +
  labs(title="Povprečno premoženje za določeno strost") +
  ylab("Mio €") +
  scale_x_continuous("Starost (leta)", breaks = seq(32, 100, 4), limits = c(32,100)) +
  geom_text(data=povprecje %>% slice_max(PovprecnoPremozenje, n=1),
            aes(label=PovprecnoPremozenje), nudge_y=1000)

# tabela odstopanj ############################################################
M_max_premozenje <- tabelaBIO[tabelaBIO$Spol == "M",] %>% slice_max(Premozenje)
M_max_starost <- tabelaBIO[tabelaBIO$Spol == "M",] %>% slice_max(Starost)
M_min_starost <- tabelaBIO[tabelaBIO$Spol == "M",] %>% slice_min(Starost)
M_mean <- tabelaBIO[tabelaBIO$Spol == "M",] %>% summarise(PvprecnaStarost = round(mean(Starost, na.rm = TRUE)))

F_max_premozenje <- tabelaBIO[tabelaBIO$Spol == "F",] %>% slice_max(Premozenje)
F_max_starost <- tabelaBIO[tabelaBIO$Spol == "F",] %>% slice_max(Starost)
F_min_starost <- tabelaBIO[tabelaBIO$Spol == "F",] %>% slice_min(Starost)
F_mean <- tabelaBIO[tabelaBIO$Spol == "F",] %>% summarise(PvprecnaStarost = round(mean(Starost, na.rm = TRUE)))

#moski
Odstopanja_M <- rbind(M_max_premozenje,
                           M_max_starost,
                           M_min_starost) %>% mutate(M_mean)

#zenske
Odstopanja_F <- rbind(F_max_premozenje,
                      F_max_starost,
                      F_min_starost) %>% mutate(F_mean)

najnaj <- c("Najbogatejši",
            "Najstarejši",
            "Najmlajši",
            "Najbogatejša",
            "Najstarejša",
            "Najmlajša")
Odstopanja <- rbind(Odstopanja_M, Odstopanja_F) %>% mutate(NajNaj=najnaj)
Odstopanja
Odstopanja <- Odstopanja[c(7, 1, 2, 3, 4, 5, 6)]

tabelaOdstopanj <- kable(Odstopanja, caption = "Tabela odstopanj")

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

# PANG
tabelaPANG <- Tabela20 %>% select(ImePriimek, Kategorija, Premozenje)

panoge <- tabelaPANG %>% group_by(Kategorija) %>% summarise(Povrecno_premozenje=mean(Premozenje),
                                                            st_oseb=n_distinct(ImePriimek))

# Povpreno premozenje na kategorijo ############################################
ggPang <- ggplot(data=panoge, aes(x=Kategorija, y=Povrecno_premozenje, fill=Kategorija)) +
  geom_bar(stat = "identity", position=position_dodge(), colour="black") +
  scale_y_continuous(breaks = seq(0, 26000, by=2000), limits = c(0, 26000))+
  theme(axis.text.x=element_blank(),
        axis.ticks = element_blank())+
  labs(title="Povprečno premoženje glede na panogo v mio €")+
  xlab("Panoge") +
  ylab("Mio €") +
  guides(fill=guide_legend("Panoge"))

# St oseb na panogo ############################################################
ggPangPie <- ggplot(data=panoge, aes(x="", y=st_oseb, fill=reorder(Kategorija, st_oseb))) +
  geom_bar(width = 1, stat = "identity",  colour="black") +
  coord_polar(theta="y") +
  scale_y_continuous(breaks = seq(0, 200, by=40)) +
  labs(title="Število oseb v posamezni panogi") +
  xlab("") +
  ylab("") +
  guides(fill=guide_legend("Panoge")) +
  blank_theme

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

#TOP
TabelaTOP <- read_csv2("podatki/Tabela.csv", locale=locale(encoding="Windows-1250")) %>%
  select(-X1)

topImena20 <- filter(TabelaTOP, Leto == 2020) %>% .[1:8,] %>% .$ImePriimek

top <- filter(TabelaTOP, ImePriimek %in% topImena20)

# Prikaz premozenja v obdobju 2015-2020 #######################################
ggTop <- ggplot(data=top, aes(x=Leto, y=Premozenje, color = ImePriimek)) +
  geom_line() +
  geom_point() +
  labs(title="Spreminjanje premoženja najbogatejših ljudi na svetu")+
  xlab("Leto") +
  ylab("Mio €") +
  guides(color=guide_legend("TOP 8"))

# Najboljši napredek v obobju 2015-2020 ########################################
max_napredovanje <- top %>% group_by(ImePriimek) %>% mutate(Napredovanje=(Premozenje - lag(Premozenje))) %>%
  group_by(ImePriimek) %>% slice_max(Napredovanje)

napredek <- ggplot(data=max_napredovanje, aes(x=ImePriimek, y=Napredovanje, fill = ImePriimek)) +
  geom_bar(width = 1, stat = "identity", position=position_dodge(), color="black") +
  geom_text(aes(label=Leto), vjust=3, color="white", size=3.5) +
  geom_text(aes(label=Napredovanje), vjust=1.5, color="white", size=3.5) +
  theme(axis.text.x=element_blank()) +
  labs(title="Povečanje premoženja v obdobju 2015-2020")+
  xlab("Osebe") +
  ylab("Mio €") +
  guides(fill=guide_legend("TOP 8"))


#' Fitting bivariate/multivariate MGL and MGL-EV copula regression models.
#'
#' @description \code{MGL.reg} is used to fit bivariate MGL and MGL-EV copula regression models for two continuous variables.
#' @param U two-dimensional matrix with values in \eqn{[0,1]}.
#' @param X design matrix
#' @param copula 'MGL', 'MGL180', "MGL-EV", "MGL-EV180", "Gumbel", "MGB2".
#' @param initpar Initial values for the parameters to be optimized over.
#' @param hessian Logical. Should a numerically differentiated Hessian matrix be returned?
#' @param ... additional arguments, see \code{\link[stats]{optim}} for more details.
#' @importFrom stats qbeta
#' @importFrom stats optim
#' @return A list containing the following components:
#' * loglike: the value of the estimated maximum of the loglikelihood function.
#' * copula: the name of the fitted copula. "MGL180" and "MGL-EV180" denote the survival MGL and MGL-EV copula respectively.
#' * estimates: the point at which the maximum value of the loglikelihood is obtained.
#' * se: the standard errors of the estimators.
#' * AIC, BIC: the goodness fit of the regression models.
#' * hessian: the hessian at the estimated maximum of the loglikelihood (if requested).
#' @details
#' The estimation method is performed via \code{\link[stats]{optim}} function. Y1 and Y2 are both continuous variables.
#'
#' copula: "MGL180" and "MGLEV180" denote the survival MGL and survival MGL-EV copula respectively.
#' * For "Gumbel" regression model, the copula parameter \deqn{\delta_i = \exp(X_i^T\beta) + 1,} where \eqn{{X}_{i}=(1,x_{i1}...,x_{ik})} denotes the vector of covariates and \eqn{\beta} is the vector of coefficients to be estimated in the copula regression.
#' * For "MGL", "MGL180", "MGL-EV", "MGL-EV180" regression model, the copula parameter \deqn{\delta_i = \exp(X_i^T\beta).}
#' * For "MGB2", the copula parameter \deqn{\q_i = \exp(X_i^T\beta)} and \eqn{(p_1,p_2)} remain to be constant.
#' * Note that the regression modelling can be extended to the high-dimensional case when copula is "MGL180" and "MGL".
#'
#' @examples
#' # 10-dimensional regression models
#' set.seed(111)
#' d <- 10
#' n <- 1000 # sample size
#' beta.true <- c(-0.6, 0.5, 0.2) # true regression coefficients
#' x1 <- rnorm(n, 0, 1)
#' x2 <- rnorm(n, 0, 1)
#' X <- model.matrix(~ x1 + x2) # design matrix
#' delta.sim <- as.vector(exp(X%*%beta.true)) # true copula parameters
#' Usim <- matrix(0, nrow = n, ncol = d)
#' for (i in 1:n){
#'   Usim[i, ] <- rcMGL.multi(n = 1, d = d, pars = delta.sim[i])
#' }
#' m.MGLMGA <- MGL.reg(U = Usim, copula = "MGL",
#'                        X = X, method = "Nelder-Mead",
#'                        initpar = c(-0.32, 0.001, 0.001)
#' )
#' m.MGLMGA
#'
#' @export
#'
#'
MGL.reg <- function(U, X, copula = c(
                      "MGL", "MGL180", "MGL-EV",
                      "MGL-EV180",
                      "Gumbel", "MGB2"),
                    hessian = TRUE, initpar, ...) {
  dcMGL.reg <- function(U, param) {
    dim <- length(U)
    a <- 1 / param[1]
    q <- qbeta(1 - U, shape1 = 0.5, shape2 = a) / (1 - qbeta(1 - U, shape1 = 0.5, shape2 = a))
    logdc <- (dim - 1) * lgamma(a) + lgamma(a + dim / 2) - dim * lgamma(a + 0.5) + (a + 0.5) * sum(log(q + 1)) - (a + dim / 2) * log(sum(q) + 1)
    out <- exp(logdc)
    return(out)
  }

  dcMGL180.reg <- function(U, param) {
    dcMGL.reg(1 - U, param = param)
  }

  dcMGLEV180.reg <- function(U, param) {
    u1 <- U[1]
    u2 <- U[2]
    as.numeric(dcMGLEV180.bivar(u1, u2, param = param[1]))
  }

  dcMGLEV.reg <- function(U, param) {
    u1 <- U[1]
    u2 <- U[2]
    as.numeric(dcMGLEV.bivar(u1, u2, param = param[1]))
  }

  dgumcop.reg <- function(U, param) {
    as.numeric(fCopulae::devCopula(u = U[1], v = U[2], type = "gumbel", param = param[1])) # Bivariate Extreme
  }

  if (copula == "MGL") {
    dcop <- dcMGL.reg
  } else if (copula == "MGL180") {
    dcop <- dcMGL180.reg
  } else if (copula == "MGL-EV") {
    dcop <- dcMGLEV.reg
  } else if (copula == "MGL-EV180") {
    dcop <- dcMGLEV180.reg
  } else if (copula == "Gumbel") {
    dcop <- dgumcop.reg
  }

  copLogL <- function(pars, X) {
    ll <- 0

    if (copula == "Gumbel") {
      delta <- exp(X %*% pars) + 1
      for (i in seq_len(nrow(X))) {ll[i] <- dcop(U[i, ], param = as.vector(delta[i]))}
    } else if (copula == "MGB2"){
      p1 <- exp(pars[ncol(X) + 1])
      p2 <- exp(pars[ncol(X) + 2])
      q <- exp(X%*%pars[1:(ncol(X))])
      for (i in seq_len(nrow(X))) {ll[i] <- dcMGB2.bivar(u1 = U[i,1], u2 = U[i,2], pars1 = p1, pars2 = p2, pars3 = q[i])}
    } else {
      delta <- exp(X %*% pars)
      for (i in seq_len(nrow(X))) {ll[i] <- dcop(U[i, ], param = as.vector(delta[i]))}
    }
    res <- -sum((log(ll)))
    return(res)
  }

  resopt <- optim(
    par = initpar,
    fn = copLogL,
    X = X,
    hessian = hessian, ...
  )

  if (hessian == TRUE){
  out <- list(
          loglike = -resopt$value,
          copula = list(name = copula),
          estimates = resopt$par,
          se = sqrt(diag(solve(resopt$hessian))),
          hessian = -resopt$hessian,
          AIC = 2 * length(resopt$par) + 2 * resopt$value,
          BIC = log(nrow(U)) * length(resopt$par) + 2 * resopt$value)
  } else {
    out <- list(
      loglike = -resopt$value,
      copula = list(name = copula),
      estimates = resopt$par,
      AIC = 2 * length(resopt$par) + 2 * resopt$value,
      BIC = log(nrow(U)) * length(resopt$par) + 2 * resopt$value)
  }
  out

}


library(MplusAutomation)
setwd("./")

this.dir<- dirname(parent.frame(2)$ofile)
parent.dir <- strsplit(this.dir,'scripts')[[1]]
setwd(parent.dir)

scaleMaxMin10 <- function(x){
  a = 10.0/max(x, na.rm=T)
  scaledvar = a*x
  return(scaledvar)
}

prep_missing <- function (data) {
  dataf <- read.table(paste0("data/",data,".csv"),sep=",",header=TRUE) #,na.strings = "")
  dataf = as.data.frame(lapply(dataf, scaleMaxMin10)) # obtain scaled dataframe
  outfile = paste0("./data/",data,"-missing.dat")
  head(dataf)
  prepareMplusData(dataf, outfile) # produce input for Mplus, remove first column (city)
}

prep <- function (data) {
  dataf <- read.table(paste0("data/",data,".csv"),sep=",",header=TRUE) #,na.strings = "")
  for(i in 1:ncol(dataf)){
    dataf[is.na(dataf[,i]), i] <- mean(dataf[,i], na.rm = TRUE)
  }
  dataf = as.data.frame(lapply(dataf, scaleMaxMin10)) # obtain scaled dataframe
  outfile = paste0("./data/",data,".dat")
  head(dataf)
  prepareMplusData(dataf, outfile) # produce input for Mplus, remove first column (city)
}

prep('urbandata2019-64var-id-sorted-updated') #output: 'urbandata2019-64var-id-sorted-updated.dat'
prep_missing('urbandata2019-64var-id-sorted-updated') #output: 'urbandata2019-64var-id-sorted-updated-missing.dat'


library(ggplot2)
library(plyr)

S <- 0.005
H <- 5
E <- 100

hic <- read.delim("hic.csv")
oeg <- read.delim("oeg.csv")
rna <- read.delim("rna.csv")
rna$padj[is.na(rna$padj)] <- 1

print(nrow(rna))
print(nrow(rna[rna$padj < S,]))
print(nrow(rna[rna$padj < S & rna$log2FoldChange > 0,]))
print(nrow(rna[rna$padj < S & rna$log2FoldChange < 0,]))
print(table(rna[rna$padj < S, 'biotype']))

a <- (rna$activated.1 + rna$activated.2) / 2 >= E
b <- (rna$nonactivated.1 + rna$nonactivated.2) / 2 >= E
print(sum(a)) # expressed act
print(sum(b)) # expressed nonact
print(sum(a | b)) # expressed union

print(nrow(hic))
c <- hic$activated >= H & hic$nonactivated < H
d <- hic$activated < H & hic$nonactivated >= H
print(nrow(hic[c | d,])) # diff contact
print(nrow(hic[c,])) # upreg
print(nrow(hic[d,])) # downreg

e <- hic$activated >= H
f <- hic$nonactivated >= H
print(sum(e))
print(sum(f))
print(sum(e | f))

png("1.png")
ggplot(hic, aes(log2(nonactivated + 0.1), log2(activated + 0.1))) + geom_point() + geom_rug(alpha=0.1)
dev.off()

all <- merge(merge(hic, oeg), rna)
sig <- all[all$padj < S,]
sgu <- unique(sig[,colnames(hic)])

png("2.png")
ggplot(sgu, aes(log2(nonactivated + 0.1), log2(activated + 0.1))) + geom_point() + geom_rug(alpha=0.1)
dev.off()

act <- ddply(hic[hic$activated >= H,], 'oeID', function(x) data.frame(nactivated=nrow(x)))
nct <- ddply(hic[hic$nonactivated >= H,], 'oeID', function(x) data.frame(nnonactivated=nrow(x)))
nin <- merge(act, nct, all=T)
nin$nactivated[is.na(nin$nactivated)] <- 0
nin$nnonactivated[is.na(nin$nnonactivated)] <- 0

png("3.png")
ggplot(nin, aes(nnonactivated, nactivated)) + geom_point() + geom_jitter() + geom_rug(alpha=0.1)
dev.off()

nnn <- merge(merge(nin, oeg), rna)
snn <- nnn[nnn$padj < S,]
unn <- unique(snn[,colnames(nin)])

png("4.png")
ggplot(unn, aes(nnonactivated, nactivated)) + geom_point() + geom_jitter() + geom_rug(alpha=0.1)
dev.off()


library(tidyverse)
library(jsonlite)
library(here)

# owid data is organised as a list of data frames, keyed by country (iso3)
owid <- get_owid()

owid %>%
  bind_rows(.id = "iso3") %>%
  unpack(data) %>%
  mutate(date = as.Date(date)) ->
owid

# fyi: some indicators are singletons (bind_rows recycles them!):
# - continent
# - location
# - population
# - population_density
# - median_age
# - aged_65_older
# - aged_70_older
# - gdp_per_capita
# - extreme_poverty
# - cardiovasc_death_rate
# - diabetes_prevalence
# - female_smokers
# - male_smokers
# - hospital_beds_per_thousand
# - life_expectancy
# - human_development_index
View(owid)

# okay, let's do a quick example: vaccine % over time
owid %>%
  select(iso3, location, continent, population, date,
    people_fully_vaccinated) %>%
  filter(
    !is.na(people_fully_vaccinated),
    !str_starts(iso3, "OWID_")) %>%
  mutate(vac_prop = people_fully_vaccinated / population) ->
owid_pct_vaxxed

owid_pct_vaxxed %>%
{
  ggplot(.) +
    aes(x = date, y = vac_prop, colour = "iso3") +
    geom_line() +
    geom_point(size = 3) +
    scale_y_continuous(labels = scales::percent) +
    labs(
      x = NULL, y = "% Fully vaccinated"
    )
}


physics.density.calculate <- function(mass, volume) {
    return(mass/volume/1000)
}


#' @title calcActualDisp
#'
#' @description Estimate actual loaded displacement (\code{actualDisplacement})
#' (m^3) using a vessel's actual draft.
#'
#' @param Cb Maximum block coefficient (vector of numericals, dimensionless) (see \code{\link{calcCb}})
#' @param Cbw Waterline block coefficient (vector of numericals, dimensionless) (see \code{\link{calcCbw}})
#' @param actualDraft Actual draft (vector of numericals, m)
#' @param maxDraft Maximum summer load line draft (vector of numericals, m)
#' @param maxDisplacement Maximum ship displacement (vector of numericals, m^3)
#'
#' @details
#' Loaded displacement is estimated using actual draft. Actual draft is
#' typically obtained from sources such as AIS messages or ship records.
#' Uses Riddlesworth method (MAN, 2011).
#'
#' @return \code{actualDisplacement} (vector of numericals, m^3)
#'
#' @references
#' \href{https://www.man-es.com/marine/products/propeller-aft-ship}{MAN Energy
#'  Solutions. 2011. "Basic Principles of Propulsion." pg. 9.}
#'
#' @seealso \code{\link{calcCb}}, \code{\link{calcCbw}}
#'
#' @examples
#' calcActualDisp(c(0.82,0.66), c(0.81,0.65), c(12.5,11.1), c(13.6,11.5), c(80097,52382))
#' calcActualDisp(0.82, 0.81, 12.5, 13.6, 80097)
#'
#' @export

calcActualDisp <- function(Cb, Cbw, actualDraft, maxDraft, maxDisplacement){

  actualDisplacement<- ((pmin(0.99,
                      Cb
  ))/Cbw)*(actualDraft/maxDraft)*maxDisplacement
  return(actualDisplacement)

}


data1 <- read.csv("../submission/02_xgb_nummodel10_mvalid0.8424.csv")
data2 <- read.csv("../submission/01_nn_nummodel10_mvalid0.8416.csv")
data3 <- read.csv("../submission/03_xgb_with_knn_nummodel10_mvalid0.8497.csv")

submission <- data1

preds <- 0.5 * data1[,2] + 0.25 * data2[,2] + 0.25 * data3[,2]

tc <- read.csv("../dataset/test.csv")

## This postprocessing is imspired by ZFTurbo's script
## https://www.kaggle.com/zfturbo/santander-customer-satisfaction/to-the-top-v3

nv <- tc['num_var33'] + tc['saldo_medio_var33_ult3'] + tc['saldo_medio_var44_hace2'] + tc['saldo_medio_var44_hace3'] + tc['saldo_medio_var33_ult1'] + tc['saldo_medio_var44_ult1']

preds[nv > 0] = 0
preds[tc['var15'] < 23] = 0
preds[tc['saldo_medio_var5_hace2'] > 160000] = 0
preds[tc['saldo_var33'] > 0] = 0
preds[tc['var38'] > 3988596] = 0
preds[tc['var21'] > 7500] = 0
preds[tc['num_var30'] > 9] = 0
preds[tc['num_var13_0'] > 6] = 0
preds[tc['num_var33_0'] > 0] = 0
preds[tc['imp_ent_var16_ult1'] > 51003] = 0
preds[tc['imp_op_var39_comer_ult3'] > 13184] = 0
preds[tc['saldo_medio_var5_ult3'] > 108251] = 0

submission[,2] <- preds

write.table(submission, "../submission/04_all_averaging_and_postprocessig.csv", row.names = FALSE, sep = ",", quote = FALSE)