Nothing
R/TSEwgt.R
In TSEwgt: Total Survey Error Under Multiple, Different Weighting Schemes
#' @title Average mean absolute error (aMAE)
#' @description Calculates average mean absolute error (aMAE) under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average mean absolute error (aMAE) under multiple, different weighting schemes
#' @details aMAE for weighting scheme # => mean value of the MAEs for specified variables
#' under weighting scheme # => mean value of MAEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVEMAEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVEMAEw
AVEMAEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vector
avemaevec=vector(length=(length(Weights)+1))
#calculate unweighted statistic and store value
avemaeuw=mean(apply(abs(mapply('-', Actual, Survey)), 2, mean))
avemaevec[1]=avemaeuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
avemae=mean(apply(abs(mapply('-', Actual, wtsvy)), 2, mean))
avemaevec[i+1]=avemae
}
#convert to matrix and label
avemaematrix=noquote(cbind(matrix(format(avemaevec, signif=7))))
rownames(avemaematrix)=paste(" wgt scheme",
seq(from=0, along=avemaematrix), " => ")
rownames(avemaematrix)[1]=paste(" unweighted => ")
colnames(avemaematrix)=c("aMAE")
#return results
avemaematrix
}
#' @title Average mean squared error (aMSE) with bias-variance decomposition
#' @description Calculates average mean squared error (aMSE) with bias-variance decomposition
#' under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average mean squared error (aMSE) with bias-variance decomposition under multiple, different weighting schemes
#' @details aMSE for weighting scheme # => mean value of the MSEs for specified variables
#' under weighting scheme # => mean value of MSEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVEMSEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVEMSEw
AVEMSEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vectors
avemsevec=vector(length=(length(Weights)+1))
avebias2vec=vector(length=(length(Weights)+1))
avevarvec=vector(length=(length(Weights)+1))
addvec=vector(length=(length(Weights)+1))
addvec[1:(length(Weights)+1)]=" + "
eqvec=vector(length=(length(Weights)+1))
eqvec[1:(length(Weights)+1)]=" => "
#calculate unweighted statistics and store values
avemseuw=mean(apply(((mapply('-', Actual, Survey))^2), 2, mean))
avemsevec[1]=avemseuw
avebias2uw=mean((apply((mapply('-', Actual, Survey)), 2, mean))^2)
avebias2vec[1]=avebias2uw
avevaruw=mean(apply(((mapply('-', (Actual-Survey),
(apply((Actual-Survey), 2, mean))))^2), 2, mean))
avevarvec[1]=avevaruw
#weight data, calculate statistics, store values
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
avemse=mean(apply(((mapply('-', Actual, wtsvy))^2), 2, mean))
avemsevec[[i+1]]=avemse
avebias2=mean((apply((mapply('-', Actual, wtsvy)), 2, mean))^2)
avebias2vec[[i+1]]=avebias2
avevar=mean(apply(((mapply('-', (Actual-wtsvy),
(apply((Actual-wtsvy), 2, mean))))^2), 2, mean))
avevarvec[[i+1]]=avevar
}
#convert to matrix and label
avemsematrix=noquote(matrix(cbind(format(avemsevec, signif=7),
eqvec, format(avebias2vec, signif=7), addvec, format(avevarvec,
signif=7)), ncol=5))
rownames(avemsematrix)=paste(" wgt scheme",
seq(from=0, along=avemsematrix[, 1]), " => ")
rownames(avemsematrix)[1]=paste(" unweighted => ")
colnames(avemsematrix)=c("aMSE", " ", "aBias^2", " ", "aVar")
#return results
avemsematrix
}
#' @title Average root mean squared error (aRMSE)
#' @description Calculates average root mean squared error (aRMSE) under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average root mean squared error (aRMSE) under multiple, different weighting schemes
#' @details aRMSE for weighting scheme # => mean value of the RMSEs for specified variables
#' under weighting scheme # => mean value of RMSEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVERMSEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVERMSEw
AVERMSEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vector
avermsevec=vector(length=length(Weights))
#calculate unweighted statistic and store value
avermseuw=mean(sqrt(apply(((mapply('-', Actual, Survey))^2), 2, mean)))
avermsevec[1]=avermseuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
avermse=mean(sqrt(apply(((mapply('-', Actual, wtsvy))^2), 2, mean)))
avermsevec[[i+1]]=avermse
}
#convert to matrix and label
avermsematrix=noquote(cbind(matrix(format(avermsevec, signif=7))))
rownames(avermsematrix)=paste(" wgt scheme",
seq(from=0, along=avermsematrix), " => ")
rownames(avermsematrix)[1]=paste(" unweighted => ")
colnames(avermsematrix)=c("aRMSE")
#return results
avermsematrix
}
#' @title Average mean squared logarithmic error (aMSLE)
#' @description Calculates average mean squared logarithmic error (aMSLE) under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average mean squared logarithmic error (aMSLE) under multiple, different weighting schemes
#' @details aMSLE for weighting scheme # => mean value of the aMSLEs for specified variables
#' under weighting scheme # => mean value of aMSLEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVEMSLEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVEMSLEw
AVEMSLEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vector
avemslevec=vector(length=length(Weights))
#calculate unweighted statistic and store value
avemsleuw=mean(apply(((mapply('-', log(Actual+1),
log(Survey+1)))^2), 2, mean))
avemslevec[1]=avemsleuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
avemsle=mean(apply(((mapply('-', log(Actual+1),
log(wtsvy+1)))^2), 2, mean))
avemslevec[[i+1]]=avemsle
}
#convert to matrix and label
avemslematrix=noquote(cbind(matrix(format(avemslevec, signif=7))))
rownames(avemslematrix)=paste(" wgt scheme",
seq(from=0, along=avemslematrix), " => ")
rownames(avemslematrix)[1]=paste(" unweighted => ")
colnames(avemslematrix)=c("aMSLE")
#return results
avemslematrix
}
#' @title Average root mean squared logarithmic error (aRMSLE)
#' @description Calculates average root mean squared logarithmic error (aRMSLE) under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average root mean squared logarithmic error (aRMSLE) under multiple, different weighting schemes
#' @details aRMSLE for weighting scheme # => mean value of the aRMSLEs for specified variables
#' under weighting scheme # => mean value of aRMSLEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVERMSLEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVERMSLEw
AVERMSLEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vector
avermslevec=vector(length=length(Weights))
#calculate unweighted statistic and store value
avermsleuw=mean(sqrt(apply(((mapply('-', log(Actual+1),
log(Survey+1)))^2), 2, mean)))
avermslevec[1]=avermsleuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
avermsle=mean(sqrt(apply(((mapply('-', log(Actual+1),
log(wtsvy+1)))^2), 2, mean)))
avermslevec[[i+1]]=avermsle
}
#convert to matrix and label
avermslematrix=noquote(cbind(matrix(format(avermslevec, signif=7))))
rownames(avermslematrix)=paste(" wgt scheme",
seq(from=0, along=avermslematrix), " => ")
rownames(avermslematrix)[1]=paste(" unweighted => ")
colnames(avermslematrix)=c("aRMSLE")
#return results
avermslematrix
}
#' @title Full scale-dependent statistics
#' @description Calculates full scale-dependent statistics
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Full scale-dependent statistics
#' @examples FULLSDw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export FULLSDw
FULLSDw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vectors
avemaevec=vector(length=(length(Weights)+1))
avemsevec=vector(length=(length(Weights)+1))
avermsevec=vector(length=(length(Weights)+1))
avemslevec=vector(length=(length(Weights)+1))
avermslevec=vector(length=(length(Weights)+1))
spacevec=vector(length=(length(Weights)+1))
spacevec[1:(length(Weights)+1)]=" "
#calculate unweighted statistics and store values
avemaeuw=mean(apply(abs(mapply('-', Actual, Survey)), 2, mean))
avemaevec[1]=avemaeuw
avemseuw=mean(apply(((mapply('-', Actual, Survey))^2), 2, mean))
avemsevec[1]=avemseuw
avermseuw=mean(sqrt(apply(((mapply('-', Actual, Survey))^2), 2, mean)))
avermsevec[1]=avermseuw
avemsleuw=mean(apply(((mapply('-', log(Actual+1),
log(Survey+1)))^2), 2, mean))
avemslevec[1]=avemsleuw
avermsleuw=mean(sqrt(apply(((mapply('-', log(Actual+1),
log(Survey+1)))^2), 2, mean)))
avermslevec[1]=avermsleuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
avemae=mean(apply(abs(mapply('-', Actual, wtsvy)), 2, mean))
avemaevec[[i+1]]=avemae
avemse=mean(apply(((mapply('-', Actual, wtsvy))^2), 2, mean))
avemsevec[[i+1]]=avemse
avermse=mean(sqrt(apply(((mapply('-', Actual, wtsvy))^2), 2, mean)))
avermsevec[[i+1]]=avermse
avemsle=mean(apply(((mapply('-', log(Actual+1),
log(wtsvy+1)))^2), 2, mean))
avemslevec[[i+1]]=avemsle
avermsle=mean(sqrt(apply(((mapply('-', log(Actual+1),
log(wtsvy+1)))^2), 2, mean)))
avermslevec[[i+1]]=avermsle
}
#convert to matrix and label
fullsdmatrix=noquote(matrix(cbind(format(avemaevec, signif=7), spacevec,
format(avemsevec, signif=7), spacevec, format(avermsevec, signif=7),
spacevec, format(avemslevec, signif=7), spacevec,
format(avermslevec, signif=7)), ncol=9))
rownames(fullsdmatrix)=paste(" wgt scheme",
seq(from=0, along=fullsdmatrix[, 1]), " => ")
rownames(fullsdmatrix)[1]=paste(" unweighted => ")
colnames(fullsdmatrix)=c("aMAE", " ", "aMSE", " ", "aRMSE", " ",
"aMSLE", " ", "aRMSLE")
#return results
fullsdmatrix
}
#' @title Average mean absolute percentage error (aMAPE)
#' @description Calculates average mean absolute percentage error (aMAPE) under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average mean absolute percentage error (aMAPE) under multiple, different weighting schemes
#' @details aMAPE for weighting scheme # => mean value of the aMAPEs for specified variables
#' under weighting scheme # => mean value of aMAPEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVEMAPEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVEMAPEw
AVEMAPEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vector
avemapevec=vector(length=(length(Weights)+1))
#calculate unweighted statistic and store value
avemapeuw=mean(apply(abs(mapply('-', Actual, Survey))/Actual, 2, mean))
avemapevec[1]=avemapeuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
avemape=mean(apply(abs(mapply('-', Actual, wtsvy))/Actual, 2, mean))
avemapevec[[i+1]]=avemape
}
#convert to matrix and label
avemapematrix=noquote(cbind(matrix(format(avemapevec, signif=7))))
rownames(avemapematrix)=paste(" wgt scheme",
seq(from=0, along=avemapematrix), " => ")
rownames(avemapematrix)[1]=paste(" unweighted => ")
colnames(avemapematrix)=c("aMAPE")
#return results
avemapematrix
}
#' @title Average symmetric mean absolute percentage error (aSMAPE)
#' @description Calculates average symmetric mean absolute percentage error (aSMAPE) under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average symmetric mean absolute percentage error (aSMAPE) under multiple, different weighting schemes
#' @details aSMAPE for weighting scheme # => mean value of the aSMAPEs for specified variables
#' under weighting scheme # => mean value of aSMAPEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVESMAPEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVESMAPEw
AVESMAPEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vector
avesmapevec=vector(length=(length(Weights)+1))
#calculate unweighted statistic and store value
avesmapeuw=mean((apply((abs(mapply('-', Actual, Survey))/
(abs(Actual)+abs(Survey))), 2, mean))*2)
avesmapevec[1]=avesmapeuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
avesmape=mean((apply((abs(mapply('-', Actual, wtsvy))/
(abs(Actual)+abs(wtsvy))), 2, mean))*2)
avesmapevec[[i+1]]=avesmape
}
#convert to matrix and label
avesmapematrix=noquote(cbind(matrix(format(avesmapevec, signif=7))))
rownames(avesmapematrix)=paste(" wgt scheme",
seq(from=0, along=avesmapematrix), " => ")
rownames(avesmapematrix)[1]=paste(" unweighted => ")
colnames(avesmapematrix)=c("aSMAPE")
#return results
avesmapematrix
}
#' @title Average relative absolute error (aRAE)
#' @description Calculates average relative absolute error (aRAE) under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average relative absolute error (aRAE) under multiple, different weighting schemes
#' @details aRAE for weighting scheme # => mean value of the aRAEs for specified variables
#' under weighting scheme # => mean value of aRAEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVERAEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVERAEw
AVERAEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vector
averaevec=vector(length=(length(Weights)+1))
#calculate unweighted statistic and store value
averaeuw=mean((apply(abs(mapply('-', Actual, Survey)), 2, sum))/
apply((abs(mapply('-', Actual, apply(Actual, 2, mean)))), 2, sum))
averaevec[1]=averaeuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
averae=mean((apply(abs(mapply('-', Actual, wtsvy)), 2, sum))/
apply((abs(mapply('-', Actual, apply(Actual, 2, mean)))), 2, sum))
averaevec[[i+1]]=averae
}
#convert to matrix and label
averaematrix=noquote(cbind(matrix(format(averaevec, signif=7))))
rownames(averaematrix)=paste(" wgt scheme",
seq(from=0, along=averaematrix), " => ")
rownames(averaematrix)[1]=paste(" unweighted => ")
colnames(averaematrix)=c("aRAE")
#return results
averaematrix
}
#' @title Average relative squared error (aRSE)
#' @description Calculates average relative squared error (aRSE) under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average relative squared error (aRSE) under multiple, different weighting schemes
#' @details aRSE for weighting scheme # => mean value of the aRSEs for specified variables
#' under weighting scheme # => mean value of aRSEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVERSEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVERSEw
AVERSEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vector
aversevec=vector(length=(length(Weights)+1))
#calculate unweighted statistic and store value
averseuw=mean((apply((mapply('-', Actual, Survey))^2, 2, sum))/
apply(((mapply('-', Actual, apply(Actual, 2, mean)))^2), 2, sum))
aversevec[1]=averseuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
averse=mean((apply((mapply('-', Actual, wtsvy))^2, 2, sum))/
apply(((mapply('-', Actual, apply(Actual, 2, mean)))^2), 2, sum))
aversevec[[i+1]]=averse
}
#convert to matrix and label
aversematrix=noquote(cbind(matrix(format(aversevec, signif=7))))
rownames(aversematrix)=paste(" wgt scheme",
seq(from=0, along=aversematrix), " => ")
rownames(aversematrix)[1]=paste(" unweighted => ")
colnames(aversematrix)=c("aRSE")
#return results
aversematrix
}
#' @title Average root relative squared error (aRRSE)
#' @description Calculates average root relative squared error (aRRSE) under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average root relative squared error (aRRSE) under multiple, different weighting schemes
#' @details aRRSE for weighting scheme # => mean value of the aRRSEs for specified variables
#' under weighting scheme # => mean value of aRRSEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVERRSEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVERRSEw
AVERRSEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vector
averrsevec=vector(length=(length(Weights)+1))
#calculate unweighted statistic and store value
averrseuw=mean(sqrt((apply((mapply('-', Actual, Survey))^2, 2, sum))/
apply(((mapply('-', Actual, apply(Actual, 2, mean)))^2), 2, sum)))
averrsevec[1]=averrseuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
averrse=mean(sqrt((apply((mapply('-', Actual, wtsvy))^2, 2, sum))/
apply(((mapply('-', Actual, apply(Actual, 2, mean)))^2), 2, sum)))
averrsevec[[i+1]]=averrse
}
#convert to matrix and label
averrsematrix=noquote(cbind(matrix(format(averrsevec, signif=7))))
rownames(averrsematrix)=paste(" wgt scheme",
seq(from=0, along=averrsematrix), " => ")
rownames(averrsematrix)[1]=paste(" unweighted => ")
colnames(averrsematrix)=c("aRRSE")
#return results
averrsematrix
}
#' @title Full scale-independent statistics
#' @description Calculates full scale-independent statistics
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Full scale-independent statistics
#' @examples FULLSIw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export FULLSIw
FULLSIw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vectors
avemapevec=vector(length=(length(Weights)+1))
avesmapevec=vector(length=(length(Weights)+1))
averaevec=vector(length=(length(Weights)+1))
aversevec=vector(length=(length(Weights)+1))
averrsevec=vector(length=(length(Weights)+1))
spacevec=vector(length=(length(Weights)+1))
spacevec[1:(length(Weights)+1)]=" "
#calculate unweighted statistics and store values
avemapeuw=mean(apply(abs(mapply('-', Actual, Survey))/Actual, 2, mean))
avemapevec[1]=avemapeuw
avesmapeuw=mean((apply((abs(mapply('-', Actual, Survey))/
(abs(Actual)+abs(Survey))), 2, mean))*2)
avesmapevec[1]=avesmapeuw
averaeuw=mean((apply(abs(mapply('-', Actual, Survey)), 2, sum))/
apply((abs(mapply('-', Actual, apply(Actual, 2, mean)))), 2, sum))
averaevec[1]=averaeuw
averseuw=mean((apply((mapply('-', Actual, Survey))^2, 2, sum))/
apply(((mapply('-', Actual, apply(Actual, 2, mean)))^2), 2, sum))
aversevec[1]=averseuw
averrseuw=mean(sqrt((apply((mapply('-', Actual, Survey))^2, 2, sum))/
apply(((mapply('-', Actual, apply(Actual, 2, mean)))^2), 2, sum)))
averrsevec[1]=averrseuw
#weight data, calculate statistics, store values
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
avemape=mean(apply(abs(mapply('-', Actual, wtsvy))/Actual, 2, mean))
avemapevec[[i+1]]=avemape
avesmape=mean((apply((abs(mapply('-', Actual, wtsvy))/
(abs(Actual)+abs(wtsvy))), 2, mean))*2)
avesmapevec[[i+1]]=avesmape
averae=mean((apply(abs(mapply('-', Actual, wtsvy)), 2, sum))/
apply((abs(mapply('-', Actual, apply(Actual, 2, mean)))), 2, sum))
averaevec[[i+1]]=averae
averse=mean((apply((mapply('-', Actual, wtsvy))^2, 2, sum))/
apply(((mapply('-', Actual, apply(Actual, 2, mean)))^2), 2, sum))
aversevec[[i+1]]=averse
averrse=mean(sqrt((apply((mapply('-', Actual, wtsvy))^2, 2, sum))/
apply(((mapply('-', Actual, apply(Actual, 2, mean)))^2), 2, sum)))
averrsevec[[i+1]]=averrse
}
#convert to matrix and label
fullsimatrix=noquote(matrix(cbind(format(avemapevec, signif=7), spacevec,
format(avesmapevec, signif=7), spacevec, format(averaevec, signif=7),
spacevec, format(aversevec, signif=7), spacevec, format(averrsevec,
signif=7)), ncol=9))
rownames(fullsimatrix)=paste(" wgt scheme",
seq(from=0, along=fullsimatrix[, 1]), " => ")
rownames(fullsimatrix)[1]=paste(" unweighted => ")
colnames(fullsimatrix)=c("aMAPE", " ", "aSMAPE", " ", "aRAE", " ",
"aRSE", " ", "aRRSE")
#return results
fullsimatrix
}
Try the TSEwgt package in your browser
Any scripts or data that you put into this service are public.
TSEwgt documentation built on July 2, 2019, 5:03 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#' @title Average mean absolute error (aMAE)
#' @description Calculates average mean absolute error (aMAE) under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average mean absolute error (aMAE) under multiple, different weighting schemes
#' @details aMAE for weighting scheme # => mean value of the MAEs for specified variables
#' under weighting scheme # => mean value of MAEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVEMAEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVEMAEw
AVEMAEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vector
avemaevec=vector(length=(length(Weights)+1))
#calculate unweighted statistic and store value
avemaeuw=mean(apply(abs(mapply('-', Actual, Survey)), 2, mean))
avemaevec[1]=avemaeuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
avemae=mean(apply(abs(mapply('-', Actual, wtsvy)), 2, mean))
avemaevec[i+1]=avemae
}
#convert to matrix and label
avemaematrix=noquote(cbind(matrix(format(avemaevec, signif=7))))
rownames(avemaematrix)=paste(" wgt scheme",
seq(from=0, along=avemaematrix), " => ")
rownames(avemaematrix)[1]=paste(" unweighted => ")
colnames(avemaematrix)=c("aMAE")
#return results
avemaematrix
}
#' @title Average mean squared error (aMSE) with bias-variance decomposition
#' @description Calculates average mean squared error (aMSE) with bias-variance decomposition
#' under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average mean squared error (aMSE) with bias-variance decomposition under multiple, different weighting schemes
#' @details aMSE for weighting scheme # => mean value of the MSEs for specified variables
#' under weighting scheme # => mean value of MSEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVEMSEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVEMSEw
AVEMSEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vectors
avemsevec=vector(length=(length(Weights)+1))
avebias2vec=vector(length=(length(Weights)+1))
avevarvec=vector(length=(length(Weights)+1))
addvec=vector(length=(length(Weights)+1))
addvec[1:(length(Weights)+1)]=" + "
eqvec=vector(length=(length(Weights)+1))
eqvec[1:(length(Weights)+1)]=" => "
#calculate unweighted statistics and store values
avemseuw=mean(apply(((mapply('-', Actual, Survey))^2), 2, mean))
avemsevec[1]=avemseuw
avebias2uw=mean((apply((mapply('-', Actual, Survey)), 2, mean))^2)
avebias2vec[1]=avebias2uw
avevaruw=mean(apply(((mapply('-', (Actual-Survey),
(apply((Actual-Survey), 2, mean))))^2), 2, mean))
avevarvec[1]=avevaruw
#weight data, calculate statistics, store values
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
avemse=mean(apply(((mapply('-', Actual, wtsvy))^2), 2, mean))
avemsevec[[i+1]]=avemse
avebias2=mean((apply((mapply('-', Actual, wtsvy)), 2, mean))^2)
avebias2vec[[i+1]]=avebias2
avevar=mean(apply(((mapply('-', (Actual-wtsvy),
(apply((Actual-wtsvy), 2, mean))))^2), 2, mean))
avevarvec[[i+1]]=avevar
}
#convert to matrix and label
avemsematrix=noquote(matrix(cbind(format(avemsevec, signif=7),
eqvec, format(avebias2vec, signif=7), addvec, format(avevarvec,
signif=7)), ncol=5))
rownames(avemsematrix)=paste(" wgt scheme",
seq(from=0, along=avemsematrix[, 1]), " => ")
rownames(avemsematrix)[1]=paste(" unweighted => ")
colnames(avemsematrix)=c("aMSE", " ", "aBias^2", " ", "aVar")
#return results
avemsematrix
}
#' @title Average root mean squared error (aRMSE)
#' @description Calculates average root mean squared error (aRMSE) under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average root mean squared error (aRMSE) under multiple, different weighting schemes
#' @details aRMSE for weighting scheme # => mean value of the RMSEs for specified variables
#' under weighting scheme # => mean value of RMSEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVERMSEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVERMSEw
AVERMSEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vector
avermsevec=vector(length=length(Weights))
#calculate unweighted statistic and store value
avermseuw=mean(sqrt(apply(((mapply('-', Actual, Survey))^2), 2, mean)))
avermsevec[1]=avermseuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
avermse=mean(sqrt(apply(((mapply('-', Actual, wtsvy))^2), 2, mean)))
avermsevec[[i+1]]=avermse
}
#convert to matrix and label
avermsematrix=noquote(cbind(matrix(format(avermsevec, signif=7))))
rownames(avermsematrix)=paste(" wgt scheme",
seq(from=0, along=avermsematrix), " => ")
rownames(avermsematrix)[1]=paste(" unweighted => ")
colnames(avermsematrix)=c("aRMSE")
#return results
avermsematrix
}
#' @title Average mean squared logarithmic error (aMSLE)
#' @description Calculates average mean squared logarithmic error (aMSLE) under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average mean squared logarithmic error (aMSLE) under multiple, different weighting schemes
#' @details aMSLE for weighting scheme # => mean value of the aMSLEs for specified variables
#' under weighting scheme # => mean value of aMSLEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVEMSLEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVEMSLEw
AVEMSLEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vector
avemslevec=vector(length=length(Weights))
#calculate unweighted statistic and store value
avemsleuw=mean(apply(((mapply('-', log(Actual+1),
log(Survey+1)))^2), 2, mean))
avemslevec[1]=avemsleuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
avemsle=mean(apply(((mapply('-', log(Actual+1),
log(wtsvy+1)))^2), 2, mean))
avemslevec[[i+1]]=avemsle
}
#convert to matrix and label
avemslematrix=noquote(cbind(matrix(format(avemslevec, signif=7))))
rownames(avemslematrix)=paste(" wgt scheme",
seq(from=0, along=avemslematrix), " => ")
rownames(avemslematrix)[1]=paste(" unweighted => ")
colnames(avemslematrix)=c("aMSLE")
#return results
avemslematrix
}
#' @title Average root mean squared logarithmic error (aRMSLE)
#' @description Calculates average root mean squared logarithmic error (aRMSLE) under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average root mean squared logarithmic error (aRMSLE) under multiple, different weighting schemes
#' @details aRMSLE for weighting scheme # => mean value of the aRMSLEs for specified variables
#' under weighting scheme # => mean value of aRMSLEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVERMSLEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVERMSLEw
AVERMSLEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vector
avermslevec=vector(length=length(Weights))
#calculate unweighted statistic and store value
avermsleuw=mean(sqrt(apply(((mapply('-', log(Actual+1),
log(Survey+1)))^2), 2, mean)))
avermslevec[1]=avermsleuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
avermsle=mean(sqrt(apply(((mapply('-', log(Actual+1),
log(wtsvy+1)))^2), 2, mean)))
avermslevec[[i+1]]=avermsle
}
#convert to matrix and label
avermslematrix=noquote(cbind(matrix(format(avermslevec, signif=7))))
rownames(avermslematrix)=paste(" wgt scheme",
seq(from=0, along=avermslematrix), " => ")
rownames(avermslematrix)[1]=paste(" unweighted => ")
colnames(avermslematrix)=c("aRMSLE")
#return results
avermslematrix
}
#' @title Full scale-dependent statistics
#' @description Calculates full scale-dependent statistics
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Full scale-dependent statistics
#' @examples FULLSDw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export FULLSDw
FULLSDw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vectors
avemaevec=vector(length=(length(Weights)+1))
avemsevec=vector(length=(length(Weights)+1))
avermsevec=vector(length=(length(Weights)+1))
avemslevec=vector(length=(length(Weights)+1))
avermslevec=vector(length=(length(Weights)+1))
spacevec=vector(length=(length(Weights)+1))
spacevec[1:(length(Weights)+1)]=" "
#calculate unweighted statistics and store values
avemaeuw=mean(apply(abs(mapply('-', Actual, Survey)), 2, mean))
avemaevec[1]=avemaeuw
avemseuw=mean(apply(((mapply('-', Actual, Survey))^2), 2, mean))
avemsevec[1]=avemseuw
avermseuw=mean(sqrt(apply(((mapply('-', Actual, Survey))^2), 2, mean)))
avermsevec[1]=avermseuw
avemsleuw=mean(apply(((mapply('-', log(Actual+1),
log(Survey+1)))^2), 2, mean))
avemslevec[1]=avemsleuw
avermsleuw=mean(sqrt(apply(((mapply('-', log(Actual+1),
log(Survey+1)))^2), 2, mean)))
avermslevec[1]=avermsleuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
avemae=mean(apply(abs(mapply('-', Actual, wtsvy)), 2, mean))
avemaevec[[i+1]]=avemae
avemse=mean(apply(((mapply('-', Actual, wtsvy))^2), 2, mean))
avemsevec[[i+1]]=avemse
avermse=mean(sqrt(apply(((mapply('-', Actual, wtsvy))^2), 2, mean)))
avermsevec[[i+1]]=avermse
avemsle=mean(apply(((mapply('-', log(Actual+1),
log(wtsvy+1)))^2), 2, mean))
avemslevec[[i+1]]=avemsle
avermsle=mean(sqrt(apply(((mapply('-', log(Actual+1),
log(wtsvy+1)))^2), 2, mean)))
avermslevec[[i+1]]=avermsle
}
#convert to matrix and label
fullsdmatrix=noquote(matrix(cbind(format(avemaevec, signif=7), spacevec,
format(avemsevec, signif=7), spacevec, format(avermsevec, signif=7),
spacevec, format(avemslevec, signif=7), spacevec,
format(avermslevec, signif=7)), ncol=9))
rownames(fullsdmatrix)=paste(" wgt scheme",
seq(from=0, along=fullsdmatrix[, 1]), " => ")
rownames(fullsdmatrix)[1]=paste(" unweighted => ")
colnames(fullsdmatrix)=c("aMAE", " ", "aMSE", " ", "aRMSE", " ",
"aMSLE", " ", "aRMSLE")
#return results
fullsdmatrix
}
#' @title Average mean absolute percentage error (aMAPE)
#' @description Calculates average mean absolute percentage error (aMAPE) under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average mean absolute percentage error (aMAPE) under multiple, different weighting schemes
#' @details aMAPE for weighting scheme # => mean value of the aMAPEs for specified variables
#' under weighting scheme # => mean value of aMAPEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVEMAPEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVEMAPEw
AVEMAPEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vector
avemapevec=vector(length=(length(Weights)+1))
#calculate unweighted statistic and store value
avemapeuw=mean(apply(abs(mapply('-', Actual, Survey))/Actual, 2, mean))
avemapevec[1]=avemapeuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
avemape=mean(apply(abs(mapply('-', Actual, wtsvy))/Actual, 2, mean))
avemapevec[[i+1]]=avemape
}
#convert to matrix and label
avemapematrix=noquote(cbind(matrix(format(avemapevec, signif=7))))
rownames(avemapematrix)=paste(" wgt scheme",
seq(from=0, along=avemapematrix), " => ")
rownames(avemapematrix)[1]=paste(" unweighted => ")
colnames(avemapematrix)=c("aMAPE")
#return results
avemapematrix
}
#' @title Average symmetric mean absolute percentage error (aSMAPE)
#' @description Calculates average symmetric mean absolute percentage error (aSMAPE) under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average symmetric mean absolute percentage error (aSMAPE) under multiple, different weighting schemes
#' @details aSMAPE for weighting scheme # => mean value of the aSMAPEs for specified variables
#' under weighting scheme # => mean value of aSMAPEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVESMAPEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVESMAPEw
AVESMAPEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vector
avesmapevec=vector(length=(length(Weights)+1))
#calculate unweighted statistic and store value
avesmapeuw=mean((apply((abs(mapply('-', Actual, Survey))/
(abs(Actual)+abs(Survey))), 2, mean))*2)
avesmapevec[1]=avesmapeuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
avesmape=mean((apply((abs(mapply('-', Actual, wtsvy))/
(abs(Actual)+abs(wtsvy))), 2, mean))*2)
avesmapevec[[i+1]]=avesmape
}
#convert to matrix and label
avesmapematrix=noquote(cbind(matrix(format(avesmapevec, signif=7))))
rownames(avesmapematrix)=paste(" wgt scheme",
seq(from=0, along=avesmapematrix), " => ")
rownames(avesmapematrix)[1]=paste(" unweighted => ")
colnames(avesmapematrix)=c("aSMAPE")
#return results
avesmapematrix
}
#' @title Average relative absolute error (aRAE)
#' @description Calculates average relative absolute error (aRAE) under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average relative absolute error (aRAE) under multiple, different weighting schemes
#' @details aRAE for weighting scheme # => mean value of the aRAEs for specified variables
#' under weighting scheme # => mean value of aRAEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVERAEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVERAEw
AVERAEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vector
averaevec=vector(length=(length(Weights)+1))
#calculate unweighted statistic and store value
averaeuw=mean((apply(abs(mapply('-', Actual, Survey)), 2, sum))/
apply((abs(mapply('-', Actual, apply(Actual, 2, mean)))), 2, sum))
averaevec[1]=averaeuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
averae=mean((apply(abs(mapply('-', Actual, wtsvy)), 2, sum))/
apply((abs(mapply('-', Actual, apply(Actual, 2, mean)))), 2, sum))
averaevec[[i+1]]=averae
}
#convert to matrix and label
averaematrix=noquote(cbind(matrix(format(averaevec, signif=7))))
rownames(averaematrix)=paste(" wgt scheme",
seq(from=0, along=averaematrix), " => ")
rownames(averaematrix)[1]=paste(" unweighted => ")
colnames(averaematrix)=c("aRAE")
#return results
averaematrix
}
#' @title Average relative squared error (aRSE)
#' @description Calculates average relative squared error (aRSE) under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average relative squared error (aRSE) under multiple, different weighting schemes
#' @details aRSE for weighting scheme # => mean value of the aRSEs for specified variables
#' under weighting scheme # => mean value of aRSEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVERSEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVERSEw
AVERSEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vector
aversevec=vector(length=(length(Weights)+1))
#calculate unweighted statistic and store value
averseuw=mean((apply((mapply('-', Actual, Survey))^2, 2, sum))/
apply(((mapply('-', Actual, apply(Actual, 2, mean)))^2), 2, sum))
aversevec[1]=averseuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
averse=mean((apply((mapply('-', Actual, wtsvy))^2, 2, sum))/
apply(((mapply('-', Actual, apply(Actual, 2, mean)))^2), 2, sum))
aversevec[[i+1]]=averse
}
#convert to matrix and label
aversematrix=noquote(cbind(matrix(format(aversevec, signif=7))))
rownames(aversematrix)=paste(" wgt scheme",
seq(from=0, along=aversematrix), " => ")
rownames(aversematrix)[1]=paste(" unweighted => ")
colnames(aversematrix)=c("aRSE")
#return results
aversematrix
}
#' @title Average root relative squared error (aRRSE)
#' @description Calculates average root relative squared error (aRRSE) under multiple, different weighting schemes
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Average root relative squared error (aRRSE) under multiple, different weighting schemes
#' @details aRRSE for weighting scheme # => mean value of the aRRSEs for specified variables
#' under weighting scheme # => mean value of aRRSEs for objects in Survey=data.frame() *
#' objects in Weights=data.frame()
#' @examples AVERRSEw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export AVERRSEw
AVERRSEw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vector
averrsevec=vector(length=(length(Weights)+1))
#calculate unweighted statistic and store value
averrseuw=mean(sqrt((apply((mapply('-', Actual, Survey))^2, 2, sum))/
apply(((mapply('-', Actual, apply(Actual, 2, mean)))^2), 2, sum)))
averrsevec[1]=averrseuw
#weight data, calculate statistic, store value
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
averrse=mean(sqrt((apply((mapply('-', Actual, wtsvy))^2, 2, sum))/
apply(((mapply('-', Actual, apply(Actual, 2, mean)))^2), 2, sum)))
averrsevec[[i+1]]=averrse
}
#convert to matrix and label
averrsematrix=noquote(cbind(matrix(format(averrsevec, signif=7))))
rownames(averrsematrix)=paste(" wgt scheme",
seq(from=0, along=averrsematrix), " => ")
rownames(averrsematrix)[1]=paste(" unweighted => ")
colnames(averrsematrix)=c("aRRSE")
#return results
averrsematrix
}
#' @title Full scale-independent statistics
#' @description Calculates full scale-independent statistics
#' @param Actual data from a "gold standard" survey; objects are variable columns
#' from "gold standard" survey that corruspond to variable columns Survey
#' @param Survey data from a survey; objects are variable columns from a
#' survey that corruspond to variable columns from Actual
#' @param Weights weights to be applied to Survey data; objects are weights columns
#' @return Full scale-independent statistics
#' @examples FULLSIw(Actual=data.frame(TESTWGT$A1, TESTWGT$A2),
#' Survey=data.frame(TESTWGT$Q1, TESTWGT$Q2),
#' Weights=data.frame(TESTWGT$W1, TESTWGT$W2))
#' @note Make sure to properly order inputs, per the example: Actual=data.frame() objects
#' and corrusponding Survey=data.frame() objects must be given in the same order as each other;
#' and Weights=data.frame() objects must be given in sequence of weighting scheme #.
#' @export FULLSIw
FULLSIw=function(Actual=data.frame(), Survey=data.frame(), Weights=data.frame()){
#create storage vectors
avemapevec=vector(length=(length(Weights)+1))
avesmapevec=vector(length=(length(Weights)+1))
averaevec=vector(length=(length(Weights)+1))
aversevec=vector(length=(length(Weights)+1))
averrsevec=vector(length=(length(Weights)+1))
spacevec=vector(length=(length(Weights)+1))
spacevec[1:(length(Weights)+1)]=" "
#calculate unweighted statistics and store values
avemapeuw=mean(apply(abs(mapply('-', Actual, Survey))/Actual, 2, mean))
avemapevec[1]=avemapeuw
avesmapeuw=mean((apply((abs(mapply('-', Actual, Survey))/
(abs(Actual)+abs(Survey))), 2, mean))*2)
avesmapevec[1]=avesmapeuw
averaeuw=mean((apply(abs(mapply('-', Actual, Survey)), 2, sum))/
apply((abs(mapply('-', Actual, apply(Actual, 2, mean)))), 2, sum))
averaevec[1]=averaeuw
averseuw=mean((apply((mapply('-', Actual, Survey))^2, 2, sum))/
apply(((mapply('-', Actual, apply(Actual, 2, mean)))^2), 2, sum))
aversevec[1]=averseuw
averrseuw=mean(sqrt((apply((mapply('-', Actual, Survey))^2, 2, sum))/
apply(((mapply('-', Actual, apply(Actual, 2, mean)))^2), 2, sum)))
averrsevec[1]=averrseuw
#weight data, calculate statistics, store values
for(i in 1:length(Weights)){
wtsvy=data.frame(lapply(Survey, '*', Weights[[i]]))
avemape=mean(apply(abs(mapply('-', Actual, wtsvy))/Actual, 2, mean))
avemapevec[[i+1]]=avemape
avesmape=mean((apply((abs(mapply('-', Actual, wtsvy))/
(abs(Actual)+abs(wtsvy))), 2, mean))*2)
avesmapevec[[i+1]]=avesmape
averae=mean((apply(abs(mapply('-', Actual, wtsvy)), 2, sum))/
apply((abs(mapply('-', Actual, apply(Actual, 2, mean)))), 2, sum))
averaevec[[i+1]]=averae
averse=mean((apply((mapply('-', Actual, wtsvy))^2, 2, sum))/
apply(((mapply('-', Actual, apply(Actual, 2, mean)))^2), 2, sum))
aversevec[[i+1]]=averse
averrse=mean(sqrt((apply((mapply('-', Actual, wtsvy))^2, 2, sum))/
apply(((mapply('-', Actual, apply(Actual, 2, mean)))^2), 2, sum)))
averrsevec[[i+1]]=averrse
}
#convert to matrix and label
fullsimatrix=noquote(matrix(cbind(format(avemapevec, signif=7), spacevec,
format(avesmapevec, signif=7), spacevec, format(averaevec, signif=7),
spacevec, format(aversevec, signif=7), spacevec, format(averrsevec,
signif=7)), ncol=9))
rownames(fullsimatrix)=paste(" wgt scheme",
seq(from=0, along=fullsimatrix[, 1]), " => ")
rownames(fullsimatrix)[1]=paste(" unweighted => ")
colnames(fullsimatrix)=c("aMAPE", " ", "aSMAPE", " ", "aRAE", " ",
"aRSE", " ", "aRRSE")
#return results
fullsimatrix
}
Try the TSEwgt package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.