Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I am trying to create a set of commands to automatically create clinical lab value plots. Using time is my major issue here. It is hard to dynamically reference the different point positions to include their labels. The value of each point located directly above it if possible. These values are located at value[i].

What I currently have

Current Output

Would I would like roughly

Desired

(* {{year,month,day,hour,minute},value}  *)
data = {
   {{2014, 1, 20, 17, 42}, 6.84},
   {{2014, 1, 20, 22, 33}, 5.87},
   {{2014, 1, 21, 6, 30}, 4.7}
   };

(* Effects the look of plot *)
min = 4;                                                              \
      (* Minimum Stable level *)
max = 11;                                                             \
    (* Maximum Stable level*)
Title = "WBC Count";                                    (* Label of \
Plot *)
taxis = "Time";                                                 (* \
Label of time axis *)
yaxis = "k/\[Mu]L";                                                (* \
Label of measured axis *)
tend = 20;                                                   (* make \
very large, defines how long the time for the min/max range is *)

RotationDegree = 0;                                    (* Rotate the \
labels by \[Theta] *)
Plotmin = 0;                                                     (* \
Minimum value to display *)
Plotmaxadd = 1;

times = Table[0, {i, Length[data]}];
Do[times[[i]] = 
  DateString[
   data[[i, 1]], {"Month", "/", "Day", " ", "Hour", ":", 
    "Minute"}], {i, Length[data]}]
value = Table[0, {i, Length[data]}];
Do[value[[i]] = data[[i, 2]], {i, Length[data]}]
a = With[{labels = 
     Rotate[DateString@#, RotationDegree/180*\[Pi]] & /@ times}, 
   ListPlot[data[[All, 2]], Mesh -> All, 
    MeshStyle -> PointSize[Large], Joined -> True, 
    PlotRange -> {Plotmin, 
      Max[Max[data[[All, 2]] + Plotmaxadd] + Plotmaxadd, 
       max + Plotmaxadd]}, 
    PlotLabel -> Style[Row@{Title}, FontSize -> 18], 
    PlotStyle -> {Thick}, Frame -> True, 
    FrameTicks -> {Transpose[{Range@Length@labels, labels}], 
      Automatic}, FrameLabel -> (Style[#, 18] & /@ {taxis, yaxis})]];
b = Plot[{min, max}, {t, 0, tend}, 
   PlotStyle -> {{Thick, Red}, {Thick, Green}}, 
   Filling -> {1 -> {{2}, RGBColor[.4, 1, .4, .2]}}];
c = Show[a, b]

Current Results:

What I currently have

enter image description here

(* Type of Date and units *)
Title = "Platelets";                                        (* Label \
of Plot *)
taxis = "Time";                                                     (* \
Label of time axis *)
yaxis = "k/\[Mu]L";                                                   \
  (* Label of measured axis *)
(* {{year,month,day,hour,minute},value}  *)
data = {
   {{2014, 1, 20, 17, 42}, 139},
   {{2014, 1, 20, 22, 33}, 123},
   {{2014, 1, 21, 6, 30}, 126}
   };
(* Effects the look of plot *)
dateplotbegin = {2014, 1, 20, 16, 
   0};(* Time to begin showing extreme values *)
dateplotend = {2014, 1, 21, 7, 
   10};     (* Time to end showing extreme values *)
min = 150;                                                            \
 (* Minimum Stable level *)
max = 450;                                                            \
      (* Maximum Stable level*)
plotmin = 
  0;                                                             (* \
Minimum Value to plot *)
plotmax = 
  600;                                                       (* Max \
value from the highest value to plot, might need tweeking based on \
lab*)

(* Font Sizes *)
TitleFont = 24;
AxesFont = 24;
PointFont = 20;
TickFont = 12;
(* Plotting, no need to touch this *)
dlp[u_, dmn_, dmx_, plotmin_, plotmax_, min_, max_, 
  opts : OptionsPattern[]] := 
 DateListPlot[u, GridLines -> {None, {min, max}}, 
  FilterRules[{opts}, Options[DateListPlot]], 
  PlotRange -> {{dmn, dmx}, {plotmin, plotmax}}, Joined -> True, 
  Epilog -> {{Opacity[0.5], RGBColor[.4, 1, .4, .2], 
     Polygon[{{dmn, min}, {dmx, min}, {dmx, max}, {dmn, 
        max}}]}, (Text[
        Style[#[[2]], FontSize -> PointFont], {1, 1.1} #] & /@ u)}, 
  BaseStyle -> {FontFamily -> "Times", TickFont}, 
  FrameLabel -> (Style[#, AxesFont] & /@ {taxis, yaxis})]
dlp[data, dateplotbegin, dateplotend, plotmin, plotmax, min, max, 
  PlotMarkers -> {Automatic, 8}, 
  GridLinesStyle -> Directive[Red, Thick], 
  PlotLabel -> Style[Row@{Title}, FontSize -> TitleFont], 
  PlotStyle -> {Thick},
  FrameTicks -> {{Automatic, None}, {data[[All, 1]], None}}, 
  DateTicksFormat -> {"Month", "/", "Day", "\n", "Hour", ":", 
    "Minute"}];
plot = Show[%, ImageSize -> {644, 385}, AspectRatio -> Full]
share|improve this question
2  
Welcome to SE, and +1 for a well-written & formatted question with all relevant information included! –  rasher Jan 26 at 2:25
    
Perhaps you could include a drawing of your desired output –  belisarius Jan 26 at 2:32
    
I added the desired output, belisarius. –  James Wine Jan 26 at 2:37
    
DateListPlot[data, Joined -> True, DateTicksFormat -> {"MonthShort", "/", "Day", " ", "Hour", ":", "Minute"}, FrameTicks -> {{Automatic, False}, data[[All, 1]]}, PlotRange -> {Automatic, {1, 12}}, Epilog -> {Red, PointSize[Medium], Point@data, Text[Style[#[[2]], 15], # + {0, 1}] & /@ data}, PlotRangePadding -> {4000, 10}] Results in !Mathematica graphics –  belisarius Jan 26 at 2:50
    
How would I include the additional two lines with their fill? My old strategy of creating a second plot and using Show[] isn't working. –  James Wine Jan 26 at 2:56

2 Answers 2

For illustrative purposes I post the following. Note I have not colored the limits for leukopenia red and leukocytosis green but just kept the limits the same colour. I used 4 and 11 counts per microlitre as bounds but this could obviously be changed. This omisssion of boundary coloring may not be ideal. As belisarius has done you can create lines to fill between. I just liked the simplicity of gridlines. You could customise the function to what is important to you. Again this is just to illustrate some capabilities of DateListPlot to motivate play.

A plotting function:

  dlp[u_, dmn_, dmx_, opts : OptionsPattern[]] := 
 DateListPlot[u, GridLines -> {None, {4, 11}}, 
  FilterRules[{opts}, Options[DateListPlot]], 
  PlotRange -> {{dmn, dmx}, {0, 12}}, Joined -> True, 
  Epilog -> {{Opacity[0.5], LightGreen, 
     Polygon[{{dmn, 4}, {dmx, 4}, {dmx, 11}, {dmn, 
        11}}]}, (Text[#[[2]], {1, 1.1} #] & /@ u)}, 
  BaseStyle -> {FontFamily -> "Kartika", 12}, 
  FrameLabel -> {"Time", "k/\[Mu]L"}]

The second and third arguments are date range.

Examples:

dlp[data, {2014, 1, 20, 16, 0}, {2014, 1, 21, 7, 10}, 
 PlotMarkers -> {Automatic, 8}, 
 GridLinesStyle -> Directive[Red, Thick], PlotLabel -> "WBC Count", 
 FrameTicks -> {{Automatic, None}, {data[[All, 1]], data[[All, 1]]}} 
 ]

enter image description here

Or using DateTicksFormat:

dlp[data, {2014, 1, 20, 16, 0}, {2014, 1, 21, 7, 10}, 
 PlotMarkers -> {Automatic, 8}, 
 GridLinesStyle -> Directive[Red, Thick], PlotLabel -> "WBC Count", 
 FrameTicks -> {{Automatic, None}, {data[[All, 1]], data[[All, 1]]}}, 
 DateTicksFormat -> {"Month", "/", "Day", "\n", "Hour", ":", 
   "Minute"}]

enter image description here

EDIT

A modification to achieve different boundary coiours and placing filled region as prolog.

dlpmod[u_, dmn_, dmx_, opts : OptionsPattern[]] := 
 DateListPlot[u, FilterRules[{opts}, Options[DateListPlot]], 
  PlotRange -> {{dmn, dmx}, {0, 12}}, Joined -> True,
  Prolog -> {{Opacity[0.5], LightGreen, 
     Polygon[{{dmn, 4}, {dmx, 4}, {dmx, 11}, {dmn, 11}}]}, {Red, 
     Thick, Line[{{dmn, 4}, {dmx, 4}}]}, {Green, Thick, 
     Line[{{dmn, 11}, {dmx, 11}}]}}, 
  Epilog -> {(Text[#[[2]], {1, 1.1} #] & /@ u)}, 
  BaseStyle -> {FontFamily -> "Kartika", 12}, 
  FrameLabel -> {"Time", "k/\[Mu]L"}]

Test:

dlpmod[data, {2014, 1, 20, 16, 0}, {2014, 1, 21, 7, 10}, 
 PlotStyle -> Black, PlotMarkers -> {Automatic, 10}, 
 PlotLabel -> "WBC Count", 
 FrameTicks -> {{Automatic, None}, {data[[All, 1]], data[[All, 1]]}}]

yielding:

enter image description here

UPDATE

A little generalization to incorporate the platelet data. Using:

datap = {{{2014, 1, 20, 17, 42}, 139}, {{2014, 1, 20, 22, 33}, 
    123}, {{2014, 1, 21, 6, 30}, 126}};
(*Effects the look of plot*)
dateplotbegin = {2014, 1, 20, 16, 
  0};(*Time to begin showing extreme values*)dateplotend = {2014, 1, 
  21, 7, 10};(*Time to end showing extreme values*)

Modifying function to allow variable reference range and plot range:

dlpedit[u_, dmn_, dmx_, ll_, ul_, opts : OptionsPattern[]] := 
 DateListPlot[u, FilterRules[{opts}, Options[DateListPlot]], 
  PlotRange -> {{dmn, dmx}, {0, Max[{1.2 ul, 1.2 Max[u[[All, 2]]]}]}},
   Joined -> True, 
  Prolog -> {{Opacity[0.5], LightGreen, 
     Polygon[{{dmn, ll}, {dmx, ll}, {dmx, ul}, {dmn, ul}}]}, {Red, 
     Thick, Line[{{dmn, ll}, {dmx, ll}}]}, {Green, Thick, 
     Line[{{dmn, ul}, {dmx, ul}}]}}, 
  Epilog -> {(Text[#[[2]], {1, 1.1} #] & /@ u)}, 
  BaseStyle -> {FontFamily -> "Kartika", 10}, 
  FrameLabel -> {"Time", "k/\[Mu]L"}]

Visualizing (modifying start date):

dlpedit[datap, 
 DatePlus[dateplotbegin, {{10, "Minute"}}], dateplotend, 150, 450, 
 PlotMarkers -> {Automatic, 8}, 
 FrameTicks -> {{Automatic, None}, {data[[All, 1]], data[[All, 1]]}}, 
 PlotLabel -> "Platelet Count", 
 DateTicksFormat -> {"Month", "/", "Day", "\n", "Hour", ":", 
   "Minute"}]

enter image description here

share|improve this answer
r = ({Min@#, Max@#} &@(AbsoluteTime /@ data[[All, 1]]));
enlarge[date_, r_] := Module[{d = AbsoluteTime[date]}, 
                      DateList@Rescale[d, r, {d - #/10, d + #/10} &@(First@Differences@r)]]
pl = DateListPlot[{#, Transpose[{enlarge[#, r] & /@ #[[All, 1]], ConstantArray[11, Length@#]}], 
                      Transpose[{enlarge[#, r] & /@ #[[All, 1]], ConstantArray[4, Length@#]}]} 
                 &@data, Joined -> True, 
                 DateTicksFormat -> {"MonthShort", "/", "Day", " ", "Hour", ":", "Minute"}, 
                 FrameTicks -> {{Automatic, False}, data[[All, 1]]}, 
                 Filling -> {2 -> {3}}, 
                 Epilog -> {Red, PointSize[Medium], Point@data, 
                            Text[Style[#[[2]], {Black, Bold, 15}], # + {0, 1}] & /@ data}, 
                 PlotRangePadding -> {0, 4}, PlotStyle -> {Black, Red, Green}]

Mathematica graphics

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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