packages feed

basesystems-1.0.0.0: basesystems/Data/BaseSystem/Alphabet.hs

-- | 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