Skip to content

Instantly share code, notes, and snippets.

@parsonsmatt parsonsmatt/log.hs
Last active Jun 21, 2019

Embed
What would you like to do?
{-# LANGUAGE TypeApplications, GADTs, FlexibleInstances, OverloadedLists #-}
module History where
import Lib
import Control.Monad (join)
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.List.NonEmpty as NEL
import Data.List.NonEmpty (NonEmpty(..))
import Data.Time (Day, fromGregorian)
import qualified Data.List as List
history :: NonEmpty Session
history =
[ 2019 05 07 #:
[ bench press %:
155 x 5 x 5
, deadlift %:
[ 225 x 5
, 275 x 3
] <>
315 x 1 x 3
, db rows %:
45 x 12 x 6
]
, 2019 04 15 #:
[ press %:
100 x 5 x 5
, deadlift %:
225 x 5 x 3
, bb curl %:
45 x 20 x 4
]
, 2019 04 11 #:
[ bench press %:
[ 155 x 5
, 165 x 3
, 175 x 2
, 185 x 1
, 195 x 1
, 205 x 1
, 185 x 3
, 155 x 5
, 155 x 5
, 155 x 5
, 135 x 10
]
, squat %:
[ 155 x 5
, 185 x 3
, 195 x 1
, 205 x 1
, 215 x 1
, 225 x 1
, 235 x 1
]
, bb curls %:
45 x 15 x 3
]
, 2019 04 08 #:
[ press %:
100 x 5 x 3
<>
[ 115 x 3
, 125 x 3
, 135 x 2
, 115 x 3
, 95 x 5
]
, deadlift %:
[ 135 x 5
, 185 x 5
, 225 x 5
, 245 x 2
, 265 x 2
, 275 x 1
, 295 x 1
, 315 x 1
]
, bb curls %:
45 x 20 x 3
, 2019 04 01 #:
[ bench press %:
[ 135 x 5
, 145 x 5
, 155 x 5
] <> 165 x 5 x 3 <>
[ 155 x 5
, 135 x 5
]
, squat %:
185 x 5 x 3
]
, 2019 03 30 #:
[ press %:
95 x 5 x 2
<>
[ 95 x 8
, 105 x 3
, 115 x 3
, 125 x 1
, 135 x 1
]
, squat %:
[ 150 x 5
, 165 x 5
, 185 x 5
, 205 x 5
, 225 x 5
]
, db curl %:
20 x 15 x 4
]
, 2019 03 27 #:
[ bench press %:
125 x 5 x 2
<>
125 x 8 x 1
, deadlift %:
[ 145 x 5
, 155 x 5
, 165 x 5
, 175 x 5
]
, db press %:
30 x 12 x 4
, db row %:
50 x 12 x 4
, latPull %:
[ 60 x 10
, 70 x 10
, 80 x 10
, 90 x 10
, 100 x 10
]
]
, 2019 03 25 #:
[ squat %:
145 x 5 x 2
<>
145 x 8 x 1
, press %:
90 x 5 x 2
<>
90 x 9 x 1
, curl %:
55 x 12 x 4
, press %:
55 x 12 x 4
]
, 2019 03 23 #:
[ squat %:
140 x 5 x 2
<>
140 x 8 x 1
, bench press %:
120 x 5 x 2
<>
120 x 8 x 1
, db row %:
50 x 12 x 4
, db press %:
25 x 12 x 4
]
, 2019 03 19 #:
[ press %:
85 x 5 x 2
<>
85 x 12 x 1
, deadlift %:
135 x 5 x 1
, reverseHyper %:
20 x 12 x 3
]
, 2019 03 17 #:
[ squat %:
135 x 5 x 3
, bench press %:
[ 115 x 5
, 115 x 5
, 115 x 12
]
, db row %:
60 x 12 x 4
]
]
{-# LANGUAGE TypeApplications, GADTs, FlexibleInstances, OverloadedLists #-}
module Lib where
import Control.Monad (join)
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.List.NonEmpty as NEL
import Data.List.NonEmpty (NonEmpty(..))
import Data.Time (Day, fromGregorian)
import qualified Data.List as List
data Lift = Lift { liftName :: String, liftSets :: NonEmpty Set }
(%:) :: String -> NonEmpty Set -> Lift
name %: lifts = Lift name lifts
(#:) :: Day -> NonEmpty Lift -> Session
(#:) = flip Session
(*:) :: Set -> Int -> NonEmpty Set
(*:) w i = w :| replicate (i-1) w
infixr 4 *:
infixr 3 %:
lift :: String -> NonEmpty Set -> Lift
lift = Lift
x :: ()
x = ()
instance (a ~ Int) => Num (() -> a -> Set) where
fromInteger i = \_ r -> Set (Weight (fromInteger i)) (Reps r)
(+) = undefined
(*) = undefined
abs = undefined
signum = undefined
negate = undefined
instance (a ~ Int, b ~ Int) => Num (() -> a -> () -> b -> NonEmpty Set) where
fromInteger i = \() r () s -> fromInteger i x r *: s
(+) = undefined
(*) = undefined
abs = undefined
signum = undefined
negate = undefined
instance (a ~ Int, b ~ Int) => Num (a -> b -> Day) where
fromInteger y m d = fromGregorian y m d
(+) = undefined
(*) = undefined
abs = undefined
signum = undefined
negate = undefined
foo :: Set
foo = 60 x 5
newtype Reps = Reps { unReps :: Int }
deriving (Eq, Ord)
newtype Weight = Weight { weightAmount :: Double }
data Set = Set
{ setWeight :: Weight
, setReps :: Reps
}
data Session = Session
{ sessionLifts :: NonEmpty Lift
, sessionDate :: Day
-- ^ If the date is 'Nothing', then this is a planned workout and not
-- one that has actually occurred yet.
}
data Entry = Entry Day (Either Bodyweight Session)
type History = NonEmpty Entry
newtype Bodyweight = Bodyweight { unBodyweight :: Weight }
greyskullStep :: Set -> Set
greyskullStep (Set weight reps) =
Set newWeight (Reps 5)
where
newWeight
| Reps 10 >= reps =
Weight (weightAmount weight + 10)
| Reps 5 >= reps =
Weight (weightAmount weight + 5)
| otherwise =
Weight
. fromInteger . (* 5) . floor . (/ 5) . (* 0.9)
. weightAmount $ weight
wilksFormula :: Bodyweight -> Weight -> Double
wilksFormula bw (Weight total) = (total *) $
500
/
sum ([a, b * x, c * x ^ 2, d * x ^ 3, e * x ^ 4, f * x ^ 5] :: [Double])
where
a = -216.0475144
b = 16.260339
c = -0.002388645
d = -0.00113732
e = 7.01863E-06
f = -1.291E-08
Bodyweight (Weight x) = bw
dateLifts :: NonEmpty Session -> Map Day (NonEmpty Lift)
dateLifts = foldr (\s -> Map.insert (sessionDate s) (sessionLifts s)) Map.empty
-- | Property:
--
-- >>> all (all ((str ==) . liftName)) (onlyLiftsOf str)
-- True
onlyLiftsOf :: String -> Map Day (NonEmpty Lift) -> Map Day (NonEmpty Lift)
onlyLiftsOf str = Map.mapMaybe (NEL.nonEmpty . NEL.filter p) . Map.filter (any p)
where
p = (str ==) . liftName
bestSet :: NonEmpty Set -> Set
bestSet = id
. head
. List.sortOn e1rm
. NEL.toList
--
findLast :: String -> NonEmpty Session -> Maybe Session
findLast lift = id
. fmap (\(a, b) -> Session b a)
. Map.lookupMax
. onlyLiftsOf lift
. dateLifts
currentWilks :: NonEmpty Session -> Bodyweight -> Maybe Double
currentWilks sess bw =
wilksFormula <$> pure bw <*> liftSessions
where
liftSessions :: Maybe Weight
liftSessions = case (,,) <$> msq <*> mdl <*> mbp of
Nothing -> Nothing
Just (sq, dl, bp) -> Just $
Weight $ sum @[] [f sq, f dl, f bp]
f :: Session -> Double
f = weightAmount . setWeight . bestSet . join . fmap liftSets . sessionLifts
msq = findLast squat sess
mdl = findLast deadlift sess
mbp = findLast (bench press) sess
squat, press, row, deadlift, curl, reverseHyper, latPull :: String
squat = "Squat"
press = "Press"
row = "Row"
deadlift = "Deadlift"
curl = "Curl"
reverseHyper = "Reverse Hyper"
latPull = "Lat Pull"
pf :: String -> String -> String
pf i a = (i ++ " " ++ a)
bench, db, romanian :: String -> String
bench = pf "Bench "
db = pf "DB "
romanian = pf "Romanian "
e1rm :: Set -> Double
e1rm (Set (Weight w) (Reps i)) =
(100 * w) / (101.3 - (2.67123 * fromIntegral i))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.