10
$\begingroup$

I am trying to create a cycle plot in Mathematica, and I am having a hard time finding the right approach to create the visualization. Can anyone give me a few pointers as to how to approach the problem?

ListPlot seems to be the right way to go, but I have to manually add a placement for the x-axis and it is not ideal. This is what I have done with simulated data:

monday = {{1.1, 3}, {1.2, 3}, {1.3, 2}, {1.4, 1}};
tuesday = {{2.1, 4}, {2.2, 4}, {2.3, 3}, {2.4, 3}};
wednesday = {{3.1, 6}, {3.2, 4}, {3.3, 3}, {3.4, 3}};
thursday = {{4.1, 6}, {4.2, 5}, {4.3, 5}, {4.4, 4}};
friday = {{5.1, 10}, {5.2, 10}, {5.3, 9}, {5.4, 8}};
saturday = {{6.1, 12}, {6.2, 10}, {6.3, 8}, {6.4, 8}};
sunday = {{7.1, 11}, {7.2, 9}, {7.3, 7}, {7.4, 6}};

ListPlot[{monday, tuesday, wednesday, thursday, friday, saturday, sunday},
Joined -> True,
Mesh -> All,
Frame -> True,
FrameTicks -> {{Automatic, All},
{{{1, "Monday"}, {2, "Tuesday"}, {3, "Wednesday"}, {4, 
  "Thursday"}, {5, "Friday"}, {6, "Saturday"}, {7, "Sunday"}}, 
None}}]

I do have David Park's Presentations package, and it seems that may be an effective tool for this problem, but I have not really used it very much.

$\endgroup$
  • $\begingroup$ I would try DateListPlot $\endgroup$ – David Slater Oct 23 '12 at 0:54
  • $\begingroup$ I tried, but kept running into a problem with the format of the plot. If the first data point is Monday, October 15 and the second is Monday, October 22 when it comes time to plot the Tuesday data it will overlap or obstruct the Monday data. $\endgroup$ – Nguyen Van Falk Oct 23 '12 at 1:20
10
$\begingroup$

I'll start with a slightly reformatted version of your data:

data = {{"Monday", 3}, {"Tuesday", 4}, {"Wednesday", 6}, {"Thursday", 6}, {"Friday", 10},
        {"Saturday", 12}, {"Sunday", 11}, {"Monday", 3}, {"Tuesday", 4}, {"Wednesday", 4},
        {"Thursday", 5}, {"Friday", 10}, {"Saturday", 10}, {"Sunday", 9}, {"Monday", 2},
        {"Tuesday", 3}, {"Wednesday", 3}, {"Thursday", 5}, {"Friday", 9}, {"Saturday", 8},
        {"Sunday", 7}, {"Monday", 1}, {"Tuesday", 3}, {"Wednesday", 3}, {"Thursday", 4},
        {"Friday", 8}, {"Saturday", 8}, {"Sunday", 6}};

Define a list of the days of the week:

$days = {"Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday"};

Gather and sort the data:

dt = #[[All, 2]] & /@ SortBy[GatherBy[data /. Thread[$days -> Range[7]], First], #[[1, 1]] &]
   {{3, 3, 2, 1}, {4, 4, 3, 3}, {6, 4, 3, 3}, {6, 5, 5, 4}, {10, 10, 9, 8},
    {12, 10, 8, 8}, {11, 9, 7, 6}}

(I used this particular method instead of using Partition[], since it can easily be used if the number of sample days are unequal (e.g. three Mondays, seven Tuesdays, etc.))

Having done this, the "cycle plot" can be generated this way:

Graphics[{Directive[AbsolutePointSize[3], AbsoluteThickness[1]], 
  MapIndexed[With[{i = First[#2], m = Mean[#1]},
                  {ColorData[1, i], Line[{{i - 1, m}, {i, m}}], 
                  Through[{Line, Point}[Transpose[{Range[i - 1, i, 1/(Length[#1] - 1)],
                          #1}]]]}] &, dt]},
         AspectRatio -> 1/GoldenRatio, Frame -> True,
         FrameTicks -> {{True, None},
                        {Transpose[{Range[7] - 1/2, Style[#, Small] & /@ $days}], None}}]

cycle plot

For

data = Join[Drop[data, 3], {{"Monday", 6}, {"Tuesday", 9}}];

here's the result of the cycle plot:

cycle plot

Encapsulating the procedure as a routine, as well as adding spacers between the daily plots, is left as an exercise to the reader.


Here's a generalization some of you might appreciate:

(* 2011 daily stock prices for Pfizer *)
data = FinancialData["NYSE:PFE", {{2011, 1, 1}, {2011, 12, 31}}];

dd = Map[#[[All, 2]] &, SortBy[GatherBy[#,
   Developer`CalendarData[First[#], "DayOfWeekNumber"] &],
   Developer`CalendarData[#[[1, 1]], "DayOfWeekNumber"] &]] & /@
   SplitBy[data, Developer`CalendarData[First[#], "MonthNumber"] &];

$months = {"January", "February", "March", "April", "May", "June", "July", "August",
           "September", "October", "November", "December"};

Partition[MapIndexed[
  Function[{da, k}, 
   Graphics[{Directive[AbsolutePointSize[3], AbsoluteThickness[1]], 
     MapIndexed[With[{i = First[#2], m = Mean[#1]},
         {ColorData[1, i], Line[{{i - 1, m}, {i, m}}], 
         Through[{Line, Point}[Transpose[{Range[i - 1, i, 1/(Length[#1] - 1)], #1}]]]}] &,
            da]},
            AspectRatio -> 1/GoldenRatio, Frame -> True, FrameTicks -> {{True, None},
            {Transpose[{Range[5] - 1/2, Style[#, Tiny] & /@ Take[$days, 5]}], None}},
        PlotLabel -> Extract[$months, k]]], dd], 4] // GraphicsGrid

calendar cycle plot

$\endgroup$
6
$\begingroup$

You should really consider changing your data format! In Mathematica, you have several ways to express a time or date.

In the following, I use your values for Monday, Tuesday, ... in a list to transform the first part of every pair, so that we have a valid date. For this I use Round[10*2.1] which ends in 21; then, taking the IntegerDigits from it lets me extract {2, 1}, which I then use to create a valid date. Note that I use the month as the hour, which makes it possible to put all Mondays together, and so on..

corr = {monday, tuesday, wednesday, thursday, friday, saturday, 
   sunday} /. {date_Real, value_Integer} :> 
   With[{d = IntegerDigits[Round[10 date]]}, {{2012, 1, d[[1]], 
      d[[2]]}, value}]

This can be used directly with DateListPlot:

DateListPlot[corr, Joined -> True, PlotStyle -> Thick, Mesh -> All, 
    DateTicksFormat -> "DayName"]

Mathematica graphics

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.