Functional coverage tree: Difference between revisions
Content added Content deleted
(→Python: Functional: Comments and space for legibility) |
(→{{header|Haskell}}: Added a Haskell draft.) |
||
Line 342: | Line 342: | ||
the top level coverage would increase by 0.016667 to 0.425833 |
the top level coverage would increase by 0.016667 to 0.425833 |
||
</pre> |
</pre> |
||
=={{header|Haskell}}== |
|||
Using a function from a text outline to an updated text outline. |
|||
The raw table (supplied in the task description) is read in from a text file, parsed to tree structure, and updated by two traversals (one bottom-up and one top down) before being serialised back to a completed outline text, with an additional 'Share of Residue' column: |
|||
{{Trans|Python}} |
|||
<lang haskell>{-# LANGUAGE OverloadedStrings #-} |
|||
import qualified Data.Text.Read as T |
|||
import qualified Data.Text.IO as T |
|||
import qualified Data.Text as T |
|||
import Control.Arrow ((&&&), first) |
|||
import Numeric (showFFloat) |
|||
import Data.Bool (bool) |
|||
import Data.Tree |
|||
data Coverage = Coverage |
|||
{ name :: T.Text |
|||
, weight :: Float |
|||
, coverage :: Float |
|||
, share :: Float |
|||
} deriving (Eq, Show) |
|||
-- TEST --------------------------------------------------- |
|||
main :: IO () |
|||
main = |
|||
T.readFile "coverageOutline.txt" >>= (T.putStrLn . updatedCoverageOutline) |
|||
-- UPDATED COVERAGE OUTLINE ------------------------------- |
|||
updatedCoverageOutline :: T.Text -> T.Text |
|||
updatedCoverageOutline s = |
|||
let delimiter = "|" |
|||
indentedLines = T.lines s |
|||
titles = init $ columnNames delimiter (head indentedLines) |
|||
in T.unlines |
|||
[ titleLine (titles ++ ["SHARE OF RESIDUE"]) |
|||
, indentedLinesFromTree " " showCoverage $ |
|||
withResidueShares 1.0 $ |
|||
foldTree |
|||
weightedCoverage |
|||
((partialRecord . fmap T.strip . T.splitOn delimiter) <$> |
|||
head (outlineParse (tail indentedLines))) |
|||
] |
|||
-- WEIGHTED COVERAGE AND SHARES OF REMAINING WORK --------- |
|||
weightedCoverage :: Coverage -> Forest Coverage -> Tree Coverage |
|||
weightedCoverage x xs = |
|||
let cws = (coverage &&& weight) <$> (rootLabel <$> xs) |
|||
totalWeight = foldr ((+) . snd) 0 cws |
|||
in Node |
|||
(x |
|||
{ coverage = |
|||
foldr (\(c, w) a -> (c * w) + a) (coverage x) cws / |
|||
bool 1 totalWeight (0 < totalWeight) |
|||
}) |
|||
xs |
|||
withResidueShares :: Float -> Tree Coverage -> Tree Coverage |
|||
withResidueShares shareOfTotal tree = |
|||
let go fraction node = |
|||
let forest = subForest node |
|||
cws = (coverage &&& weight) <$> (rootLabel <$> forest) |
|||
weights = snd <$> cws |
|||
weightTotal = sum weights |
|||
nodeRoot = rootLabel node |
|||
in Node |
|||
(nodeRoot |
|||
{ share = fraction * (1 - coverage nodeRoot) |
|||
}) |
|||
(zipWith go (((fraction *) . (/ weightTotal)) <$> weights) forest) |
|||
in go shareOfTotal tree |
|||
-- OUTLINE PARSE ------------------------------------------ |
|||
outlineParse :: [T.Text] -> [Tree T.Text] |
|||
outlineParse = forestFromLineIndents . indentLevelsFromLines |
|||
forestFromLineIndents :: [(Int, T.Text)] -> [Tree T.Text] |
|||
forestFromLineIndents pairs = |
|||
let go [] = [] |
|||
go ((n, s):xs) = |
|||
let (firstTreeLines, rest) = span ((n <) . fst) xs |
|||
in Node s (go firstTreeLines) : go rest |
|||
in go pairs |
|||
indentLevelsFromLines :: [T.Text] -> [(Int, T.Text)] |
|||
indentLevelsFromLines xs = |
|||
let pairs = T.span (' ' ==) <$> xs |
|||
indentUnit = |
|||
foldr |
|||
(\x a -> |
|||
let w = (T.length . fst) x |
|||
in bool a w (w < a && 0 < w)) |
|||
(maxBound :: Int) |
|||
pairs |
|||
in first (flip div indentUnit . T.length) <$> pairs |
|||
partialRecord :: [T.Text] -> Coverage |
|||
partialRecord xs = |
|||
let [name, weightText, coverageText] = take 3 (xs ++ repeat "") |
|||
in Coverage |
|||
{ name = name |
|||
, weight = defaultOrRead 1.0 weightText |
|||
, coverage = defaultOrRead 0.0 coverageText |
|||
, share = 0.0 |
|||
} |
|||
columnNames :: T.Text -> T.Text -> [T.Text] |
|||
columnNames delimiter = fmap T.strip . T.splitOn delimiter |
|||
defaultOrRead :: Float -> T.Text -> Float |
|||
defaultOrRead n txt = either (const n) fst $ T.rational txt |
|||
-- SERIALISATION OF TREE TO TABULATED OUTLINE ------------- |
|||
indentedLinesFromTree :: T.Text -> (T.Text -> a -> T.Text) -> Tree a -> T.Text |
|||
indentedLinesFromTree tab showRoot tree = |
|||
let go indent node = |
|||
showRoot indent (rootLabel node) : |
|||
(subForest node >>= go (T.append tab indent)) |
|||
in T.unlines $ go "" tree |
|||
showCoverage :: T.Text -> Coverage -> T.Text |
|||
showCoverage indent x = |
|||
T.intercalate |
|||
"| " |
|||
(T.justifyLeft 31 ' ' (T.append indent (name x)) : |
|||
T.justifyLeft 9 ' ' (T.pack (showN 0 (weight x))) : |
|||
((T.justifyLeft 9 ' ' . T.pack . showN 4) <$> ([coverage, share] <*> [x]))) |
|||
titleLine :: [T.Text] -> T.Text |
|||
titleLine = T.intercalate "| " . zipWith (`T.justifyLeft` ' ') [31, 9, 9, 9] |
|||
justifyRight :: Int -> a -> [a] -> [a] |
|||
justifyRight n c = (drop . length) <*> (replicate n c ++) |
|||
showN :: Int -> Float -> String |
|||
showN p n = justifyRight 7 ' ' (showFFloat (Just p) n "") |
|||
-- GENERIC ------------------------------------------------ |
|||
foldTree :: (a -> [b] -> b) -> Tree a -> b |
|||
foldTree f = go |
|||
where |
|||
go (Node x ts) = f x (map go ts)</lang> |
|||
{{Out}} |
|||
<pre>NAME_HIERARCHY | WEIGHT | COVERAGE | SHARE OF RESIDUE |
|||
cleaning | 1 | 0.4092 | 0.5908 |
|||
house1 | 40 | 0.3312 | 0.2675 |
|||
bedrooms | 1 | 0.2500 | 0.0375 |
|||
bathrooms | 1 | 0.5000 | 0.0250 |
|||
bathroom1 | 1 | 0.5000 | 0.0083 |
|||
bathroom2 | 1 | 0.0000 | 0.0167 |
|||
outside_lavatory | 1 | 1.0000 | 0.0000 |
|||
attic | 1 | 0.7500 | 0.0125 |
|||
kitchen | 1 | 0.1000 | 0.0450 |
|||
living_rooms | 1 | 0.2500 | 0.0375 |
|||
lounge | 1 | 0.0000 | 0.0125 |
|||
dining_room | 1 | 0.0000 | 0.0125 |
|||
conservatory | 1 | 0.0000 | 0.0125 |
|||
playroom | 1 | 1.0000 | 0.0000 |
|||
basement | 1 | 0.0000 | 0.0500 |
|||
garage | 1 | 0.0000 | 0.0500 |
|||
garden | 1 | 0.8000 | 0.0100 |
|||
house2 | 60 | 0.4611 | 0.3233 |
|||
upstairs | 1 | 0.1500 | 0.1700 |
|||
bedrooms | 1 | 0.0000 | 0.0500 |
|||
suite_1 | 1 | 0.0000 | 0.0125 |
|||
suite_2 | 1 | 0.0000 | 0.0125 |
|||
bedroom_3 | 1 | 0.0000 | 0.0125 |
|||
bedroom_4 | 1 | 0.0000 | 0.0125 |
|||
bathroom | 1 | 0.0000 | 0.0500 |
|||
toilet | 1 | 0.0000 | 0.0500 |
|||
attics | 1 | 0.6000 | 0.0200 |
|||
groundfloor | 1 | 0.3167 | 0.1367 |
|||
kitchen | 1 | 0.0000 | 0.0333 |
|||
living_rooms | 1 | 0.0000 | 0.0333 |
|||
lounge | 1 | 0.0000 | 0.0083 |
|||
dining_room | 1 | 0.0000 | 0.0083 |
|||
conservatory | 1 | 0.0000 | 0.0083 |
|||
playroom | 1 | 0.0000 | 0.0083 |
|||
wet_room_&_toilet | 1 | 0.0000 | 0.0333 |
|||
garage | 1 | 0.0000 | 0.0333 |
|||
garden | 1 | 0.9000 | 0.0033 |
|||
hot_tub_suite | 1 | 1.0000 | 0.0000 |
|||
basement | 1 | 0.9167 | 0.0167 |
|||
cellars | 1 | 1.0000 | 0.0000 |
|||
wine_cellar | 1 | 1.0000 | 0.0000 |
|||
cinema | 1 | 0.7500 | 0.0167 </pre> |
|||
=={{header|J}}== |
=={{header|J}}== |