RandomText.purs 3.9 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
{-|
Module      : RandomText
Description : Contextual randomized text
Copyright   : (c) CNRS / Alexandre Delanoe, 2017-present
License     : AGPL + CECILL v3
Maintainer  : alexandre.delanoe@iscpif.fr
Stability   : experimental
Portability : POSIX

How semantic emerge from contextualized randomness can be experimented
with these simple functions;

randomSentences: randomizes sentences in a paragraph.
randomWords    : randomizes words     in a sentence.
randomChars    : randomizes chars     in a word.

TODO: add some tests as examples.
-}

20
module Gargantext.Components.RandomText where
21 22 23

import Prelude

24
import Data.Array (drop, dropEnd, filter, foldl, head, length, tail, take, takeEnd, (!!))
25
import Data.Maybe (Maybe(Nothing, Just), fromJust)
Sudhir Kumar's avatar
Sudhir Kumar committed
26 27 28 29
import Data.String (Pattern(..), split)
import Data.String.CodeUnits (fromCharArray, toCharArray)
import Effect (Effect)
import Effect.Random (randomInt)
30 31
import Partial (crash)
import Partial.Unsafe (unsafePartial)
32

33 34

-------------------------------------------------------------------
35
randomSentences :: String -> Effect String
36 37 38 39 40
randomSentences ss = case (length (sentences ss)) >= 5 of
                    true -> foldl (\a b -> a <> "." <> b) "" <$> randomPart (sentences ss)
                    _    -> pure ss


41
randomWords :: String -> Effect String
42 43 44 45
randomWords ws = case (length (words ws)) >= 5 of
                    true -> foldl (\a b -> a <> " " <> b) "" <$> randomPart (words ws)
                    _    -> pure ws

46
randomChars :: String -> Effect String
47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64
randomChars word = case (length (toCharArray word)) >= 5 of
                    true -> fromCharArray <$> randomPart (toCharArray word)
                    _    -> pure word

-------------------------------------------------------------------
words :: String -> Array String
words sentence = filter ((/=) "") $ split (Pattern " ") sentence

sentences :: String -> Array String
sentences paragraph = filter ((/=) "") $ split (Pattern ".") paragraph
-------------------------------------------------------------------


data RandomWheel a = RandomWheel { before :: Array a
                                 , during :: a
                                 , after  :: Array a
                                 }

Sudhir Kumar's avatar
Sudhir Kumar committed
65
randomPart :: forall b. Array b -> Effect (Array b)
66 67 68 69 70 71 72
randomPart array = randomArrayPoly middle >>= \(middle') -> pure ( start <> middle' <> end)
        where
            start   = take    2          array
            middle  = dropEnd 2 $ drop 2 array
            end     = takeEnd 2          array


Sudhir Kumar's avatar
Sudhir Kumar committed
73
randomArrayPoly :: forall a. Array a -> Effect (Array a)
74 75
randomArrayPoly wheel = case head wheel of
                         Nothing -> pure []
76
                         Just wheel' -> randomWheel (RandomWheel { before:wheel, during:wheel', after:[]})
77 78
                                     >>= \(RandomWheel rand) -> (pure rand.after)

Sudhir Kumar's avatar
Sudhir Kumar committed
79
randomWheel :: forall b. RandomWheel b -> Effect (RandomWheel b)
80
randomWheel (RandomWheel {before:[], during:d, after:a}) =
81 82 83 84 85 86 87
    pure   (RandomWheel {before:[], during:d, after:a})

randomWheel (RandomWheel {before:b, during:d, after:a}) = do
    RandomWheel {before:b', during:d', after:a'} <- randomArray b
    randomWheel $ RandomWheel {before:b', during:d', after:(a <> [d'])}


Sudhir Kumar's avatar
Sudhir Kumar committed
88
randomArray :: forall b. Array b -> Effect (RandomWheel b)
89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110
randomArray array = unsafePartial $ do
    n    <- randomInt 0 (length array - 1)

    let maybeDuring = (array !! n)

    case maybeDuring of
         Nothing    ->
            crash "[ERROR] It should never happen."
         Just during  ->
            pure $ RandomWheel { before : remove n array
                               , during : during
                               , after  : []
                               }


remove :: forall a. Int -> Array a -> Array a
remove n [] = []
remove n xs = unsafePartial $ case n of
                   0 -> fromJust $ tail xs
                   _ -> (take n xs) <> (drop (n+1) xs)

-------------------------------------------------------------------