diff --git a/app/Main.hs b/app/Main.hs index 2385f93..3969ca5 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,8 +1,14 @@ module Main where +import Control.Lens +import Data.Either import Petzval.Optics import Petzval.Optics.RTM import Petzval.System +import Petzval.Trace +import Petzval.Calculations +import Linear +import Numeric.AD.Mode (Scalar, Mode) bk7 = SellemeierMat [ (1.03961212, 6.00069867e-3 ) , (0.231792344, 2.00179144e-2 ) @@ -34,6 +40,22 @@ system2 = where s_sk16 = ConstMat 1.620408 s_f4 = ConstMat 1.616589 +merit :: (Material mat, RealFloat a, Scalar a ~ Double, Epsilon a, Mode a) => [Element mat a] -> a +-- merit :: (Material mat) => [Element mat Double] -> Double +merit system = result + where baked = bake 0.587618 system + ep = entrancePupil baked + result = sum + . map (^2) + . map (\ angle -> rmsSize + . toListOf (each._pos._xy) + -- . (\x -> x :: [Ray a]) + . rights + . map fst + . map (raytrace baked . createRay Nothing ep angle) + $ spiralPattern 100) + $ [0, 7.07, 15] + main :: IO () main = let baked = bake 0.587618 system2 diff --git a/flake.nix b/flake.nix index ae6b274..4be0ecd 100644 --- a/flake.nix +++ b/flake.nix @@ -18,6 +18,7 @@ devShell = pkgs.mkShell { buildInputs = with pkgs; [ cabal-install + haskell-language-server ghc ]; }; diff --git a/lib/Petzval/Internal/Vec.hs b/lib/Petzval/Internal/Vec.hs index 2f8e44e..9ed0529 100644 --- a/lib/Petzval/Internal/Vec.hs +++ b/lib/Petzval/Internal/Vec.hs @@ -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 diff --git a/lib/Petzval/System.hs b/lib/Petzval/System.hs index a868760..49c8b68 100644 --- a/lib/Petzval/System.hs +++ b/lib/Petzval/System.hs @@ -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)) diff --git a/petzval-hs.cabal b/petzval-hs.cabal index 834987a..45aed00 100644 --- a/petzval-hs.cabal +++ b/petzval-hs.cabal @@ -35,6 +35,9 @@ executable petzval-hs -- LANGUAGE extensions used by modules in this package. -- other-extensions: build-depends: base ^>=4.15.1.0, + ad ^>=4.5.2, + linear ^>=1.21, + lens ^>=5.2, petzval-hs hs-source-dirs: app @@ -46,6 +49,7 @@ library Petzval.Optics.RTM Petzval.System Petzval.Trace + Petzval.Calculations other-modules: Petzval.Internal.Vec hs-source-dirs: lib