Random.hs

module Zwirn.Core.Random where

{-
    Random.hs - simple random signals and related functions
    Copyright (C) 2025, Martin Gius

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

import Control.Monad (join)
import System.Random
import Zwirn.Core.Core
import Zwirn.Core.Modulate
import Zwirn.Core.Query
import Zwirn.Core.Types

randR :: (Random a, Applicative k) => ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a
randR l r = zwirn q
  where
    q t = unzwirn (fmap fst $ liftA2 randomR zipp $ pure $ mkStdGen $ floor (t / precision)) t
      where
        zipp = liftA2 (,) l r

rand :: (Random a, Applicative k) => ZwirnT k st i a
rand = zwirn $ \t st -> pure (Value (fst $ random (mkStdGen $ floor (t / precision))) t [], st)

noise :: (Applicative k) => ZwirnT k st i Double
noise = rand

irand :: (Applicative k) => ZwirnT k st i Int -> ZwirnT k st i Int
irand = randR (pure 0)

brandBy :: (Applicative k) => ZwirnT k st i Double -> ZwirnT k st i Bool
brandBy prob = liftA2 (>) prob rand

sometimesBy :: (MultiMonad k) => ZwirnT k st i Double -> (ZwirnT k st i a -> ZwirnT k st i a) -> ZwirnT k st i a -> ZwirnT k st i a
sometimesBy prob f x = innerJoin $ fmap cho (brandBy prob)
  where
    cho True = f x
    cho False = x

-- these versions take the cycle number as seed

randR' :: (Random a, Applicative k) => ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a
randR' r l = zwirn q
  where
    q t = unzwirn (fmap fst $ liftA2 randomR zipp $ pure $ mkStdGen $ floor t) t
      where
        zipp = liftA2 (,) l r

rand' :: (Random a, Applicative k) => ZwirnT k st i a
rand' = zwirn $ \t st -> pure (Value (fst $ random (mkStdGen $ floor t)) t [], st)

irand' :: (Applicative k) => ZwirnT k st i Int -> ZwirnT k st i Int
irand' = randR' (pure 0)

brandBy' :: (Applicative k) => ZwirnT k st i Double -> ZwirnT k st i Bool
brandBy' prob = liftA2 (>) prob rand'

chooseWithSeed :: (Monad k) => Int -> [ZwirnT k st i a] -> ZwirnT k st i a
chooseWithSeed i ps = (ps !!) =<< shift (pure $ fromIntegral i / precision) (irand' $ pure $ length ps - 1)

chooseList :: (Monad k) => [ZwirnT k st i a] -> ZwirnT k st i a
chooseList = chooseWithSeed 0

enumFromToChoice :: (Ord a, Num a, Monad k) => Int -> ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a
enumFromToChoice i xz yz = join $ en <$> xz <*> yz
  where
    en x y = chooseWithSeed i $ map pure $ enumerateFromTo x y

enumFromThenToChoice :: (Ord a, Num a, Monad k) => Int -> ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a
enumFromThenToChoice i xz yz zz = join $ en <$> xz <*> yz <*> zz
  where
    en x y z = chooseWithSeed i $ map pure $ enumerateFromThenTo x y z