Commit 8042e3a3 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[ngrams] accept Set Int being set as occurrences

parent 41668044
...@@ -23,7 +23,6 @@ import Data.List as List ...@@ -23,7 +23,6 @@ import Data.List as List
import Data.Map (Map) import Data.Map (Map)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, isNothing, maybe) import Data.Maybe (Maybe(..), fromMaybe, isNothing, maybe)
import Data.Monoid.Additive (Additive(..))
import Data.Ord.Down (Down(..)) import Data.Ord.Down (Down(..))
import Data.Sequence as Seq import Data.Sequence as Seq
import Data.Set (Set) import Data.Set (Set)
...@@ -466,11 +465,11 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where ...@@ -466,11 +465,11 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
let ngramsTable = applyNgramsPatches state' initTable let ngramsTable = applyNgramsPatches state' initTable
rowMap (Tuple ng nre) = rowMap (Tuple ng nre) =
let ng_scores :: Map NgramsTerm (Additive Int) let ng_scores :: Map NgramsTerm (Set Int)
ng_scores = ngramsTable ^. _NgramsTable <<< _ngrams_scores ng_scores = ngramsTable ^. _NgramsTable <<< _ngrams_scores
Additive s = ng_scores ^. at ng <<< _Just s = ng_scores ^. at ng <<< _Just
addOcc ne = addOcc ne =
let Additive occurrences = sumOccurrences ngramsTable (ngramsElementToNgramsOcc ne) in let occurrences = sumOccurrences ngramsTable (ngramsElementToNgramsOcc ne) in
ne # _NgramsElement <<< _occurrences .~ occurrences ne # _NgramsElement <<< _occurrences .~ occurrences
in in
addOcc <$> rowsFilter (ngramsRepoElementToNgramsElement ng s nre) addOcc <$> rowsFilter (ngramsRepoElementToNgramsElement ng s nre)
...@@ -1119,23 +1118,23 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp ...@@ -1119,23 +1118,23 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp
, versioned , versioned
, withAutoUpdate } [] , withAutoUpdate } []
type NgramsOcc = { occurrences :: Additive Int, children :: Set NgramsTerm } type NgramsOcc = { occurrences :: Set Int, children :: Set NgramsTerm }
ngramsElementToNgramsOcc :: NgramsElement -> NgramsOcc ngramsElementToNgramsOcc :: NgramsElement -> NgramsOcc
ngramsElementToNgramsOcc (NgramsElement {occurrences, children}) = {occurrences: Additive occurrences, children} ngramsElementToNgramsOcc (NgramsElement {occurrences, children}) = {occurrences, children}
sumOccurrences :: NgramsTable -> NgramsOcc -> Additive Int sumOccurrences :: NgramsTable -> NgramsOcc -> Set Int
sumOccurrences nt = sumOccChildren mempty sumOccurrences nt = sumOccChildren mempty
where where
sumOccTerm :: Set NgramsTerm -> NgramsTerm -> Additive Int sumOccTerm :: Set NgramsTerm -> NgramsTerm -> Set Int
sumOccTerm seen label sumOccTerm seen label
| Set.member label seen = Additive 0 -- TODO: Should not happen, emit a warning/error. | Set.member label seen = Set.empty -- TODO: Should not happen, emit a warning/error.
| otherwise = | otherwise =
sumOccChildren (Set.insert label seen) sumOccChildren (Set.insert label seen)
{ occurrences: nt ^. _NgramsTable <<< _ngrams_scores <<< ix label { occurrences: nt ^. _NgramsTable <<< _ngrams_scores <<< ix label
, children: nt ^. ix label <<< _NgramsRepoElement <<< _children , children: nt ^. ix label <<< _NgramsRepoElement <<< _children
} }
sumOccChildren :: Set NgramsTerm -> NgramsOcc -> Additive Int sumOccChildren :: Set NgramsTerm -> NgramsOcc -> Set Int
sumOccChildren seen {occurrences, children} = sumOccChildren seen {occurrences, children} =
occurrences <> children ^. folded <<< to (sumOccTerm seen) occurrences <> children ^. folded <<< to (sumOccTerm seen)
......
...@@ -256,7 +256,7 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt ...@@ -256,7 +256,7 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
, ,
B.wad' B.wad'
[ "pl-3" ] $ [ "pl-3" ] $
show (ngramsElement ^. _NgramsElement <<< _occurrences) show $ A.length $ A.fromFoldable (ngramsElement ^. _NgramsElement <<< _occurrences)
] ]
where where
ngramsDepth = { ngrams, depth: 0 } ngramsDepth = { ngrams, depth: 0 }
......
...@@ -87,7 +87,7 @@ normNgramWithTrim nt = DSC.trim <<< normNgramInternal nt ...@@ -87,7 +87,7 @@ normNgramWithTrim nt = DSC.trim <<< normNgramInternal nt
normNgram :: CTabNgramType -> String -> NgramsTerm normNgram :: CTabNgramType -> String -> NgramsTerm
normNgram tabType = NormNgramsTerm <<< normNgramWithTrim tabType normNgram tabType = NormNgramsTerm <<< normNgramWithTrim tabType
ngramsRepoElementToNgramsElement :: NgramsTerm -> Int -> NgramsRepoElement -> NgramsElement ngramsRepoElementToNgramsElement :: NgramsTerm -> Set Int -> NgramsRepoElement -> NgramsElement
ngramsRepoElementToNgramsElement ngrams occurrences (NgramsRepoElement { children, list, parent, root, size }) = ngramsRepoElementToNgramsElement ngrams occurrences (NgramsRepoElement { children, list, parent, root, size }) =
NgramsElement NgramsElement
{ children { children
......
...@@ -16,7 +16,6 @@ import Data.List (List) ...@@ -16,7 +16,6 @@ import Data.List (List)
import Data.Map (Map) import Data.Map (Map)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), isJust) import Data.Maybe (Maybe(..), isJust)
import Data.Monoid.Additive (Additive(..))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Ord.Generic (genericCompare) import Data.Ord.Generic (genericCompare)
import Data.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
...@@ -255,7 +254,7 @@ newtype NgramsElement = NgramsElement ...@@ -255,7 +254,7 @@ newtype NgramsElement = NgramsElement
, root :: Maybe NgramsTerm -- ok , root :: Maybe NgramsTerm -- ok
, parent :: Maybe NgramsTerm -- ok , parent :: Maybe NgramsTerm -- ok
, children :: Set NgramsTerm -- ok , children :: Set NgramsTerm -- ok
, occurrences :: Int -- HERE , occurrences :: Set Int -- HERE
} }
derive instance Eq NgramsElement derive instance Eq NgramsElement
derive instance Newtype NgramsElement _ derive instance Newtype NgramsElement _
...@@ -267,13 +266,15 @@ instance JSON.ReadForeign NgramsElement where ...@@ -267,13 +266,15 @@ instance JSON.ReadForeign NgramsElement where
, size :: Int , size :: Int
, list :: GT.TermList , list :: GT.TermList
, ngrams :: NgramsTerm , ngrams :: NgramsTerm
, occurrences :: Int , occurrences :: Array Int
, parent :: Maybe NgramsTerm , parent :: Maybe NgramsTerm
, root :: Maybe NgramsTerm }<- JSON.readImpl f , root :: Maybe NgramsTerm } <- JSON.readImpl f
pure $ NgramsElement $ inst { children = Set.fromFoldable inst.children } pure $ NgramsElement $ inst { children = Set.fromFoldable inst.children
, occurrences = Set.fromFoldable inst.occurrences }
instance JSON.WriteForeign NgramsElement where instance JSON.WriteForeign NgramsElement where
writeImpl (NgramsElement ne) = writeImpl (NgramsElement ne) =
JSON.writeImpl $ ne { children = Set.toUnfoldable ne.children :: Array _ } JSON.writeImpl $ ne { children = Set.toUnfoldable ne.children :: Array _
, occurrences = Set.toUnfoldable ne.occurrences :: Array _ }
_parent :: forall parent row. Lens' { parent :: parent | row } parent _parent :: forall parent row. Lens' { parent :: parent | row } parent
_parent = prop (Proxy :: Proxy "parent") _parent = prop (Proxy :: Proxy "parent")
...@@ -287,7 +288,7 @@ _ngrams = prop (Proxy :: Proxy "ngrams") ...@@ -287,7 +288,7 @@ _ngrams = prop (Proxy :: Proxy "ngrams")
_children :: forall row. Lens' { children :: Set NgramsTerm | row } (Set NgramsTerm) _children :: forall row. Lens' { children :: Set NgramsTerm | row } (Set NgramsTerm)
_children = prop (Proxy :: Proxy "children") _children = prop (Proxy :: Proxy "children")
_occurrences :: forall row. Lens' { occurrences :: Int | row } Int _occurrences :: forall row. Lens' { occurrences :: Set Int | row } (Set Int)
_occurrences = prop (Proxy :: Proxy "occurrences") _occurrences = prop (Proxy :: Proxy "occurrences")
_list :: forall a row. Lens' { list :: a | row } a _list :: forall a row. Lens' { list :: a | row } a
...@@ -304,7 +305,7 @@ _NgramsElement :: Iso' NgramsElement { ...@@ -304,7 +305,7 @@ _NgramsElement :: Iso' NgramsElement {
, size :: Int , size :: Int
, list :: GT.TermList , list :: GT.TermList
, ngrams :: NgramsTerm , ngrams :: NgramsTerm
, occurrences :: Int , occurrences :: Set Int
, parent :: Maybe NgramsTerm , parent :: Maybe NgramsTerm
, root :: Maybe NgramsTerm , root :: Maybe NgramsTerm
} }
...@@ -356,7 +357,7 @@ _NgramsRepoElement = _Newtype ...@@ -356,7 +357,7 @@ _NgramsRepoElement = _Newtype
-} -}
newtype NgramsTable = NgramsTable newtype NgramsTable = NgramsTable
{ ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement { ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement
, ngrams_scores :: Map NgramsTerm (Additive Int) , ngrams_scores :: Map NgramsTerm (Set Int)
} }
derive instance Newtype NgramsTable _ derive instance Newtype NgramsTable _
derive instance Generic NgramsTable _ derive instance Generic NgramsTable _
...@@ -372,11 +373,11 @@ instance JSON.ReadForeign NgramsTable where ...@@ -372,11 +373,11 @@ instance JSON.ReadForeign NgramsTable where
where where
f (NgramsElement {ngrams, size, list, root, parent, children}) = f (NgramsElement {ngrams, size, list, root, parent, children}) =
Tuple ngrams (NgramsRepoElement {size, list, root, parent, children}) Tuple ngrams (NgramsRepoElement {size, list, root, parent, children})
g (NgramsElement e) = Tuple e.ngrams (Additive e.occurrences) g (NgramsElement e) = Tuple e.ngrams e.occurrences
_NgramsTable :: Iso' NgramsTable _NgramsTable :: Iso' NgramsTable
{ ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement { ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement
, ngrams_scores :: Map NgramsTerm (Additive Int) , ngrams_scores :: Map NgramsTerm (Set Int)
} }
_NgramsTable = _Newtype _NgramsTable = _Newtype
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment