-- |
-- Module      :  Phladiprelio.Distribution
-- Copyright   :  (c) Oleksandr Zhabenko 2020-2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@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.
-- 
--
-- 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 BangPatterns, NoImplicitPrelude #-}

module Phladiprelio.Distribution where

import GHC.Base
import GHC.Real
import GHC.Float
import Data.Tuple
import System.IO
import GHC.Num ((+),subtract,(*)) 
import Control.Parallel.Strategies
import Data.Maybe (fromMaybe,isJust,fromJust)
import Text.Read (readMaybe)
import Numeric (showFFloat)
import Data.List
import Numeric.Stats
import Data.Char (isDigit)
import Data.Lists.FLines hiding (mconcat)
import Phladiprelio.RulesIntervals
import Phladiprelio.RulesIntervalsPlus
import Text.Show (Show(..),show)

-- | Sum data type to control whether the functions work with multiple properties or with just one.
data ControlStatsIntervals = U ([Double],[(Int,Int)]) | M [(Int,Int)] deriving (ControlStatsIntervals -> ControlStatsIntervals -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControlStatsIntervals -> ControlStatsIntervals -> Bool
$c/= :: ControlStatsIntervals -> ControlStatsIntervals -> Bool
== :: ControlStatsIntervals -> ControlStatsIntervals -> Bool
$c== :: ControlStatsIntervals -> ControlStatsIntervals -> Bool
Eq,Int -> ControlStatsIntervals -> ShowS
[ControlStatsIntervals] -> ShowS
ControlStatsIntervals -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControlStatsIntervals] -> ShowS
$cshowList :: [ControlStatsIntervals] -> ShowS
show :: ControlStatsIntervals -> String
$cshow :: ControlStatsIntervals -> String
showsPrec :: Int -> ControlStatsIntervals -> ShowS
$cshowsPrec :: Int -> ControlStatsIntervals -> ShowS
Show)

isU :: ControlStatsIntervals -> Bool
isU :: ControlStatsIntervals -> Bool
isU (U ([Double], [(Int, Int)])
_) = Bool
True
isU ControlStatsIntervals
_ = Bool
False

isM :: ControlStatsIntervals -> Bool
isM :: ControlStatsIntervals -> Bool
isM (M [(Int, Int)]
_) = Bool
True
isM ControlStatsIntervals
_ = Bool
False

data31F :: ControlStatsIntervals -> Maybe [Double]
data31F (U ([Double]
x,[(Int, Int)]
y)) = forall a. a -> Maybe a
Just [Double]
x
data31F (M [(Int, Int)]
_) = forall a. Maybe a
Nothing

wordsCnt0_data32F :: ControlStatsIntervals -> [(Int, Int)]
wordsCnt0_data32F (U ([Double]
x,[(Int, Int)]
y)) = [(Int, Int)]
y
wordsCnt0_data32F (M [(Int, Int)]
y) = [(Int, Int)]
y

maybeDII :: (Int -> Bool) -> ControlStatsIntervals -> Maybe [(Double,(Int,Int))]
maybeDII :: (Int -> Bool)
-> ControlStatsIntervals -> Maybe [(Double, (Int, Int))]
maybeDII Int -> Bool
p (U ([Double]
xs,[(Int, Int)]
ys)) = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\(Double
_,(Int
y,Int
_)) -> Int -> Bool
p Int
y) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
xs forall a b. (a -> b) -> a -> b
$ [(Int, Int)]
ys
maybeDII Int -> Bool
_ ControlStatsIntervals
_ = forall a. Maybe a
Nothing

numberProps :: String -> Int
numberProps :: String -> Int
numberProps String
contents = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
subtract Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall a b. (a -> b) -> a -> b
$ String
contents
        
innerProcG :: Bool -> Bool -> String -> Bool -> String -> IO ()
innerProcG :: Bool -> Bool -> String -> Bool -> String -> IO ()
innerProcG Bool
pairwisePermutations Bool
whitelines String
gzS Bool
multiprop String
contents 
   | Bool
multiprop  = forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Int
i -> Int -> String -> IO ControlStatsIntervals
processContentsMultiprop Int
i String
contents forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ControlStatsIntervals
csi -> Bool -> Bool -> String -> ControlStatsIntervals -> String -> IO ()
innerProc Bool
pairwisePermutations Bool
whitelines String
gzS ControlStatsIntervals
csi String
contents) [Int
1..String -> Int
numberProps String
contents] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
   | Bool
otherwise = Bool -> String -> IO ControlStatsIntervals
processContents Bool
whitelines String
contents forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ControlStatsIntervals
csi -> Bool -> Bool -> String -> ControlStatsIntervals -> String -> IO ()
innerProc Bool
pairwisePermutations Bool
whitelines String
gzS ControlStatsIntervals
csi String
contents

innerProc :: Bool -> Bool -> String -> ControlStatsIntervals -> String -> IO ()
innerProc :: Bool -> Bool -> String -> ControlStatsIntervals -> String -> IO ()
innerProc Bool
pairwisePermutations Bool
whitelines String
gzS ControlStatsIntervals
csi String
contents = do
  if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((forall a. Ord a => a -> a -> Bool
< Int
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlStatsIntervals -> [(Int, Int)]
wordsCnt0_data32F forall a b. (a -> b) -> a -> b
$ ControlStatsIntervals
csi
    then String -> IO ()
putStrLn (forall a. Int -> a -> [a]
replicate Int
80 Char
'-') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn String
"1.000+-0.000\tALL!" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn (forall a. Int -> a -> [a]
replicate Int
80 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 !gz :: Int
gz
            | ControlStatsIntervals -> Bool
isU ControlStatsIntervals
csi = forall a. String -> [a] -> Int
getIntervalsN String
gzS (forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlStatsIntervals -> Maybe [Double]
data31F forall a b. (a -> b) -> a -> b
$ ControlStatsIntervals
csi) -- Obtained from the first command line argument except those ones that are for RTS
            | Bool
otherwise = forall a. String -> [a] -> Int
getIntervalsN String
gzS forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlStatsIntervals -> [(Int, Int)]
wordsCnt0_data32F forall a b. (a -> b) -> a -> b
$ ControlStatsIntervals
csi
          !mndsp :: Maybe (Double, Double)
mndsp
            | ControlStatsIntervals -> Bool
isU ControlStatsIntervals
csi = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> (Double, Double)
meanWithDispD2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool)
-> ControlStatsIntervals -> Maybe [(Double, (Int, Int))]
maybeDII (forall a. Ord a => a -> a -> Bool
>Int
1) forall a b. (a -> b) -> a -> b
$ ControlStatsIntervals
csi -- Since the 0.6.0.0 version switched to the sample unbiased dispersion with (n - 1) in the denominator.
            | Bool
otherwise = forall a. Maybe a
Nothing
          !pairs :: [(Int, Int)]
pairs = forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlStatsIntervals -> [(Int, Int)]
wordsCnt0_data32F forall a b. (a -> b) -> a -> b
$ ControlStatsIntervals
csi
          g :: Int -> Int -> Int
g !Int
m !Int
n = (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(Int
_,Int
v) -> Int
v forall a. Eq a => a -> a -> Bool
== Int
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\(Int
_,Int
v) -> Int
v forall a. Eq a => a -> a -> Bool
/= Int
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(Int
u,Int
_) -> Int
u forall a. Eq a => a -> a -> Bool
== Int
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\(Int
u,Int
_) -> Int
u forall a. Eq a => a -> a -> Bool
/= Int
m) forall a b. (a -> b) -> a -> b
$ [(Int, Int)]
pairs) forall a. a -> Strategy a -> a
`using` forall a. NFData a => Strategy a
rdeepseq
          h :: Bool -> Char -> String
h !Bool
y !Char
x = forall a. Monoid a => [a] -> a
mconcat [forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Int
m1 -> forall a. Monoid a => [a] -> a
mconcat [forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Int
n1 ->  (if Bool
y then 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 forall a. Eq a => a -> a -> Bool
== Int
0 then String
"." else forall a. Show a => a -> String
show (Int -> Int -> Int
g Int
m1 Int
n1)) forall a. [a] -> [a] -> [a]
++ String
"\t") forall a b. (a -> b) -> a -> b
$ [Int
1..Int
gz],String
newLineEnding]) forall a b. (a -> b) -> a -> b
$
                [Int
2..(if Bool
pairwisePermutations then Int
10 else Int
7)],forall a. Int -> a -> [a]
replicate Int
80 Char
x]
      String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> Int -> [(Int, Int)] -> Maybe (Double, Double) -> Int -> String
generalInfo1 Bool
pairwisePermutations Int
gz [(Int, Int)]
pairs Maybe (Double, Double)
mndsp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlStatsIntervals -> [(Int, Int)]
wordsCnt0_data32F forall a b. (a -> b) -> a -> b
$ ControlStatsIntervals
csi
      String -> IO ()
putStrLn (Bool -> Char -> String
h Bool
False Char
'~')
      String -> IO ()
putStrLn (Bool -> Char -> String
h Bool
True Char
'=')

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

processContentsMultiprop :: Int -> String -> IO ControlStatsIntervals
processContentsMultiprop :: Int -> String -> IO ControlStatsIntervals
processContentsMultiprop Int
propN String
contents = do
    let !anwords :: [[String]]
anwords = forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
words forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall a b. (a -> b) -> a -> b
$ String
contents
        !wordsNStrs :: [String]
wordsNStrs = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
head [[String]]
anwords
        !intervalNStrs :: [String]
intervalNStrs = forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
propN forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take (Int
propN forall a. Num a => a -> a -> a
+ Int
1)) [[String]]
anwords
        !wordsNs :: [Int]
wordsNs = forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
> Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\String
xs -> forall a. a -> Maybe a -> a
fromMaybe Int
0 (forall a. Read a => String -> Maybe a
readMaybe String
xs::Maybe Int)) forall a b. (a -> b) -> a -> b
$ [String]
wordsNStrs
        !intervalNs :: [Int]
intervalNs = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
> Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\String
xs -> forall a. a -> Maybe a -> a
fromMaybe Int
0 (forall a. Read a => String -> Maybe a
readMaybe String
xs::Maybe Int)) forall a b. (a -> b) -> a -> b
$ [String]
intervalNStrs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> ControlStatsIntervals
M forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
wordsNs forall a b. (a -> b) -> a -> b
$ [Int]
intervalNs

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