mechexpr2.hs

module Main where

type Row = Int

type Col = Int

type Load = Double

type Deflection = Double

type Position = Double

type Young = Double

type Width = Double

type Height = Double

type Length = Double

type MomentOfInertia = Double

type Strain = Double

angled :: (Ord r, Floating r) => r -> r
angled x = if x > 0 then x else 0

mm :: (Floating r) => r -> r
mm x = x * 0.001

showTable :: Show b => String -> Col -> (a -> b) -> [a] -> String
showTable legend = curry3 (showString (legend ++ "\n") . uncurry3 go) where
    go :: Show b => Col -> (a -> b) -> [a] -> String
    go col fun inputs
        | col <= 0 = undefined
        | length inputs >= col = concat
            [ concat
                [ "  " ++ show (fun input)
                | input <- take col inputs
                ]
            , "\n"
            , go col fun (drop col inputs)
            ]
        | otherwise = concat
            [ concat
                [ "  " ++ show (fun input)
                | input <- inputs
                ]
            , "======================================"
            ]

uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d)
uncurry3 f (x, y, z) = f x y z

curry3 :: ((a, b, c) -> d) -> (a -> b -> c -> d)
curry3 f x y z = f (x, y, z)

fourpointsbending :: Load -> Load -> Deflection -> Young
fourpointsbending = getYoungsModulus where
    l :: Length
    l = mm 500
    b :: Width
    b = 0.025
    h :: Height
    h = 0.006
    i :: MomentOfInertia
    i = b * h^3 / 12
    a_1 :: Position
    a_1 = mm 200
    a_2 :: Position
    a_2 = mm 300
    b_1 :: Position
    b_1 = l - a_1
    b_2 :: Position
    b_2 = l - a_2
    x :: Position
    x = l / 2
    getYoungsModulus :: Load -> Load -> Deflection -> Young
    getYoungsModulus p_1 p_2 delta = (p_1 * b_1 * ((l / b_1) * (angled (x - a_1))^3 - x^3 + (l^2 - b_1^2) * x) + p_2 * b_2 * ((l / b_2) * (angled (x - a_2))^3 - x^3 + (l^2 - b_2^2) * x)) / (6 * l * i * delta)

threepointsbending :: Length -> Load -> Deflection -> Young
threepointsbending l = getYoungsModulus where
    b :: Width
    b = 0.025
    h :: Height
    h = 0.006
    i :: MomentOfInertia
    i = b * h^3 / 12
    a_1 :: Position
    a_1 = l / 2
    b_1 :: Position
    b_1 = l - a_1
    x :: Position
    x = l / 2
    getYoungsModulus :: Load -> Deflection -> Young
    getYoungsModulus p_1 delta = (p_1 * b_1 * ((l / b_1) * (angled (x - a_1))^3 - x^3 + (l^2 - b_1^2) * x)) / (6 * l * i * delta)

cantileverbeam :: Position -> Deflection -> Strain
cantileverbeam = getStrain where
    l :: Length
    l = 0.255
    h :: Height
    h = 0.005
    getStrain :: Position -> Deflection -> Strain
    getStrain x delta = (3 * (l - x) * h * delta) / (2 * l^3)

table1 :: [(Load, Load, Deflection)]
table1 =
    [ ( 5.0,  5.0, 0.00065)
    , (10.0, 10.0, 0.00135)
    , (15.0, 15.0, 0.00202)
    , (20.0, 20.0, 0.00268)
    , (25.0, 25.0, 0.00335)
    ]

table2 :: [(Load, Load, Deflection)]
table2 =
    [ ( 5.0,  5.0, 0.00024)
    , (10.0, 10.0, 0.00050)
    , (15.0, 15.0, 0.00075)
    , (20.0, 20.0, 0.00100)
    , (25.0, 25.0, 0.00125)
    ]

table3 :: [(Load, Load, Deflection)]
table3 =
    [ ( 5.0, 10.0, 0.001010)
    , (10.0,  5.0, 0.001010)
    , (10.0, 15.0, 0.001670)
    , (15.0, 10.0, 0.001680)
    , (15.0, 20.0, 0.002340)
    , (20.0, 15.0, 0.002350)
    ]

table4 :: [(Load, Load, Deflection)]
table4 =
    [ ( 5.0, 10.0, 0.000820)
    , (10.0,  5.0, 0.000820)
    , (10.0, 15.0, 0.001360)
    , (15.0, 10.0, 0.001370)
    , (15.0, 20.0, 0.001900)
    , (20.0, 15.0, 0.001910)
    ]

table5 :: [(Length, Load, Deflection)]
table5 =
    [ (mm 400,  5, 0.00018), (mm 400, 10, 0.00026), (mm 400, 15, 0.00050), (mm 400, 20, 0.00074), (mm 400, 25, 0.00090)
    , (mm 500,  5, 0.00035), (mm 500, 10, 0.00070), (mm 500, 15, 0.00097), (mm 500, 20, 0.00135), (mm 500, 25, 0.00166)
    , (mm 600,  5, 0.00060), (mm 600, 10, 0.00124), (mm 600, 15, 0.00186), (mm 600, 20, 0.00248), (mm 600, 25, 0.00304)
    , (mm 700,  5, 0.00097), (mm 700, 10, 0.00195), (mm 700, 15, 0.00289), (mm 700, 20, 0.00391), (mm 700, 25, 0.00479)
    ]

table6 :: [(Length, Load, Deflection)]
table6 =
    [ (mm 400,  5, 0.00015), (mm 400, 10, 0.00030), (mm 400, 15, 0.00044), (mm 400, 20, 0.00059), (mm 400, 25, 0.00072)
    , (mm 500,  5, 0.00028), (mm 500, 10, 0.00058), (mm 500, 15, 0.00086), (mm 500, 20, 0.00114), (mm 500, 25, 0.00143)
    , (mm 600,  5, 0.00050), (mm 600, 10, 0.00098), (mm 600, 15, 0.00146), (mm 600, 20, 0.00199), (mm 600, 25, 0.00248)
    , (mm 700,  5, 0.00078), (mm 700, 10, 0.00160), (mm 700, 15, 0.00238), (mm 700, 20, 0.00319), (mm 700, 25, 0.00388)
    ]

table7 :: [(Position, Deflection)]
table7 =
    [ (mm 100, mm 0.1)
    , (mm 100, mm 0.2)
    , (mm 100, mm 0.3)
    , (mm 100, mm 0.4)
    , (mm 100, mm 0.5)
    ]

table8 :: [(Position, Deflection)]
table8 =
    [ (mm 125, mm 0.1)
    , (mm 125, mm 0.2)
    , (mm 125, mm 0.3)
    , (mm 125, mm 0.4)
    , (mm 125, mm 0.5)
    ]

main :: IO ()
main = do
    let newl = putStrLn ""
    putStrLn "tables:"
    newl
    putStrLn "* fourpointsbending[ Young's Modulus ]:"
    newl
    putStrLn (showTable "[Al]" 1 (uncurry3 fourpointsbending) table1)
    putStrLn (showTable "[Steel]" 1 (uncurry3 fourpointsbending) table2)
    putStrLn (showTable "[Al]" 1 (uncurry3 fourpointsbending) table3)
    putStrLn (showTable "[Brass]" 1 (uncurry3 fourpointsbending) table4)
    newl
    putStrLn "* threepointsbending[ Young's Modulus ]:"
    newl
    putStrLn (showTable "[Al]" 5 (uncurry3 threepointsbending) table5)
    putStrLn (showTable "[Brass]" 5 (uncurry3 threepointsbending) table6)
    newl
    putStrLn "* cantileverbeam[ Strain(Theoretical Value) ]:"
    newl
    putStrLn (showTable "[100mm]" 1 (uncurry cantileverbeam) table7)
    putStrLn (showTable "[125mm]" 1 (uncurry cantileverbeam) table8)
    newl
    return ()