-- | Judgment processes: streaming machines that emit multi-valued logic.
--
-- @Process obs H3@ is the flagship shape — Moore machines whose timeline
-- is a sequence of epistemic verdicts. This module is a compile target for
-- agent/sensor/parser-style \"are we decided yet?\" stories on top of
-- @Circuit.Process@.
module Circuit.Logics.Process
  ( -- * Threshold judges
    voteH3,
    voteLatchH3,

    -- * Combinators on H3 streams
    consensusProc,
    latchProc,

    -- * Gödel degree process
    ewmaGoedel,
  )
where

import Circuit.Logics.Combine (consensusH3, latchH3)
import Circuit.Logics.Goedel (Goedel (..), mkGoedel)
import Circuit.Logics.H3 (H3 (..))
import Circuit.Process (Process (..))

-- | Majority-style judge on @Bool@ votes.
--
-- Emits @HTrue@ / @HFalse@ once one side reaches threshold @k@ and leads;
-- otherwise @HUnknown@. Verdicts are revisable if the other side catches up
-- (no latch).
voteH3 :: Int -> Process Bool H3
voteH3 :: Int -> Process Bool H3
voteH3 Int
k = (Bool -> (Int, Int))
-> ((Int, Int) -> Bool -> (Int, Int))
-> ((Int, Int) -> H3)
-> Process Bool H3
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process Bool -> (Int, Int)
forall {a} {b}. (Num a, Num b) => Bool -> (a, b)
inject (Int, Int) -> Bool -> (Int, Int)
forall {a} {b}. (Num a, Num b) => (a, b) -> Bool -> (a, b)
step (Int, Int) -> H3
extract
  where
    inject :: Bool -> (a, b)
inject Bool
b = (a, b) -> Bool -> (a, b)
forall {a} {b}. (Num a, Num b) => (a, b) -> Bool -> (a, b)
step (a
0, b
0) Bool
b
    step :: (a, b) -> Bool -> (a, b)
step (a
y, b
n) Bool
True = (a
y a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
n)
    step (a
y, b
n) Bool
False = (a
y, b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)
    extract :: (Int, Int) -> H3
extract (Int
y, Int
n)
      | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = H3
HTrue
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
y = H3
HFalse
      | Bool
otherwise = H3
HUnknown

-- | Like 'voteH3' but freezes the first decided verdict.
voteLatchH3 :: Int -> Process Bool H3
voteLatchH3 :: Int -> Process Bool H3
voteLatchH3 Int
k = (Bool -> Either (Int, Int) H3)
-> (Either (Int, Int) H3 -> Bool -> Either (Int, Int) H3)
-> (Either (Int, Int) H3 -> H3)
-> Process Bool H3
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process Bool -> Either (Int, Int) H3
inject Either (Int, Int) H3 -> Bool -> Either (Int, Int) H3
step Either (Int, Int) H3 -> H3
extract
  where
    inject :: Bool -> Either (Int, Int) H3
inject Bool
b =
      case (Int, Int) -> H3
extractOpen ((Int, Int) -> Bool -> (Int, Int)
forall {a} {b}. (Num a, Num b) => (a, b) -> Bool -> (a, b)
stepOpen (Int
0, Int
0) Bool
b) of
        H3
HUnknown -> (Int, Int) -> Either (Int, Int) H3
forall a b. a -> Either a b
Left ((Int, Int) -> Bool -> (Int, Int)
forall {a} {b}. (Num a, Num b) => (a, b) -> Bool -> (a, b)
stepOpen (Int
0, Int
0) Bool
b)
        H3
v -> H3 -> Either (Int, Int) H3
forall a b. b -> Either a b
Right H3
v
    step :: Either (Int, Int) H3 -> Bool -> Either (Int, Int) H3
step (Left (Int, Int)
yn) Bool
b =
      case (Int, Int) -> H3
extractOpen ((Int, Int) -> Bool -> (Int, Int)
forall {a} {b}. (Num a, Num b) => (a, b) -> Bool -> (a, b)
stepOpen (Int, Int)
yn Bool
b) of
        H3
HUnknown -> (Int, Int) -> Either (Int, Int) H3
forall a b. a -> Either a b
Left ((Int, Int) -> Bool -> (Int, Int)
forall {a} {b}. (Num a, Num b) => (a, b) -> Bool -> (a, b)
stepOpen (Int, Int)
yn Bool
b)
        H3
v -> H3 -> Either (Int, Int) H3
forall a b. b -> Either a b
Right H3
v
    step (Right H3
v) Bool
_ = H3 -> Either (Int, Int) H3
forall a b. b -> Either a b
Right H3
v
    extract :: Either (Int, Int) H3 -> H3
extract (Left (Int, Int)
yn) = (Int, Int) -> H3
extractOpen (Int, Int)
yn
    extract (Right H3
v) = H3
v

    stepOpen :: (a, b) -> Bool -> (a, b)
stepOpen (a
y, b
n) Bool
True = (a
y a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
n)
    stepOpen (a
y, b
n) Bool
False = (a
y, b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)
    extractOpen :: (Int, Int) -> H3
extractOpen (Int
y, Int
n)
      | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = H3
HTrue
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
y = H3
HFalse
      | Bool
otherwise = H3
HUnknown

-- | Pointwise consensus of two H3 streams (same observation).
--
-- State is a pair of sub-states; extract is 'consensusH3'.
consensusProc :: Process a H3 -> Process a H3 -> Process a H3
consensusProc :: forall a. Process a H3 -> Process a H3 -> Process a H3
consensusProc (Process a -> s
i1 s -> a -> s
st1 s -> H3
ex1) (Process a -> s
i2 s -> a -> s
st2 s -> H3
ex2) =
  (a -> (s, s))
-> ((s, s) -> a -> (s, s)) -> ((s, s) -> H3) -> Process a H3
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process
    (\a
a -> (a -> s
i1 a
a, a -> s
i2 a
a))
    (\(s
s1, s
s2) a
a -> (s -> a -> s
st1 s
s1 a
a, s -> a -> s
st2 s
s2 a
a))
    (\(s
s1, s
s2) -> H3 -> H3 -> H3
consensusH3 (s -> H3
ex1 s
s1) (s -> H3
ex2 s
s2))

-- | Running latch over an H3-producing process.
latchProc :: Process a H3 -> Process a H3
latchProc :: forall a. Process a H3 -> Process a H3
latchProc (Process a -> s
i s -> a -> s
st s -> H3
ex) =
  (a -> (s, H3))
-> ((s, H3) -> a -> (s, H3)) -> ((s, H3) -> H3) -> Process a H3
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process
    (\a
a -> let s0 :: s
s0 = a -> s
i a
a in (s
s0, s -> H3
ex s
s0))
    ( \(s
s, H3
v) a
a ->
        let s' :: s
s' = s -> a -> s
st s
s a
a
            v' :: H3
v' = H3 -> H3 -> H3
latchH3 H3
v (s -> H3
ex s
s')
         in (s
s', H3
v')
    )
    (s, H3) -> H3
forall a b. (a, b) -> b
snd

-- | Exponentially weighted moving average of @[0,1]@ samples as Gödel degrees.
--
-- @ewmaGoedel alpha@ uses smoothing factor @alpha ∈ (0,1]@.
ewmaGoedel :: Double -> Process Double (Goedel Double)
ewmaGoedel :: Double -> Process Double (Goedel Double)
ewmaGoedel Double
alpha = (Double -> Double)
-> (Double -> Double -> Double)
-> (Double -> Goedel Double)
-> Process Double (Goedel Double)
forall s a b. (a -> s) -> (s -> a -> s) -> (s -> b) -> Process a b
Process Double -> Double
forall {a}. (Ord a, Num a) => a -> a
inject Double -> Double -> Double
step Double -> Goedel Double
extract
  where
    inject :: a -> a
inject a
x = a -> a
forall {a}. (Ord a, Num a) => a -> a
clamp a
x
    step :: Double -> Double -> Double
step Double
s Double
x = (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
alpha) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
alpha Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall {a}. (Ord a, Num a) => a -> a
clamp Double
x
    extract :: Double -> Goedel Double
extract = Double -> Goedel Double
forall r. (Ord r, Num r) => r -> Goedel r
mkGoedel
    clamp :: a -> a
clamp a
x = a -> a -> a
forall a. Ord a => a -> a -> a
max a
0 (a -> a -> a
forall a. Ord a => a -> a -> a
min a
1 a
x)