個人の運動データを解析する 

個人のフィットネスデバイスによって生成された時系列を解析すると，その人の活動量について役立つ情報を得たり，最適な健康状態になるための現実的な目標を定めたりすることができる．

時系列には5ヶ月の間に，ある人が毎日歩いた歩数が含まれる．

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

1日に1万歩という理想的な目標と，毎日の歩数を一緒にプロットする．

完全な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=

1週間ごとに集計する．

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