-- | Module : Data.BaseSystem.Alphabet -- Description : Functions for Alphabets on BaseSystems -- Copyright : Zoey McBride (c) 2026 -- License : BSD-3-Clause -- Maintainer : zoeymcbride@mailbox.org -- Stability : experimental -- -- Implements digit alphabets for BaseSystems. module Data.BaseSystem.Alphabet ( Symbol, Value, Alphabet (alphaRadix, alphaHashId), mkAlphabet, resolveValue, resolveSymbol, ) where import Data.Array.IArray (Array, (!?)) import Data.Array.IArray qualified as Array import Data.Char (ord) import Data.Function (on) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Text (Text) import Data.Text qualified as Text -- | Represents a symbol to act as a digit in a numbering system. type Symbol = Text -- | The value of a symbol in a number system. type Value = Integer -- | Stores the String hash for an Alphabet. Used for comparision. type HashId = Int -- | Represents a two-way mapping between symbol's values and values's symbols. data Alphabet = Alphabet { alphaRadix :: Int, alphaHashId :: HashId, alphaValues :: Array Value Symbol, alphaSymbols :: Map Symbol Value } instance Eq Alphabet where (==) = (==) `on` alphaHashId instance Ord Alphabet where compare = compare `on` alphaHashId -- | Implements https://cp-algorithms.com/string/string-hashing.html mkHashId :: String -> Int mkHashId = foldr (\term acc -> (term + acc) `mod` modprime) 0 . zipWith (\i ch -> baseprime ^ i * ord ch) [(0 :: Int) ..] where -- Should be around of characters in any given alphabet baseprime = 53 -- Large prime to prevent most collisions (1/modulus chance) modprime = 1_000_009 -- | Creates an Alphabet from a given String by chunking the single unicode -- points into Symbols. mkAlphabet :: String -> Alphabet mkAlphabet str = let text = Text.pack str symbols = Text.chunksOf 1 text numsymbols = Text.length text arraybound = fromIntegral $ numsymbols - 1 in Alphabet { alphaRadix = numsymbols, alphaHashId = mkHashId str, alphaValues = Array.listArray (0, arraybound) symbols, alphaSymbols = Map.fromList $ zip symbols [0 ..] } -- | /O(log n)/ Find a value from a symbol in an alphabet. resolveValue :: Alphabet -> Symbol -> Maybe Value resolveValue abc symbol = Map.lookup symbol $ alphaSymbols abc -- | /O(1)/ Find a symbol from a value in an alphabet. resolveSymbol :: Alphabet -> Value -> Maybe Symbol resolveSymbol abc value = alphaValues abc !? value