thequux/petzval
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

First pass at merit function

Browse Source
This commit is contained in:
TQ Hirsch
2022-10-10 11:46:27 +02:00
parent a80a7f749e
commit a61f15df44
5 changed files with 32 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
lib/Petzval/Internal/Vec.hs
View File

@@ -25,7 +25,7 @@ class VConcat (v1 :: * -> *) (v2 :: * -> *) where
type VConcated v1 v2 :: * -> *
vconcat :: v1 a -> v2 a -> (VConcated v1 v2) a
instance {-# OVERLAPPED #-} VConcat V0 v where
instance VConcat V0 v where
type VConcated V0 v = v
vconcat V0 v = v

9
lib/Petzval/System.hs
View File

@@ -34,7 +34,7 @@ pupil (stop@Stop{_outsideRadius}) subsystem =
, position = -cy / cu }
-- | Compute the entrance pupil of a system viewed from infinity
entrancePupil :: (RealFloat a, Mode a, Scalar a ~ Double, Epsilon a, Show a) => [Element BakedIOR a] -> Pupil a
entrancePupil :: (RealFloat a, Mode a, Scalar a ~ Double, Epsilon a) => [Element BakedIOR a] -> Pupil a
entrancePupil system = pupil stop prefix
where (prefix, (Just stop), _) = splitSystem system
@@ -73,9 +73,9 @@ instance Num a => Monoid (Seidel a) where
-- | Initial matrix is [ h_ h; u_ u ]
seidel' :: (RealFloat a, Mode a, Scalar a ~ Double, Epsilon a, Show a) => M22 a -> Element BakedIOR a -> (M22 a, Seidel a)
seidel' :: (RealFloat a, Mode a, Scalar a ~ Double, Epsilon a) => M22 a -> Element BakedIOR a -> (M22 a, Seidel a)
seidel' rays (s@Stop{}) = (thicknessRTM s !*! rays, mempty)
seidel' rays (s@Surface{_material=BakedIOR n1 n2,_roc=roc}) = Debug.Trace.trace msg (rays'', Seidel {sphr,coma,asti,fcur,dist})
seidel' rays (s@Surface{_material=BakedIOR n1 n2,_roc=roc}) = (rays'', Seidel {sphr,coma,asti,fcur,dist})
where rays' = refractionRTM s !*! rays
rays'' = thicknessRTM s !*! rays'
marg = column _y
@@ -97,13 +97,12 @@ seidel' rays (s@Surface{_material=BakedIOR n1 n2,_roc=roc}) = Debug.Trace.trace
-- However, a is 0 whenever the marginal ray is normal to the surface
-- Thus, we use this formula from Kidger
dist = -abar^3 * h * δ1n2 + (rays^. chief._x) * abar * (2 * h * abar - rays ^. chief._x * a) * δ1n / roc
msg = intercalate "\t" [show δun, show a, show abar]
-- TODO: evaluate at other IORs
-- cbas = h (n2 - n1) / n1
-- c1 =
-- | Compute the seidel coefficients of a system given the pupil and field angle
seidel :: (RealFloat a, Mode a, Scalar a ~ Double, Epsilon a, Show a) => Pupil a -> Double -> [Element BakedIOR a] -> [Seidel a]
seidel :: (RealFloat a, Mode a, Scalar a ~ Double, Epsilon a) => Pupil a -> Double -> [Element BakedIOR a] -> [Seidel a]
seidel pupil fieldAngle =
snd . mapAccumL seidel' rays
where ubar = auto (tan (pi / 180 * fieldAngle))