Approaches For Creating Cycle Plots in Mathematica

Question

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.

Answer 1

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

For

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

here's the result of the 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

Answer 2

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