Наглядный анализ дневных норм питания

База знаний Wolfram Knowledgebase включает в себя не только информацию о подробныx свойстваx и питательной ценности более чем 37000 продуктов питания ("Food" )и 1000 единиц в категории "пища" ("FoodType"), но и данные о дневных рекомендуемых нормах 176 питательных веществ. Эти обширные наборы данных о питании позволяют производить анализ содержания питательных веществ в практически любой еде и представлять эти данные как в виде числовых значений, так и графически.

In[1]:=

EntityValue["Nutrient", "EntityCount"]

Out[1]=

Получим список ежедневных рекомендуемых норм питательных веществ, основанных на 2000-калорийной диете.

In[2]:=

allDailyValues = Append[DeleteMissing[ EntityValue["Nutrient", "DailyValue", "EntityAssociation"]], Entity["Nutrient", "Energy"] -> Quantity[2000, ("LargeCalories")/("Days")]]*Quantity[1, "Days"]

Out[2]=

Подберем питательных вещества, содержащие необходимые для питания элементы.

In[3]:=

propertyNutrientRules = {EntityProperty["Food", "AbsoluteSodiumContent"] -> Entity["Nutrient", "Sodium"], EntityProperty["Food", "AbsoluteTotalCarbohydratesContent"] -> Entity["Nutrient", "TotalCarbohydrates"], EntityProperty["Food", "AbsoluteTotalFatContent"] -> Entity["Nutrient", "TotalFat"], EntityProperty["Food", "AbsoluteTotalFiberContent"] -> Entity["Nutrient", "TotalFiber"], EntityProperty["Food", "AbsoluteIronContent"] -> Entity["Nutrient", "Iron"], EntityProperty["Food", "AbsoluteTotalCaloriesContent"] -> Entity["Nutrient", "Energy"]};

Рассмотрим питательные составляющие типичного завтрака с использованием функций EntityGroup и EntityInstance.

In[4]:=

breakfast = EntityGroup[{ EntityInstance[Entity[ "Food", { EntityProperty["Food", "CookingMethod"] -> Entity[ "CookingMethod", "HardBoiled"], EntityProperty["Food", "FoodType"] -> ContainsExactly[{ Entity["FoodType", "Egg"]}], EntityProperty[ "Food", "AddedFoodTypes"] -> ContainsExactly[{}]}], Quantity[2, "Servings"]], EntityInstance[Entity[ "Food", {EntityProperty["Food", "FoodType"] -> ContainsExactly[{ Entity["FoodType", "Bacon"]}], EntityProperty[ "Food", "AddedFoodTypes"] -> ContainsExactly[{}]}], Quantity[3, "Slices"]], EntityInstance[Entity[ "Food", {EntityProperty["Food", "FoodType"] -> ContainsExactly[{ Entity["FoodType", "HashBrown"]}], EntityProperty[ "Food", "AddedFoodTypes"] -> ContainsExactly[{}]}], Quantity[1, "Servings"]], EntityInstance[Entity[ "Food", {EntityProperty["Food", "FoodType"] -> ContainsExactly[{ Entity["FoodType", "OrangeJuice"]}], EntityProperty[ "Food", "AddedFoodTypes"] -> ContainsExactly[{}]}], Quantity[2, "Servings"]] }];

Построим график-"компас", с радиально вложенными шестиугольниками с указанными 50%, 100% (шестиугольник помечен зеленым цветом), и 150% суточными рекомендованными нормами шести основных питательных веществ.

In[5]:=

compassPlot[ent : _EntityGroup | {__EntityGroup}, opts : OptionsPattern[Graphics]] := Module[{data, n, circlePoints, dailyValues, scaledData, coordinates, fillStyle, opacityStyle, pointStyle, labelCoordPairs, missingPositions, rMax}, (* Get data, total up nutrients *) data = EntityValue[ Replace[ent, eg_EntityGroup :> {eg}], {EntityProperty["Food", "AbsoluteTotalCarbohydratesContent"], EntityProperty["Food", "AbsoluteTotalFatContent"], EntityProperty["Food", "AbsoluteSodiumContent"], EntityProperty["Food", "AbsoluteTotalFiberContent"], EntityProperty["Food", "AbsoluteIronContent"], EntityProperty["Food", "AbsoluteTotalCaloriesContent"]}, "PropertyAssociation" ]; data = Merge[data, Total]; (* Get DailyValues, scale data to DailyValues *) dailyValues = Keys[data] /. propertyNutrientRules /. allDailyValues; scaledData = 100*AssociationThread[ Keys[data], (Values[data]/dailyValues) /. {_Missing -> Quantity[0, "Grams"]}]; (* Compute the coordinates for each of the points *) n = Length[data]; circlePoints = CirclePoints[n]; missingPositions = Cases[MapIndexed[If[Not[FreeQ[#, _Missing]], #2] &, Values[data]], _Integer, Infinity]; coordinates = Normal@AssociationThread[Keys[scaledData], circlePoints*Values[scaledData]]; (* Precompute the label-coordinate pairs *) labelCoordPairs = Thread[Keys[data] -> circlePoints] /. {_Missing -> Quantity[0, "Grams"]}; fillStyle = Opacity[0.5, Black]; opacityStyle = Opacity[0.01, Black]; pointStyle = Blue; rMax = 150; (* Create the plot *) Graphics[{ (* Add lines from the center outwards to indicate "axes" for the \ nutrients *) {Thin, Opacity[0.75], Gray, Dashed, Line[{{0, 0}, #}]} & /@ (rMax*circlePoints), (* For each position, draw a triangle and a line (taking missing values into account) *) MapIndexed[ With[{currentPosition = First[#2], nextPosition = Replace[First[#2] + 1, (n + 1) -> 1]}, { (* For each position, draw a triangle (origin -> point -> next point) *) { fillStyle, EdgeForm[], Polygon[ {{0, 0}, coordinates[[currentPosition, 2]], coordinates[[nextPosition, 2]]}, VertexColors -> { fillStyle, If[MemberQ[missingPositions, currentPosition], opacityStyle, fillStyle], If[MemberQ[missingPositions, nextPosition], opacityStyle, fillStyle] } ] // If[MemberQ[missingPositions, nextPosition | currentPosition], Tooltip[#, Missing["NotAvailable"]] &, Identity] }, (* Connect two points if neither of them are missing data *) If[ FreeQ[missingPositions, nextPosition | currentPosition], {Thickness[0.0033], Gray, Line[{coordinates[[currentPosition, 2]], coordinates[[nextPosition, 2]]}]} ] } ] &, coordinates[[;; -1, -1]]], (* For each non-missing position, put a small point *) { pointStyle, PointSize[0.0100], Tooltip[Point[coordinates[[#, 2]]], Grid[{{ToString[ Round[100*(data[[#]]/dailyValues[[#]]), 0.1]] <> " %", "", coordinates[[#, 1]]}, {data[[#]], "of", dailyValues[[#]]}}]] } & /@ Complement[Range[n], Flatten[missingPositions]], (* Radially nested polygons to indicate 50%, 100%, 150%, etc... of DV *) Table[ {Thin, Opacity[0.75], Sequence @@ If[r === 100, {Thick, Darker@Green}, {Gray, Dashed}], Tooltip[Line[r*Join[circlePoints, circlePoints[[;; 1]]]], ToString[r] <> "%"]}, {r, 50, rMax, 50}], (* Label the axes afterwards so that they aren't covered/ unreadable *) {Text[ Style[StringTrim@ StringReplace[ EntityValue[#1, "Description"], ("absolute" | "content") -> ""]], (rMax*1.175)*#2]} & @@@ labelCoordPairs }, opts ] ]

In[6]:=

compassPlot[breakfast]

Out[6]=

Укажем обед и ужин в дополнении к завтраку.

In[7]:=

lunch = EntityGroup[{ EntityInstance[Entity[ "Food", {EntityProperty["Food", "FoodType"] -> ContainsExactly[{ Entity["FoodType", "PeanutButter"]}], EntityProperty[ "Food", "AddedFoodTypes"] -> ContainsExactly[{}]}], Quantity[2, "Tablespoons"]], EntityInstance[Entity[ "Food", {EntityProperty["Food", "FoodType"] -> ContainsExactly[{ Entity["FoodType", "Bread"]}], EntityProperty[ "Food", "AddedFoodTypes"] -> ContainsExactly[{}]}], Quantity[2, "Slices"]], EntityInstance[Entity[ "Food", {EntityProperty["Food", "FoodType"] -> ContainsExactly[{ Entity["FoodType", "Jelly"]}], EntityProperty[ "Food", "AddedFoodTypes"] -> ContainsExactly[{}]}], Quantity[1, "Servings"]] }];

In[8]:=

dinner = EntityGroup[{ EntityInstance[Entity[ "Food", {EntityProperty["Food", "FoodType"] -> ContainsExactly[{ Entity["FoodType", "Spaghetti"]}], EntityProperty[ "Food", "AddedFoodTypes"] -> ContainsExactly[{}]}], Quantity[1, "Servings"]], EntityInstance[Entity[ "Food", {EntityProperty["Food", "FoodType"] -> ContainsExactly[{ Entity["FoodType", "Meatball"]}], EntityProperty[ "Food", "AddedFoodTypes"] -> ContainsExactly[{}]}], Quantity[3, "Items"]], EntityInstance[Entity[ "Food", { EntityProperty["Food", "BrandName"] -> Entity[ "FoodBrandName", "Bertolli"], EntityProperty["Food", "FoodType"] -> ContainsExactly[{ Entity["FoodType", "Sauce"]}], EntityProperty[ "Food", "AddedFoodTypes"] -> ContainsExactly[{}]}], Quantity[1.5, "Servings"]], EntityInstance[Entity[ "Food", { EntityProperty["Food", "Flavor"] -> Entity[ "FoodFlavor", "Cola"], EntityProperty["Food", "FoodType"] -> ContainsExactly[{ Entity["FoodType", "CarbonatedBeverage"]}], EntityProperty[ "Food", "AddedFoodTypes"] -> ContainsExactly[{}]}], Quantity[1, "USSodaCanVolumes"]] }];

Визуализируем инкрементное поступление питательных веществ после каждого приема пищи.

In[9]:=

Grid[Partition[ MapThread[ compassPlot[#1, PlotLabel -> #2] &, {Rest[ FoldList[ Append, {}, {breakfast, lunch, dinner}]], {"After Breakfast", "After Lunch", "After Dinner"}}], UpTo[2]]]

Out[9]=