Non-linear scaled X axis in DateListPlot

Question

I have a lot of plots like this in Mathematica:

And I would like to transform it in something like that:

Where the information between 0 and 7 hours and 18 and 00 hour is "compressed" in the chart.

I know about ScalingFunctions, but it doesn't work for DateListPlot.

Here is some toy code to reproduce the original version behavior:

dtIni={2013,1,1,0};
dtFim={2013,1,1,24};
data={#,RandomVariate[NormalDistribution[0,1]]}&/@RandomReal[{AbsoluteTime@dtIni,AbsoluteTime@dtFim},500];

DateListPlot[data
    ,FrameTicks->{Automatic,{DateRange[dtIni, dtFim, "Hour"],None}}
    ,GridLines -> {If[MemberQ[{0,7,12,18},Last@#],{#,Gray},{#,LightGray}]&/@DateRange[dtIni, dtFim, "Hour"],{#,LightGray}&/@{0.5,1,2,5,10,20}}
    ,DateTicksFormat->{"Hour"}
]

I don't know if the best idea is try to scale the X axis, or join 3 charts, one for each time period using something like this dismembered data:

dataP1 = Select[data, #[[1]] < AbsoluteTime@{2013, 1, 1, 7} &];
dataP3 = Select[data, #[[1]] > AbsoluteTime@{2013, 1, 1, 18} &];
dataP2 = Complement[data, dataP1, dataP3];

I think that the axis scale solution appear to be more elegant, but I don't know how to implement it. 3 Graphics join will be welcome too. Any Clue?

Answer 1

Another way is to rescale the data that occur before 07:00 to the range between 06:00-07:00 and the data that occur after 18:00 to the range 18:00-19:00.

dtIni = {2013, 1, 1, 0};
dtFim = {2013, 1, 1, 24};
data = {#, RandomVariate[NormalDistribution[0, 1]]} & /@ 
   RandomReal[{AbsoluteTime@dtIni, AbsoluteTime@dtFim}, 500];

lowerBorder = AbsoluteTime[dtIni + {0, 0, 0, 7}];
lowerBorder2 = lowerBorder - 3600;
upperBorder = AbsoluteTime[dtFim - {0, 0, 0, 6}];
upperBorder2 = upperBorder + 3600;

pre = Select[data, #[[1]] <= lowerBorder &];
post = Select[data, #[[1]] >= upperBorder &];
data2 = Select[data, #[[1]] > lowerBorder && #[[1]] < upperBorder &];

preNew = Transpose[{Rescale[
     pre[[All, 1]], {AbsoluteTime[dtIni], lowerBorder}, {lowerBorder2,
       lowerBorder}], pre[[All, 2]]}];
postNew = 
  Transpose[{Rescale[
     post[[All, 1]], {upperBorder, AbsoluteTime[dtFim]}, {upperBorder,
       upperBorder2}], post[[All, 2]]}];

DateListPlot[Join[preNew, data2, postNew], 
 FrameTicks -> {{Automatic, 
    Automatic}, {Join[{{lowerBorder2, "00:00"}}, 
     Range[lowerBorder, upperBorder, 
      3600], {{upperBorder2, "00:00"}}], Automatic}}]

Answer 2

An alternative is to plot the data over 3 separate time ranges and combine the 3 plots. Here is how to do it set out step by step. Firstly it looks like your y axis scale is logarithmic right? In that case I am using DateListLogPlot but if I have misinterpreted you can easily switch to DateListPlot.

The objective is to create 3 plots and adjust the image padding in each plot then combine the 3.

data = Partition[data, 3];

hour = 35 (* pixel width of each hour *);
w = 11*hour;
h = 300;
(* image padding *)
{{l, r}, {b, t}} = {{30, 5}, {30, 5}};

(* options used in all plots *)
commonOptions = {
   GridLines -> {Thread[{2013, 1, 1, Range[24]}], None},
   GridLinesStyle -> LightGray,
   PlotStyle -> {Blue, Green, Red}};

(* first 7 hours *)

p1 = DateListLogPlot[data, DateTicksFormat -> {"Hour"},
   AspectRatio -> h/hour,
   FrameTicks -> {{Automatic, None}, {None, None}},
   ImageSize -> {l + hour, h + b + t},
   ImagePadding -> {{l, 0}, {b, t}},
   PlotRange -> {{{2013, 1, 1, 0}, {2013, 1, 1, 6, 23, 59}}, 
     Automatic},
   commonOptions];

(* main plot *)
p2 = DateListLogPlot[data, DateTicksFormat -> {"Hour"},
   AspectRatio -> h/w,
   FrameTicks -> {{None, None}, {Thread[{2013, 1, 1, Range[24]}], 
      None}},
   ImageSize -> {w, h + b + t},
   ImagePadding -> {{0, 0}, {b, t}},
   PlotRange -> {{{2013, 1, 1, 7}, {2013, 1, 1, 18}}, Automatic},
   commonOptions];

(* last 6 hours *)

p3 = DateListLogPlot[data, DateTicksFormat -> {"Hour"},
   AspectRatio -> h/hour,
   FrameTicks -> None,
   ImageSize -> {r + hour, h + b + t},
   ImagePadding -> {{0, r}, {b, t}},
   PlotRange -> {{{2013, 1, 1, 18, 0, 1}, {2013, 1, 1, 24}}, 
     Automatic},
   commonOptions];

So combine the plots:

Grid[{{p1, p2, p3}}, Spacings -> {0, 0}]

Notice how the "18" tick label is obscured. To get around this alter the middle plot with extra padding to the right and use Overlay

p2 = DateListLogPlot[data, DateTicksFormat -> {"Hour"},
   AspectRatio -> h/w,
   FrameTicks -> {{None, None}, {Thread[{2013, 1, 1, Range[24]}], 
      None}},
   ImageSize -> {w + hour + r, h + b + t},
   ImagePadding -> {{0, hour + r}, {b, t}},
   PlotRange -> {{{2013, 1, 1, 7}, {2013, 1, 1, 18}}, Automatic},
   coomonOptions];

Grid[{{p1, Overlay[{p2, p3}, Alignment -> {Right, Center}]}}, 
 Spacings -> {0, 0}]

If you are doing this regularly you should be able to combine these steps into a function. The code is lengthy because you have 3 plots with options but nevertheless it is relatively straight forward to modify.

Other things to consider:

1. The "gridlines" at t=7 and 18 are actually the frames so you could alter the relevant vertical FrameStyle to make them the appear like the other gridlines.

2. I haven't added horizontal gridlines but easy enough for you to add.

3. I haven't added x axis ticks in the "unwanted" periods but you make a tick function that displays a tick mark but not a tick label.

4. I haven't added a plot label. Add this to plot #2.

Answer 3

One way is to assign the "unwanted" points to the contiguous points of the "wanted" region. You can relabel them, if you prefer, to something like "0-7" and "18-24".

dataP1new = {AbsoluteTime@{2013, 1, 1, 6}, #[[2]]} & /@ dataP1;
dataP3new = {AbsoluteTime@{2013, 1, 1, 19}, #[[2]]} & /@ dataP3;

dataNew = Join[dataP1new, dataP2, dataP3new];

DateListPlot[dataNew,  FrameTicks -> {Automatic, {DateRange[dtIni, dtFim, "Hour"], None}}, 
 GridLines -> {If[MemberQ[{0, 7, 12, 18}, Last@#], {#, Gray}, {#, LightGray}] & /@
 DateRange[dtIni, dtFim, "Hour"], 
    {#, LightGray} & /@ {0.5, 1, 2, 5, 10, 20}}, DateTicksFormat -> {"Hour"}]