Skip to content

Instantly share code, notes, and snippets.

@Gitmoko

Gitmoko/adj.hs

Created December 13, 2017 07:31
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save Gitmoko/dd7e1e1405149c2e94df09e79caf6eac to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save Gitmoko/dd7e1e1405149c2e94df09e79caf6eac to your computer and use it in GitHub Desktop.
Download ZIP
Raw
adj.hs
module Lib
( someFunc
) where
import KdTree
import Data.Maybe
import ReturnNearestMap
import qualified Data.Array.Repa as R
ps =
let
p0 = Point3dIndexed (Point3d (negate 2) (negate 2) (negate 2)) 0 [(Point3d (negate 2) (negate 2) (negate 3)),(Point3d (negate 2) (negate 2) (negate 1)),(Point3d (negate 2) (negate 3) (negate 2)),(Point3d (negate 1) (negate 2) (negate 2)),(Point3d (negate 2) (negate 1) (negate 2)),(Point3d (negate 3) (negate 2) (negate 2))]
p1 = Point3dIndexed (Point3d 0 (negate 2) (negate 2)) 1 [(Point3d 0 (negate 2) (negate 3)),(Point3d 0 (negate 2) (negate 1)),(Point3d 0 (negate 3) (negate 2)),(Point3d 1 (negate 2) (negate 2)),(Point3d 0 (negate 1) (negate 2)),(Point3d (negate 1) (negate 2) (negate 2))]
p2 = Point3dIndexed (Point3d 2 (negate 2) (negate 2)) 2 [(Point3d 2 (negate 2) (negate 3)),(Point3d 2 (negate 2) (negate 1)),(Point3d 2 (negate 3) (negate 2)),(Point3d 3 (negate 2) (negate 2)),(Point3d 2 (negate 1) (negate 2)),(Point3d 1 (negate 2) (negate 2))]
p3 = Point3dIndexed (Point3d (negate 2) 0 (negate 2)) 3 [(Point3d (negate 2) 0 (negate 3)),(Point3d (negate 2) 0 (negate 1)),(Point3d (negate 2) (negate 1) (negate 2)),(Point3d (negate 1) 0 (negate 2)),(Point3d (negate 2) 1 (negate 2)),(Point3d (negate 3) 0 (negate 2))]
p4 = Point3dIndexed (Point3d 0 0 (negate 2)) 4 [(Point3d 0 0 (negate 3)),(Point3d 0 0 (negate 1)),(Point3d 0 (negate 1) (negate 2)),(Point3d 1 0 (negate 2)),(Point3d 0 1 (negate 2)),(Point3d (negate 1) 0 (negate 2))]
p5 = Point3dIndexed (Point3d 2 0 (negate 2)) 5 [(Point3d 2 0 (negate 3)),(Point3d 2 0 (negate 1)),(Point3d 2 (negate 1) (negate 2)),(Point3d 3 0 (negate 2)),(Point3d 2 1 (negate 2)),(Point3d 1 0 (negate 2))]
p6 = Point3dIndexed (Point3d (negate 2) 2 (negate 2)) 6 [(Point3d (negate 2) 2 (negate 3)),(Point3d (negate 2) 2 (negate 1)),(Point3d (negate 2) 1 (negate 2)),(Point3d (negate 1) 2 (negate 2)),(Point3d (negate 2) 3 (negate 2)),(Point3d (negate 3) 2 (negate 2))]
p7 = Point3dIndexed (Point3d 0 2 (negate 2)) 7 [(Point3d 0 2 (negate 3)),(Point3d 0 2 (negate 1)),(Point3d 0 1 (negate 2)),(Point3d 1 2 (negate 2)),(Point3d 0 3 (negate 2)),(Point3d (negate 1) 2 (negate 2))]
p8 = Point3dIndexed (Point3d 2 2 (negate 2)) 8 [(Point3d 2 2 (negate 3)),(Point3d 2 2 (negate 1)),(Point3d 2 1 (negate 2)),(Point3d 3 2 (negate 2)),(Point3d 2 3 (negate 2)),(Point3d 1 2 (negate 2))]
p9 = Point3dIndexed (Point3d (negate 2) (negate 2) 0) 9 [(Point3d (negate 2) (negate 2) (negate 1)),(Point3d (negate 2) (negate 2) 1),(Point3d (negate 2) (negate 3) 0),(Point3d (negate 1) (negate 2) 0),(Point3d (negate 2) (negate 1) 0),(Point3d (negate 3) (negate 2) 0)]
p10 = Point3dIndexed (Point3d 0 (negate 2) 0) 10 [(Point3d 0 (negate 2) (negate 1)),(Point3d 0 (negate 2) 1),(Point3d 0 (negate 3) 0),(Point3d 1 (negate 2) 0),(Point3d 0 (negate 1) 0),(Point3d (negate 1) (negate 2) 0)]
p11 = Point3dIndexed (Point3d 2 (negate 2) 0) 11 [(Point3d 2 (negate 2) (negate 1)),(Point3d 2 (negate 2) 1),(Point3d 2 (negate 3) 0),(Point3d 3 (negate 2) 0),(Point3d 2 (negate 1) 0),(Point3d 1 (negate 2) 0)]
p12 = Point3dIndexed (Point3d (negate 2) 0 0) 12 [(Point3d (negate 2) 0 (negate 1)),(Point3d (negate 2) 0 1),(Point3d (negate 2) (negate 1) 0),(Point3d (negate 1) 0 0),(Point3d (negate 2) 1 0),(Point3d (negate 3) 0 0)]
p13 = Point3dIndexed (Point3d 0 0 0) 13 [(Point3d 0 0 (negate 1)),(Point3d 0 0 1),(Point3d 0 (negate 1) 0),(Point3d 1 0 0),(Point3d 0 1 0),(Point3d (negate 1) 0 0)]
p14 = Point3dIndexed (Point3d 2 0 0) 14 [(Point3d 2 0 (negate 1)),(Point3d 2 0 1),(Point3d 2 (negate 1) 0),(Point3d 3 0 0),(Point3d 2 1 0),(Point3d 1 0 0)]
p15 = Point3dIndexed (Point3d (negate 2) 2 0) 15 [(Point3d (negate 2) 2 (negate 1)),(Point3d (negate 2) 2 1),(Point3d (negate 2) 1 0),(Point3d (negate 1) 2 0),(Point3d (negate 2) 3 0),(Point3d (negate 3) 2 0)]
p16 = Point3dIndexed (Point3d 0 2 0) 16 [(Point3d 0 2 (negate 1)),(Point3d 0 2 1),(Point3d 0 1 0),(Point3d 1 2 0),(Point3d 0 3 0),(Point3d (negate 1) 2 0)]
p17 = Point3dIndexed (Point3d 2 2 0) 17 [(Point3d 2 2 (negate 1)),(Point3d 2 2 1),(Point3d 2 1 0),(Point3d 3 2 0),(Point3d 2 3 0),(Point3d 1 2 0)]
p18 = Point3dIndexed (Point3d (negate 2) (negate 2) 2) 18 [(Point3d (negate 2) (negate 2) 1),(Point3d (negate 2) (negate 2) 3),(Point3d (negate 2) (negate 3) 2),(Point3d (negate 1) (negate 2) 2),(Point3d (negate 2) (negate 1) 2),(Point3d (negate 3) (negate 2) 2)]
p19 = Point3dIndexed (Point3d 0 (negate 2) 2) 19 [(Point3d 0 (negate 2) 1),(Point3d 0 (negate 2) 3),(Point3d 0 (negate 3) 2),(Point3d 1 (negate 2) 2),(Point3d 0 (negate 1) 2),(Point3d (negate 1) (negate 2) 2)]
p20 = Point3dIndexed (Point3d 2 (negate 2) 2) 20 [(Point3d 2 (negate 2) 1),(Point3d 2 (negate 2) 3),(Point3d 2 (negate 3) 2),(Point3d 3 (negate 2) 2),(Point3d 2 (negate 1) 2),(Point3d 1 (negate 2) 2)]
p21 = Point3dIndexed (Point3d (negate 2) 0 2) 21 [(Point3d (negate 2) 0 1),(Point3d (negate 2) 0 3),(Point3d (negate 2) (negate 1) 2),(Point3d (negate 1) 0 2),(Point3d (negate 2) 1 2),(Point3d (negate 3) 0 2)]
p22 = Point3dIndexed (Point3d 0 0 2) 22 [(Point3d 0 0 1),(Point3d 0 0 3),(Point3d 0 (negate 1) 2),(Point3d 1 0 2),(Point3d 0 1 2),(Point3d (negate 1) 0 2)]
p23 = Point3dIndexed (Point3d 2 0 2) 23 [(Point3d 2 0 1),(Point3d 2 0 3),(Point3d 2 (negate 1) 2),(Point3d 3 0 2),(Point3d 2 1 2),(Point3d 1 0 2)]
p24 = Point3dIndexed (Point3d (negate 2) 2 2) 24 [(Point3d (negate 2) 2 1),(Point3d (negate 2) 2 3),(Point3d (negate 2) 1 2),(Point3d (negate 1) 2 2),(Point3d (negate 2) 3 2),(Point3d (negate 3) 2 2)]
p25 = Point3dIndexed (Point3d 0 2 2) 25 [(Point3d 0 2 1),(Point3d 0 2 3),(Point3d 0 1 2),(Point3d 1 2 2),(Point3d 0 3 2),(Point3d (negate 1) 2 2)]
p26 = Point3dIndexed (Point3d 2 2 2) 26 [(Point3d 2 2 1),(Point3d 2 2 3),(Point3d 2 1 2),(Point3d 3 2 2),(Point3d 2 3 2),(Point3d 1 2 2)]
in
[p0,p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11,p12,p13,p14,p15,p16,p17,p18,p19,p20,p21,p22,p23,p24,p25,p26]
getRelVertsNearRelVert relv =
case relv of
1 -> [(-1,-1,-1,7),(0,-1,-1,8),(-1,0,-1,6),(0,0,-1,5),(-1,-1,0,3),(0,-1,0,4),(-1,0,0,2),(0,0,0,1)]
2 -> [(0,-1,-1,7),(1,-1,-1,8),(0,0,-1,6),(1,0,-1,5),(0,-1,0,3),(1,-1,0,4),(0,0,0,2),(1,0,0,1)]
3 -> [(0,0,-1,7),(1,0,-1,8),(0,1,-1,6),(1,1,-1,5),(0,0,0,3),(1,0,0,4),(0,1,0,2),(1,1,0,1)]
4 -> [(-1,0,-1,7),(0,0,-1,8),(-1,1,-1,6),(0,1,-1,5),(-1,0,0,3),(0,0,0,4),(-1,1,0,2),(0,1,0,1)]
5 -> [(-1,-1,0,7),(0,-1,0,8),(-1,0,0,6),(0,0,0,5),(-1,-1,1,3),(0,-1,1,4),(-1,0,1,2),(0,0,1,1)]
6 -> [(0,-1,0,7),(1,-1,0,8),(0,0,0,6),(1,0,0,5),(0,-1,1,3),(1,-1,1,4),(0,0,1,2),(1,0,1,1)]
7 -> [(0,0,0,7),(1,0,0,8),(0,1,0,6),(1,1,0,5),(0,0,1,3),(1,0,1,4),(0,1,1,2),(1,1,1,1)]
8 -> [(-1,0,0,7),(0,0,0,8),(-1,1,0,6),(0,1,0,5),(-1,0,1,3),(0,0,1,4),(-1,1,1,2),(0,1,1,1)]
getCellIndexfromPQR (p,q,r) pmax qmax rmax = (p*qmax*rmax) + (q*rmax) + r
getPQRfromCellIndex index pmax qmax rmax =
let
r = index `mod` rmax
q = ((index - r) `div` rmax) `mod` qmax
p = (index - (q*rmax) -r) `div` (qmax*rmax)
in
(p,q,r)
getAdjVertsfromCellIndex cellindex pmax qmax rmax =
let
(p,q,r) = getPQRfromCellIndex cellindex pmax qmax rmax
in
do
i <- [1..8]
let vs = do
(dx,dy,dz,v) <- getRelVertsNearRelVert i
if (p+dx) >=0 && (q+dy)>=0 && (r+dz) >=0 then
return $ Just ((p+dx), (q+dy), (r+dz), v)
else
return Nothing
return $ catMaybes vs
move_p3 :: Point3d->Point3d-> Point3d
move_p3 p d = Point3d (p3x p + p3x d) (p3y p + p3y d) (p3z p + p3z d)
move_p3i :: Point3dIndexed->Point3d->Point3dIndexed
move_p3i p3 d = Point3dIndexed (move_p3 (point p3) d) (index p3) (map (\x -> move_p3 x d) ( surfaceArray p3))
someFunc :: IO ()
someFunc = do
putStrLn "someFunc"
putStrLn $ show $ returnNearestMap [ps !! 3, ps !! 4]
let ps' = map (\x -> move_p3i x (Point3d 100 100 100)) ps
let ps03 = [ps' !! 3, ps'!! 4]
putStrLn $ show $ ps03
putStrLn $ show $ returnNearestMap ps03
putStrLn $ show $ (1,2,3)
putStrLn $ show $ getAdjVertsfromCellIndex 12 3 3 3
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment