This project directory contains code and data for a Meal Plan Optimization project as part of MSDS 460.
The premise of this project: Create a linear program that reccomends amounts of foods to eat for n number of consecutive days (7 days, for example). The program can take various objective functions, for example, minimize carbs, sodium and/or cholesterol. The meals must meet all nutritional requirements as prescribed by The Institue of Medicine (IOM).
FORMULATION
Minimize the amount of a given nutrient or set of nutrients, e.g., carbohydrates, present in daily meals subject to upper and lower bounds on various nutritional constraints as prescribed by the IOM. Constraints include upper and lower bounds on daily intake of calories, vitamins, minerals, etc.
Note the values of the nutriets (in the columns) are per 100g of the food item listed. For example "BUTTER, WITH SALT" has 15.87 g of water per 100 g of Butter with Salt
raw_nutriet_data<- suppressMessages(read_csv("data/Nutrient Data.csv"))
message("Number of food items in raw nutriets data: ",scales::comma(nrow(raw_nutriet_data)))
## Number of food items in raw nutriets data: 8,790
message("Number of nutriets in raw nutriets data: ",scales::comma(length(raw_nutriet_data)-2))
Run the LP in a loop for n number of days for LOW CARB DIET
# how many days should we plan? (each day is a loop iteration)all_days<-7foods_used<- c("WATER")
all_results<-list()
for(dayin1:all_days){
# day <- 1# for development purposes, sample the nutrients list. Set to 1 to use full listsample_size<-1
set.seed(1)
sample_nutriets<- sample_frac(nutriets, sample_size)
# remove foods that have already been used, other than waterfoods_used<-foods_used[foods_used!="WATER"]
sample_nutriets<-sample_nutriets %>% filter(!Category%in%foods_used)
# set objective: minimize carbohydratesobjective_function<-sample_nutriets$`Carbohydrt_(g)`# initiate LHS constraint matrixLeft_Hand_Side<-matrix(numeric(nrow(sample_nutriets)), nrow=1)
# for each constraint, create a row in the LHS matrixfor(iin1:nrow(constraints)){
contraint_row<-constraints[i,]
constraint_name<-contraint_row$`Nutrient Name`constraint_lower<-contraint_row$`Lower Bound`constraint_upper<-contraint_row$`Upper Bound`nutirent_column<-sample_nutriets %>%
select_at(vars(constraint_name)) %>%
unlist() %>% as.numeric() %>%
matrix(nrow=1)
rownames(nutirent_column) <-constraint_nameLeft_Hand_Side<- rbind(Left_Hand_Side, nutirent_column)
}
# remove the initialization row at the topLeft_Hand_Side<-Left_Hand_Side[2:nrow(Left_Hand_Side),]
# direction of the constraints. Half are lower bounds half are upper boundsconstraint_directions<- c(rep(">=", nrow(Left_Hand_Side))
,rep("<=", nrow(Left_Hand_Side))
)
# Lower and Upper bounds for RHSRight_Hand_Side<- c(constraints$`Lower Bound`
, constraints$`Upper Bound`)
# duplicate the LHS matrix since we have both upper and lower boundsLeft_Hand_Side_Lower<-Left_Hand_Side
rownames(Left_Hand_Side_Lower) <- paste0(rownames(Left_Hand_Side),"_Lower")
Left_Hand_Side_Upper<-Left_Hand_Side
rownames(Left_Hand_Side_Upper) <- paste0(rownames(Left_Hand_Side),"_Upper")
Left_Hand_Side_all<- rbind(Left_Hand_Side_Lower, Left_Hand_Side_Upper)
## check the rows and columns match up:# all_equal(nrow(Left_Hand_Side_all)# , length(Right_Hand_Side)# , length(constraint_directions)# )## all_equal(length(objective_function), ncol(Left_Hand_Side_all))## run the soverlp_time_start<- Sys.time()
(LP_Solved<- lp(direction="min"
, objective.in=objective_function
, const.mat=Left_Hand_Side_all
, const.dir=constraint_directions
, const.rhs=Right_Hand_Side
, presolve=0
, compute.sens=TRUE
, all.bin=FALSE#, binary.vec#, all.int=FALSE#, int.vec
))
(lp_time<- Sys.time()-lp_time_start)
# record resultsresult_objective<-LP_Solved$objval# record non-zero decision variablesresults<- data_frame(
Food=sample_nutriets$Category[LP_Solved$solution>0]
,`Amount(g)`=LP_Solved$solution[LP_Solved$solution>0]
)
results$Day<- as.integer(day)
all_results[[day]] <-results# record foods used so they will be removed from subsequent loopfoods_used<- c(foods_used, results$Food)
# display info
message("DAY ",day, ": ", length(results$Food)," items selected. "
,scales::percent(sample_size), " of data used. LP completed in "
,round(lp_time,2), units(lp_time))
}
## DAY 1: 19 items selected. 100% of data used. LP completed in 0.02secs
## DAY 2: 15 items selected. 100% of data used. LP completed in 0.09secs
## DAY 3: 16 items selected. 100% of data used. LP completed in 0.02secs
## DAY 4: 19 items selected. 100% of data used. LP completed in 0.02secs
## DAY 5: 16 items selected. 100% of data used. LP completed in 0.02secs
## DAY 6: 14 items selected. 100% of data used. LP completed in 0.02secs
## DAY 7: 15 items selected. 100% of data used. LP completed in 0.02secs
