%!PS-Adobe-3.0 EPSF-3.0 %%BoundingBox: 0 0 626 952 %%Creator: Gernot Hoffmann %%Title: CG19-18062008-A %CreationDate: June 21 2008 /mm {2.834646 mul} def /n 100 def /dx 1 n div def /sx 80 mm def /sy 80 mm def /x0 20 mm def /y0 20 mm def /lw 0.4 mm def 0 setgray newpath lw lw moveto 220 mm 0 rlineto 0 335 mm rlineto -220 mm 0 rlineto closepath stroke /Patterns { /x1 0 def /y1 0 def /dx1 20 mm def /dy1 25 mm def 0 1 8 { /i exch def Tabx i get dup dup setrgbcolor newpath x1 y1 moveto dx1 0 rlineto 0 dx1 rlineto dx1 neg 0 rlineto closepath fill /x1 x1 dx1 add def } for /x1 0 def /y1 y1 dy1 add def /i 0 def 0 1 8 { /i exch def 0 0 Tabx i get setrgbcolor newpath x1 y1 moveto dx1 0 rlineto 0 dx1 rlineto dx1 neg 0 rlineto closepath fill /x1 x1 dx1 add def } for /i 0 def /x1 0 def /y1 y1 dy1 add def 0 1 8 { /i exch def 0 Tabx i get 0 setrgbcolor newpath x1 y1 moveto dx1 0 rlineto 0 dx1 rlineto dx1 neg 0 rlineto closepath fill /x1 x1 dx1 add def } for /i 0 def /x1 0 def /y1 y1 dy1 add def 0 1 8 { /i exch def Tabx i get 0 0 setrgbcolor newpath x1 y1 moveto dx1 0 rlineto 0 dx1 rlineto dx1 neg 0 rlineto closepath fill /x1 x1 dx1 add def } for /fh 10 def /Helvetica findfont fh scalefont setfont /buf 20 string def 0 setgray /y1 -3.5 mm def /x1 9 mm def 0 1 8 {/i exch def x1 y1 moveto i buf cvs show /x1 x1 dx1 add def } for } def /Grid { 0.2 mm sx div setlinewidth newpath 0.5 setgray /mg 8 def /dg 1 mg div def /y dg def newpath 1 1 mg 1 sub { 0 y moveto 1 y lineto /y y dg add def } for stroke /x dg def newpath 1 1 mg 1 sub { x 0 moveto x 1 lineto /x x dg add def } for stroke } def /Axes { 0.4 mm sx div setlinewidth 2 setlinecap newpath 0 1 moveto 1 1 lineto 1 0 moveto 1 1 lineto 0.5 setgray stroke newpath 0 0 moveto 1 0 lineto 0 0 moveto 0 1 lineto 0.0 setgray stroke } def /Dots {/d1 0.02 def /d2 d1 -0.5 mul def /i 0 def 0.5 setgray 0 1 8 {/i exch def /x Tabx i get def /y Taby i get def newpath x y moveto d2 d2 rmoveto d1 0 rlineto 0 d1 rlineto d1 neg 0 rlineto closepath stroke } for } def /Text {0 setgray /fh 12 sx div def /Helvetica findfont fh scalefont setfont /buf 20 string def /x -0.04 def /y 0 fh sub def x y moveto (0.0) show /x 0.48 def x y moveto (0.5) show /x 0.98 def x y moveto (1.0) show /x 0.74 def x y moveto (x) show /x -0.10 def /y -0.01 def x y moveto (0.0) show /y 0.49 def x y moveto (0.5) show /y 0.99 def x y moveto (1.0) show /y 0.74 def /x -0.05 def x y moveto +90 rotate (Y/Ymax) show -90 rotate 0.8 setgray /x 0.03 def /y 0.765 def /d1 0.57 def /d2 0.22 def newpath x y moveto d1 0 rlineto 0 d2 rlineto d1 neg 0 rlineto closepath fill 0 setgray /x 0.05 def /y 0.924 def x y moveto txt show x 0.37 add y moveto Gam 1000 mul round 1000 div buf cvs show /y 0.85 def x y moveto (Offset) show x 0.37 add y moveto Ofs 10000 mul round 10000 div buf cvs show /y 0.78 def x y moveto (Ymax) show x ymax 100 lt{0.37 add}{0.33 add} ifelse y moveto ymax buf cvs show % Loop control message / use true or false false {/y 0.66 def emod 1 eq {/txe (Exit Func) def} if emod 2 eq {/txe (Exit Grad) def} if emod 3 eq {/txe (Exit Loop) def} if x y moveto txe show /y y fh sub def x y moveto (loops ) show k buf cvs show /y y fh sub def x y moveto (Error per point ) show Fo 8 div sqrt buf cvs show} if } def /GamCalc { % Steepest descent with one-dim search % yi = Yi/Ymax % Minimize F=Sum(1..8)[p1+(1-p1)*xi^p2-yi]^2 % Fo=F(p1,p2) % g1=(F(p1+dp1,p2)-Fo)/dp % g2=(F(p1,p2+dp2)-Fo)/dp % dn=g1*g1+g2*g2 % p1=p1-sig*Fo*g1/dn % p2=p2-sig*Fo*g2/dn % Function /Fun {% table entry No.0 ignored /Fu 0 def 1 1 8 {/i exch def /xi Tabx i get def /yi Taby i get def % Use either Type A or Type B % Type A % /Fu Fu xi p2 exp yi sub dup mul add def % Type B /Fu Fu p1 1 p1 sub xi p2 exp mul add yi sub dup mul add def } for } def % Normalize /ymax Taby 8 get def 0 1 8 {/i exch def Taby i Taby i get ymax div put } for % Steepest descent /p1 0.0 def /p2 1.0 def /q1 p1 def /q2 p2 def /Fo 999 def /dp 1e-4 def /eps 1e-8 def /sig 0.07 def /k 1 def { Fun Fu Fo sub abs eps lt {/emod 1 def exit} if /Fo Fu def /p1 p1 dp add def Fun /g1 Fu Fo sub dp div def /p1 q1 def /p2 p2 dp add def Fun /g2 Fu Fo sub dp div def /p2 q2 def /dn g1 dup mul g2 dup mul add def dn eps lt {/emod 2 def exit} if /fc Fo sig mul dn div neg def /r1 fc g1 mul def /r2 fc g2 mul def /Fm Fo def % one-dim search /q1 p1 def /q2 p2 def 1 1 10 { pop /p1 p1 r1 add def /p2 p2 r2 add def Fun Fu Fm lt {/Fm Fu def /q1 p1 def /q2 p2 def} if } for /p1 q1 def /p2 q2 def /k k 1 add def k 1000 eq {/emod 3 def exit} if } loop /Ofs p1 def /Gam p2 def } def /TestTab {% Fill Tab for test % 2.2=arbitrary gamma % 130=arbitrary gain % 0.5=arbitrary offset 0 1 8 {/i exch def Taby i Tabx i get 2.2 exp 130 mul 0.5 add put }for } def /TabRGB [ 0 32 64 96 128 160 192 224 255 ] def /Tabx [ 0.000000 0.125490 0.250980 0.376471 0.501961 0.627451 0.752941 0.878431 1.000000 ] def /GamRed {/Taby [ 0.3 0.6 1.4 3.1 5.7 9.0 13.4 19.0 24.9 ] def %TestTab GamCalc /GamR Gam def /OfsR Ofs def } def /GamGrn {/Taby [ 0.3 1.0 3.5 7.9 15.0 24.6 36.4 51.0 67.2 ] def %TestTab GamCalc /GamG Gam def /OfsG Ofs def } def /GamBlu {/Taby [ 0.3 0.5 0.8 1.5 2.6 4.1 6.0 8.3 11.3 ] def %TestTab GamCalc /GamB Gam def /OfsB Ofs def } def /GamWht {/Taby [ 0.4 1.5 5.4 12.5 23.4 37.8 55.5 77.5 102.0 ] def %TestTab GamCalc /GamW Gam def /OfsW Ofs def } def /FuncS {/y x 2.2 exp def } def /FuncR {/y x GamR exp 1 OfsR sub mul OfsR add def } def /FuncG {/y x GamG exp 1 OfsG sub mul OfsG add def } def /FuncB {/y x GamB exp 1 OfsB sub mul OfsB add def } def /FuncW {/y x GamW exp 1 OfsW sub mul OfsW add def } def false setstrokeadjust gsave x0 y0 200 mm add translate Patterns grestore gsave x0 y0 100 mm add translate sx sx scale Grid Axes lw sx div setlinewidth 0 setlinecap /txt (Red Gamma) def GamRed 1 0 0 setrgbcolor /x 0 def newpath FuncR x y moveto 1 1 n { pop /x x dx add def FuncR x y lineto } for stroke Dots Text grestore gsave x0 100 mm add y0 100 mm add translate sx sx scale Grid Axes lw sx div setlinewidth 0 setlinecap /txt (Green Gamma) def GamGrn Dots 0 0.8 0 setrgbcolor /x 0 def newpath FuncG x y moveto 1 1 n { pop /x x dx add def FuncG x y lineto } for stroke Dots Text grestore gsave x0 y0 translate sx sx scale Grid Axes lw sx div setlinewidth 0 setlinecap /txt (Blue Gamma) def GamBlu 0 0 1 setrgbcolor /x 0 def newpath FuncB x y moveto 1 1 n { pop /x x dx add def FuncB x y lineto } for stroke Dots Text grestore gsave x0 100 mm add y0 translate sx sx scale Grid Axes lw sx div setlinewidth 0 setlinecap /txt (Gray Gamma) def GamWht 0 setgray /x 0 def newpath FuncW x y moveto 1 1 n { pop /x x dx add def FuncW x y lineto } for stroke Dots Text showpage