X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FMain.hs;h=9742a1f096d5bc6e1ec6946e7b968eeb846a641e;hb=374082b271180b6ffc64d49c334ace155a196d59;hp=8376ce954ff9f840d2b88f11b65a2393a283cd5f;hpb=89b8b6e94fcc944a1f4611811265f3c6217af850;p=spline3.git diff --git a/src/Main.hs b/src/Main.hs index 8376ce9..9742a1f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,104 +1,78 @@ module Main where -import Cube -import Face -import Grid -import Misc (flatten) -import Point -import RealFunction -import Tetrahedron -import ThreeDimensional +import qualified Data.Array.Repa as R +import qualified Data.Array.Repa.IO.BMP as R (writeComponentsToBMP) +import System.Environment (getArgs) -trilinear :: [[[Double]]] -trilinear = [ [ [ 1, 2, 3 ], - [ 1, 3, 5 ], - [ 1, 4, 7 ] ], - [ [ 1, 2, 3 ], - [ 1, 4, 7 ], - [ 1, 6, 11 ] ], - [ [ 1, 2, 3 ], - [ 1, 5, 9 ], - [ 1, 8, 15 ]]] +import Grid (make_grid, zoom) +import MRI +import Values (drop_z, zoom_shape) -zeros :: [[[Double]]] -zeros = [ [ [ 0, 0, 0 ], - [ 0, 0, 0 ], - [ 0, 0, 0 ] ], - -- - [ [ 0, 0, 0 ], - [ 0, 0, 0 ], - [ 0, 0, 0 ] ], - -- - [ [ 0, 0, 0 ], - [ 0, 0, 0 ], - [ 0, 0, 0 ]]] +main :: IO () +main = do + (s:_) <- getArgs + let scale = read s :: Int + let zoom_factor = (1, scale, scale) + let out_file = "output.bmp" + arr <- read_word16s in_file + let arr' = swap_bytes arr + let arrInv = flip_x $ flip_y arr' + let arrSlice = z_slice3 50 arrInv + let dbl_data = R.map fromIntegral arrSlice + let g = make_grid 1 dbl_data + let output = zoom g zoom_factor + let arrBrack = bracket_array output + print $ "arrBrack extent:" ++ (show $ R.extent arrBrack) + let arrBrack' = z_slice 1 arrBrack + print $ "arrBrack' extent:" ++ (show $ R.extent arrBrack') + let mri_slice2d = drop_z $ zoom_shape zoom_factor mri_slice3d + let colors = values_to_colors $ R.reshape mri_slice2d + $ R.map fromIntegral arrBrack' + let routput = R.map (\(red, _, _) -> red) colors + let goutput = R.map (\(_, green, _) -> green) colors + let boutput = R.map (\(_, _, blue) -> blue) colors + R.writeComponentsToBMP out_file routput goutput boutput -dummy :: [[[Double]]] -dummy = [ [ [ 0, 1, 2 ], - [ 3, 4, 5 ], - [ 6, 7, 8 ] ], - -- - [ [ 9, 10, 11 ], - [ 12, 13, 14 ], - [ 15, 16, 17 ] ], - -- - [ [ 18, 19, 20 ], - [ 21, 22, 23 ], - [ 24, 25, 26 ]]] +in_file :: FilePath +in_file = "./data/mri.bin" -find_point_value :: RealFunction Point -find_point_value p = poly p - where - g0 = make_grid 1 trilinear - the_cubes = flatten (cubes g0) - good_cubes = filter ((flip contains_point) p) the_cubes - target_cube = good_cubes !! 0 - good_tets = filter ((flip contains_point) p) (tetrahedrons target_cube) - target_tetrahedron = good_tets !! 0 - poly = polynomial target_tetrahedron +main3d :: IO () +main3d = do + (s:_) <- getArgs + let scale = read s :: Int + let zoom_factor = (scale, scale, scale) + let out_file = "output.bin" + arr <- read_word16s in_file + let arr' = swap_bytes arr +-- let arrInv = flip_x $ flip_y arr' + let arrMRI = R.reshape mri_shape arr' + let dbl_data = R.force $ R.map fromIntegral arrMRI + let g = make_grid 1 dbl_data + let output = zoom g zoom_factor + let word16_output = bracket_array output + write_word16s out_file word16_output -main :: IO () -main = do - putStrLn $ show $ find_point_value (0,0,0) - putStrLn $ show $ find_point_value (1,0,0) - putStrLn $ show $ find_point_value (2,0,0) - putStrLn $ show $ find_point_value (0,1,0) - putStrLn $ show $ find_point_value (1,1,0) - putStrLn $ show $ find_point_value (2,1,0) - putStrLn $ show $ find_point_value (0,2,0) - putStrLn $ show $ find_point_value (1,2,0) - putStrLn $ show $ find_point_value (2,2,0) - putStrLn $ show $ find_point_value (0,0,1) - putStrLn $ show $ find_point_value (1,0,1) - putStrLn $ show $ find_point_value (2,0,1) - putStrLn $ show $ find_point_value (0,1,1) - putStrLn $ show $ find_point_value (1,1,1) - putStrLn $ show $ find_point_value (2,1,1) - putStrLn $ show $ find_point_value (0,2,1) - putStrLn $ show $ find_point_value (1,2,1) - putStrLn $ show $ find_point_value (2,2,1) - putStrLn $ show $ find_point_value (0,0,2) - putStrLn $ show $ find_point_value (1,0,2) - putStrLn $ show $ find_point_value (2,0,2) - putStrLn $ show $ find_point_value (0,1,2) - putStrLn $ show $ find_point_value (1,1,2) - putStrLn $ show $ find_point_value (2,1,2) - putStrLn $ show $ find_point_value (0,2,2) - putStrLn $ show $ find_point_value (1,2,2) - putStrLn $ show $ find_point_value (2,2,2) - -- let g0 = make_grid 1 trilinear - -- let the_cubes = flatten (cubes g0) - -- putStrLn $ show $ the_cubes - -- let p = (2, 0, 0) - -- let target_cubes = filter ((flip contains_point) p) the_cubes - -- putStrLn $ show $ target_cubes - -- let target_cube = (take 1 target_cubes) !! 0 - -- putStrLn $ show $ target_cube - -- let target_tetrahedra = filter ((flip contains_point) p) (tetrahedrons target_cube) - -- let target_tetrahedron = (take 1 target_tetrahedra) !! 0 - -- putStrLn $ show $ target_tetrahedron - -- let poly = polynomial target_tetrahedron - -- putStrLn $ show $ poly - -- putStrLn $ show $ poly p +main2d :: IO () +main2d = do + (s:_) <- getArgs + let scale = read s :: Int + let zoom_factor = (1, scale, scale) + let out_file = "output.bmp" + arr <- read_word16s in_file + let arr' = swap_bytes arr + let arrInv = flip_x $ flip_y arr' + let arrSlice = z_slice 50 arrInv + let arrSlice' = R.reshape mri_slice3d arrSlice + let dbl_data = R.map fromIntegral arrSlice' + let g = make_grid 1 dbl_data + let output = zoom g zoom_factor + let arrBrack = bracket_array output + let mri_slice2d = drop_z $ zoom_shape zoom_factor mri_slice3d + let colors = values_to_colors $ R.reshape mri_slice2d + $ R.map fromIntegral arrBrack + let routput = R.map (\(red, _, _) -> red) colors + let goutput = R.map (\(_, green, _) -> green) colors + let boutput = R.map (\(_, _, blue) -> blue) colors + R.writeComponentsToBMP out_file routput goutput boutput