In DarkEyes/MRReg: MDL Multiresolution Linear Regression Framework

Edit: 07/24/2020 TKDD REV2

Code running block: the framework execution chunk starts here!

instruction - Please run all chunks above (Ctrl+Alt+P) - Then set the parameter below (Input: DataT and gamma) - Run all chunks below to start the framwork

Explanation: FindMaxHomoPartition(DataT,gamma) - INPUT: DataT$X[i,j] is the value of jth independent variable of ith individual. - INPUT: DataT$Y[i] is the value of dependent variable of ith individual. - INPUT: DataT$clsLayer[i,k] is the cluster label of ith individual in kth cluster layer.

OUTPUT: Copt[p,1] is equal to k means a cluster that is a pth member of the maximal homogeneous partition is at kth layer and the cluster name in kth layer is Copt[p,2]
OUTPUT: Copt[p,3] is "Model Information Reduction Ratio" of pth member of the maximal homogeneous partition: positive means the linear model is better than the null model.
OUTPUT: Copt[p,4] is $$R^2(C)_{\text{cv}}$$ of pth member of the maximal homogeneous partition. The greater Copt[p,4], the higher homoheneous degree of this cluster.
OUTPUT: models[[k]][[j]] is the linear regression model of jth cluster in kth layer.
OUTPUT: models[[k]][[j]]$clustInfoRecRatio is the "Cluster Information Reduction Ratio" between the jth cluster in kth layer and its children clusters in (k+1)th layer: positive means current cluster is better than its children clusters. Hence, we should keep this cluster at the member of maximal homogeneous partition instead of its children.

#========= Test 
library(MRReg)
source("supportExpFunctions.R")
load(file="../data/SimGT.RData")
# DataT<-clusterSimpleGenT1Func(10000)
# DataT<-clusterSimpleGenT2Func(10000)
# DataT<-clusterSimpleGenT3Func(10000)
#DataT<-clusterSimpleGenT4Func(10000) # Type of simulation datasets
DataT<-SimpleSimulation(1000,type=4)

gamma <- 0.05 # Gamma parameter

out<-FindMaxHomoOptimalPartitions(DataT,gamma, expFlag = FALSE )

out2<-greedyAlgo(out$DataT,out)
CoptGreedy<-out2$Copt

OPTresiduals<-getResidualFromCopt(out$Copt,out$models)$residuals
GreedyResiduals<-getResidualFromCopt(CoptGreedy,out$models)$residuals
RegResiduals<-out$models[[1]][[1]]$residuals
H0Residuals<-DataT$Y - mean(DataT$Y)
cat("\014") 
print(sprintf("OPT Residuals: RMSE=%g",sqrt(mean(OPTresiduals^2)) ))
print(sprintf("Greedy Residuals: RMSE=%g",sqrt(mean(GreedyResiduals^2)) ))
print(sprintf("Reg Residuals: RMSE=%g",sqrt(mean(RegResiduals^2)) ))
print(sprintf("\bar{Y} Residuals: RMSE=%g",sqrt(mean(H0Residuals^2)) ))
FscoreOut<-getPartitionFscore(T4GTCopt,out$Copt,DataT$clsLayer)
FscoreOut
getPartitionFscore(T4GTCopt,CoptGreedy,DataT$clsLayer)

TEST: iGraph output distplay

plotOptimalClustersTree(out)

PrintOptimalClustersResult(out, selFeature = TRUE)

Mixture Model

library("flexmix")
#DataT<-clusterSimpleGenT4Func(10000)
x<-DataT$X
y<-DataT$Y
df<- data.frame(y,x)
m2<-flexmix(y~.,data = df, k=4, control = list(minprior=0.2) )
predict(m2, data.frame( t(x[1,]) ) )
y[1]

Exp mixture model - as baseline method

library("flexmix")
library(MRReg)
source("supportExpFunctions.R")

DataT<-MRReg::SimpleSimulation(100,type=5)
x<-DataT$X
y<-DataT$Y
mixOut<-getRMSEFromMixtureModel(x,y,k=13, expFlag = TRUE)
getMixturePartitionFscore(DataT$TrueFeature,mixOut$clsVec)

Exp 100 mixture model

library(MRReg)
source("supportExpFunctions.R")
load(file="../data/SimGT.RData")
gamma<-0.05
RMSEtableRes<-matrix(0,100,5)
F1tableRes<-matrix(0,100,9)
simType=6
polyDegree = 3
for(i in seq(1,100))
{
  DataT<-MRReg::SimpleSimulation(100,type=simType, degree = polyDegree)
  x<-DataT$X
  y<-DataT$Y
  mixOut<-getRMSEFromMixtureModel(x,y,k=13, expFlag = FALSE)
  RMSEtableRes[i,4]<-mixOut$RMSE
  outMX<-getMixturePartitionFscore(DataT$TrueFeature,mixOut$clsVec)
  F1tableRes[i,9]<- outMX$Fscore
  F1tableRes[i,7]<-outMX$prcVal
  F1tableRes[i,8]<-outMX$recal

  out<-FindMaxHomoOptimalPartitions(DataT,gamma, expFlag = FALSE )

  out2<-greedyAlgo(out$DataT,out)
  CoptGreedy<-out2$Copt

  OPTresiduals<-getResidualFromCopt(out$Copt,out$models)$residuals
  GreedyResiduals<-getResidualFromCopt(CoptGreedy,out$models)$residuals
  RegResiduals<-out$models[[1]][[1]]$residuals
  H0Residuals<-DataT$Y - mean(DataT$Y)
  cat("\014") 
  RMSEtableRes[i,1] <-sqrt(mean(OPTresiduals^2)) 
  RMSEtableRes[i,2] <-sqrt(mean(GreedyResiduals^2))
  RMSEtableRes[i,3] <-sqrt(mean(RegResiduals^2))
  RMSEtableRes[i,5] <-sqrt(mean(H0Residuals^2))

  FscoreOut<-getPartitionFscore(T4GTCopt,out$Copt,DataT$clsLayer)
  F1tableRes[i,3]<- FscoreOut$Fscore
  F1tableRes[i,1]<-FscoreOut$prcVal
  F1tableRes[i,2]<-FscoreOut$recal

  GreedyFscoreOut<-getPartitionFscore(T4GTCopt,CoptGreedy,DataT$clsLayer)
  F1tableRes[i,6]<- GreedyFscoreOut$Fscore
  F1tableRes[i,4]<-GreedyFscoreOut$prcVal
  F1tableRes[i,5]<-GreedyFscoreOut$recal

  print(sprintf("Type%d #%d",simType,i) )
}
F1rowRes<-colMeans(F1tableRes)
RMSErowRes<-colMeans(RMSEtableRes)
print("Finish")
cat("\014")
save(RMSEtableRes,F1tableRes,F1rowRes,RMSErowRes,file = sprintf("T%dResout.rdata",simType) )

Data distribution

#barplot(table(DataT$X),xlab="Value",ylab="Frequency")
#barplot(table(DataT$Y),xlab="Value",ylab="Frequency")
DataT<-SimpleSimulation(indvN = 100, type = 5)
hist(DataT$X,xlab="Value",ylab="Frequency" ,main ="")
hist(DataT$Y,xlab="Value",ylab="Frequency" ,main ="")