Nothing
computeMSDPS <- function(data, WholeCereals, Fruit, Vegetables, Dairy, Wine,
Fish, Poultry, LegumesAndMore, Potatoes, Eggs, Sweets,
Meat, OOprincipal,
WholeCerealsK, FruitK, VegetablesK, DairyK, WineK,
FishK, PoultryK, LegumesAndMoreK, PotatoesK, EggsK, SweetsK,
MeatK, OliveOilK, Kcal,
Sex, men = "male", women = "female",
output = "percent", frequency = "daily", rm.na = FALSE){
arguments <- as.list( match.call() )
WC <- eval(arguments$WholeCereals, data)
Fr <- eval(arguments$Fruit, data)
Ve <- eval(arguments$Vegetables, data)
Da <- eval(arguments$Dairy, data)
Wi <- eval(arguments$Wine, data)
Fs <- eval(arguments$Fish, data)
Pl <- eval(arguments$Poultry, data)
LNO <- eval(arguments$LegumesAndMore, data)
Pt <- eval(arguments$Potatoes, data)
Eg <- eval(arguments$Eggs, data)
Sw <- eval(arguments$Sweets, data)
Me <- eval(arguments$Meat, data)
OO <- eval(arguments$OOprincipal, data)
Sex <- eval(arguments$Sex, data)
WCK <- eval(arguments$WholeCerealsK, data)
FrK <- eval(arguments$FruitK, data)
VeK <- eval(arguments$VegetablesK, data)
DaK <- eval(arguments$DairyK, data)
WiK <- eval(arguments$WineK, data)
FsK <- eval(arguments$FishK, data)
PlK <- eval(arguments$PoultryK, data)
LNOK <- eval(arguments$LegumesAndMoreK, data)
PtK <- eval(arguments$PotatoesK, data)
EgK <- eval(arguments$EggsK, data)
SwK <- eval(arguments$SweetsK, data)
MeK <- eval(arguments$MeatK, data)
OOK <- eval(arguments$OliveOilK, data)
Kcal <- eval(arguments$Kcal, data)
# this code chunk tests if data has not been introduced in a daily fashion, and if so, transform data to daily consumption
if(is.null(frequency)){stop("please, provide the frequency of consumption in which the data is tabulated with the 'frequency' argument. Accepted values are 'daily', 'weekly' and 'monthly'")}
if(frequency == "monthly" || frequency == "weekly"){
Vars <- list(WC = WC, Fr = Fr, Ve = Ve, Da = Da, Wi = Wi, Fs = Fs, Pl = Pl, LNO = LNO,
Pt = Pt, Eg = Eg, Sw = Sw, Me = Me, OO = OO)
Vars <- periodicity(Vars, OriginalFreq = frequency, TargetFreq = "daily")
WC <- Vars$WC
Fr <- Vars$Fr
Ve <- Vars$Ve
Da <- Vars$Da
Wi <- Vars$Wi
Fs <- Vars$Fs
Pl <- Vars$Pl
LNO <- Vars$LNO
Pt <- Vars$Pt
Eg <- Vars$Eg
Sw <- Vars$Sw
Me <- Vars$Me
OO <- Vars$OO
} else {
if(frequency != "daily"){stop("accepted values for 'frequency' argument are 'daily', 'weekly' and 'monthly'")}
}
Item <- function(food, Servings){
De <- 100 * sqrt((Servings - food)^2) / Servings # Percent of deviation from the recomended amount of servings
S <- 10 - (De / 10) # 10 is the maximun item Score, from it, deviation is sustracted (as tens)
S[S < 0] <- 0 # minimun is zero
return(S)
}
WCs <- Item(WC, 8)
Frs <- Item(Fr, 3)
Ves <- Item(Ve, 6)
Das <- Item(Da, 2)
Wis <- numeric(length = nrow(data))
Wis[Sex == men] <- Item(Wi[Sex == men], 3)
Wis[Sex == women] <- Item(Wi[Sex == women], 1.5)
# Some items are scored in a weekly fashion
Fss <- Item(7 * Fs, 6)
Pls <- Item(7 * Pl, 4)
LNOs <- Item(7 * LNO, 4)
Pts <- Item(7 * Pt, 3)
Egs <- Item(7 * Eg, 3)
Sws <- Item(7 * Sw, 3)
Mes <- Item(7 * Me, 1)
OOs <- ifelse(OO == 2, 10,
ifelse(OO == 1, 5, 0))
score <- data.frame(WCs, Frs, Ves, Das, Wis, Fss, Pls, LNOs, Pts, Egs, Sws, Mes, OOs)
score <- round(score, 1) # otherwise output 'data.frame' is hard to read
score$absolute <- apply(score, 1, function(x) sum(x, na.rm = rm.na))
score$percentBrute <- round(100 * score$absolute / 130, 1)
# Corection factor "P"
P <- (WCK + FrK + VeK + DaK + WiK + FsK + PlK + LNOK + PtK + EgK + SwK + MeK + OOK) / Kcal
score$percent <- round(score$percentBrute * P, 1)
if(missing(output) || output == "percent") {return(score$percent)
} else {
if(output == "data.frame") {return(score)
} else {
stop("please, select a valid output argument, admited values are 'percent' -default- and 'data.frame' " )
}
}
}
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.