File size: 2,051 Bytes
0c6f0f2 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | {-# LANGUAGE OverloadedStrings #-}
-- | Rule-based linguistic feature encoder (POS, lemma, dependency).
-- No ML training. Deterministic, auditable.
-- Author: Ahmad Ali Parr · Trust: Bel Esprit D'Accord Irrevocable Trust
module LinguisticEncoder
( encodeLinguisticFeatures
, combineWithBERT
, ruleBasedPOS
, ruleBasedLemma
) where
import qualified Data.Vector as V
import Data.Vector (Vector)
import Data.List (isSuffixOf)
import NeurologicalRegex (Token(..), Embedding, bertEmbeddings)
type LinguisticEmbedding = Vector Double
ruleBasedPOS :: String -> String
ruleBasedPOS w
| "ed" `isSuffixOf` w = "VERB"
| "ing" `isSuffixOf` w = "VERB"
| "ly" `isSuffixOf` w = "ADV"
| "s" `isSuffixOf` w && length w > 1 = "NOUN"
| otherwise = "NOUN"
ruleBasedLemma :: String -> String
ruleBasedLemma w
| "ing" `isSuffixOf` w && length w > 3 = take (length w - 3) w
| "ed" `isSuffixOf` w && length w > 2 = take (length w - 2) w
| "s" `isSuffixOf` w && length w > 1 = init w
| otherwise = w
ruleBasedDepRel :: [String] -> Int -> String
ruleBasedDepRel ws i
| i == 0 = "ROOT"
| i > 0 && ruleBasedPOS (ws !! (i-1)) == "VERB"
&& ruleBasedPOS (ws !! i) == "NOUN" = "nsubj"
| otherwise = "dep"
encodeLinguisticFeatures :: [String] -> [LinguisticEmbedding]
encodeLinguisticFeatures ws =
[ featureToEmb (ruleBasedPOS w) (ruleBasedDepRel ws i) (ruleBasedLemma w)
| (i, w) <- zip [0..] ws ]
where
featureToEmb pos dep lemma =
V.generate 16 $ \j ->
let base = fromIntegral (sum (map fromEnum (pos++dep++lemma)) `mod` 1024)
in (base + fromIntegral j * 17.0) / 2048.0
combineWithBERT :: [Token] -> [LinguisticEmbedding] -> [Embedding]
combineWithBERT toks lingEmbs =
let bertEmbs = map (\t -> bertEmbeddings 8 t) toks
padLing = map (\e -> V.generate 8 (\i -> V.unsafeIndex e (i `mod` V.length e))) lingEmbs
pairs = zip bertEmbs (padLing ++ repeat (V.replicate 8 0))
in map (\(b,l) -> b V.++ l) pairs
|