From c1a6505b90d598ed9023247f6c8b0fd0be1c01d6 Mon Sep 17 00:00:00 2001 From: Luis Borjas Reyes Date: Thu, 2 Dec 2021 23:14:01 -0500 Subject: [PATCH 1/7] trying to fix gravgroup fix grob_compare, first --- ChangeLog.md | 3 ++- csrc/dgravgroup.c | 3 ++- test/ChartUtilsSpec.hs | 10 ++++++---- 3 files changed, 10 insertions(+), 6 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index 1e47be4..e64caab 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,7 +1,8 @@ # Changelog for swiss-ephemeris -## UPCOMING +## v1.4.1.0 (2021-11-27) +* Fix edge case in grav group * Export `utcToJulianDays`, to obtain a product of `(TT, UT1)` Julian Days from a `UTCTime` value -- saves you one IO trip vs. getting them separately. * Support for GHC 9.2.1 diff --git a/csrc/dgravgroup.c b/csrc/dgravgroup.c index 331210a..c44c621 100644 --- a/csrc/dgravgroup.c +++ b/csrc/dgravgroup.c @@ -65,7 +65,8 @@ int grob_compare(const GROB *g1, const GROB *g2) { - return (int)(g1->pos - g2->pos); + // convert to centiseconds + return (int)(g1->pos * 360000) - (int)(g2->pos * 360000); } /* diff --git a/test/ChartUtilsSpec.hs b/test/ChartUtilsSpec.hs index 3793287..69ceda1 100644 --- a/test/ChartUtilsSpec.hs +++ b/test/ChartUtilsSpec.hs @@ -93,8 +93,9 @@ spec = do sectors = [] grouped = fromRight [] $ gravGroup2Easy 5.0 positions sectors True grouped - `shouldBe` [ GlyphInfo {originalPosition = 275.0, glyphSize = (2.5, 2.5), placedPosition = 272.25, sectorNumber = 0, sequenceNumber = 1, levelNumber = 0, glyphScale = 1.0, extraData = Venus}, - GlyphInfo {originalPosition = 274.5, glyphSize = (2.5, 2.5), placedPosition = 277.25, sectorNumber = 0, sequenceNumber = 0, levelNumber = 0, glyphScale = 1.0, extraData = Mars} + `shouldBe` [ + GlyphInfo {originalPosition = 274.5, glyphSize = (2.5, 2.5), placedPosition = 272.25, sectorNumber = 0, sequenceNumber = 0, levelNumber = 0, glyphScale = 1.0, extraData = Mars}, + GlyphInfo {originalPosition = 275.0, glyphSize = (2.5, 2.5), placedPosition = 277.25, sectorNumber = 0, sequenceNumber = 1, levelNumber = 0, glyphScale = 1.0, extraData = Venus} ] it "shifts glyphs in narrow sectors to different levels, keeps the scale" $ do @@ -103,8 +104,9 @@ spec = do sectors = [270.0, 274.0, 280.0] grouped = fromRight [] $ gravGroup2Easy 5.0 positions sectors True grouped - `shouldBe` [ GlyphInfo {originalPosition = 275.0, glyphSize = (2.5, 2.5), placedPosition = 276.5, sectorNumber = 1, sequenceNumber = 1, levelNumber = 0, glyphScale = 1.0, extraData = Venus}, - GlyphInfo {originalPosition = 274.5, glyphSize = (2.5, 2.5), placedPosition = 276.5, sectorNumber = 1, sequenceNumber = 0, levelNumber = 1, glyphScale = 1.0, extraData = Mars} + `shouldBe` [ + GlyphInfo {originalPosition = 274.5, glyphSize = (2.5, 2.5), placedPosition = 276.5, sectorNumber = 1, sequenceNumber = 0, levelNumber = 0, glyphScale = 1.0, extraData = Mars}, + GlyphInfo {originalPosition = 275.0, glyphSize = (2.5, 2.5), placedPosition = 276.5, sectorNumber = 1, sequenceNumber = 1, levelNumber = 1, glyphScale = 1.0, extraData = Venus} ] it "returns planets in corrected positions, when applicable" $ do From e2a70fa16a9c71ee07055ad7da62d8139ae6319c Mon Sep 17 00:00:00 2001 From: Luis Borjas Reyes Date: Fri, 3 Dec 2021 10:39:05 -0500 Subject: [PATCH 2/7] fix gravGroupEasy MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Instead of naïve sort + append, do actual "linearization" relative to the first sector, just like Alois recommends. * Include a test showing that sectors that jump over 360 will be dealt with appropriately. --- src/SwissEphemeris/ChartUtils.hs | 47 ++++++++++++++++++++++++++--- src/SwissEphemeris/Internal.hs | 2 ++ src/SwissEphemeris/Precalculated.hs | 3 +- test/ChartUtilsSpec.hs | 39 +++++++++++++++--------- 4 files changed, 71 insertions(+), 20 deletions(-) diff --git a/src/SwissEphemeris/ChartUtils.hs b/src/SwissEphemeris/ChartUtils.hs index 9a26525..9c9f39f 100644 --- a/src/SwissEphemeris/ChartUtils.hs +++ b/src/SwissEphemeris/ChartUtils.hs @@ -29,6 +29,8 @@ import System.IO.Unsafe (unsafePerformIO) import Data.List ( sort ) import Control.Monad (forM) import Control.Exception (bracket) +import Data.Bifunctor (second) +import Data.Maybe (listToMaybe) type PlanetGlyph = GravityObject Planet @@ -127,18 +129,53 @@ gravGroup sz positions sectors = glyphInfos <- mapM glyphInfo repositioned pure . Right $ glyphInfos --- | /Easy/ version of 'gravGroup' that assumes: +-- | /Easy/ version of 'gravGroup' that: -- --- * Glyphs are square/symmetrical, so the left and right widths +-- * Assums glyphs are square/symmetrical, so the left and right widths -- are just half of the provided width, each. --- * The provided cusps can be "linearized" by the naïve approach of 'cuspsToSectors' --- +-- * Will "linearize" all positions before processing by setting them to be +-- relative to the first cusp/sector, and correct them afterwards. gravGroupEasy :: HasEclipticLongitude a => Double -> [(Planet, a)] -> [HouseCusp] -> Either String [PlanetGlyphInfo] -gravGroupEasy w ps s = gravGroup (w/2,w/2) ps (cuspsToSectors s) +gravGroupEasy w ps s = do + -- 13 sectors are necessary: the 13th is just to complete the circle + glyphs <- gravGroup (w/2,w/2) ps' (s' <> coda) + pure $ map (recenterGlyph s1) glyphs + where + coda = + if null s' then mempty else [head s' + 360] + s1 = listToMaybe s + s' = map (relativeTo s1) s + ps' = map (second (\p -> setEclipticLongitude p (relativeTo s1 (getEclipticLongitude p)))) ps + + +recenterGlyph :: Maybe Double -> GlyphInfo a -> GlyphInfo a +recenterGlyph s1 g@GlyphInfo{originalPosition, placedPosition} = + g{ + originalPosition = unrelativeTo s1 originalPosition, + placedPosition = unrelativeTo s1 placedPosition + } + +relativeTo :: Maybe Double -> Double -> Double +relativeTo Nothing pos = pos +relativeTo (Just s1) pos = + let corrected = pos - s1 + in if corrected < 0 then + corrected + 360 + else + corrected + +unrelativeTo :: Maybe Double -> Double -> Double +unrelativeTo Nothing pos = pos +unrelativeTo (Just s1) pos = + let undone = pos + s1 + in if undone >= 360 then + undone - 360 + else + undone -- | Same semantics and warnings as 'gravGroup', but allows a couple of things for -- more advanced (or crowded) applications: diff --git a/src/SwissEphemeris/Internal.hs b/src/SwissEphemeris/Internal.hs index 384319a..100c8e7 100644 --- a/src/SwissEphemeris/Internal.hs +++ b/src/SwissEphemeris/Internal.hs @@ -21,6 +21,7 @@ import Foreign.Storable -- in a 1-dimensional "longitude-only" manner. class Eq a => HasEclipticLongitude a where getEclipticLongitude :: a -> Double + setEclipticLongitude :: a -> Double -> a -- | All bodies for which a position can be calculated. Covers planets -- in the solar system, points between the Earth and the Moon, and @@ -215,6 +216,7 @@ data EclipticPosition = EclipticPosition instance HasEclipticLongitude EclipticPosition where getEclipticLongitude = lng + setEclipticLongitude p l' = p{lng=l'} -- | Represents a point on Earth, with negative values -- for latitude meaning South, and negative values for longitude diff --git a/src/SwissEphemeris/Precalculated.hs b/src/SwissEphemeris/Precalculated.hs index 106637b..aed6b28 100644 --- a/src/SwissEphemeris/Precalculated.hs +++ b/src/SwissEphemeris/Precalculated.hs @@ -209,8 +209,9 @@ data EphemerisPosition a = EphemerisPosition } deriving (Eq, Show, Generic) -instance (Real a, Eq a) => HasEclipticLongitude (EphemerisPosition a) where +instance (Real a, Eq a, Fractional a) => HasEclipticLongitude (EphemerisPosition a) where getEclipticLongitude = realToFrac . epheLongitude + setEclipticLongitude p l' = p{epheLongitude = realToFrac l'} -- | The positions of all planets for a given time, -- plus ecliptic and nutation. diff --git a/test/ChartUtilsSpec.hs b/test/ChartUtilsSpec.hs index 69ceda1..7b5048d 100644 --- a/test/ChartUtilsSpec.hs +++ b/test/ChartUtilsSpec.hs @@ -11,6 +11,7 @@ newtype Lng = Lng Double instance HasEclipticLongitude Lng where getEclipticLongitude (Lng d) = d + setEclipticLongitude (Lng _) d' = Lng d' examplePositions :: [(Planet, Lng)] examplePositions = @@ -70,23 +71,33 @@ spec = do it "returns planets in corrected positions, when applicable" $ do let grouped = fromRight [] $ gravGroupEasy 5.0 examplePositions exampleCusps redux = sortBy sectorCompare grouped - redux - `shouldBe` [ GlyphInfo {originalPosition = 22.78, glyphSize = (2.5, 2.5), placedPosition = 22.78, sectorNumber = 0, sequenceNumber = 4, levelNumber = 0, glyphScale = 1.0, extraData = Mars}, - GlyphInfo {originalPosition = 56.44, glyphSize = (2.5, 2.5), placedPosition = 56.44, sectorNumber = 1, sequenceNumber = 5, levelNumber = 0, glyphScale = 1.0, extraData = Jupiter}, - GlyphInfo {originalPosition = 93.53, glyphSize = (2.5, 2.5), placedPosition = 93.53, sectorNumber = 2, sequenceNumber = 12, levelNumber = 0, glyphScale = 1.0, extraData = Chiron}, - GlyphInfo {originalPosition = 176.41, glyphSize = (2.5, 2.5), placedPosition = 176.41, sectorNumber = 5, sequenceNumber = 11, levelNumber = 0, glyphScale = 1.0, extraData = MeanApog}, - GlyphInfo {originalPosition = 224.68, glyphSize = (2.5, 2.5), placedPosition = 224.68, sectorNumber = 7, sequenceNumber = 9, levelNumber = 0, glyphScale = 1.0, extraData = Pluto}, - GlyphInfo {originalPosition = 262.47, glyphSize = (2.5, 2.5), placedPosition = 258.6401159871351, sectorNumber = 8, sequenceNumber = 1, levelNumber = 0, glyphScale = 1.0, extraData = Moon}, - GlyphInfo {originalPosition = 264.04, glyphSize = (2.5, 2.5), placedPosition = 263.6401159871351, sectorNumber = 8, sequenceNumber = 3, levelNumber = 0, glyphScale = 1.0, extraData = Venus}, - GlyphInfo {originalPosition = 272.05, glyphSize = (2.5, 2.5), placedPosition = 268.6401159871351, sectorNumber = 8, sequenceNumber = 7, levelNumber = 0, glyphScale = 1.0, extraData = Uranus}, - GlyphInfo {originalPosition = 276.18, glyphSize = (2.5, 2.5), placedPosition = 273.6401159871351, sectorNumber = 8, sequenceNumber = 6, levelNumber = 0, glyphScale = 1.0, extraData = Saturn}, - GlyphInfo {originalPosition = 280.11, glyphSize = (2.5, 2.5), placedPosition = 278.6401159871351, sectorNumber = 8, sequenceNumber = 8, levelNumber = 0, glyphScale = 1.0, extraData = Neptune}, - GlyphInfo {originalPosition = 285.64, glyphSize = (2.5, 2.5), placedPosition = 285.64, sectorNumber = 9, sequenceNumber = 0, levelNumber = 0, glyphScale = 1.0, extraData = Sun}, - GlyphInfo {originalPosition = 304.31, glyphSize = (2.5, 2.5), placedPosition = 304.31, sectorNumber = 9, sequenceNumber = 2, levelNumber = 0, glyphScale = 1.0, extraData = Mercury}, - GlyphInfo {originalPosition = 337.52, glyphSize = (2.5, 2.5), placedPosition = 337.52, sectorNumber = 10, sequenceNumber = 10, levelNumber = 0, glyphScale = 1.0, extraData = MeanNode} + `shouldBe` [ + GlyphInfo {originalPosition = 224.68, glyphSize = (2.5, 2.5), placedPosition = 224.68, sectorNumber = 1, sequenceNumber = 9, levelNumber = 0, glyphScale = 1.0, extraData = Pluto}, + GlyphInfo {originalPosition = 262.47, glyphSize = (2.5, 2.5), placedPosition = 258.6401159871351, sectorNumber = 2, sequenceNumber = 1, levelNumber = 0, glyphScale = 1.0, extraData = Moon}, + GlyphInfo {originalPosition = 264.04, glyphSize = (2.5, 2.5), placedPosition = 263.6401159871351, sectorNumber = 2, sequenceNumber = 3, levelNumber = 0, glyphScale = 1.0, extraData = Venus}, + GlyphInfo {originalPosition = 272.05, glyphSize = (2.5, 2.5), placedPosition = 268.6401159871351, sectorNumber = 2, sequenceNumber = 7, levelNumber = 0, glyphScale = 1.0, extraData = Uranus}, + GlyphInfo {originalPosition = 276.18, glyphSize = (2.5, 2.5), placedPosition = 273.6401159871351, sectorNumber = 2, sequenceNumber = 6, levelNumber = 0, glyphScale = 1.0, extraData = Saturn}, + GlyphInfo {originalPosition = 280.11, glyphSize = (2.5, 2.5), placedPosition = 278.6401159871351, sectorNumber = 2, sequenceNumber = 8, levelNumber = 0, glyphScale = 1.0, extraData = Neptune}, + GlyphInfo {originalPosition = 285.64, glyphSize = (2.5, 2.5), placedPosition = 285.64, sectorNumber = 3, sequenceNumber = 0, levelNumber = 0, glyphScale = 1.0, extraData = Sun}, + GlyphInfo {originalPosition = 304.31, glyphSize = (2.5, 2.5), placedPosition = 304.31, sectorNumber = 3, sequenceNumber = 2, levelNumber = 0, glyphScale = 1.0, extraData = Mercury}, + GlyphInfo {originalPosition = 337.52, glyphSize = (2.5, 2.5), placedPosition = 337.52, sectorNumber = 4, sequenceNumber = 10, levelNumber = 0, glyphScale = 1.0, extraData = MeanNode}, + GlyphInfo {originalPosition = 22.779999999999973, glyphSize = (2.5, 2.5), placedPosition = 22.779999999999973, sectorNumber = 6, sequenceNumber = 4, levelNumber = 0, glyphScale = 1.0, extraData = Mars}, + GlyphInfo {originalPosition = 56.44, glyphSize = (2.5, 2.5), placedPosition = 56.44, sectorNumber = 7, sequenceNumber = 5, levelNumber = 0, glyphScale = 1.0, extraData = Jupiter}, + GlyphInfo {originalPosition = 93.53000000000003, glyphSize = (2.5, 2.5), placedPosition = 93.53000000000003, sectorNumber = 8, sequenceNumber = 12, levelNumber = 0, glyphScale = 1.0, extraData = Chiron}, + GlyphInfo {originalPosition = 176.41000000000008, glyphSize = (2.5, 2.5), placedPosition = 176.41000000000008, sectorNumber = 11, sequenceNumber = 11, levelNumber = 0, glyphScale = 1.0, extraData = MeanApog} ] + it "can deal with sectors that jump 360" $ do + let planets = [(Uranus, Lng 41.685460865149885), (Chiron, Lng 8.560852515243027)] + sectors = [355.2817671250407, 26.407082565767553, 57.62582859633026] + grouped = fromRight [] $ gravGroupEasy 6 planets sectors + grouped `shouldBe` [ + GlyphInfo {originalPosition = 8.560852515243027, glyphSize = (3.0,3.0), placedPosition = 8.560852515243027, sectorNumber = 0, sequenceNumber = 1, levelNumber = 0, glyphScale = 1.0, extraData = Chiron}, + GlyphInfo {originalPosition = 41.68546086514988, glyphSize = (3.0,3.0), placedPosition = 41.68546086514988, sectorNumber = 1, sequenceNumber = 0, levelNumber = 0, glyphScale = 1.0, extraData = Uranus} + ] + + describe "gravGroup2Easy" $ do it "accepts empty sectors" $ do let positions = [(Mars, Lng 274.5), (Venus, Lng 275.0)] From 738bcfd514e0586b58792dc05fd0a0108abc6c4c Mon Sep 17 00:00:00 2001 From: Luis Borjas Reyes Date: Fri, 3 Dec 2021 11:51:19 -0500 Subject: [PATCH 3/7] fix gravGroup2, too --- src/SwissEphemeris/ChartUtils.hs | 82 ++++++++++++++++++-------------- test/ChartUtilsSpec.hs | 36 +++++++++----- 2 files changed, 68 insertions(+), 50 deletions(-) diff --git a/src/SwissEphemeris/ChartUtils.hs b/src/SwissEphemeris/ChartUtils.hs index 9c9f39f..8fb75a7 100644 --- a/src/SwissEphemeris/ChartUtils.hs +++ b/src/SwissEphemeris/ChartUtils.hs @@ -140,42 +140,7 @@ gravGroupEasy :: HasEclipticLongitude a -> [(Planet, a)] -> [HouseCusp] -> Either String [PlanetGlyphInfo] -gravGroupEasy w ps s = do - -- 13 sectors are necessary: the 13th is just to complete the circle - glyphs <- gravGroup (w/2,w/2) ps' (s' <> coda) - pure $ map (recenterGlyph s1) glyphs - where - coda = - if null s' then mempty else [head s' + 360] - s1 = listToMaybe s - s' = map (relativeTo s1) s - ps' = map (second (\p -> setEclipticLongitude p (relativeTo s1 (getEclipticLongitude p)))) ps - - -recenterGlyph :: Maybe Double -> GlyphInfo a -> GlyphInfo a -recenterGlyph s1 g@GlyphInfo{originalPosition, placedPosition} = - g{ - originalPosition = unrelativeTo s1 originalPosition, - placedPosition = unrelativeTo s1 placedPosition - } - -relativeTo :: Maybe Double -> Double -> Double -relativeTo Nothing pos = pos -relativeTo (Just s1) pos = - let corrected = pos - s1 - in if corrected < 0 then - corrected + 360 - else - corrected - -unrelativeTo :: Maybe Double -> Double -> Double -unrelativeTo Nothing pos = pos -unrelativeTo (Just s1) pos = - let undone = pos + s1 - in if undone >= 360 then - undone - 360 - else - undone +gravGroupEasy = gravGroupEasy' gravGroup -- | Same semantics and warnings as 'gravGroup', but allows a couple of things for -- more advanced (or crowded) applications: @@ -230,7 +195,8 @@ gravGroup2Easy :: HasEclipticLongitude a -> [HouseCusp] -> Bool -> Either String [PlanetGlyphInfo] -gravGroup2Easy w ps s = gravGroup2 (w/2, w/2) ps (cuspsToSectors s) +gravGroup2Easy w' ps' hs' shift' = + gravGroupEasy' (\w ps hs -> gravGroup2 w ps hs shift') w' ps' hs' -- | Given glyph dimensions and a list of ecliptic positions for planets, -- execute the given computation with an array of @GravityObject@s, @@ -289,3 +255,45 @@ glyphInfo GravityObject{pos, lsize, rsize, ppos, sector_no, sequence_no, level_n , glyphScale = realToFrac scale , extraData = planet' } + +gravGroupEasy' :: HasEclipticLongitude c => + ((Double, Double) -> [(Planet, c)] -> [Double] -> Either String [PlanetGlyphInfo]) + -> Double + -> [(Planet, c)] + -> [Double] + -> Either String [PlanetGlyphInfo] +gravGroupEasy' gravGroupF w ps s = do + glyphs <- gravGroupF (w/2,w/2) ps' (s' <> coda) + pure $ map (recenterGlyph s1) glyphs + where + coda = + if null s' then mempty else [head s' + 360] + s1 = listToMaybe s + s' = map (relativeTo s1) s + ps' = map (second (\p -> setEclipticLongitude p (relativeTo s1 (getEclipticLongitude p)))) ps + + +recenterGlyph :: Maybe Double -> GlyphInfo a -> GlyphInfo a +recenterGlyph s1 g@GlyphInfo{originalPosition, placedPosition} = + g{ + originalPosition = unrelativeTo s1 originalPosition, + placedPosition = unrelativeTo s1 placedPosition + } + +relativeTo :: Maybe Double -> Double -> Double +relativeTo Nothing pos = pos +relativeTo (Just s1) pos = + let corrected = pos - s1 + in if corrected < 0 then + corrected + 360 + else + corrected + +unrelativeTo :: Maybe Double -> Double -> Double +unrelativeTo Nothing pos = pos +unrelativeTo (Just s1) pos = + let undone = pos + s1 + in if undone >= 360 then + undone - 360 + else + undone diff --git a/test/ChartUtilsSpec.hs b/test/ChartUtilsSpec.hs index 7b5048d..46741d7 100644 --- a/test/ChartUtilsSpec.hs +++ b/test/ChartUtilsSpec.hs @@ -125,21 +125,31 @@ spec = do redux = sortBy sectorCompare grouped redux - `shouldBe` [ GlyphInfo {originalPosition = 22.78, glyphSize = (2.5, 2.5), placedPosition = 22.78, sectorNumber = 0, sequenceNumber = 4, levelNumber = 0, glyphScale = 1.0, extraData = Mars}, - GlyphInfo {originalPosition = 56.44, glyphSize = (2.5, 2.5), placedPosition = 56.44, sectorNumber = 1, sequenceNumber = 5, levelNumber = 0, glyphScale = 1.0, extraData = Jupiter}, - GlyphInfo {originalPosition = 93.53, glyphSize = (2.5, 2.5), placedPosition = 93.53, sectorNumber = 2, sequenceNumber = 12, levelNumber = 0, glyphScale = 1.0, extraData = Chiron}, - GlyphInfo {originalPosition = 176.41, glyphSize = (2.5, 2.5), placedPosition = 176.41, sectorNumber = 5, sequenceNumber = 11, levelNumber = 0, glyphScale = 1.0, extraData = MeanApog}, - GlyphInfo {originalPosition = 224.68, glyphSize = (2.5, 2.5), placedPosition = 224.68, sectorNumber = 7, sequenceNumber = 9, levelNumber = 0, glyphScale = 1.0, extraData = Pluto}, - GlyphInfo {originalPosition = 262.47, glyphSize = (2.5, 2.5), placedPosition = 258.6401159871351, sectorNumber = 8, sequenceNumber = 1, levelNumber = 0, glyphScale = 1.0, extraData = Moon}, - GlyphInfo {originalPosition = 264.04, glyphSize = (2.5, 2.5), placedPosition = 263.6401159871351, sectorNumber = 8, sequenceNumber = 3, levelNumber = 0, glyphScale = 1.0, extraData = Venus}, - GlyphInfo {originalPosition = 272.05, glyphSize = (2.5, 2.5), placedPosition = 268.6401159871351, sectorNumber = 8, sequenceNumber = 7, levelNumber = 0, glyphScale = 1.0, extraData = Uranus}, - GlyphInfo {originalPosition = 276.18, glyphSize = (2.5, 2.5), placedPosition = 273.6401159871351, sectorNumber = 8, sequenceNumber = 6, levelNumber = 0, glyphScale = 1.0, extraData = Saturn}, - GlyphInfo {originalPosition = 280.11, glyphSize = (2.5, 2.5), placedPosition = 278.6401159871351, sectorNumber = 8, sequenceNumber = 8, levelNumber = 0, glyphScale = 1.0, extraData = Neptune}, - GlyphInfo {originalPosition = 285.64, glyphSize = (2.5, 2.5), placedPosition = 285.64, sectorNumber = 9, sequenceNumber = 0, levelNumber = 0, glyphScale = 1.0, extraData = Sun}, - GlyphInfo {originalPosition = 304.31, glyphSize = (2.5, 2.5), placedPosition = 304.31, sectorNumber = 9, sequenceNumber = 2, levelNumber = 0, glyphScale = 1.0, extraData = Mercury}, - GlyphInfo {originalPosition = 337.52, glyphSize = (2.5, 2.5), placedPosition = 337.52, sectorNumber = 10, sequenceNumber = 10, levelNumber = 0, glyphScale = 1.0, extraData = MeanNode} + `shouldBe` [ + GlyphInfo {originalPosition = 224.68, glyphSize = (2.5, 2.5), placedPosition = 224.68, sectorNumber = 1, sequenceNumber = 9, levelNumber = 0, glyphScale = 1.0, extraData = Pluto}, + GlyphInfo {originalPosition = 262.47, glyphSize = (2.5, 2.5), placedPosition = 258.6401159871351, sectorNumber = 2, sequenceNumber = 1, levelNumber = 0, glyphScale = 1.0, extraData = Moon}, + GlyphInfo {originalPosition = 264.04, glyphSize = (2.5, 2.5), placedPosition = 263.6401159871351, sectorNumber = 2, sequenceNumber = 3, levelNumber = 0, glyphScale = 1.0, extraData = Venus}, + GlyphInfo {originalPosition = 272.05, glyphSize = (2.5, 2.5), placedPosition = 268.6401159871351, sectorNumber = 2, sequenceNumber = 7, levelNumber = 0, glyphScale = 1.0, extraData = Uranus}, + GlyphInfo {originalPosition = 276.18, glyphSize = (2.5, 2.5), placedPosition = 273.6401159871351, sectorNumber = 2, sequenceNumber = 6, levelNumber = 0, glyphScale = 1.0, extraData = Saturn}, + GlyphInfo {originalPosition = 280.11, glyphSize = (2.5, 2.5), placedPosition = 278.6401159871351, sectorNumber = 2, sequenceNumber = 8, levelNumber = 0, glyphScale = 1.0, extraData = Neptune}, + GlyphInfo {originalPosition = 285.64, glyphSize = (2.5, 2.5), placedPosition = 285.64, sectorNumber = 3, sequenceNumber = 0, levelNumber = 0, glyphScale = 1.0, extraData = Sun}, + GlyphInfo {originalPosition = 304.31, glyphSize = (2.5, 2.5), placedPosition = 304.31, sectorNumber = 3, sequenceNumber = 2, levelNumber = 0, glyphScale = 1.0, extraData = Mercury}, + GlyphInfo {originalPosition = 337.52, glyphSize = (2.5, 2.5), placedPosition = 337.52, sectorNumber = 4, sequenceNumber = 10, levelNumber = 0, glyphScale = 1.0, extraData = MeanNode}, + GlyphInfo {originalPosition = 22.779999999999973, glyphSize = (2.5, 2.5), placedPosition = 22.779999999999973, sectorNumber = 6, sequenceNumber = 4, levelNumber = 0, glyphScale = 1.0, extraData = Mars}, + GlyphInfo {originalPosition = 56.44, glyphSize = (2.5, 2.5), placedPosition = 56.44, sectorNumber = 7, sequenceNumber = 5, levelNumber = 0, glyphScale = 1.0, extraData = Jupiter}, + GlyphInfo {originalPosition = 93.53000000000003, glyphSize = (2.5, 2.5), placedPosition = 93.53000000000003, sectorNumber = 8, sequenceNumber = 12, levelNumber = 0, glyphScale = 1.0, extraData = Chiron}, + GlyphInfo {originalPosition = 176.41000000000008, glyphSize = (2.5, 2.5), placedPosition = 176.41000000000008, sectorNumber = 11, sequenceNumber = 11, levelNumber = 0, glyphScale = 1.0, extraData = MeanApog} ] + it "can deal with sectors that jump 360" $ do + let planets = [(Uranus, Lng 41.685460865149885), (Chiron, Lng 8.560852515243027)] + sectors = [355.2817671250407, 26.407082565767553, 57.62582859633026] + grouped = fromRight [] $ gravGroup2Easy 6 planets sectors False + grouped `shouldBe` [ + GlyphInfo {originalPosition = 8.560852515243027, glyphSize = (3.0,3.0), placedPosition = 8.560852515243027, sectorNumber = 0, sequenceNumber = 1, levelNumber = 0, glyphScale = 1.0, extraData = Chiron}, + GlyphInfo {originalPosition = 41.68546086514988, glyphSize = (3.0,3.0), placedPosition = 41.68546086514988, sectorNumber = 1, sequenceNumber = 0, levelNumber = 0, glyphScale = 1.0, extraData = Uranus} + ] + {- IDEAS FOR PROPS * preserves original sequence number From 96613ad61a6995c203824757b598bc623170573b Mon Sep 17 00:00:00 2001 From: Luis Borjas Reyes Date: Fri, 3 Dec 2021 11:55:46 -0500 Subject: [PATCH 4/7] remove ill-advised helper --- ChangeLog.md | 5 ++++- src/SwissEphemeris/ChartUtils.hs | 29 +++++------------------------ 2 files changed, 9 insertions(+), 25 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index e64caab..c2e17b9 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,7 +2,10 @@ ## v1.4.1.0 (2021-11-27) -* Fix edge case in grav group +* Fix edge case in grav group: incorrect casting in the C code was causing + planets that were too close to a sector boundary or another planet to be thrown + back into the first sector. +* Remove `cuspsToSectors`. * Export `utcToJulianDays`, to obtain a product of `(TT, UT1)` Julian Days from a `UTCTime` value -- saves you one IO trip vs. getting them separately. * Support for GHC 9.2.1 diff --git a/src/SwissEphemeris/ChartUtils.hs b/src/SwissEphemeris/ChartUtils.hs index 8fb75a7..bfbb81e 100644 --- a/src/SwissEphemeris/ChartUtils.hs +++ b/src/SwissEphemeris/ChartUtils.hs @@ -13,7 +13,6 @@ module SwissEphemeris.ChartUtils ( GlyphInfo(..), PlanetGlyphInfo, glyphPlanet, - cuspsToSectors, gravGroup, gravGroupEasy, gravGroup2, @@ -26,7 +25,6 @@ import Foreign.C.String import Foreign.SwissEphemerisExtras import SwissEphemeris.Internal import System.IO.Unsafe (unsafePerformIO) -import Data.List ( sort ) import Control.Monad (forM) import Control.Exception (bracket) import Data.Bifunctor (second) @@ -71,22 +69,6 @@ type PlanetGlyphInfo = GlyphInfo Planet glyphPlanet :: PlanetGlyphInfo -> Planet glyphPlanet = extraData --- | This function does a little bit of insider trading: --- given N cusps, returns N+1 sectors; where the last --- sector is an "impossible" position beyond 360, that --- sets the end of the last sector as the first sector's beginning, --- beyond one turn. That way, any body occurring in --- the last sector will exist between @sectors[N-1]@ and --- @sectors[N]@. I've been using this as the "linearization" --- approach for the sectors required by 'gravGroup', --- but one may choose something different. -cuspsToSectors :: [HouseCusp] -> [Double] -cuspsToSectors [] = [] -cuspsToSectors cusps = - sortedCusps ++ [head sortedCusps + 360.0] - where - sortedCusps = sort cusps - -- | Given dimensions, planet positions and "sectors" within which -- the planets are meant to be drawn as glyphs, return a list -- pairing each position with a 'PlanetGlyphInfo' that not only @@ -96,12 +78,11 @@ cuspsToSectors cusps = -- -- Note that "sectors" are usually cusps, but one must take that they're -- sorted or "linearized": no sector should jump over 0/360, and the --- last sector should mark the "end" of the circle. I use 'cuspsToSectors' --- on cusps obtained from the main module's cusp calculation functionality --- and that seems to ensure that sectors are adequately monotonic and not --- truncated, but one would be wise to take heed to the swiss ephemeris author's --- notes, too: --- https://groups.io/g/swisseph/message/5568 +-- last sector should mark the "end" of the circle. +-- See 'gravGroupEasy' for an approach +-- that incorporates the advice of Alois, from astro.com: https://groups.io/g/swisseph/message/5568 +-- (in short: make all positions, planets and sectors, relative to the first sector, +-- to ensure there's no "jumping" the 360 degree mark.) gravGroup :: HasEclipticLongitude a => (Double, Double) From 7a8c26410d0637b195f8e666d77ef2dd911cf51d Mon Sep 17 00:00:00 2001 From: Luis Borjas Reyes Date: Fri, 3 Dec 2021 17:47:13 -0500 Subject: [PATCH 5/7] silly list operator vs. semigroup, to please ghc 8.2.2 --- src/SwissEphemeris/ChartUtils.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/SwissEphemeris/ChartUtils.hs b/src/SwissEphemeris/ChartUtils.hs index bfbb81e..c032d9d 100644 --- a/src/SwissEphemeris/ChartUtils.hs +++ b/src/SwissEphemeris/ChartUtils.hs @@ -244,7 +244,9 @@ gravGroupEasy' :: HasEclipticLongitude c => -> [Double] -> Either String [PlanetGlyphInfo] gravGroupEasy' gravGroupF w ps s = do - glyphs <- gravGroupF (w/2,w/2) ps' (s' <> coda) + -- NOTE(luis) Only using `(++)` to please base <= 4.10, + -- I'm partial to treating all Semigroups uniformly! + glyphs <- gravGroupF (w/2,w/2) ps' (s' ++ coda) pure $ map (recenterGlyph s1) glyphs where coda = From e8dae8ada8ce8059c5415889f832bbe297eaa2a6 Mon Sep 17 00:00:00 2001 From: Luis Borjas Reyes Date: Fri, 3 Dec 2021 18:03:52 -0500 Subject: [PATCH 6/7] amend changelog, bump version --- ChangeLog.md | 7 ++++++- package.yaml | 2 +- swiss-ephemeris.cabal | 4 ++-- 3 files changed, 9 insertions(+), 4 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index c2e17b9..1a7d849 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,11 +1,16 @@ # Changelog for swiss-ephemeris -## v1.4.1.0 (2021-11-27) + +# UPCOMING * Fix edge case in grav group: incorrect casting in the C code was causing planets that were too close to a sector boundary or another planet to be thrown back into the first sector. * Remove `cuspsToSectors`. + + +## v1.4.1.0 (2021-11-27) + * Export `utcToJulianDays`, to obtain a product of `(TT, UT1)` Julian Days from a `UTCTime` value -- saves you one IO trip vs. getting them separately. * Support for GHC 9.2.1 diff --git a/package.yaml b/package.yaml index 8040966..038a339 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: swiss-ephemeris -version: 1.4.1.0 +version: 1.4.2.0 github: "lfborjas/swiss-ephemeris" license: AGPL-3 author: "Luis Borjas Reyes" diff --git a/swiss-ephemeris.cabal b/swiss-ephemeris.cabal index b4c4bfa..431442b 100644 --- a/swiss-ephemeris.cabal +++ b/swiss-ephemeris.cabal @@ -4,10 +4,10 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 0feead7e44aba9915159eab5ab88bf44fc083266e7fbefe092fe08f1572f95b2 +-- hash: e7928c1b947cdfac890861bca07fa71244acadb0a156fc37ce416800d363e581 name: swiss-ephemeris -version: 1.4.1.0 +version: 1.4.2.0 synopsis: Haskell bindings for the Swiss Ephemeris C library description: Please see the README on GitHub at category: Data, Astrology From fc3bddb83e3349825cfd14c4fd6c3be8065e44a2 Mon Sep 17 00:00:00 2001 From: Luis Borjas Reyes Date: Fri, 3 Dec 2021 21:02:25 -0500 Subject: [PATCH 7/7] update changelog --- ChangeLog.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ChangeLog.md b/ChangeLog.md index 1a7d849..139b97e 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,12 +1,13 @@ # Changelog for swiss-ephemeris -# UPCOMING +# v1.4.2.0 (2021-12-03) * Fix edge case in grav group: incorrect casting in the C code was causing planets that were too close to a sector boundary or another planet to be thrown back into the first sector. * Remove `cuspsToSectors`. +* Add ability to set longitude in `HasEclipticLongitude` typeclass ## v1.4.1.0 (2021-11-27)