Commit 2ddee534 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch '149-dev-ngrams-table-sorting-fix' into 465-dev-graph-explorer-recursion-error

parents 7f36bec4 8042e3a3
......@@ -23,7 +23,6 @@ import Data.List as List
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, isNothing, maybe)
import Data.Monoid.Additive (Additive(..))
import Data.Ord.Down (Down(..))
import Data.Sequence as Seq
import Data.Set (Set)
......@@ -466,11 +465,11 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
let ngramsTable = applyNgramsPatches state' initTable
rowMap (Tuple ng nre) =
let ng_scores :: Map NgramsTerm (Additive Int)
let ng_scores :: Map NgramsTerm (Set Int)
ng_scores = ngramsTable ^. _NgramsTable <<< _ngrams_scores
Additive s = ng_scores ^. at ng <<< _Just
s = ng_scores ^. at ng <<< _Just
addOcc ne =
let Additive occurrences = sumOccurrences ngramsTable (ngramsElementToNgramsOcc ne) in
let occurrences = sumOccurrences ngramsTable (ngramsElementToNgramsOcc ne) in
ne # _NgramsElement <<< _occurrences .~ occurrences
in
addOcc <$> rowsFilter (ngramsRepoElementToNgramsElement ng s nre)
......@@ -1119,23 +1118,23 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp
, versioned
, withAutoUpdate } []
type NgramsOcc = { occurrences :: Additive Int, children :: Set NgramsTerm }
type NgramsOcc = { occurrences :: Set Int, children :: Set NgramsTerm }
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
where
sumOccTerm :: Set NgramsTerm -> NgramsTerm -> Additive Int
sumOccTerm :: Set NgramsTerm -> NgramsTerm -> Set Int
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 =
sumOccChildren (Set.insert label seen)
{ occurrences: nt ^. _NgramsTable <<< _ngrams_scores <<< ix label
, children: nt ^. ix label <<< _NgramsRepoElement <<< _children
}
sumOccChildren :: Set NgramsTerm -> NgramsOcc -> Additive Int
sumOccChildren :: Set NgramsTerm -> NgramsOcc -> Set Int
sumOccChildren seen {occurrences, children} =
occurrences <> children ^. folded <<< to (sumOccTerm seen)
......
......@@ -256,7 +256,7 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
,
B.wad'
[ "pl-3" ] $
show (ngramsElement ^. _NgramsElement <<< _occurrences)
show $ A.length $ A.fromFoldable (ngramsElement ^. _NgramsElement <<< _occurrences)
]
where
ngramsDepth = { ngrams, depth: 0 }
......
......@@ -87,7 +87,7 @@ normNgramWithTrim nt = DSC.trim <<< normNgramInternal nt
normNgram :: CTabNgramType -> String -> NgramsTerm
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 }) =
NgramsElement
{ children
......
......@@ -16,7 +16,6 @@ import Data.List (List)
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), isJust)
import Data.Monoid.Additive (Additive(..))
import Data.Newtype (class Newtype)
import Data.Ord.Generic (genericCompare)
import Data.Show.Generic (genericShow)
......@@ -255,7 +254,7 @@ newtype NgramsElement = NgramsElement
, root :: Maybe NgramsTerm -- ok
, parent :: Maybe NgramsTerm -- ok
, children :: Set NgramsTerm -- ok
, occurrences :: Int -- HERE
, occurrences :: Set Int -- HERE
}
derive instance Eq NgramsElement
derive instance Newtype NgramsElement _
......@@ -267,13 +266,15 @@ instance JSON.ReadForeign NgramsElement where
, size :: Int
, list :: GT.TermList
, ngrams :: NgramsTerm
, occurrences :: Int
, occurrences :: Array Int
, parent :: Maybe NgramsTerm
, root :: Maybe NgramsTerm }<- JSON.readImpl f
pure $ NgramsElement $ inst { children = Set.fromFoldable inst.children }
, root :: Maybe NgramsTerm } <- JSON.readImpl f
pure $ NgramsElement $ inst { children = Set.fromFoldable inst.children
, occurrences = Set.fromFoldable inst.occurrences }
instance JSON.WriteForeign NgramsElement where
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 = prop (Proxy :: Proxy "parent")
......@@ -287,7 +288,7 @@ _ngrams = prop (Proxy :: Proxy "ngrams")
_children :: forall row. Lens' { children :: Set NgramsTerm | row } (Set NgramsTerm)
_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")
_list :: forall a row. Lens' { list :: a | row } a
......@@ -304,7 +305,7 @@ _NgramsElement :: Iso' NgramsElement {
, size :: Int
, list :: GT.TermList
, ngrams :: NgramsTerm
, occurrences :: Int
, occurrences :: Set Int
, parent :: Maybe NgramsTerm
, root :: Maybe NgramsTerm
}
......@@ -356,7 +357,7 @@ _NgramsRepoElement = _Newtype
-}
newtype NgramsTable = NgramsTable
{ ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement
, ngrams_scores :: Map NgramsTerm (Additive Int)
, ngrams_scores :: Map NgramsTerm (Set Int)
}
derive instance Newtype NgramsTable _
derive instance Generic NgramsTable _
......@@ -372,11 +373,11 @@ instance JSON.ReadForeign NgramsTable where
where
f (NgramsElement {ngrams, 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
{ ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement
, ngrams_scores :: Map NgramsTerm (Additive Int)
, ngrams_scores :: Map NgramsTerm (Set Int)
}
_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