duckling/Duckling/Numeral/EL/Rules.hs

-- Copyright (c) 2016-present, Facebook, Inc.
-- All rights reserved.
--
-- This source code is licensed under the BSD-style license found in the
-- LICENSE file in the root directory of this source tree. An additional grant
-- of patent rights can be found in the PATENTS file in the same directory.


{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoRebindableSyntax #-}
{-# LANGUAGE OverloadedStrings #-}

module Duckling.Numeral.EL.Rules
  ( rules
  ) where

import Data.HashMap.Strict (HashMap)
import Data.List (intercalate)
import Data.Maybe
import Data.String
import Data.Text (Text)
import Prelude
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as Text

import Duckling.Dimensions.Types
import Duckling.Numeral.Helpers
import Duckling.Numeral.Types (NumeralData (..))
import Duckling.Regex.Types
import Duckling.Types
import qualified Duckling.Numeral.Types as TNumeral

oneOrTwoDigitsMap :: HashMap Text Integer
oneOrTwoDigitsMap = HashMap.fromList
  [ ( "μηδέν"       , 0  )
  , ( "ένα"         , 1  )
  , ( "ένας"        , 1  )
  , ( "ενός"        , 1  )
  , ( "μία"         , 1  )
  , ( "μια"         , 1  )
  , ( "δύο"         , 2  )
  , ( "δυο"         , 2  )
  , ( "τρία"        , 3  )
  , ( "τρεις"       , 3  )
  , ( "τέσσερα"     , 4  )
  , ( "τέσσερις"    , 4  )
  , ( "πέντε"       , 5  )
  , ( "έξι"         , 6  )
  , ( "επτά"        , 7  )
  , ( "εφτά"        , 7  )
  , ( "οκτώ"        , 8  )
  , ( "οχτώ"        , 8  )
  , ( "εννιά"       , 9  )
  , ( "εννέα"       , 9  )
  , ( "δέκα"        , 10 )
  , ( "δεκαριά"     , 10 )
  , ( "έντεκα"      , 11 )
  , ( "ένδεκα"      , 11 )
  , ( "δώδεκα"      , 12 )
  , ( "ντουζίνα"    , 12 )
  , ( "ντουζίνες"   , 12 )
  , ( "δεκατρία"    , 13 )
  , ( "δεκατέσσερα" , 14 )
  , ( "δεκαπέντε"   , 15 )
  , ( "δεκαέξι"     , 16 )
  , ( "δεκαεπτά"    , 17 )
  , ( "δεκαοκτώ"    , 18 )
  , ( "δεκαεννέα"   , 19 )
  , ( "δεκαεννιά"   , 19 )
  , ( "είκοσι"      , 20 )
  , ( "τριάντα"     , 30 )
  , ( "σαράντα"     , 40 )
  , ( "πενήντα"     , 50 )
  , ( "εξήντα"      , 60 )
  , ( "εβδομήντα"   , 70 )
  , ( "ογδόντα"     , 80 )
  , ( "ενενήντα"    , 90 )
  ]

hundredsMap :: HashMap Text Integer
hundredsMap = HashMap.fromList
  [ ( "δι"   , 200 )
  , ( "τρι"  , 300 )
  , ( "τετρ" , 400 )
  , ( "πεντ" , 500 )
  , ( "εξ"   , 600 )
  , ( "επτ"  , 700 )
  , ( "εφτ"  , 700 )
  , ( "οκτ"  , 800 )
  , ( "οχτ"  , 800 )
  , ( "εννι" , 900 )
  ]

ruleNumeral :: Rule
ruleNumeral = Rule
  { name = "number (0..19, 20, 30..90)"
  , pattern = [ regex regexString ]
  , prod = \tokens -> case tokens of
      (Token RegexMatch (GroupMatch (match:_)):_) ->
        HashMap.lookup (Text.toLower match) oneOrTwoDigitsMap >>= integer
      _ -> Nothing
  }
  where
    regexString = "(" ++ intercalate "|"
      [ "μηδέν|[εέ]ν[αοό]ς?|μ[ιί]ας?"                                -- [0..1]
      , "δ[υύ]ο|τρ(ία|εις)|τέσσερ(α|ις)|πέντε"                       -- [2..5]
      , "έξι|ε[πφ]τά|ο[κχ]τώ|ενν(ιά|έα)|δέκα|δεκαριά"                -- [6..10]
      , "έν[τδ]εκα|δώδεκα|ντουζίν(α|ες)"                             -- [11..12]
      , "δεκα(τρία|τέσσερα|πέντε|έξι|ε[πφ]τά|ο[χκ]τώ|ενν(έα|ιά))"    -- [13..19]
      , "είκοσι|(τριά|σαρά|πενή|εξή|εβδομή|ογδό|ενενή)ντα"           -- [2..9]0
      ] ++ ")"

ruleFew :: Rule
ruleFew = Rule
  { name = "few"
  , pattern =
    [ regex "μερικ(ά|ές|οί)"
    ]
  , prod = \_ -> integer 3
  }

ruleCompositeTens :: Rule
ruleCompositeTens = Rule
  { name = "integer 21..99"
  , pattern =
      [ oneOf [20,30..90]
      , numberBetween 1 10
      ]
  , prod = \tokens -> case tokens of
      (Token Numeral NumeralData{TNumeral.value = tens} :
       Token Numeral NumeralData{TNumeral.value = units} :
       _) -> double (tens + units)
      _ -> Nothing
  }

ruleHundred :: Rule
ruleHundred = Rule
  { name = "number (100)"
  , pattern = [ regex "(εκατόν?)" ]
  , prod = \tokens -> case tokens of
      (Token RegexMatch (GroupMatch _):_) -> integer 100 >>= withGrain 2
      _ -> Nothing
  }

ruleHundreds :: Rule
ruleHundreds = Rule
  { name = "number (200..900)"
  , pattern =
      [ regex "(δι|τρι|τετρ|πεντ|εξ|ε(π|φ)τ|ο(χ|κ)τ|εννι)ακόσι(α|ες|οι)"
      ]
  , prod = \tokens -> case tokens of
      (Token RegexMatch (GroupMatch (match:_)):_) ->
        HashMap.lookup (Text.toLower match) hundredsMap >>=
        integer >>= withGrain 2
      _ -> Nothing
  }

rulePowersOfTen :: Rule
rulePowersOfTen = Rule
  { name = "powers of tens"
  , pattern =
    [ regex "(χίλι(α|οι|ες)|χιλιάδες|εκατομμύρι(ο|α)|δις|δισεκατομμύριο)"
    ]
  , prod = \tokens -> case tokens of
      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of
        "χίλια"          -> double 1e3 >>= withGrain 3 >>= withMultipliable
        "χιλιάδες"       -> double 1e3 >>= withGrain 3 >>= withMultipliable
        "εκατομμύριο"    -> double 1e6 >>= withGrain 6 >>= withMultipliable
        "εκατομμύρια"    -> double 1e6 >>= withGrain 6 >>= withMultipliable
        "δις"            -> double 1e9 >>= withGrain 9 >>= withMultipliable
        "δισεκατομμύριο" -> double 1e9 >>= withGrain 9 >>= withMultipliable
        "δισεκατομμύρια" -> double 1e9 >>= withGrain 9 >>= withMultipliable
        _                -> Nothing
      _ -> Nothing
  }

ruleNegative :: Rule
ruleNegative = Rule
  { name = "negative numbers"
  , pattern =
    [ regex "-|μείον"
    , Predicate isPositive
    ]
  , prod = \tokens -> case tokens of
      (_:Token Numeral nd:_) -> double (TNumeral.value nd * (-1))
      _ -> Nothing
  }

ruleSum :: Rule
ruleSum = Rule
  { name = "intersect 2 numbers"
  , pattern =
    [ Predicate hasGrain
    , Predicate $ and . sequence [not . isMultipliable, isPositive]
    ]
  , prod = \tokens -> case tokens of
      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:
       Token Numeral NumeralData{TNumeral.value = val2}:
       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2
      _ -> Nothing
  }

ruleMultiply :: Rule
ruleMultiply = Rule
  { name = "compose by multiplication"
  , pattern =
    [ dimension Numeral
    , Predicate isMultipliable
    ]
  , prod = \tokens -> case tokens of
      (token1:token2:_) -> multiply token1 token2
      _ -> Nothing
  }

ruleDecimals :: Rule
ruleDecimals = Rule
  { name = "decimal number"
  , pattern =
    [ regex "(\\d+,\\d+)"
    ]
  , prod = \tokens -> case tokens of
      (Token RegexMatch (GroupMatch (match:_)):_) ->
        parseDecimal True (Text.replace "," "." match)
      _ -> Nothing
  }

ruleCommaSpelledOut :: Rule
ruleCommaSpelledOut = Rule
  { name = "one point two"
  , pattern =
    [ dimension Numeral
    , regex "κόμμα"
    , Predicate $ not . hasGrain
    ]
  , prod = \tokens -> case tokens of
      (Token Numeral nd1:_:Token Numeral nd2:_) ->
        double $ TNumeral.value nd1 + decimalsToDouble (TNumeral.value nd2)
      _ -> Nothing
  }

ruleDots :: Rule
ruleDots = Rule
  { name = "dot-separated numbers"
  , pattern =
    [ regex "(\\d+(\\.\\d\\d\\d)+(,\\d+)?)"
    ]
  , prod = \tokens -> case tokens of
      (Token RegexMatch (GroupMatch (match:_)):_) ->
        parseDouble (
          Text.replace "," "." $ Text.replace "." Text.empty match
        ) >>= double
      _ -> Nothing
  }

rules :: [Rule]
rules =
  [ ruleFew
  , ruleNumeral
  , ruleCompositeTens
  , rulePowersOfTen
  , ruleNegative
  , ruleHundred
  , ruleHundreds
  , ruleSum
  , ruleMultiply
  , ruleDecimals
  , ruleCommaSpelledOut
  , ruleDots
  ]