-- |
-- Module      :  Distribution.Processment
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Analyzes a poetic text in Ukrainian, for every line prints statistic data and
-- then for the whole poem prints the hypothesis evaluation information.
-- Is used in pair with some other programs, e. g. with propertiesTextG3 from phonetic-languages-simplified-examples-array package
-- or with a new phonetic-languages-ukrainian series.
-- The module contains library functions for the program.
-- The program tries to be more accurate in cases of the lines consisting entirely of the words
-- which are unique in phonetic meaning alongside the line. Another hypothesis is for the seventh command line
-- argument equal to \"y0\" that the distribution
-- of the placement of the actual poetic text in Ukrainian is not one of the standard distributions.
-- It can probably have approximately a form of and is different for different authors:
--
-- >    --   --   --
-- >   /  \_/  \_/  \
--
-- To enable parallel computations (potentially, they can speed up the work), please, run the @distributionText@ executable with
-- @+RTS -threaded -RTS@ command line options with possibly @-N@ option inside.
--

{-# OPTIONS_GHC -threaded -rtsopts #-}

{-# LANGUAGE CPP, BangPatterns #-}

module Distribution.Processment where

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
import GHC.Base (mconcat)
#endif
#endif
import Control.Parallel.Strategies
import Data.Maybe (fromMaybe,mapMaybe)
import Text.Read (readMaybe)
import Numeric (showFFloat)
import Data.List (sort)
import Numeric.Stats
import qualified Data.ByteString.Char8 as B
import Data.Lists.FLines hiding (mconcat)
import Data.Statistics.RulesIntervals
import Data.Statistics.RulesIntervalsPlus
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__==708
/* code that applies only to GHC 7.8.* */
mconcat = concat
#endif
#endif

innerProc :: Bool -> Bool -> String -> String -> B.ByteString -> IO ()
innerProc :: Bool -> Bool -> String -> String -> ByteString -> IO ()
innerProc Bool
pairwisePermutations Bool
whitelines String
gzS String
printInput ByteString
contents = do
  if String
printInput String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"1" then ByteString -> IO ()
B.putStr ByteString
contents else ByteString -> IO ()
B.putStr ByteString
B.empty
  (![Double]
data31,![(Int, Int)]
wordsCnt0_data32) <- Bool -> ByteString -> IO ([Double], [(Int, Int)])
processContents Bool
whitelines ByteString
contents
  let !gz :: Int
gz = String -> [Double] -> Int
forall a. String -> [a] -> Int
getIntervalsN String
gzS [Double]
data31 -- Obtained from the first command line argument except those ones that are for RTS
      !pair2s :: [(Double, (Int, Int))]
pair2s = [Double] -> [(Int, Int)] -> [(Double, (Int, Int))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
data31 [(Int, Int)]
wordsCnt0_data32
      !data4 :: [Double]
data4 = ((Double, (Int, Int)) -> Maybe Double)
-> [(Double, (Int, Int))] -> [Double]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(!Double
x,(!Int
y,Int
_)) -> if Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then Double -> Maybe Double
forall a. a -> Maybe a
Just Double
x else Maybe Double
forall a. Maybe a
Nothing) [(Double, (Int, Int))]
pair2s
  if [Double] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
data4 then String -> IO ()
putStrLn (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
102 Char
'-') IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn String
"1.000+-0.000\tALL!" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
102 Char
'=') -- Well, this means that all the text consists of the lines that have no variativity from the program perspective and, therefore, they cannot be analyzed effectively by it. Nevertheless, you can accurately exclude them from the consideration. A rather rare occurrence.
  else do
      let (!Double
mean1,!Double
disp) = [Double] -> (Double, Double)
meanWithDispD2 [Double]
data4
          !pairs :: [(Int, Int)]
pairs = [(Int, Int)] -> [(Int, Int)]
forall a. Ord a => [a] -> [a]
sort ([(Int, Int)] -> [(Int, Int)])
-> ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Int -> Bool) -> ((Int, Int) -> Int) -> (Int, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> b
snd) ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ [(Int, Int)]
wordsCnt0_data32
          g :: Int -> Int -> Int
g !Int
m !Int
n = ([(Int, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Int, Int)] -> Int)
-> ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(Int
_,Int
v) -> Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n) ([(Int, Int)] -> [(Int, Int)])
-> ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\(Int
_,Int
v) -> Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n) ([(Int, Int)] -> [(Int, Int)])
-> ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(Int
u,Int
_) -> Int
u Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
m) ([(Int, Int)] -> [(Int, Int)])
-> ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\(Int
u,Int
_) -> Int
u Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
m) ([(Int, Int)] -> Int) -> [(Int, Int)] -> Int
forall a b. (a -> b) -> a -> b
$ [(Int, Int)]
pairs) Int -> Strategy Int -> Int
forall a. a -> Strategy a -> a
`using` Strategy Int
forall a. NFData a => Strategy a
rdeepseq
          h :: Bool -> Char -> String
h !Bool
y !Char
x = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [[String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> ([Int] -> [String]) -> [Int] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
m1 -> [String] -> String
forall a. Monoid a => [a] -> a
mconcat [[String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> ([Int] -> [String]) -> [Int] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
n1 ->  (if Bool
y then Int -> String
forall a. Show a => a -> String
show (Int -> Int -> Int
g Int
m1 Int
n1)
              else if Int -> Int -> Int
g Int
m1 Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then String
"." else Int -> String
forall a. Show a => a -> String
show (Int -> Int -> Int
g Int
m1 Int
n1)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\t") ([Int] -> String) -> [Int] -> String
forall a b. (a -> b) -> a -> b
$ [Int
1..Int
gz],String
newLineEnding]) ([Int] -> String) -> [Int] -> String
forall a b. (a -> b) -> a -> b
$
                [Int
2..(if Bool
pairwisePermutations then Int
10 else Int
7)],Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
102 Char
x]
      String -> IO ()
putStrLn (String -> IO ()) -> ([Double] -> String) -> [Double] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> Int -> [(Int, Int)] -> (Double, Double) -> [Double] -> String
generalInfo1 Bool
pairwisePermutations Int
gz [(Int, Int)]
pairs (Double
mean1, Double
disp) ([Double] -> IO ()) -> [Double] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Double]
data31
      String -> IO ()
putStrLn (Bool -> Char -> String
h Bool
False Char
'~')
      String -> IO ()
putStrLn (Bool -> Char -> String
h Bool
True Char
'=')

processContents :: Bool -> B.ByteString -> IO ([Double],[(Int,Int)])
processContents :: Bool -> ByteString -> IO ([Double], [(Int, Int)])
processContents Bool
whitelines ByteString
contents = do
    let !anlines :: [ByteString]
anlines = ByteString -> [ByteString]
B.lines ByteString
contents
        !anStrs :: [[ByteString]]
anStrs
          | Bool
whitelines = ([ByteString] -> Bool) -> [[ByteString]] -> [[ByteString]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([ByteString] -> Bool) -> [ByteString] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[ByteString]] -> [[ByteString]])
-> ([ByteString] -> [[ByteString]])
-> [ByteString]
-> [[ByteString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString]) -> [ByteString] -> [[ByteString]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop Int
6 ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take Int
9 ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.words) ([ByteString] -> [[ByteString]]) -> [ByteString] -> [[ByteString]]
forall a b. (a -> b) -> a -> b
$ [ByteString]
anlines
          | Bool
otherwise = (ByteString -> [ByteString]) -> [ByteString] -> [[ByteString]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop Int
6 ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take Int
9 ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.words) [ByteString]
anlines
        !ratioStrs :: [String]
ratioStrs = ([ByteString] -> String) -> [[ByteString]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> String
B.unpack (ByteString -> String)
-> ([ByteString] -> ByteString) -> [ByteString] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. [a] -> a
head) [[ByteString]]
anStrs
        !wordsNStrs :: [String]
wordsNStrs = ([ByteString] -> String) -> [[ByteString]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> String
B.unpack (ByteString -> String)
-> ([ByteString] -> ByteString) -> [ByteString] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!! Int
1)) [[ByteString]]
anStrs
        !intervalNStrs :: [String]
intervalNStrs = ([ByteString] -> String) -> [[ByteString]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> String
B.unpack (ByteString -> String)
-> ([ByteString] -> ByteString) -> [ByteString] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. [a] -> a
last) [[ByteString]]
anStrs
        !ratios :: [Double]
ratios = (String -> Double) -> [String] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\String
xs -> Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 (String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe String
xs::Maybe Double)) [String]
ratioStrs
        !wordsNs :: [Int]
wordsNs = (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\String
xs -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
xs::Maybe Int)) [String]
wordsNStrs
        !intervalNs :: [Int]
intervalNs = (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\String
xs -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
xs::Maybe Int)) [String]
intervalNStrs
    ([Double], [(Int, Int)]) -> IO ([Double], [(Int, Int)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Double]
ratios,[Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
wordsNs [Int]
intervalNs)

generalInfo1 :: Bool -> Int -> [(Int,Int)] -> (Double,Double) -> [Double] -> String
generalInfo1 :: Bool
-> Int -> [(Int, Int)] -> (Double, Double) -> [Double] -> String
generalInfo1 Bool
pairwisePermutations Int
gz [(Int, Int)]
pairs (Double
mean1, Double
disp) [Double]
data31 =
 let !ks :: [Int]
ks = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
r -> [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> Int) -> ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r) ([Int] -> [Int])
-> ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
r) ([Int] -> [Int])
-> ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int])
-> ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd ([(Int, Int)] -> Int) -> [(Int, Int)] -> Int
forall a b. (a -> b) -> a -> b
$ [(Int, Int)]
pairs) [Int
1..Int
gz]
     !s :: Int
s = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
ks in
       [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
102 Char
'-', String
newLineEnding, [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> ([Int] -> [String]) -> [Int] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
r -> Int -> String
forall a. Show a => a -> String
show Int
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\t") ([Int] -> String) -> [Int] -> String
forall a b. (a -> b) -> a -> b
$ [Int
1..Int
gz], String
newLineEnding,
        [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> ([Int] -> [String]) -> [Int] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
r ->  Int -> String
forall a. Show a => a -> String
show Int
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\t") ([Int] -> String) -> [Int] -> String
forall a b. (a -> b) -> a -> b
$ [Int]
ks,
         String
newLineEnding, [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> ([Int] -> [String]) -> [Int] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
r -> Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)  String
"%\t") ([Int] -> String) -> [Int] -> String
forall a b. (a -> b) -> a -> b
$ [Int]
ks,
          String
newLineEnding, [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) Double
mean1 String
"+-", Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) (Double -> Double
forall a. Floating a => a -> a
sqrt Double
disp) String
"\t",
           Int -> String
forall a. Show a => a -> String
show ([(Int, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Int, Int)] -> Int)
-> ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1) (Int -> Bool) -> ((Int, Int) -> Int) -> (Int, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> a
fst) ([(Int, Int)] -> Int) -> [(Int, Int)] -> Int
forall a b. (a -> b) -> a -> b
$ [(Int, Int)]
pairs), Char
'\t'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
forall a. Show a => a -> String
show ([Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
data31)], String
newLineEnding,
            [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String)
-> ([Integer] -> [String]) -> [Integer] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
r -> Integer -> String
forall a. Show a => a -> String
show Integer
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\t") ([Integer] -> String) -> [Integer] -> String
forall a b. (a -> b) -> a -> b
$ [Integer
2..(if Bool
pairwisePermutations then Integer
10 else Integer
7)], String
newLineEnding, [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> ([Int] -> [String]) -> [Int] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
r ->  (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> ([(Int, Int)] -> Int) -> [(Int, Int)] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> Int) -> ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r) ([Int] -> [Int])
-> ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
r) ([Int] -> [Int])
-> ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst ([(Int, Int)] -> String) -> [(Int, Int)] -> String
forall a b. (a -> b) -> a -> b
$ [(Int, Int)]
pairs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\t") ([Int] -> String) -> [Int] -> String
forall a b. (a -> b) -> a -> b
$
                [Int
2..(if Bool
pairwisePermutations then Int
10 else Int
7)], String
newLineEnding, Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
102 Char
'*']
{-# INLINE generalInfo1 #-}