Nothing
MonoInc <-
function(data,id.col,x.col,y.col,data.r=NULL,tol=0, direction='inc', w1=.5, min, max, impType1='nn', impType2='reg', sum=FALSE)
{
#This function will predict the missing value using a regression which will be used for the weighted regression imputation
pred.lm <- function(x,y,miss) #function to compute a predicted value not in the dataset - miss: x of missing y
{
fit <- lm(y~x)
slope <- fit$coefficients[[2]]
int <- fit$coefficients[[1]]
return(int + slope*miss)
}
########### Last Observation carried forward Function #############
LOCF.func <- function(data.keep, data.fix, xcol, ycol) #data.fix should have NAs for variable that will be imputed
{
ln <- data.fix
for(j in 1:nrow(data.fix))
{
data <- rbind(data.keep, data.fix[j,])
data <- data[order(data[,xcol]),]
m <- match(NA, data[,3])
if(isTRUE(m>1)==T) (ln[j,3] <- data[m-1,3])
}
return(ln)
}
############## Last & Next Imputation Function #################
LN.func <- function(data.keep, data.fix, xcol, ycol)
{
ln <- data.fix
for(j in 1:nrow(data.fix))
{
data <- rbind(data.keep, data.fix[j,])
data <- data[order(data[,xcol]),]
m <- match(NA, data[,3])
if(isTRUE(m>1)==T & isTRUE(m<nrow(data))==T) (ln[j,3] <- mean(c(data[m-1,3], data[m+1,3])))
}
return(ln)
}
###################### Fractional Regression Function ################
frac.reg <- function(x, y, miss)
{
fit <- lm(y~x)
slope <- fit$coefficients[[2]]
int <- fit$coefficients[[1]]
return(int + slope*miss + sample(fit$residuals,1))
}
############### Nearest Neighbor Function ###############
NN.func <- function(data.keep, data.fix, xcol, ycol) #returns matrix of all imputed values
{
n.y <- nrow(data.fix)
y.mat <- data.fix
for(j in 1:n.y)
{
nn <- which.min(abs(data.keep[,xcol] - data.fix[j,xcol])) #identify placement of nearest x neighbor
n<-data.keep[nn,xcol]
m<- which(data.keep[,xcol]==n)
if(data.fix[j,xcol]>=n && length(m)>1){
x<-max(m)
replace<-x
}else if(data.fix[j,xcol]<n && length(m)>1){
x<-min(m)
replace<-x
}else{
replace<-nn}
NN.y <- data.keep[replace,ycol] #identify y value of nearest neighbor
y.mat[j,ycol] <- NN.y
}
return(y.mat)
}
#flag data that needs to be imputed
flag<-mono.flag(data,id.col,x.col,y.col,min,max,data.r,tol, direction)
flag<- subset(flag, !(is.na(flag[,2])))
if(direction=="inc"){
#data.keep
mono1.keep<-foreach(i = 1:nrow(flag), .combine='rbind') %do%
{
if(flag[i,4]==FALSE && flag[i,5]==FALSE && isTRUE(is.na(flag[i,3]))==FALSE){
return(flag[i,])}
}
mono1.keep <-unique(mono1.keep[1:nrow(mono1.keep),])
mono1.keep <- subset(mono1.keep, !(is.na(mono1.keep[,2])))
mono.fix<-foreach(i = 1:nrow(flag), .combine='rbind') %do%
{
if(flag[i,4]==TRUE||flag[i,5]==TRUE||isTRUE(is.na(flag[i,3]))==TRUE){
return(flag[i,])}
}
mono.fix<-unique(mono.fix[1:nrow(mono.fix),])
mono.fix<- subset(mono.fix, !(is.na(mono.fix[,2])))
}else{
#data.keep
mono1.keep<-foreach(i = 1:nrow(flag), .combine='rbind') %do%
{
if(flag[i,4]==TRUE && flag[i,5]==FALSE && isTRUE(is.na(flag[i,3]))==FALSE){
return(flag[i,])}
}
mono1.keep <-unique(mono1.keep[1:nrow(mono1.keep),])
mono1.keep <- subset(mono1.keep, !(is.na(mono1.keep[,2])))
mono.fix<-foreach(i = 1:nrow(flag), .combine='rbind') %do%
{
if(flag[i,4]==FALSE||flag[i,5]==TRUE||isTRUE(is.na(flag[i,3]))==TRUE){
return(flag[i,])}
}
mono.fix<-unique(mono.fix[1:nrow(mono.fix),])
mono.fix<- subset(mono.fix, !(is.na(mono.fix[,2])))
}
#data.fix
mono.fix1<-mono.fix
mono.fix1[,3]<-NA
#impute data
if((sum==TRUE && is.null(impType1)==FALSE && is.null(impType2)==FALSE)||(sum==TRUE && is.null(impType1)==FALSE)){
cat("Error: choose either sum or an imputation method")
#summary
}else if(sum==TRUE){
#impute data
U<-unique(mono.fix[,1])
#NN
a <-foreach(i = 1:length(U), .combine='rbind') %do%
{
x<- subset(mono1.keep, mono1.keep[,1] ==U[i])
x<-x[order(x[,2]),]
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
z<-subset(mono.fix1, mono.fix1[,1]==U[i])
z<-z[order(z[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(length(x)==3)){
a<-y
names(a)<-names(x)
a<-as.data.frame(rbind(x,a))
a<-a[order(a[,2]),]
}else{
a <-NN.func(x,z, 2, 3)
names(a)<-names(x)
a<-as.data.frame(rbind(x,a))
a<-a[order(a[,2]),]
}
return(a)
}
a<-as.data.frame(rbind(a,mono1.keep))
a<-as.data.frame(unique(a[1:nrow(a),]))
a<-a[order(a[,1]),]
#REG
b <-foreach(i = 1:length(U), .combine='rbind') %do%
{
x<- as.data.frame(subset(mono1.keep, mono1.keep[,1] ==U[i])) #subset that doesnt need imputation
miss<-as.data.frame(subset(mono.fix1, mono.fix1[,1]==U[i])) #subset that needs imputation
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(sum(is.na(x[,3]))==1 && nrow(x)==2 )||(length(x)==3)){
b<- cbind(miss[,1:2], y[,3],miss[,4:5])
names(b)<-names(x)
b<-as.data.frame(rbind(x,b))
b<-b[order(b[,2]),]
}else{
b<-pred.lm(x[,2],x[,3],miss[,2])
b<- cbind(miss[,1:2], b,miss[,4:5])
names(b)<-names(x)
b<-as.data.frame(rbind(x,b))
b<-b[order(b[,2]),]
}
return(b)
}
b<-as.data.frame(rbind(b,mono1.keep))
b<-as.data.frame(unique(b[1:nrow(b),]))
b<-b[order(b[,1]),]
#LOCF
c <-foreach(i = 1:length(U), .combine='rbind') %do%
{
x<- subset(mono1.keep, mono1.keep[,1] ==U[i])
x<-x[order(x[,2]),]
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
z<-subset(mono.fix1, mono.fix1[,1]==U[i])
z<-z[order(z[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(length(x)==3)){
c<-y
names(c)<-names(x)
c<-as.data.frame(rbind(x,c))
c<-c[order(c[,2]),]
}else{
c <-LOCF.func(x,z, 2, 3)
names(c)<-names(x)
c<-as.data.frame(rbind(x,c))
c<-c[order(c[,2]),]
}
return(c)
}
c<-as.data.frame(rbind(c,mono1.keep))
c<-as.data.frame(unique(c[1:nrow(c),]))
c<-c[order(c[,1]),]
#LN
d <-foreach(i = 1:length(U), .combine='rbind') %do%
{
x<- subset(mono1.keep, mono1.keep[,1] ==U[i])
x<-x[order(x[,2]),]
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
z<-subset(mono.fix1, mono.fix1[,1]==U[i])
z<-z[order(z[,2]),]
if((sum(!is.na(x[,3])) == 0) || (sum(is.na(x[,3]))==1 && nrow(x)==2 )||(length(x)==3)){
d<-y
names(d)<-names(x)
d<-as.data.frame(rbind(x,d))
d<-d[order(d[,2]),]
}else{
d <-LN.func(x, z, 2, 3)
names(d)<-names(x)
d<-as.data.frame(rbind(x,d))
d<-d[order(d[,2]),]
}
return(d)
}
d<-as.data.frame(rbind(d,mono1.keep))
d<-as.data.frame(unique(d[1:nrow(d),]))
d<-d[order(d[,1]),]
#FR
e <-foreach(i = 1:length(U), .combine='rbind') %do%
{
x<- as.data.frame(subset(mono1.keep, mono1.keep[,1] ==U[i])) #subset that doesnt need imputation
miss<-as.data.frame(subset(mono.fix1, mono.fix1[,1]==U[i])) #subset that needs imputation
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(sum(is.na(x[,3]))==1 && nrow(x)==2 )||(length(x)==3)){
e<- cbind(miss[,1:2], y[,3],miss[,4:5])
names(e)<-names(x)
e<-as.data.frame(rbind(x,e))
e<-e[order(e[,2]),]
}else{
e<-frac.reg(x[,2],x[,3],miss[,2])
e<- cbind(miss[,1:2], e,miss[,4:5])
names(e)<-names(x)
e<-as.data.frame(rbind(x,e))
e<-e[order(e[,2]),]
}
return(e)
}
e<-as.data.frame(rbind(e,mono1.keep))
e<-as.data.frame(unique(e[1:nrow(e),]))
e<-e[order(e[,1]),]
mono.keep <-rbind(mono1.keep,mono.fix1) #all data with NAs for data that needs to be imputed
idx<-match(row.names(mono.keep), row.names(a))
idx<-na.omit(idx)
sortnames <- colnames(mono.keep)[1:2]
mono.keep <- mono.keep[do.call("order", mono.keep[sortnames]),]
mono.keep<-mono.keep[idx,]
idx<-row.names(mono.keep)
sum<-cbind(a[idx,1:2],mono.keep[idx,3],a[idx,3],b[idx,3],c[idx,3],d[idx,3],e[idx,3:5])
colnames(sum)<-c("ID", "X", "Y","Nearest.Neighbor", "Regression", "LOCF", "Last.Next","Fractional.Reg","Decreasing", "Outside.Range" )
return(sum)
}else if(sum==FALSE){
#ALL IMPUTATIONS
if(impType1 =="nn" && is.null(impType2)==TRUE){ #Nearest Neighbor Imputation
U<- unique(mono.fix[,1])
a <-foreach(i = 1:length(U), .combine='rbind') %do%
{
x<- subset(mono1.keep, mono1.keep[,1] ==U[i])
x<-x[order(x[,2]),]
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
z<-subset(mono.fix1, mono.fix1[,1]==U[i])
z<-z[order(z[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(length(x)==3)){
a<-y
names(a)<-names(x)
a<-as.data.frame(rbind(x,a))
a<-a[order(a[,2]),]
}else{
a <-NN.func(x,z, 2, 3)
names(a)<-names(x)
a<-as.data.frame(rbind(x,a))
a<-a[order(a[,2]),]
}
return(a)
}
a<-as.data.frame(rbind(a,mono1.keep))
a<-as.data.frame(unique(a[1:nrow(a),]))
a<-a[order(a[,1]),]
return(a)
}else if(impType1 =="reg" && is.null(impType2)==TRUE){ #Regression Imputation
U<- unique(mono.fix[,1])
b <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- as.data.frame(subset(mono1.keep, mono1.keep[,1] ==U[i])) #subset that doesnt need imputation
miss<-as.data.frame(subset(mono.fix1, mono.fix1[,1]==U[i])) #subset that needs imputation
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(sum(is.na(x[,3]))==1 && nrow(x)==2 )||(length(x)==3)){
b<- cbind(miss[,1:2], y[,3],miss[,4:5])
names(b)<-names(x)
b<-as.data.frame(rbind(x,b))
b<-b[order(b[,2]),]
}else{
b<-pred.lm(x[,2],x[,3],miss[,2])
b<- cbind(miss[,1:2], b,miss[,4:5])
names(b)<-names(x)
b<-as.data.frame(rbind(x,b))
b<-b[order(b[,2]),]
}
return(b)
}
b<-as.data.frame(rbind(b,mono1.keep))
b<-as.data.frame(unique(b[1:nrow(b),]))
b<-b[order(b[,1]),]
return(b)
}else if(impType1 =="locf" && is.null(impType2)==TRUE){ #Last Obervation Carried Forward
U<-unique(mono.fix[,1])
c <-foreach(i = 1:length(U), .combine='rbind') %do%
{
x<- subset(mono1.keep, mono1.keep[,1] ==U[i])
x<-x[order(x[,2]),]
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
z<-subset(mono.fix1, mono.fix1[,1]==U[i])
z<-z[order(z[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(length(x)==3)){
c<-y
names(c)<-names(x)
c<-as.data.frame(rbind(x,c))
c<-c[order(c[,2]),]
}else{
c <-LOCF.func(x,z, 2, 3)
names(c)<-names(x)
c<-as.data.frame(rbind(x,c))
c<-c[order(c[,2]),]
}
return(c)
}
c<-as.data.frame(rbind(c,mono1.keep))
c<-as.data.frame(unique(c[1:nrow(c),]))
c<-c[order(c[,1]),]
return(c)
}else if(impType1 =="ln" && is.null(impType2)==TRUE){ #Last and Next Imputation
U<-unique(mono.fix[,1])
d <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- subset(mono1.keep, mono1.keep[,1] ==U[i])
x<-x[order(x[,2]),]
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
z<-subset(mono.fix1, mono.fix1[,1]==U[i])
z<-z[order(z[,2]),]
if((sum(!is.na(x[,3])) == 0) || (sum(is.na(x[,3]))==1 && nrow(x)==2 )||(length(x)==3)){
d<-y
names(d)<-names(x)
d<-as.data.frame(rbind(x,d))
d<-d[order(d[,2]),]
}else{
d <-LN.func(x, z, 2, 3)
names(d)<-names(x)
d<-as.data.frame(rbind(x,d))
d<-d[order(d[,2]),]
}
return(d)
}
d<-as.data.frame(rbind(d,mono1.keep))
d<-as.data.frame(unique(d[1:nrow(d),]))
d<-d[order(d[,1]),]
return(d)
}else if(impType1 =="fr" && is.null(impType2)==TRUE){ #Fractional Regression Imputation
U<-unique(mono.fix[,1])
e <-foreach(i = 1:length(U), .combine='rbind') %do%
{
x<- as.data.frame(subset(mono1.keep, mono1.keep[,1] ==U[i])) #subset that doesnt need imputation
miss<-as.data.frame(subset(mono.fix1, mono.fix1[,1]==U[i])) #subset that needs imputation
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(sum(is.na(x[,3]))==1 && nrow(x)==2 )||(length(x)==3)){
e<- cbind(miss[,1:2], y[,3],miss[,4:5])
names(e)<-names(x)
e<-as.data.frame(rbind(x,e))
e<-e[order(e[,2]),]
}else{
e<-frac.reg(x[,2],x[,3],miss[,2])
e<- cbind(miss[,1:2], e,miss[,4:5])
names(e)<-names(x)
e<-as.data.frame(rbind(x,e))
e<-e[order(e[,2]),]
}
return(e)
}
e<-as.data.frame(rbind(e,mono1.keep))
e<-as.data.frame(unique(e[1:nrow(e),]))
e<-e[order(e[,1]),]
return(e)
###WEIGHTED IMPUTATIONS##
}else if((impType1 =="nn" && impType2=="reg") || (impType1 =="reg" && impType2=="nn")){
U<- unique(mono.fix[,1])
a <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- subset(mono1.keep, mono1.keep[,1] ==U[i])
x<-x[order(x[,2]),]
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
z<-subset(mono.fix1, mono.fix1[,1]==U[i])
z<-z[order(z[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(length(x)==3)){
a<-y
names(a)<-names(x)
a<-as.data.frame(rbind(x,a))
a<-a[order(a[,2]),]
}else{
a <-NN.func(x,z, 2, 3)
names(a)<-names(x)
a<-as.data.frame(rbind(x,a))
a<-a[order(a[,2]),]
}
return(a)
}
a<-as.data.frame(rbind(a,mono1.keep))
a<-as.data.frame(unique(a[1:nrow(a),]))
a<-a[order(a[,1]),]
#REG
b <-foreach(i = 1:length(U), .combine='rbind') %do%
{
x<- as.data.frame(subset(mono1.keep, mono1.keep[,1] ==U[i])) #subset that doesnt need imputation
miss<-as.data.frame(subset(mono.fix1, mono.fix1[,1]==U[i])) #subset that needs imputation
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(sum(is.na(x[,3]))==1 && nrow(x)==2 )||(length(x)==3)){
b <- cbind(miss[,1:2], y[,3],miss[,4:5])
names(b)<-names(x)
b<-as.data.frame(rbind(x,b))
b<-b[order(b[,2]),]
}else{
b<-pred.lm(x[,2],x[,3],miss[,2])
b<- cbind(miss[,1:2], b,miss[,4:5])
names(b)<-names(x)
b<-as.data.frame(rbind(x,b))
b<-b[order(b[,2]),]
}
return(b)
}
b<-as.data.frame(rbind(b,mono1.keep))
b<-as.data.frame(unique(b[1:nrow(b),]))
b<-b[order(b[,1]),]
common<- b[,1] %in% a[,1]
if(impType1=='nn'){
y.star<-a[common,3]
y.hat<-b[common,3]
}else{
y.star<-b[common,3]
y.hat<-a[common,3]
}
Nn.Reg<-as.matrix(w1*y.star +(1-w1)*y.hat)
h<- cbind(a[common,1:2], Nn.Reg ,a[common,4:5])
return(h)
}else if((impType1 =="nn" && impType2=="locf") || (impType1 =="locf" && impType2=="nn")){
#NN
U<- unique(mono.fix[,1])
a <-foreach(i = 1:length(U), .combine='rbind') %do%
{
x<- subset(mono1.keep, mono1.keep[,1] ==U[i])
x<-x[order(x[,2]),]
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
z<-subset(mono.fix1, mono.fix1[,1]==U[i])
z<-z[order(z[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(length(x)==3)){
a<-y
names(a)<-names(x)
a<-as.data.frame(rbind(x,a))
a<-a[order(a[,2]),]
}else{
a <-NN.func(x,z, 2, 3)
names(a)<-names(x)
a<-as.data.frame(rbind(x,a))
a<-a[order(a[,2]),]
}
return(a)
}
a<-as.data.frame(rbind(a,mono1.keep))
a<-as.data.frame(unique(a[1:nrow(a),]))
a<-a[order(a[,1]),]
#LOCF
U<-unique(mono.fix[,1])
c <-foreach(i = 1:length(U), .combine='rbind') %do%
{
x<- subset(mono1.keep, mono1.keep[,1] ==U[i])
x<-x[order(x[,2]),]
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
z<-subset(mono.fix1, mono.fix1[,1]==U[i])
z<-z[order(z[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(length(x)==3)){
c<-y
names(c)<-names(x)
c<-as.data.frame(rbind(x,c))
c<-c[order(c[,2]),]
}else{
c <-LOCF.func(x,z, 2, 3)
names(c)<-names(x)
c<-as.data.frame(rbind(x,c))
c<-c[order(c[,2]),]
}
return(c)
}
c<-as.data.frame(rbind(c,mono1.keep))
c<-as.data.frame(unique(c[1:nrow(c),]))
c<-c[order(c[,1]),]
common<- c[,1] %in% a[,1]
if(impType1=='nn'){
y.star<-a[common,3]
y.hat<-c[common,3]
}else{
y.star<-c[common,3]
y.hat<-a[common,3]
}
Nn.LOCF<-w1*y.star +(1-w1)*y.hat
h<- cbind(c[common,1:2], Nn.LOCF,c[common,4:5])
return(h)
}else if((impType1 =="nn" && impType2=="ln") ||(impType1 =="ln" && impType2=="nn")){
#NN
U<- unique(mono.fix[,1])
a <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- subset(mono1.keep, mono1.keep[,1] ==U[i])
x<-x[order(x[,2]),]
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
z<-subset(mono.fix1, mono.fix1[,1]==U[i])
z<-z[order(z[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(length(x)==3)){
a<-y
names(a)<-names(x)
a<-as.data.frame(rbind(x,a))
a<-a[order(a[,2]),]
}else{
a <-NN.func(x,z, 2, 3)
names(a)<-names(x)
a<-as.data.frame(rbind(x,a))
a<-a[order(a[,2]),]
}
return(a)
}
a<-as.data.frame(rbind(a,mono1.keep))
a<-as.data.frame(unique(a[1:nrow(a),]))
a<-a[order(a[,1]),]
#LN
U<-unique(mono.fix[,1])
d <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- subset(mono1.keep, mono1.keep[,1] ==U[i])
x<-x[order(x[,2]),]
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
z<-subset(mono.fix1, mono.fix1[,1]==U[i])
z<-z[order(z[,2]),]
if((sum(!is.na(x[,3])) == 0) || (sum(is.na(x[,3]))==1 && nrow(x)==2 )||(length(x)==3)){
d<-y
names(d)<-names(x)
d<-as.data.frame(rbind(x,d))
d<-d[order(d[,2]),]
}else{
d <-LN.func(x, z, 2, 3)
names(d)<-names(x)
d<-as.data.frame(rbind(x,d))
d<-d[order(d[,2]),]
}
return(d)
}
d<-as.data.frame(rbind(d,mono1.keep))
d<-as.data.frame(unique(d[1:nrow(d),]))
d<-d[order(d[,1]),]
common<- d[,1] %in% a[,1]
if(impType1=='ln'){
y.star<-d[common,3]
y.hat<-a[common,3]
}else{
y.star<-a[common,3]
y.hat<-d[common,3]
}
Nn.Ln<-w1*y.star +(1-w1)*y.hat
h<- cbind(d[common,1:2], Nn.Ln,d[common,4:5])
return(h)
}else if((impType1 =="nn" && impType2=="fr") ||(impType1 =="fr" && impType2=="nn")){
#NN
U<- unique(mono.fix[,1])
a <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- subset(mono1.keep, mono1.keep[,1] ==U[i])
x<-x[order(x[,2]),]
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
z<-subset(mono.fix1, mono.fix1[,1]==U[i])
z<-z[order(z[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(length(x)==3)){
a<-y
names(a)<-names(x)
a<-as.data.frame(rbind(x,a))
a<-a[order(a[,2]),]
}else{
a <-NN.func(x,z, 2, 3)
names(a)<-names(x)
a<-as.data.frame(rbind(x,a))
a<-a[order(a[,2]),]
}
return(a)
}
a<-as.data.frame(rbind(a,mono1.keep))
a<-as.data.frame(unique(a[1:nrow(a),]))
a<-a[order(a[,1]),]
#FR
U<-unique(mono.fix[,1])
e <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- as.data.frame(subset(mono1.keep, mono1.keep[,1] ==U[i])) #subset that doesnt need imputation
miss<-as.data.frame(subset(mono.fix1, mono.fix1[,1]==U[i])) #subset that needs imputation
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(sum(is.na(x[,3]))==1 && nrow(x)==2 )||(length(x)==3)){
e<- cbind(miss[,1:2], y[,3],miss[,4:5])
names(e)<-names(x)
e<-as.data.frame(rbind(x,e))
e<-e[order(e[,2]),]
}else{
e<-frac.reg(x[,2],x[,3],miss[,2])
e<- cbind(miss[,1:2], e,miss[,4:5])
names(e)<-names(x)
e<-as.data.frame(rbind(x,e))
e<-e[order(e[,2]),]
}
return(e)
}
e<-as.data.frame(rbind(e,mono1.keep))
e<-as.data.frame(unique(e[1:nrow(e),]))
e<-e[order(e[,1]),]
common<- e[,1] %in% a[,1]
if(impType1=='nn'){
y.star<-a[common,3]
y.hat<-e[common,3]
}else{
y.star<-e[common,3]
y.hat<-a[common,3]
}
Nn.Fr<-w1*y.star +(1-w1)*y.hat
h<- cbind(e[common,1:2], Nn.Fr,e[common,4:5])
return(h)
}else if((impType1 =="reg" && impType2=="locf") ||(impType1 =="locf" && impType2=="reg")){
#REG
U<- unique(mono.fix[,1])
b <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- as.data.frame(subset(mono1.keep, mono1.keep[,1] ==U[i])) #subset that doesnt need imputation
miss<-as.data.frame(subset(mono.fix1, mono.fix1[,1]==U[i])) #subset that needs imputation
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(sum(is.na(x[,3]))==1 && nrow(x)==2 )||(length(x)==3)){
b<- cbind(miss[,1:2], y[,3],miss[,4:5])
names(b)<-names(x)
b<-as.data.frame(rbind(x,b))
b<-b[order(b[,2]),]
}else{
b<-pred.lm(x[,2],x[,3],miss[,2])
b<- cbind(miss[,1:2], b,miss[,4:5])
names(b)<-names(x)
b<-as.data.frame(rbind(x,b))
b<-b[order(b[,2]),]
}
return(b)
}
b<-as.data.frame(rbind(b,mono1.keep))
b<-as.data.frame(unique(b[1:nrow(b),]))
b<-b[order(b[,1]),]
#LOCF
U<-unique(mono.fix[,1])
c <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- subset(mono1.keep, mono1.keep[,1] ==U[i])
x<-x[order(x[,2]),]
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
z<-subset(mono.fix1, mono.fix1[,1]==U[i])
z<-z[order(z[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(length(x)==3)){
c<-y
names(c)<-names(x)
c<-as.data.frame(rbind(x,c))
c<-c[order(c[,2]),]
}else{
c <-LOCF.func(x,z, 2, 3)
names(c)<-names(x)
c<-as.data.frame(rbind(x,c))
c<-c[order(c[,2]),]
}
return(c)
}
c<-as.data.frame(rbind(c,mono1.keep))
c<-as.data.frame(unique(c[1:nrow(c),]))
c<-c[order(c[,1]),]
common<- c[,1] %in% b[,1]
if(impType1=='reg'){
y.star<-b[common,3]
y.hat<-c[common,3]
}else{
y.star<-c[common,3]
y.hat<-b[common,3]
}
Reg.LOCF<-w1*y.star +(1-w1)*y.hat
h<- cbind(c[common,1:2], Reg.LOCF,c[common,4:5])
return(h)
}else if((impType1 =="reg" && impType2=="fr") ||(impType1 =="fr" && impType2=="reg")){
#REG
U<- unique(mono.fix[,1])
b <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- as.data.frame(subset(mono1.keep, mono1.keep[,1] ==U[i])) #subset that doesnt need imputation
miss<-as.data.frame(subset(mono.fix1, mono.fix1[,1]==U[i])) #subset that needs imputation
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(sum(is.na(x[,3]))==1 && nrow(x)==2 )||(length(x)==3)){
b<- cbind(miss[,1:2], y[,3],miss[,4:5])
names(b)<-names(x)
b<-as.data.frame(rbind(x,b))
b<-b[order(b[,2]),]
}else{
b<-pred.lm(x[,2],x[,3],miss[,2])
b<- cbind(miss[,1:2], b,miss[,4:5])
names(b)<-names(x)
b<-as.data.frame(rbind(x,b))
b<-b[order(b[,2]),]
}
return(b)
}
b<-as.data.frame(rbind(b,mono1.keep))
b<-as.data.frame(unique(b[1:nrow(b),]))
b<-b[order(b[,1]),]
#FR
U<-unique(mono.fix[,1])
e <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- as.data.frame(subset(mono1.keep, mono1.keep[,1] ==U[i])) #subset that doesnt need imputation
miss<-as.data.frame(subset(mono.fix1, mono.fix1[,1]==U[i])) #subset that needs imputation
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(sum(is.na(x[,3]))==1 && nrow(x)==2 )||(length(x)==3)){
e<- cbind(miss[,1:2], y[,3],miss[,4:5])
names(e)<-names(x)
e<-as.data.frame(rbind(x,e))
e<-e[order(e[,2]),]
}else{
e<-frac.reg(x[,2],x[,3],miss[,2])
e<- cbind(miss[,1:2], e,miss[,4:5])
names(e)<-names(x)
e<-as.data.frame(rbind(x,e))
e<-e[order(e[,2]),]
}
return(e)
}
e<-as.data.frame(rbind(e,mono1.keep))
e<-as.data.frame(unique(e[1:nrow(e),]))
e<-e[order(e[,1]),]
common<- e[,1] %in% b[,1]
if(impType1=='fr'){
y.star<-e[common,3]
y.hat<-b[common,3]
}else{
y.star<-b[common,3]
y.hat<-e[common,3]
}
Reg.Fr<-w1*y.star +(1-w1)*y.hat
h<- cbind(e[common,1:2], Reg.Fr,e[common,4:5])
return(h)
}else if((impType1 =="reg" && impType2=="ln") ||(impType1 =="ln" && impType2=="reg")){
#REG
U<- unique(mono.fix[,1])
b <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- as.data.frame(subset(mono1.keep, mono1.keep[,1] ==U[i])) #subset that doesnt need imputation
miss<-as.data.frame(subset(mono.fix1, mono.fix1[,1]==U[i])) #subset that needs imputation
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(sum(is.na(x[,3]))==1 && nrow(x)==2 )||(length(x)==3)){
b<- cbind(miss[,1:2], y[,3],miss[,4:5])
names(b)<-names(x)
b<-as.data.frame(rbind(x,b))
b<-b[order(b[,2]),]
}else{
b<-pred.lm(x[,2],x[,3],miss[,2])
b<- cbind(miss[,1:2], b,miss[,4:5])
names(b)<-names(x)
b<-as.data.frame(rbind(x,b))
b<-b[order(b[,2]),]
}
return(b)
}
b<-as.data.frame(rbind(b,mono1.keep))
b<-as.data.frame(unique(b[1:nrow(b),]))
b<-b[order(b[,1]),]
#LN
U<-unique(mono.fix[,1])
d <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- subset(mono1.keep, mono1.keep[,1] ==U[i])
x<-x[order(x[,2]),]
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
z<-subset(mono.fix1, mono.fix1[,1]==U[i])
z<-z[order(z[,2]),]
if((sum(!is.na(x[,3])) == 0) || (sum(is.na(x[,3]))==1 && nrow(x)==2 )||(length(x)==3)){
d<-y
names(d)<-names(x)
d<-as.data.frame(rbind(x,d))
d<-d[order(d[,2]),]
}else{
d <-LN.func(x, z, 2, 3)
names(d)<-names(x)
d<-as.data.frame(rbind(x,d))
d<-d[order(d[,2]),]
}
return(d)
}
d<-as.data.frame(rbind(d,mono1.keep))
d<-as.data.frame(unique(d[1:nrow(d),]))
d<-d[order(d[,1]),]
common<- d[,1] %in% b[,1]
if(impType1=='reg'){
y.star<-b[common,3]
y.hat<-d[common,3]
}else{
y.star<-d[common,3]
y.hat<-b[common,3]
}
Reg.Ln<-w1*y.star +(1-w1)*y.hat
h<- cbind(d[common,1:2], Reg.Ln,d[common,4:5])
return(h)
}else if((impType1 =="ln" && impType2=="locf") ||(impType1 =="locf" && impType2=="ln")){
#LOCF
U<-unique(mono.fix[,1])
c <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- subset(mono1.keep, mono1.keep[,1] ==U[i])
x<-x[order(x[,2]),]
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
z<-subset(mono.fix1, mono.fix1[,1]==U[i])
z<-z[order(z[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(length(x)==3)){
c<-y
names(c)<-names(x)
c<-as.data.frame(rbind(x,c))
c<-c[order(c[,2]),]
}else{
c <-LOCF.func(x,z, 2, 3)
names(c)<-names(x)
c<-as.data.frame(rbind(x,c))
c<-c[order(c[,2]),]
}
return(c)
}
c<-as.data.frame(rbind(c,mono1.keep))
c<-as.data.frame(unique(c[1:nrow(c),]))
c<-c[order(c[,1]),]
#LN
U<-unique(mono.fix[,1])
d <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- subset(mono1.keep, mono1.keep[,1] ==U[i])
x<-x[order(x[,2]),]
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
z<-subset(mono.fix1, mono.fix1[,1]==U[i])
z<-z[order(z[,2]),]
if((sum(!is.na(x[,3])) == 0) || (sum(is.na(x[,3]))==1 && nrow(x)==2 )||(length(x)==3)){
d<-y
names(d)<-names(x)
d<-as.data.frame(rbind(x,d))
d<-d[order(d[,2]),]
}else{
d <-LN.func(x, z, 2, 3)
names(d)<-names(x)
d<-as.data.frame(rbind(x,d))
d<-d[order(d[,2]),]
}
return(d)
}
d<-as.data.frame(rbind(d,mono1.keep))
d<-as.data.frame(unique(d[1:nrow(d),]))
d<-d[order(d[,1]),]
common<- d[,1] %in% c[,1]
if(impType1=='ln'){
y.star<-d[common,3]
y.hat<-c[common,3]
}else{
y.star<-c[common,3]
y.hat<-d[common,3]
}
Ln.LOCF<-w1*y.star +(1-w1)*y.hat
h<- cbind(d[common,1:2], Ln.LOCF,d[common,4:5])
return(h)
}else if((impType1 =="fr" && impType2=="locf") ||(impType1 =="locf" && impType2=="fr")){
#LOCF
U<-unique(mono.fix[,1])
c <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- subset(mono1.keep, mono1.keep[,1] ==U[i])
x<-x[order(x[,2]),]
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
z<-subset(mono.fix1, mono.fix1[,1]==U[i])
z<-z[order(z[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(length(x)==3)){
c<-y
names(c)<-names(x)
c<-as.data.frame(rbind(x,c))
c<-c[order(c[,2]),]
}else{
c <-LOCF.func(x,z, 2, 3)
names(c)<-names(x)
c<-as.data.frame(rbind(x,c))
c<-c[order(c[,2]),]
}
return(c)
}
c<-as.data.frame(rbind(c,mono1.keep))
c<-as.data.frame(unique(c[1:nrow(c),]))
c<-c[order(c[,1]),]
#FR
U<-unique(mono.fix[,1])
e <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- as.data.frame(subset(mono1.keep, mono1.keep[,1] ==U[i])) #subset that doesnt need imputation
miss<-as.data.frame(subset(mono.fix1, mono.fix1[,1]==U[i])) #subset that needs imputation
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(sum(is.na(x[,3]))==1 && nrow(x)==2 )||(length(x)==3)){
e<- cbind(miss[,1:2], y[,3],miss[,4:5])
names(e)<-names(x)
e<-as.data.frame(rbind(x,e))
e<-e[order(e[,2]),]
}else{
e<-frac.reg(x[,2],x[,3],miss[,2])
e<- cbind(miss[,1:2], e,miss[,4:5])
names(e)<-names(x)
e<-as.data.frame(rbind(x,e))
e<-e[order(e[,2]),]
}
return(e)
}
e<-as.data.frame(rbind(e,mono1.keep))
e<-as.data.frame(unique(e[1:nrow(e),]))
e<-e[order(e[,1]),]
common<- e[,1] %in% c[,1]
if(impType1=='locf'){
y.star<-c[common,3]
y.hat<-e[common,3]
}else{
y.star<-e[common,3]
y.hat<-c[common,3]
}
Fr.LOCF<-w1*y.star +(1-w1)*y.hat
h<- cbind(e[common,1:2], Fr.LOCF,e[common,4:5])
return(h)
}else if((impType1 =="ln" && impType2=="fr") ||(impType1 =="fr" && impType2=="ln")){
#LN
U<-unique(mono.fix[,1])
d <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- subset(mono1.keep, mono1.keep[,1] ==U[i])
x<-x[order(x[,2]),]
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
z<-subset(mono.fix1, mono.fix1[,1]==U[i])
z<-z[order(z[,2]),]
if((sum(!is.na(x[,3])) == 0) || (sum(is.na(x[,3]))==1 && nrow(x)==2 )||(length(x)==3)){
d<-y
names(d)<-names(x)
d<-as.data.frame(rbind(x,d))
d<-d[order(d[,2]),]
}else{
d <-LN.func(x, z, 2, 3)
names(d)<-names(x)
d<-as.data.frame(rbind(x,d))
d<-d[order(d[,2]),]
}
return(d)
}
d<-as.data.frame(rbind(d,mono1.keep))
d<-as.data.frame(unique(d[1:nrow(d),]))
d<-d[order(d[,1]),]
#FR
U<-unique(mono.fix[,1])
e <-foreach( i = 1:length(U), .combine='rbind') %do%
{
x<- as.data.frame(subset(mono1.keep, mono1.keep[,1] ==U[i])) #subset that doesnt need imputation
miss<-as.data.frame(subset(mono.fix1, mono.fix1[,1]==U[i])) #subset that needs imputation
y<-subset(mono.fix, mono.fix[,1]==U[i])
y<-y[order(y[,2]),]
if((sum(!is.na(x[,3])) == 0) ||(sum(is.na(x[,3]))==1 && nrow(x)==2 )||(length(x)==3)){
e<- cbind(miss[,1:2], y[,3],miss[,4:5])
names(e)<-names(x)
e<-as.data.frame(rbind(x,e))
e<-e[order(e[,2]),]
}else{
e<-frac.reg(x[,2],x[,3],miss[,2])
e<- cbind(miss[,1:2], e,miss[,4:5])
names(e)<-names(x)
e<-as.data.frame(rbind(x,e))
e<-e[order(e[,2]),]
}
return(e)
}
e<-as.data.frame(rbind(e,mono1.keep))
e<-as.data.frame(unique(e[1:nrow(e),]))
e<-e[order(e[,1]),]
common<- d[,1] %in% e[,1]
if(impType1=='ln'){
y.star<-d[common,3]
y.hat<-e[common,3]
}else{
y.star<-e[common,3]
y.hat<-d[common,3]
}
Ln.Fr<-w1*y.star +(1-w1)*y.hat
h<- cbind(d[common,1:2], Ln.Fr,d[common,4:5])
i <- NULL; rm(i)
return(h)}
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.