分析个人健康数据 

对从个人健康设备生成的时间序列的分析可提供关于个人运动水平的有益总结，并且可为得到最理想健康显示提出实际目标.

该时间序列包含了在五个月期间个人每日的行走步数.

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.];

一同绘制每日步数记录和每日10,000步健康目标图.

显示完整的 Wolfram 语言输入隐藏输入

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]=

计算每日步数的基本统计.

显示完整的 Wolfram 语言输入隐藏输入

In[4]:=

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

Out[4]=

分析每日计数频率.

In[5]:=

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

Out[5]=

在每月的颜色编码日历显示每日计数的步数.

显示完整的 Wolfram 语言输入隐藏输入

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]=

根据每周各日分析步数.

In[11]:=

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

显示完整的 Wolfram 语言输入隐藏输入

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]=

计算每周各日的描述性统计.

In[13]:=

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

显示完整的 Wolfram 语言输入隐藏输入

In[14]:=

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

Out[14]//TableForm=

计算每周总数.

In[15]:=

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

显示完整的 Wolfram 语言输入隐藏输入

In[16]:=

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

Out[16]=