(* The motivation for writing this program was the article                *)
(* http://www.nytimes.com/2007/09/15/business/15chart.html?ex=1347508800  *)
(* "Double Warning That a Recession May Be on the Way", by FLOYD NORRIS   *)
(* Published: September 15, 2007                                          *)
(* The Mathematica program extracts functions and draws the curve         *)
(* as well as colors interesting aspects                                  *)
(* Oliver Knill, Harvard University, September 15, 2007                   *)

ExtractFunction[graphics_]:=Module[{A,B,B1,B2},
    A=Import[graphics]; B=A[[1]]; B1=B[[1]]; B2=2-Transpose[B1]; {width,height} = A[[2,2]];
    FindLeftBorder[v_] :=Module[{k},k=1; While[v[[k]]==0 &&k<Length[v],k++];k];
    FindRightBorder[v_]:=Module[{k},k=Length[v]; While[v[[k]]==0 && k>1,k--];k];
    FindCenter[v_]:=(FindRightBorder[v]+FindLeftBorder[v])/2;
    {width,height,Function[x,FindCenter[B2[[Floor[x]]]]]}
];

{w1,h1,f1}=ExtractFunction["yieldspread.gif"]; 
{w2,h2,f2}=ExtractFunction["employment.gif"];  

w=Min[w1,w2]; {start,end}={1985,2007.75};  scale[x_]:= (x-start) (w-1)/(end-start); 
rec1=scale[1990]; r1l=scale[1989]; r1r=scale[1990];
rec2=scale[2001]; r2l=scale[2000.8]; r2r=scale[2001.4];
rec3=scale[2007]; r3l=scale[2006.7]; r3r=scale[2007.75];
S1= ParametricPlot[{f1[x],f2[x]},{x,1,w},PlotStyle->{RGBColor[1,1,0],Thickness[0.003]}]
S2= ParametricPlot[{f1[x],f2[x]},{x,r1l,r1r},PlotStyle->{RGBColor[1,0,0],Thickness[0.01]}]
S3= ParametricPlot[{f1[x],f2[x]},{x,r2l,r2r},PlotStyle->{RGBColor[0,1,0],Thickness[0.01]}]
S4= ParametricPlot[{f1[x],f2[x]},{x,r3l,r3r},PlotStyle->{RGBColor[0,0,1],Thickness[0.01]}]
S=Show[{S1,S2,S3,S4},Frame->False,Axes->False,Background->RGBColor[0,0,0]]