Analyze Personal Fitness Data 

An analysis of the time series generated by a personal fitness device can provide a useful summary of one's activity levels and suggest realistic goals for achieving optimal fitness.

This time series contains the number of steps taken daily by a person during a period of five months.

In[1]:=

X stepdata = TemporalData[TimeSeries, {CompressedData[" 1:eJwdkk1IVGEUhh+FjCRTzJrMn3Eya/Ina3TKMQdEVEIMyhYKgoIL0RIjWhYF IVTQxhKDBEUUgqlFhKJgtptFuBCUIoIWoRGBtXAjKIJPXjic+93znvd9z/lu qOdO22AqkGK8NkKl8KcCZvIgkQPjR+FIAbRUw0IZrF6AZWP9PMSMlCz4dBnC YXjreewiZMeh/D+uCK5mQ+QsfCmGRfmul8CvY/CvCt7Le/cQ+0/xAbglpk/t bnsy1Hopx7a5SM7UCHTWwdBxseXQXgn3zFP6WtTrjUJ4ZB60d1vur9Zbrd2U I67e7yg81U9pEL7pM2FMyjst7tVJeKDuG9/r7Ilece4a6LoEyRhsyRl0Lx8z YaAW1uRZt6e60f5TMOK8NX5fUueJ+5o1T2dAvZgW9xPTe5de0+X5oLc0uWud e+Ic3D4IjblwX3/P9RM5487k28h3VvU7miFX/LD+KuQd0UdQj6t6Tao54z6y 7H2nt2F1ctRJsy8sLi6mROyctXm5v3v+bL3X/EzsuDmq1qg7eew+rnn+q86K uVncgLwJffQcdjbvLuTdJb2PhwEION9P/Td49z/ccZ/4DTn6ne+FuJ02/412 2JU/0ASVp+Xy25D73DwBez7dZgU= "], { TemporalData`DateSpecification[{2013, 4, 1, 0, 0, 0.}, { 2013, 9, 1, 0, 0, 0.}, {1, "Day"}]}, 1, {"Discrete", 1}, { "Discrete", 1}, 1, {ValueDimensions -> 1}}, True, 10.];

Plot the daily step counts together with a healthy goal of 10,000 steps per day.

show complete Wolfram Language inputhide input

In[2]:=

X tenKlevel = {{{2013, 04, 01}, 10^4}, {{2013, 09, 01}, 10^4}}; opt = {Joined -> {False, True}, Filling -> 0, ImageSize -> Medium};

In[3]:=

X DateListPlot[{stepdata, tenKlevel}, opt]

Out[3]=

Compute the basic statistics for the daily number of steps.

show complete Wolfram Language inputhide input

In[4]:=

X Grid[Transpose@ Map[{#, Floor[#[stepdata]]} &, {Min, Mean, Median, Max}], Alignment -> {Left, Center}, Dividers -> All, Spacings -> {1.5, 1.}]

Out[4]=

Analyze the frequency of daily counts.

In[5]:=

X Histogram[stepdata, 10, ImageSize -> 300]

Out[5]=

Display the daily step counts in a color-coded calendar for each of the months.

show complete Wolfram Language inputhide input

In[6]:=

X monthlyTS[k_] := Block[{start = {2013, k, 1}, end, dno, wo}, end = DayRound[start, "EndOfMonth", "Next"]; dno = DayCount[start, end] + 1; wo = TimeSeriesWindow[stepdata, {start, end}]; TimeSeriesRescale[wo, {1, dno}] ]

In[7]:=

X data = Table[monthlyTS[k], {k, 4, 8}];

In[8]:=

X fmdow = Table[ DateValue[{2013, k, 1}, "DayName"] /. {Sunday -> 1, Monday -> 2, Tuesday -> 3, Wednesday -> 4, Thursday -> 5, Friday -> 6, Saturday -> 7}, {k, 4, 8}];

In[9]:=

X colors = {Red, Orange, Lighter[Green], Darker[Green], Purple}; months = {"April", "May", "June", "July", "August"}; cf[x_] := Piecewise[ Transpose@{colors, Map[#[[1]] <= x < #[[2]] &, Partition[Range[0, 25000, 5000], 2, 1]]}, Last[colors]]; legend = SwatchLegend[colors, Map[Row[{ToString[First[#]], "-", ToString[Last[#]]}] &, Partition[Range[0, 25000, 5000], 2, 1]], LegendLayout -> {"Column", 2}];

In[10]:=

X Grid[Partition[ Table[Labeled[ Grid[Partition[ Framed[Style[#1, Bold, White, FontFamily -> "Helvetica"], Background -> cf[#2], Alignment -> Center, ImageSize -> {25, 25}] & @@@ data[[k]]["Path"], 7, 7, {fmdow[[k]], 1}, ""], Dividers -> False, Spacings -> {0, 0}], Style[months[[k]], Bold, FontFamily -> "Helvetica"], Top], {k, 1, 5}], 2, 2, 1, legend], Spacings -> {2, 1.5}]

Out[10]=

Analyze the number of steps depending on a day of the week.

In[11]:=

X weekdays = {Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday}; wk = Map[TimeSeriesResample[stepdata, #] &, weekdays];

show complete Wolfram Language inputhide input

In[12]:=

X hlist = HistogramList[#, {0, 25000, 5000}] & /@ wk; colors = {Red, Orange, Lighter[Green], Darker[Green], Purple}; charts = Table[ SectorChart[Transpose[{Table[1, {5}], hlist[[i, 2]]}], ChartStyle -> colors, SectorOrigin -> {{-\[Pi]/2 , "Clockwise"}, 2}], {i, 7}]; graph = Graph[ Table[Property[ v, {VertexSize -> 1.1, VertexShape -> Legended[charts[[v + 1]], Placed[Style[weekdays[[v + 1]], FontFamily -> "Helvetica", Bold], {Center, {-.1, 2.7}}]]}], {v, 6, 0, -1}], Table[v <-> Mod[v + 1, 7], {v, 0, 6}], EdgeStyle -> Transparent, ImageSize -> 500]; Legended[graph, Placed[Framed[legend, Background -> GrayLevel[.9], FrameStyle -> GrayLevel[.8], RoundingRadius -> 5], {Center, Center}]]

Out[12]=

Calculate descriptive statistics for each day of the week.

In[13]:=

X stats = {Min, Mean, Median, Max, Total}; statsTable = Outer[Round[#1[#2]] &, stats, wk];

show complete Wolfram Language inputhide input

In[14]:=

X TableForm[statsTable, TableHeadings -> {stats, weekdays}, TableSpacing -> {2, 1.2}]

Out[14]//TableForm=

Calculate weekly totals.

In[15]:=

X weekly = TimeSeriesAggregate[stepdata, {7, "Day"}, Total];

show complete Wolfram Language inputhide input

In[16]:=

X DateListPlot[{weekly, MapAt[7 # &, tenKlevel, {All, 2}]}, Joined -> {False, True}, Filling -> 0, ImageSize -> Medium]

Out[16]=