Spec.purs 6.97 KB
Newer Older
1 2 3
module Gargantext.Components.NgramsTable.Spec where

import Prelude
4
import Data.List as L
5
import Data.Maybe (Maybe(..))
6 7
import Data.Map as Map
import Data.Set as Set
8 9
import Data.Tuple (Tuple(..))
import Test.Spec (Spec, describe, it)
10
-- import Test.Spec.Assertions (shouldEqual)
11 12
-- import Test.Spec.QuickCheck (quickCheck')

13 14
import Test.Utils (shouldEqualArray)

15
import Gargantext.Core.NgramsTable.Functions (highlightNgrams, normNgram)
16
import Gargantext.Core.NgramsTable.Types (HighlightElement, NgramsElement(..), NgramsRepoElement(..), NgramsTable(..), NgramsTerm)
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
import Gargantext.Types (CTabNgramType(..), TermList(..))


ne :: String -> TermList -> CTabNgramType -> NgramsElement
ne ngrams list ngramType = NgramsElement { ngrams: normed
                                         , size: 1  -- TODO
                                         , list
                                         , occurrences: 0
                                         , parent:   Nothing
                                         , root:     Nothing
                                         , children: Set.empty
                                         }
  where
    normed = normNgram ngramType ngrams

tne :: String -> TermList -> CTabNgramType -> Tuple NgramsTerm NgramsElement
tne ngrams list ngramType = Tuple normed (ne ngrams list ngramType)
  where
    normed = normNgram ngramType ngrams

nre :: String -> TermList -> CTabNgramType -> NgramsRepoElement
nre ngrams list ngramType = NgramsRepoElement { size: 1  -- TODO
                                              , list
                                              , parent:   Nothing
                                              , root:     Nothing
                                              , children: Set.empty
                                              }

tnre :: String -> TermList -> CTabNgramType -> Tuple NgramsTerm NgramsRepoElement
tnre ngrams list ngramType = Tuple normed (nre ngrams list ngramType)
  where
    normed = normNgram ngramType ngrams

50 51 52 53 54 55 56 57 58
highlightNil :: String -> HighlightElement
highlightNil s = Tuple s L.Nil

highlightTuple :: String -> CTabNgramType -> TermList -> Tuple NgramsTerm TermList
highlightTuple s ngramType term = Tuple (normNgram ngramType s) term

highlightSingleton :: String -> CTabNgramType -> TermList -> HighlightElement
highlightSingleton s ngramType term = Tuple s (L.singleton $ highlightTuple s ngramType term)

59
spec :: Spec Unit
60
spec = do
61
  describe "NgramsTable.highlightNgrams" do
62
    it "works on a simple example" do
63
      let ngramType = CTabSources
64
      let table = NgramsTable
65 66 67 68 69
                   { ngrams_repo_elements: Map.fromFoldable [ tnre "which"     StopTerm ngramType
                                                            , tnre "stops"     StopTerm ngramType
                                                            , tnre "candidate" CandidateTerm ngramType
                                                            ]
                   , ngrams_scores: Map.fromFoldable [] }
70
          input = "this is a graph about a biography which stops at every candidate"
71 72 73 74 75 76 77
          output = [ highlightNil " this is a graph about a biography "
                   , highlightSingleton " which" ngramType StopTerm
                   , highlightNil " "
                   , highlightSingleton " stops" ngramType StopTerm
                   , highlightNil " at every "
                   , highlightSingleton " candidate" ngramType CandidateTerm
                   , highlightNil " "
78
                   ]
79
      highlightNgrams CTabTerms table input `shouldEqualArray` output
80 81

    it "works when pattern overlaps" do
82
      let ngramType = CTabSources
83
      let table = NgramsTable
84 85 86 87 88
                    { ngrams_repo_elements: Map.fromFoldable [ tnre "is"     StopTerm ngramType
                                                             , tnre "a"      StopTerm ngramType
                                                             , tnre "of"     StopTerm ngramType
                                                             ]
                    , ngrams_scores: Map.fromFoldable [] }
89
          input = "This is a new state of the"
90 91 92 93 94 95 96
          output = [ highlightNil " This "
                   , highlightSingleton " is" ngramType StopTerm
                   , highlightNil " "
                   , highlightSingleton " a" ngramType StopTerm
                   , highlightNil " new state "
                   , highlightSingleton " of" ngramType StopTerm
                   , highlightNil " the "
97
                   ]
98
      highlightNgrams CTabTerms table input `shouldEqualArray` output
99 100

    it "works when pattern overlaps 2" do
101
      let ngramType = CTabSources
102
      let table = NgramsTable
103 104 105 106 107
                    { ngrams_repo_elements: Map.fromFoldable [ tnre "from"   CandidateTerm ngramType
                                                             , tnre "i"      StopTerm ngramType
                                                             , tnre "images" CandidateTerm ngramType
                                                             ]
                    , ngrams_scores: Map.fromFoldable [] }
108
          input = "This is from space images"
109 110 111 112 113
          output = [ highlightNil " This is "
                   , highlightSingleton " from" ngramType CandidateTerm
                   , highlightNil " space "
                   , highlightSingleton " images" ngramType CandidateTerm
                   , highlightNil " "
114
                   ]
115
      highlightNgrams CTabTerms table input `shouldEqualArray` output
116 117 118 119

    it "works when pattern overlaps 3" do
      let ngramType = CTabSources
      let table = NgramsTable
120 121
                    { ngrams_repo_elements: Map.fromFoldable [ tnre "something"             CandidateTerm ngramType
                                                             , tnre "something different"   MapTerm ngramType
122 123
                                                             ]
                    , ngrams_scores: Map.fromFoldable [] }
124 125 126 127 128 129 130 131
          input = "and now for something different"
          output = [ highlightNil " and now for "
                   , Tuple " something" $ L.fromFoldable [
                         highlightTuple "something different" ngramType MapTerm
                       , highlightTuple "something" ngramType CandidateTerm
                       ]
                   , Tuple " different" $ L.singleton $ highlightTuple "something different" ngramType MapTerm
                   , highlightNil " "
132
                   ]
133
      highlightNgrams CTabTerms table input `shouldEqualArray` output
134 135

    it "works with punctuation" do
136
      let ngramType = CTabSources
137
      let table = NgramsTable
138 139
                    { ngrams_repo_elements: Map.fromFoldable [ tnre "graph" CandidateTerm ngramType ]
                    , ngrams_scores: Map.fromFoldable [] }
140
          input = "before graph, after"
141 142 143
          output = [ highlightNil " before "
                   , highlightSingleton " graph" ngramType CandidateTerm
                   , highlightNil ", after "
144
                   ]
145
      highlightNgrams CTabTerms table input `shouldEqualArray` output