Semi-successful optimization run. Unfortunately, I just got screwed by my choice of RoC rather than curvature, which means that optimization won't invert a surface

lib/Petzval/Merit.hs

@@ -1,5 +1,5 @@
 {- LANGUAGE ImpredicativeTypes #-}
-module Petzval.Merit (BFL(..), SpotSize(..), DynMerit(..), TW(..), Merit(..), MeritFunction, evalMerit, mkMerit) where
+module Petzval.Merit (BFL(..), SpotSize(..), DynMerit(..), TW(..), Merit(..), MeritFunction, TraceConditions(..), evalMerit, mkMerit) where
 
 import Petzval.Calculations
 import Petzval.Types
@@ -66,7 +66,7 @@ spotSize' conditions ts = rmsSize
                              . map fst
                              . map (raytrace system)
                              . map (createRay Nothing ep fa)
-                             $ hexapolarPattern 10
+                             $ hexapolarPattern 6
     where
       system = systemAtWavelength (wavelength conditions) ts
       fa = auto $ fieldAngle conditions

lib/Petzval/Optimization.hs

@@ -19,6 +19,7 @@ import Petzval.Optics
 import Petzval.Types
 import Control.Monad.Writer.Class
 import Data.Default
+import qualified Data.List as L
 
 import Debug.Trace
 
@@ -129,6 +130,17 @@ optimizeDLS cfg vars merit system = fmap (setVars vars system . toList) $ evalSt
       tell [toList y]
       
       return $ newMerit - oldMerit
+    jacobian' :: ([Double] -> [Double]) -> [Double] -> [(Double, [Double])]
+    jacobian' fn vars = zip (fn vars) jacobian
+        where deltas = map (/1000) vars
+              jacobian = L.transpose $ varSets vars id
+              varSets :: [Double] -> ([Double] -> [Double]) -> [[Double]]
+              varSets [] _ = []
+              varSets (var:vars) varPfx = head : rest
+                  where fnWithD d = fn . varPfx $ var + d : vars
+                        delta = var / 1000
+                        head = map (/ (2 * delta)) $ zipWith (-) (fnWithD delta) (fnWithD (-delta))
+                        rest = varSets vars (varPfx . (var:))
     jacobianAt :: Vector Double -> (Vector Double, Matrix Double)
     jacobianAt pt = let eval pt = undefined
                         (y,a) = unzip . jacobian' (\adpt -> evalMerit merit $ setVars vars (system & each.liftFp %~ auto) adpt) $ toList pt