Mathematical Principles for Scientific Computing and Visualization
http : // www.farinhansford.com/books/scv
by Gerald Farin and Dianne Hansford

This notebook illustrates a transfer function.
This example is meant to isolate blood in a CT scan, and the transfer function is superimposed over the scan's histogram.  

Figures  15.10 was created with this notebook. See the figure caption for a complete description of this notbook.

See Chapter 15 : Volume Visualization for details.

Updated May 2008

(* Set the output folder *)

SetDirectory[ToFileName[Extract["FileName"/.NotebookInformation[EvaluationNotebook[]],{1},FrontEnd`FileName]]];

(* Create functions to define the transfer function for blood, bones, etc *)

f[x_]=((E^(-(1/2) (((x-3))^2)))/(Sqrt[2 π]));
 f2[x_]=((E^(-(1/2) (((x-3))^4)))/(Sqrt[2 π]));

(* Transfer function for blood histogram *)
bloodplot=Plot[f2[x],{x,0,6},PlotStyle->{Thickness[0.0001`],GrayLevel[0.6`]},FillingStyle->{GrayLevel[0.6`]},BaseStyle->{"FontFamily"->"Helvetica","FontSize"->11},Filling->Axis];

(* Create a plot of the CT values for all other readings *)
ctallplot=Plot[2 f[x],{x,0,6},PlotStyle->{Thickness[0.0001`],GrayLevel[0.8`]},FillingStyle->{GrayLevel[0.8`]},BaseStyle->{"FontFamily"->"Helvetica","FontSize"->11},AxesLabel->{"CT Values","Frequency / Color Value"},Filling->Axis];

(* Here we are making up the transfer functions by looking at the CT histograms from above *)
redlst={{0,0},{1.2`,0},{1.4`,1.`},{6,1.`}};

bluelst={{0,-0.04`},{4.6`,-0.04`},{4.8`,0.96`},{6,0.96`}};

oplst={{0,0.04`},{1.13`,0.04`},{1.19`,0.45`},{4.83`,0.45`},{4.89`,1.04`},{6,1.04`}};

(* Create a plot of the transfer functions *)
colorplot=ListPlot[{redlst,bluelst,oplst},Joined->True,PlotStyle->{{GrayLevel[0.`],Thickness[0.01`],PointSize[0.0001`]},{GrayLevel[0.5`],Thickness[0.01`],PointSize[0.0001`]},{GrayLevel[0.3`],Thickness[0.01`],PointSize[0.00001`],Dashing[{0.03`}]}},PlotMarkers->{■, ■, ■},BaseStyle->{"FontFamily"->"Helvetica","FontSize"->11}];

(* Put it all together *)
Show[ctallplot,bloodplot,colorplot,PlotRange->All,Ticks->None] 

(* Output to postscript file *)
Export["transfer_fct.eps",%]