<commit_before>{-# OPTIONS

  -XExistentialQuantification
  -XRank2Types
  -XTupleSections
#-}

{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances   #-}
{-# LANGUAGE MultiParamTypeClasses   #-}

-- | Agents created from formulas. Each of these agents has a set of formulas, and it tries to apply the formulas to build upon existing structures. For example, 'ranger' would try to apply the formula [1..n]++[n+1] = [1..(n+1)] to build longer ranges.
module PatternMatchers where

import System.Environment
import Control.Monad
import qualified Data.List as L
import qualified Data.Map.Strict as M
import qualified Data.MultiMap as MM
import Data.Maybe
import Data.Char
import qualified Data.Set as S
import Data.Array
import Data.Tuple
import qualified Data.Graph.Inductive as G
import System.Random
import Control.Lens hiding ((|>))

import TreeState
import Utilities
import ParseUtilities
import IMap
import GraphUtils
import RandomUtils
import Formulas
import MaybeUtils
import Functions

import Mind
import Workspace
import Modifiers

-- * Pattern Matchers in the abstract

data PMMemory = PMMemory {_pMMemoryChildStructs :: S.Set Int,
                          _pMMemoryModifiers :: ModifierMap} deriving Show
--only include the structures at the top.

instance Pointed PMMemory where
    point = PMMemory S.empty M.empty

makeFields ''PMMemory
--makeLenses ''PMMemory

filterIDs :: (Int -> Int -> Bool) -> Mind Workspace mes -> [Int] -> [(Int, Structure)]
filterIDs f m li = map (appendFun (\i -> m ^. (workspace . board . nodeIndex i))) li 

getPMActivations :: Bool -> Mind Workspace mes -> [Int] -> [((Int, Structure), Double)]
getPMActivations b w ids = 
    map ((\(cid, str) -> ((cid, str), lclamp 0.5 $ fromIntegral (_length str) + totalMod (str ^. modifiers)))) $
         filterIDs (\_ _ -> True) w
          (ids ++ (if b then filter (\x -> null $ ((_atIndex $ _workspace w) MM.! x) `L.intersect` ids) [1..(length $ _list $ _workspace w)] else []))

{-
    map (\cid -> 
                 let 
                     str = w ^. (workspace . board . nodeIndex cid) 
                 in 
                   ((cid, str), lclamp 0.5 $ fromIntegral (_length str) + totalMod (str ^. modifiers))) ids ++ 
        (if b then (map (\cid -> 
                 let 
                     str = w ^. (workspace . board . nodeIndex cid) 
                 in 
                   ((cid, str), lclamp 0.5 $ fromIntegral (_length str) + totalMod (str ^. modifiers)))
            (filter (\x -> null $ ((_atIndex $ _workspace w) MM.! x) `L.intersect` ids) [1..(length $ _list $ _workspace w)])) else [])
-}

{-| Find the activation of child structures. The bool is whether to include singletons. -}
getChildPMActivations :: Bool -> Mind Workspace mes -> Agent' (Mind Workspace mes) PMMemory mes -> [((Int, Structure), Double)]
getChildPMActivations b w a = getPMActivations b w (S.toList $ (a ^. (memory . childStructs)))  

makeCombineRule' :: (Show a) => (MTreeState', MTreeState', [Int] -> [Int] -> Maybe a) -> Formula -> Formula -> Maybe a
makeCombineRule' (m1, m2, f) f1 f2 = 
    case (patternMatch' m1 f1, patternMatch' m2 f2) of
      (Just li1, Just li2) -> f li1 li2 --`debug` ("CR:"++(show (li1, li2)))
      _ -> Nothing --`debug` ("No!" ++ (show (patternMatch' m1 f1, patternMatch' m2 f2)))
<commit_msg>clean up code for filtering ids<commit_after>{-# OPTIONS

  -XExistentialQuantification
  -XRank2Types
  -XTupleSections
#-}

{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances   #-}
{-# LANGUAGE MultiParamTypeClasses   #-}

-- | Agents created from formulas. Each of these agents has a set of formulas, and it tries to apply the formulas to build upon existing structures. For example, 'ranger' would try to apply the formula [1..n]++[n+1] = [1..(n+1)] to build longer ranges.
module PatternMatchers where

import System.Environment
import Control.Monad
import qualified Data.List as L
import qualified Data.Map.Strict as M
import qualified Data.MultiMap as MM
import Data.Maybe
import Data.Char
import qualified Data.Set as S
import Data.Array
import Data.Tuple
import qualified Data.Graph.Inductive as G
import System.Random
import Control.Lens hiding ((|>))

import TreeState
import Utilities
import ParseUtilities
import IMap
import GraphUtils
import RandomUtils
import Formulas
import MaybeUtils
import Functions

import Mind
import Workspace
import Modifiers

-- * Pattern Matchers in the abstract

data PMMemory = PMMemory {_pMMemoryChildStructs :: S.Set Int,
                          _pMMemoryModifiers :: ModifierMap} deriving Show
--only include the structures at the top.

instance Pointed PMMemory where
    point = PMMemory S.empty M.empty

makeFields ''PMMemory

filterIDs :: (Int -> Int -> Bool) -> Mind Workspace mes -> [Int] -> [(Int, Structure)]
filterIDs f m li = map (appendFun (\i -> m ^. (workspace . board . nodeIndex i))) li 

filterNonIntersecting:: Mind Workspace mes -> [Int] -> [Int]
filterNonIntersecting w ids = filter (\x -> null $ ((_atIndex $ _workspace w) MM.! x) `L.intersect` ids) ids

getPMActivations :: Bool -> Mind Workspace mes -> [Int] -> [((Int, Structure), Double)]
getPMActivations b w ids = 
    map ((\(cid, str) -> ((cid, str), lclamp 0.5 $ fromIntegral (_length str) + totalMod (str ^. modifiers)))) $
         filterIDs (\_ _ -> True) w
          (ids ++ (if b then filterNonIntersecting w [1..(length $ _list $ _workspace w)] else []))

{-| Find the activation of child structures. The bool is whether to include singletons. -}
getChildPMActivations :: Bool -> Mind Workspace mes -> Agent' (Mind Workspace mes) PMMemory mes -> [((Int, Structure), Double)]
getChildPMActivations b w a = getPMActivations b w (S.toList $ (a ^. (memory . childStructs)))  

makeCombineRule' :: (Show a) => (MTreeState', MTreeState', [Int] -> [Int] -> Maybe a) -> Formula -> Formula -> Maybe a
makeCombineRule' (m1, m2, f) f1 f2 = 
    case (patternMatch' m1 f1, patternMatch' m2 f2) of
      (Just li1, Just li2) -> f li1 li2 --`debug` ("CR:"++(show (li1, li2)))
      _ -> Nothing --`debug` ("No!" ++ (show (patternMatch' m1 f1, patternMatch' m2 f2)))

{'fraction_non_alphanumeric': 0.12649164677804295, 'fraction_numerical': 0.009069212410501194, 'mean_word_length': 3.241565452091768, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 56, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5813774', 'n_tokens_mistral': 2060, 'n_tokens_neox': 1972, 'n_words': 704}