{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Phladiprelio.RGLPK.General where
import GHC.Base
import Text.Read
import Data.Maybe
import CaseBi.Arr (getBFstL')
import Data.Foldable (foldl')
import GHC.Arr
import Numeric
import Data.List
import GHC.Num ((+),(-),(*),abs)
import Data.Bits (shiftR)
import Data.Lists.FLines (newLineEnding)
import Data.Foldable.Ix (findIdx1)
import Text.Show (Show(..))
createCoeffsObj :: Int -> [String] -> [Double]
createCoeffsObj :: Int -> [String] -> [Double]
createCoeffsObj Int
l [String]
xss
| forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xss forall a. Ord a => a -> a -> Bool
< Int
l = [String] -> [Double]
f ([String]
xss forall a. Monoid a => a -> a -> a
`mappend` forall a. Int -> a -> [a]
replicate (Int
l forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xss) String
"1.0")
| Bool
otherwise = [String] -> [Double]
f (forall a. Int -> [a] -> [a]
take Int
l [String]
xss)
where f :: [String] -> [Double]
f = forall a b. (a -> b) -> [a] -> [b]
map (\String
ts -> forall a. a -> Maybe a -> a
fromMaybe Double
1.0 (forall a. Read a => String -> Maybe a
readMaybe String
ts::Maybe Double))
countCharInWords :: [String] -> Char -> [Int]
countCharInWords :: [String] -> Char -> [Int]
countCharInWords [String]
xss Char
x
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xss = []
| Bool
otherwise = forall a b. (a -> b) -> [a] -> [b]
map (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. Eq a => a -> a -> Bool
== Char
x)) [String]
xss
matrix1Column :: PairwiseC -> [String] -> String -> Char -> [Int]
matrix1Column :: PairwiseC -> [String] -> String -> Char -> [Int]
matrix1Column PairwiseC
pw [String]
xss String
js Char
x = Char -> PairwiseC -> [Int] -> [Int]
pairwiseComparings Char
x PairwiseC
pw (forall a. Monoid a => [a] -> a
mconcat [[String] -> Char -> [Int]
countCharInWords [String]
xss Char
x, [Int]
rs, [Int]
rs])
where l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
js
iX :: Int
iX = forall a. a -> Maybe a -> a
fromMaybe (-Int
l forall a. Num a => a -> a -> a
- Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (t :: * -> *) b.
(Eq a, Foldable t, Integral b) =>
a -> t a -> Maybe b
findIdx1 Char
x forall a b. (a -> b) -> a -> b
$ String
js
rs :: [Int]
rs = if Int
iX forall a. Ord a => a -> a -> Bool
< Int
0 then [] else forall a. Monoid a => [a] -> a
mconcat [forall a. Int -> a -> [a]
replicate Int
iX Int
0, [Int
1], forall a. Int -> a -> [a]
replicate (Int
l forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- Int
iX) Int
0]
pairwiseComparings :: Char -> PairwiseC -> [Int] -> [Int]
pairwiseComparings :: Char -> PairwiseC -> [Int] -> [Int]
pairwiseComparings Char
x PairwiseC
y [Int]
zs = [Int]
zs forall a. Monoid a => a -> a -> a
`mappend` PairwiseC -> Char -> [Int]
pairs' PairwiseC
y Char
x
data PairwisePL = PW Char Int [Int] deriving (PairwisePL -> PairwisePL -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PairwisePL -> PairwisePL -> Bool
$c/= :: PairwisePL -> PairwisePL -> Bool
== :: PairwisePL -> PairwisePL -> Bool
$c== :: PairwisePL -> PairwisePL -> Bool
Eq, ReadPrec [PairwisePL]
ReadPrec PairwisePL
Int -> ReadS PairwisePL
ReadS [PairwisePL]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PairwisePL]
$creadListPrec :: ReadPrec [PairwisePL]
readPrec :: ReadPrec PairwisePL
$creadPrec :: ReadPrec PairwisePL
readList :: ReadS [PairwisePL]
$creadList :: ReadS [PairwisePL]
readsPrec :: Int -> ReadS PairwisePL
$creadsPrec :: Int -> ReadS PairwisePL
Read, Int -> PairwisePL -> ShowS
[PairwisePL] -> ShowS
PairwisePL -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PairwisePL] -> ShowS
$cshowList :: [PairwisePL] -> ShowS
show :: PairwisePL -> String
$cshow :: PairwisePL -> String
showsPrec :: Int -> PairwisePL -> ShowS
$cshowsPrec :: Int -> PairwisePL -> ShowS
Show)
lengthPW :: PairwisePL -> Int
lengthPW :: PairwisePL -> Int
lengthPW (PW Char
_ Int
l [Int]
_) = Int
l
charPW :: PairwisePL -> Char
charPW :: PairwisePL -> Char
charPW (PW Char
c Int
_ [Int]
_) = Char
c
listPW :: PairwisePL -> [Int]
listPW :: PairwisePL -> [Int]
listPW (PW Char
_ Int
_ [Int]
xs) = [Int]
xs
data PairwiseC = LL [PairwisePL] Int deriving (PairwiseC -> PairwiseC -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PairwiseC -> PairwiseC -> Bool
$c/= :: PairwiseC -> PairwiseC -> Bool
== :: PairwiseC -> PairwiseC -> Bool
$c== :: PairwiseC -> PairwiseC -> Bool
Eq, ReadPrec [PairwiseC]
ReadPrec PairwiseC
Int -> ReadS PairwiseC
ReadS [PairwiseC]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PairwiseC]
$creadListPrec :: ReadPrec [PairwiseC]
readPrec :: ReadPrec PairwiseC
$creadPrec :: ReadPrec PairwiseC
readList :: ReadS [PairwiseC]
$creadList :: ReadS [PairwiseC]
readsPrec :: Int -> ReadS PairwiseC
$creadsPrec :: Int -> ReadS PairwiseC
Read, Int -> PairwiseC -> ShowS
[PairwiseC] -> ShowS
PairwiseC -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PairwiseC] -> ShowS
$cshowList :: [PairwiseC] -> ShowS
show :: PairwiseC -> String
$cshow :: PairwiseC -> String
showsPrec :: Int -> PairwiseC -> ShowS
$cshowsPrec :: Int -> PairwiseC -> ShowS
Show)
isCorrectPWC :: PairwiseC -> Bool
isCorrectPWC :: PairwiseC -> Bool
isCorrectPWC (LL [PairwisePL]
xs Int
n) = Int
n forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (forall a b. (a -> b) -> [a] -> [b]
map PairwisePL -> Int
lengthPW [PairwisePL]
xs)
pwsC :: PairwiseC -> [PairwisePL]
pwsC :: PairwiseC -> [PairwisePL]
pwsC (LL [PairwisePL]
xs Int
n) = forall a b. (a -> b) -> [a] -> [b]
map (\(PW Char
c Int
m [Int]
ys) -> Char -> Int -> [Int] -> PairwisePL
PW Char
c Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
n forall a b. (a -> b) -> a -> b
$ [Int]
ys) [PairwisePL]
xs
pairs' :: PairwiseC -> Char -> [Int]
pairs' :: PairwiseC -> Char -> [Int]
pairs' y :: PairwiseC
y@(LL [PairwisePL]
xs Int
n) Char
x
| PairwiseC -> Bool
isCorrectPWC PairwiseC
y = let z :: Maybe PairwisePL
z = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== Char
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PairwisePL -> Char
charPW) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PairwiseC -> [PairwisePL]
pwsC forall a b. (a -> b) -> a -> b
$ PairwiseC
y in
if forall a. Maybe a -> Bool
isJust Maybe PairwisePL
z then PairwisePL -> [Int]
listPW forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe PairwisePL
z
else forall a. Int -> a -> [a]
replicate Int
n Int
0
| Bool
otherwise = forall a. HasCallStack => String -> a
error String
"Phladiprelio.RGLPK.General.pairs': Not defined for the arguments. "
matrixLine
:: Int
-> PairwiseC
-> [String]
-> String
-> String
matrixLine :: Int -> PairwiseC -> [String] -> ShowS
matrixLine Int
nn PairwiseC
pw [String]
bss String
js
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
bss Bool -> Bool -> Bool
|| Int
n forall a. Ord a => a -> a -> Bool
<=Int
0 = []
| Bool
otherwise = forall a. Monoid a => [a] -> a
mconcat [String
"mat1 <- matrix(c(", forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(PairwiseC -> [String] -> String -> Char -> [Int]
matrix1Column PairwiseC
pw ([String]
bss forall a. Monoid a => a -> a -> a
`mappend` [String]
bss) String
js) forall a b. (a -> b) -> a -> b
$ String
js, String
"), nrow = ", forall a. Show a => a -> String
show (Int
2 forall a. Num a => a -> a -> a
* Int
n forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. Foldable t => t a -> Int
length String
js forall a. Num a => a -> a -> a
+ Int
nn), String
")", String
newLineEnding]
where n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
bss
objLine
:: Int
-> [(Int,Int)]
-> Array Int Double
-> String
objLine :: Int -> [(Int, Int)] -> Array Int Double -> String
objLine Int
lng [(Int, Int)]
xs Array Int Double
arr
| forall i e. Array i e -> Int
numElements Array Int Double
arr forall a. Ord a => a -> a -> Bool
>= Int
lng = forall a. Monoid a => [a] -> a
mconcat [String
"obj1 <- c(", forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Double
t -> forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat forall a. Maybe a
Nothing Double
t String
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Int, Int)] -> Array Int Double -> [Double]
objCoeffsNew Int
lng [(Int, Int)]
xs forall a b. (a -> b) -> a -> b
$ Array Int Double
arr,
String
")", String
newLineEnding]
| Bool
otherwise = forall a. HasCallStack => String -> a
error String
"Phladiprelio.RGLPK.General.objLine: Not defined for the short argument. "
objCoeffsNew
:: Int
-> [(Int, Int)]
-> Array Int Double
-> [Double]
objCoeffsNew :: Int -> [(Int, Int)] -> Array Int Double -> [Double]
objCoeffsNew Int
lng [(Int, Int)]
xs Array Int Double
arr = let lst :: [(Int, Double)]
lst = forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x,Int
y) -> (Int
x,forall i e. Array i e -> Int -> e
unsafeAt Array Int Double
arr Int
y)) [(Int, Int)]
xs in forall a b. (a -> b) -> [a] -> [b]
map (forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' Double
1.0 [(Int, Double)]
lst) [Int
0..Int
lng forall a. Num a => a -> a -> a
- Int
1]
maxLine :: String
maxLine :: String
maxLine = String
"max1 <- TRUE\n"
dirLine
:: Int
-> Int
-> [String]
-> String
-> String
dirLine :: Int -> Int -> [String] -> ShowS
dirLine Int
lng Int
nn [String]
bss String
js = forall a. Monoid a => [a] -> a
mconcat [String
"dir1 <- c(\"<", forall {t :: * -> *} {a}. Foldable t => String -> t a -> String
g String
"<" [String]
bss, String
"\", \">", forall {t :: * -> *} {a}. Foldable t => String -> t a -> String
g String
">" ([String]
bss, forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
:[]) String
js), String
"\"", Int -> String
h0 Int
lng,
Int -> String
h (forall a. Bits a => a -> Int -> a
shiftR Int
nn Int
1), String
")", String
newLineEnding]
where g :: String -> t a -> String
g String
xs t a
ys = (forall a. [a] -> [[a]] -> [a]
intercalate (String
"\", \"" forall a. Monoid a => a -> a -> a
`mappend` String
xs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
ys) forall a b. (a -> b) -> a -> b
$ String
"=")
h :: Int -> String
h Int
n = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> [a]
replicate Int
n forall a b. (a -> b) -> a -> b
$ String
", \">=\", \"<=\""
h0 :: Int -> String
h0 Int
n = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> [a]
replicate Int
n forall a b. (a -> b) -> a -> b
$ String
", \"<=\""
rhsLineG :: [Double] -> [Double] -> [Double] -> String
rhsLineG :: [Double] -> [Double] -> [Double] -> String
rhsLineG [Double]
zs [Double]
xs [Double]
ys = forall a. Monoid a => [a] -> a
mconcat [String
"rhs1 <- c(" , forall {a}. RealFloat a => [a] -> String
f (forall a. Monoid a => [a] -> a
mconcat [[Double]
xs , [Double]
ys , [Double]
zs]) , String
")", String
newLineEnding]
where f :: [a] -> String
f [a]
ts = (forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\a
t -> forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat forall a. Maybe a
Nothing a
t String
"") forall a b. (a -> b) -> a -> b
$ [a]
ts)
rhsLine
:: Int
-> Int
-> Double
-> Double
-> Double
-> Double
-> [Int]
-> [Int]
-> [Double]
-> [Double]
-> String
rhsLine :: Int
-> Int
-> Double
-> Double
-> Double
-> Double
-> [Int]
-> [Int]
-> [Double]
-> [Double]
-> String
rhsLine Int
lng Int
nn Double
mx Double
mn1 Double
mnSpecial Double
mnG [Int]
xs1 [Int]
sps1 = [Double] -> [Double] -> [Double] -> String
rhsLineG forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ [Int -> Double -> Double -> Double -> [Int] -> [Int] -> [Double]
minDurations Int
lng Double
mn1 Double
mnSpecial Double
mnG [Int]
xs1 [Int]
sps1, Int -> Double -> [Double]
maxDurations Int
lng Double
mx, Int -> [Double]
constraintsR1 (forall a. Bits a => a -> Int -> a
shiftR Int
nn Int
1)]
constraintsR1 :: Int -> [Double]
constraintsR1 :: Int -> [Double]
constraintsR1 Int
n = forall a. Int -> a -> [a]
replicate (Int
2 forall a. Num a => a -> a -> a
* Int
n) Double
0.0
minDurations
:: Int
-> Double
-> Double
-> Double
-> [Int]
-> [Int]
-> [Double]
minDurations :: Int -> Double -> Double -> Double -> [Int] -> [Int] -> [Double]
minDurations Int
lng Double
mn1 Double
mnSpecial Double
mnG [Int]
xs1 [Int]
sps1 = forall a b. (a -> b) -> [a] -> [b]
map Int -> Double
h [Int
0..Int
lng forall a. Num a => a -> a -> a
- Int
1]
where xs2 :: [Int]
xs2
| forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
xs1 forall a. Ord a => a -> a -> Bool
<= Int
lng forall a. Num a => a -> a -> a
- Int
1 = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
>= Int
0) [Int]
xs1
| Bool
otherwise = forall a. HasCallStack => String -> a
error String
"Phladiprelio.RGLPK.General.objLine: Not defined for these arguments. "
sps2 :: [Int]
sps2
| forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
sps1 forall a. Ord a => a -> a -> Bool
<= Int
lng forall a. Num a => a -> a -> a
- Int
1 = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
>= Int
0) [Int]
sps1 forall a. Eq a => [a] -> [a] -> [a]
\\ [Int]
xs2
| Bool
otherwise = forall a. HasCallStack => String -> a
error String
"Phladiprelio.RGLPK.General.objLine: Not defined for these arguments. "
h :: Int -> Double
h Int
i
| Int
i forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
xs2 = Double
mn1
| Int
i forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
sps2 = Double
mnSpecial
| Bool
otherwise = Double
mnG
maxDurations
:: Int
-> Double
-> [Double]
maxDurations :: Int -> Double -> [Double]
maxDurations Int
lng Double
mx = forall a. Int -> a -> [a]
replicate Int
lng Double
mx
answer
:: Int
-> Int
-> PairwiseC
-> Double
-> [(Int, Int)]
-> Double
-> Double
-> Double
-> [Int]
-> [Int]
-> Array Int Double
-> [String]
-> [Double]
-> [Double]
-> String
-> String
answer :: Int
-> Int
-> PairwiseC
-> Double
-> [(Int, Int)]
-> Double
-> Double
-> Double
-> [Int]
-> [Int]
-> Array Int Double
-> [String]
-> [Double]
-> [Double]
-> ShowS
answer Int
lng Int
nn PairwiseC
pw Double
mx [(Int, Int)]
ts = Int
-> Int
-> PairwiseC
-> Double
-> [(Int, Int)]
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> [Int]
-> [Int]
-> Array Int Double
-> [String]
-> [Double]
-> [Double]
-> ShowS
answer2 Int
lng Int
nn PairwiseC
pw Double
mx [(Int, Int)]
ts (-Double
0.003) Double
0.003 (-Double
0.0012) Double
0.0012
answer2
:: Int
-> Int
-> PairwiseC
-> Double
-> [(Int, Int)]
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> [Int]
-> [Int]
-> Array Int Double
-> [String]
-> [Double]
-> [Double]
-> String
-> String
answer2 :: Int
-> Int
-> PairwiseC
-> Double
-> [(Int, Int)]
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> [Int]
-> [Int]
-> Array Int Double
-> [String]
-> [Double]
-> [Double]
-> ShowS
answer2 Int
lng Int
nn PairwiseC
pw Double
mx [(Int, Int)]
ts Double
min1 Double
max1 Double
min2 Double
max2 Double
mn1 Double
mnSpecial Double
mnG [Int]
xs1 [Int]
sps1 Array Int Double
lsts [String]
bss [Double]
xs [Double]
ys String
js = forall a. Monoid a => [a] -> a
mconcat [String
"library(\"Rglpk\")",String
newLineEnding,Int -> [(Int, Int)] -> Array Int Double -> String
objLine Int
lng [(Int, Int)]
ts Array Int Double
lsts,
Int -> PairwiseC -> [String] -> ShowS
matrixLine Int
nn PairwiseC
pw [String]
bss String
js,Int -> Int -> [String] -> ShowS
dirLine Int
lng Int
nn [String]
bss String
js, Int
-> Int
-> Double
-> Double
-> Double
-> Double
-> [Int]
-> [Int]
-> [Double]
-> [Double]
-> String
rhsLine Int
lng Int
nn Double
mx Double
mn1 Double
mnSpecial Double
mnG [Int]
xs1 [Int]
sps1 [Double]
xs [Double]
ys,String
maxLine,String
newLineEnding,
String
"k <- Rglpk_solve_LP(obj = obj1, mat = mat1, dir = dir1, rhs = rhs1, max = max1)",String
newLineEnding, String
"y <- runif(",forall a. Show a => a -> String
show Int
lng,
String
", min = ", forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat forall a. Maybe a
Nothing (-(forall a. Num a => a -> a
abs Double
min1)) String
", max = ", forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat forall a. Maybe a
Nothing (forall a. Num a => a -> a
abs Double
max1) String
")", String
newLineEnding,
String
"if (k$status == 0){k$solution / mean(k$solution)} else {c()}", String
newLineEnding, String
"\")}"]