-- ~ import Data.List
--
-- West Gable Upper
--
-- Define the design of the boarding.
board_width = 150 :: Float
overlap = 30 :: Float
-- Define the board numbers we're dealing with.
boards = [391..418]
-- Board 400 is the board with the peak - i.e., its left edge
-- is on the north slope and its right edge is on the south.
middle_board = 400
-- Point between the measured points for each slope, close to,
-- but not necessarily exactly, the actual peak.
middle_point = (left middle_board) + (board_width / 2)
-- We number boards in increasing x direction (left to right = north
-- to south) with back (nailed to the battens) boards being odd numbered
-- and front (nailed on top of the back boards) being even numbered.
is_back :: Int -> Bool
is_back n = (n `mod` 2) == 1
is_front :: Int -> Bool
is_front n = not $ is_back n
-- Nominal horizontal (x) positions of board edges if they were all
-- exactly 150mm wide and nailed in place exactly correctly.
nominal_left :: Int -> Float
nominal_left n = fromIntegral (n - leftmost_n) * (board_width - overlap)
where leftmost_n = minimum boards
nominal_right :: Int -> Float
nominal_right n = nominal_left n + board_width
left = nominal_left
right = nominal_right
-- Define the roof geometry we're building up to by specifying
-- points on the slopes.
-- These are measured up or down from the top edge of the longest horizontal
-- batten spanning the roof. Some down measurements are from battens B and C
-- below it at measured distances.
b = 705
c = b + 694
-- Type for (x, y) tuples.
type Point = (Float, Float)
-- Measurements up to the main house roof.
up_points :: [Point]
up_points = [
(right 399, 1127),
(left 401, 1186-47),
(right 404, 303-48),
(left 398, 723-47),
(left 395, 70),
(right 410, 411 - c)
]
north_up_points = [(x, y) | (x, y) <- up_points, x <= middle_point]
south_up_points = [(x, y) | (x, y) <- up_points, x >= middle_point]
-- Measurements down to the batten just above the porch/greenhouse roof.
-- Measurements were made downwards but we record them as negative so +y
-- is always upwards.
down_points :: [Point]
down_points = [(x, -y) | (x, y) <- [
(right 394, 886),
(left 400, 1201),
(right 403, 1482),
(left 398, 1068),
(left 406, 1598),
(left 409, 1093 + b),
(right 410, 548 + c)
]]
-- Linear regression. Return (a, b) for regression line of the form
-- y = a * x + b given a list of two or more (x, y) values.
linreg :: [Point] -> (Float, Float)
linreg xys = (a, b)
where
n = (fromIntegral $ length xys) :: Float
σx = sum[x | (x, _) <- xys]
σy = sum[y | (_, y) <- xys]
σxx = sum[x*x | (x, _) <- xys]
σxy = sum[x*y | (x, y) <- xys]
det = (σxx * n) - (σx * σx)
a = ((σxy * n) - (σy * σx)) / det
b = ((σxx * σy) - (σx * σxy)) / det
-- Type of function which calculates y value of slope given x value.
type Slope = Float -> Float
-- Given a list of points return the best-fit Slope function.
make_slope :: [Point] -> Slope
make_slope points = \x -> (a * x) + b
where (a, b) = linreg points
north_up_slope :: Slope
north_up_slope = make_slope north_up_points
south_up_slope :: Slope
south_up_slope = make_slope south_up_points
down_slope :: Slope
down_slope = make_slope down_points
-- Work out a point's vertical distance from a slope.
slope_δ :: Slope -> Point -> Float
slope_δ slope (x, y) = abs $ y - (slope x)
slope_max_δ :: Slope -> [Point] -> Float
slope_max_δ slope points = maximum [slope_δ slope p | p <- points]
non_linearity :: [Point] -> Float
non_linearity points = slope_max_δ (make_slope points) points
-- Extract the regression line parameters back out of a slope function.
slope_ab :: Slope -> (Float, Float)
slope_ab slope = (a, b)
where a = (slope 1.0) - (slope 0.0)
b = (slope 0.0)
-- Given two slopes, work out the x position they intersect, i.e., the peak
-- of the roof (or trough if we had one).
slope_intersection :: Slope -> Slope -> Float
slope_intersection s1 s2 = (d - b) / (a - c)
where (a, b) = slope_ab s1
(c, d) = slope_ab s2
peak_x = slope_intersection north_up_slope south_up_slope
-- Calculate roof height (y) at a given x position.
type Profile = Float -> Float
roof_height :: Profile
roof_height x = min (north_up_slope x) (south_up_slope x)
-- For a list return a list of its sub-lists which omit exactly one
-- element of the original list.
lists_without_one :: [a] -> [[a]]
lists_without_one [] = []
lists_without_one (x:xs) = xs : [x : t | t <- lists_without_one xs]
-- Print information on the roof slope.
degrees radians = radians / pi * 180.0
print_slope :: Slope -> IO()
print_slope slope = do
putStr "Slope = "
putStr $ show $ degrees $ atan a
putStrLn "°"
where (a, _) = slope_ab slope
-- Check that the slope points defined are consistent with each other.
pad :: Int -> String -> String
pad len s
| length s < len = pad len $ ' ':s
| otherwise = s
check_point :: Profile -> Point -> IO()
check_point profile (x, y) = do
putStr "Check point at x = "
putStr $ pad 6 $ show x
putStr ", measured height = "
putStr $ pad 6 $ show y
putStr ", calculated height = "
putStr $ show yc
putStr ", δ = "
putStr $ show $ δ
putStr ", "
putStr $ if (abs δ) < 5.0 then "OK" else "FAIL!!!!"
putStrLn ""
where
yc = profile x
δ = yc - y
-- Calculate board geometry.
-- We use the lowest point on the board (bottom right) as the reference
-- point for *other* point positions.
bottom_right :: Int -> Float
bottom_right n = down_slope $ right n -- Relative to reference batten
bottom_left :: Int -> Float
bottom_left n = (down_slope $ left n) - (bottom_right n)
top_left :: Int -> Float
top_left n = (roof_height $ left n) - (bottom_right n)
top_right :: Int -> Float
top_right n = (roof_height $ right n) - (bottom_right n)
board_length :: Int -> Float -- Total length of the board.
board_length n = max (top_left n) (top_right n)
actual_board :: Int -> Bool -- Whether board has longer than zero length.
actual_board n = or [top_left n > bottom_left n, top_right n > 0]
peak_in_board :: Int -> Bool -- Whether board has the roof peak in it.
peak_in_board n = and [left n < peak_x, peak_x < right n]
-- Print details of the boards.
col_width = 6
col :: String -> IO()
col s = putStr $ pad col_width s
span_cols :: Int -> String -> IO()
span_cols cols s = putStr $ pad (cols * col_width) s
show_mm :: Float -> IO()
show_mm f = col $ show $ round f
print_board :: Int -> IO()
print_board n = do
col $ show n
show_mm $ left n
show_mm $ right n
show_mm $ bottom_right n
show_mm $ bottom_left n
show_mm $ top_left n
show_mm $ top_right n
if peak_in_board n
then do
show_mm $ peak_x - left n
show_mm $ (roof_height peak_x) - (bottom_right n)
else do
putStr ""
if not $ actual_board n
then do
col "XXXX"
else do
putStr ""
putStrLn ""
print_board_list' [] = return ()
print_board_list' (n:ns) = do
print_board n
print_board_list' ns
print_board_list :: [Int] -> IO()
print_board_list ns = do
col ""
span_cols 2 "Nom X"
span_cols 2 "Bottom"
span_cols 2 "Top"
span_cols 2 "Peak"
putStrLn ""
col "Brd"
col "L"
col "R"
col "R"
col "L"
col "L"
col "R"
col "L"
col "H"
putStrLn ""
print_board_list' ns
-- Main
main = do
putStrLn ""
putStrLn "North Roof"
print_slope north_up_slope
putStrLn ""
putStrLn "South Roof"
print_slope south_up_slope
putStrLn ""
putStrLn "Porch/Greenhouse Roof"
print_slope down_slope
putStrLn ""
mapM_ (check_point roof_height) up_points
putStrLn ""
mapM_ (check_point down_slope) down_points
putStrLn ""
putStrLn "Back boards"
print_board_list $ filter is_back boards
putStrLn ""
putStrLn "Front boards"
print_board_list $ filter is_front boards
putStrLn ""
putStr "Total length: "
putStrLn $ show $ sum [board_length n | n <- boards]