In[]:=
hearingCurtain[threshold_,magnification_,opts___]:=Module[{thresholdCurves,curtain},thresholdCurves=ParametricPlot3D[Evaluate[{{freq,threshold[freq],0},{freq,threshold[freq],threshold[freq]}}],{freq,–3,3},PlotStyle–>Thick];curtain=ParametricPlot3D[{(*{freq,threshold[freq],110v},*){freq,threshold[freq],(1–v)threshold[freq]+vmagnification[threshold[freq]]}},{freq,–3,3},{v,0,1}];Show[thresholdCurves,curtain,Graphics3D[{Opacity[0.4],Polygon[{{–3,0,0},{–3,100,100}{3,100,100},{3,0,0}}],Polygon[{{–3,0,0},{–3,120,0},{3,120,0},{3,0,0}}],Opacity[0.1],Polygon[{{–3,0,0},{–3,0,120},{3,0,120},{3,0,0}}]}],AxesLabel–>{"Frequency","Threshold Volume","Played Volume"},Ticks–>{{{–3,125},{–2,250},{–1,500},{0,1000},{1,2000},{2,4000},{3,8000}},Range[0,100,20],Range[0,100,20]},PlotRange–>{{–3,3},{0,120},{0,120}},BoxRatios–>{1,1,1},FilterRules[{opts},Options[Graphics3D]]]];hearingCurtainBothAnimate[{leftData_,rightData_},magnification_]:=Module[{leftThreshold,rightThreshold,leftWedge,rightWedge,magnifiedSize=0.04,thresholdSize=0.03,volumeLeft,volumeRight},leftThreshold=Interpolation[Map[{Log[2,First[#]/1000],Last[#]}&,leftData]];rightThreshold=Interpolation[Map[{Log[2,First[#]/1000],Last[#]}&,rightData]];leftWedge=hearingCurtain[leftThreshold,magnification];rightWedge=hearingCurtain[rightThreshold,magnification];(*Manipulate[GraphicsRow[{leftWedge,rightWedge}],{f,–3,3}]*)Manipulate[volumeLeft=leftThreshold[f];volumeRight=rightThreshold[f];GraphicsRow[{Show[leftWedge,Graphics3D[{Dashed,Line[{{f,volumeLeft,0},{f,volumeLeft,120}}],PointSize[magnifiedSize],Green,Point[{f,volumeLeft,magnification[volumeLeft]}],PointSize[thresholdSize],Blue,Point[{f,volumeLeft,0}],Pink,Point[{f,volumeLeft,volumeLeft}]}],PlotLabel–>"Left Ear",AxesLabel–>{"Frequency","Threshold Volume","Played Volume"},Ticks–>{{{–3,125},{–2,250},{–1,500},{0,1000},{1,2000},{2,4000},{3,8000}},Range[0,100,20],Range[0,100,20]},PlotRange–>{{–3,3},{–10,120},{–10,120}},BoxRatios–>{1,1,1}],Show[rightWedge,Graphics3D[{Dashed,Line[{{f,volumeRight,0},{f,volumeRight,120}}],PointSize[magnifiedSize],Green,Point[{f,volumeRight,magnification[volumeRight]}],PointSize[thresholdSize],Blue,Point[{f,volumeRight,0}],Pink,Point[{f,volumeRight,volumeRight}]}],PlotLabel–>"Right Ear",AxesLabel–>{"Frequency","Threshold Volume","Played Volume"},Ticks–>{{{–3,125},{–2,250},{–1,500},{0,1000},{1,2000},{2,4000},{3,8000}},Range[0,100,20],Range[0,100,20]},PlotRange–>{{–3,3},{–10,120},{–10,120}},BoxRatios–>{1,1,1}]}],{f,–3,3}]]
In[]:=
right=Map[{1000*2^First[#],Last[#]}&,{{–3,10},{–2,0},{–1,5},{0,10},{1,5},{Log[2,3],15},{2,25},{Log[2,6],30},{3,35}}]
Out[]=
{{125,10},{250,0},{500,5},{1000,10},{2000,5},{3000,15},{4000,25},{6000,30},{8000,35}}
In[]:=
left=Map[{1000*2^First[#],Last[#]}&,{{–3,10},{–2,5},{–1,10},{0,5},{1,5},{Log[2,3],20},{2,30},{Log[2,6],35},{3,35}}]
Out[]=
{{125,10},{250,5},{500,10},{1000,5},{2000,5},{3000,20},{4000,30},{6000,35},{8000,35}}
In[]:=
hearingCurtainBothAnimate[{left,right},3#&]
Out[]=
|  | ||||||
| |||||||
