functionalProject/sample.hs at master · diwakarchauhan/functionalProject · GitHub

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
-- This is haskell code
-- :set -XTypeOperators

{-# LANGUAGE TypeOperators #-}

import Data.Array.Repa
--import Data.Array.Repa.IO.Matrix
import Language.Haskell.Extension

--create array by y =  fromListUnboxed(Z :.(4::Int):.(4::Int)) [1..16]
-- let y1 =  Data.Array.Repa.map (+0) y
createArr::(Array D ((Z :. Int) :. Int) Double ) ->(Array D DIM2 Double)
createArr  y = traverse y id (\f (Z:.i :. j) -> if j  > 0 && i  > 0 && j < col -1 && i < row -1 then(sum'' (f(Z:.i :.j))  (f(Z:.i :.j+1)) (f(Z:.i :.j-1))  (f(Z:.i+1 :.j)))
                                                                  else f(Z:.i:.j))
    where row = dim!! 0
          col = dim!! 1
          dim = (listOfShape (extent y))

sum'' x1 x2 x3 x4  = (x1+x2+x3+x4)/5

createArr1::(Array D ((Z :. Int) :. Int) Double ) ->(Array D DIM2 Double)
createArr1  y = traverse y id (\f (Z:.i :. j) -> if j  > 0 && i  > 0 && j < col -1 && i < row -1 then 2*f(Z:.i :.j)
                                                                  else f(Z:.i:.j))
    where row = dim!! 0
          col = dim!! 1
          dim = (listOfShape (extent y))

computeFuncIter::(Array D ((Z :. Int) :. Int) Double )->((Array D ((Z :. Int) :. Int) Double ) ->(Array D DIM2 Double))->Int ->(IO (Array U DIM2 Double))
computeFuncIter y func numIter  | numIter == 1  = computeP y
                                 | otherwise = computeFuncIter (func y) func  (numIter - 1)

    --do
    --                        let res = (take numIter (iterate func y))!!(numIter - 1)
    --                        computeP res

--computeFuncChange::(Array D ((Z :. Int) :. Int) Double )->((Array D ((Z :. Int) :. Int) Double ) ->(Array D DIM2 Double))->Int ->(IO (Array U DIM2 Double))
--computeFuncChange y func numIter = do
--                            let arrList = iterate func y
--                            let val = map sumAllP arrList
--                            computeP res
--functions of 1D array
setBoundaryLeft1D :: (Array U (Z :. Int) Double) -> Double -> (IO (Array U DIM1 Double))
setBoundaryLeft1D array val = computeP $ traverse array id (\f(Z :. i) -> if i == 0 then val else f(Z:.i))


setBoundaryRight1D :: (Array U (Z :. Int) Double) -> Double -> (IO (Array U DIM1 Double))
setBoundaryRight1D array val = computeP $ traverse array id (\f(Z :. i) -> if i == dim - 1 then val else f(Z:.i))
    where dim = (listOfShape (extent array))!! 0

setBoundaryAll1D :: (Array U (Z :. Int) Double) -> Double -> (IO (Array U DIM1 Double))
setBoundaryAll1D array val= computeP $ traverse array id (\f(Z :. i) -> if i == 0 || i == dim - 1 then val else f(Z:.i))
    where dim = (listOfShape (extent array))!! 0


--Functions of 2D array
setBoundaryAll2D :: (Array U ((Z :. Int) :. Int) Double ) -> Double->(IO (Array U DIM2 Double))
setBoundaryAll2D array val = computeP $ traverse array id (\f (Z:. i:. j) -> if j == 0 || i == 0 || i == dimOne -1 || j == dimTwo -1 then val
                                                                                        else f(Z:. i :. j))
    where dimOne = dim !! 0
          dimTwo = dim !! 1
          dim = (listOfShape (extent array))

setBoundaryLeft2D :: (Array U ((Z :. Int) :. Int) Double ) -> Double ->(IO (Array U DIM2 Double))
setBoundaryLeft2D array val = computeP $ traverse array id (\f (Z:. i:. j) -> if j == 0  then val else f(Z:. i :. j))

setBoundaryRight2D :: (Array U ((Z :. Int) :. Int) Double ) -> Double ->(IO (Array U DIM2 Double))
setBoundaryRight2D array val = computeP $ traverse array id (\f (Z:. i:. j) -> if j == dimTwo - 1  then val else f(Z:. i :. j))
    where dimTwo = dim !! 1
          dim = (listOfShape (extent array))

setBoundaryTop2D :: (Array U ((Z :. Int) :. Int) Double ) -> Double ->(IO (Array U DIM2 Double))
setBoundaryTop2D array val = computeP $ traverse array id (\f (Z:. i:. j) -> if i == 0  then val else f(Z:. i :. j))

setBoundaryBottom2D :: (Array U ((Z :. Int) :. Int) Double ) -> Double ->(IO (Array U DIM2 Double))
setBoundaryBottom2D array val = computeP $ traverse array id (\f (Z:. i:. j) -> if i == dimOne - 1  then val else f(Z:. i :. j))
    where dimOne = dim !! 0
          dim = (listOfShape (extent array))

--Functions of 3D array

   --assume the array as cube positioned with z axis downward and x axis to right
-- left-right i = 0-dimOne
-- top-bottom  k = 0-dimThree
-- up-down j = 0-dimTwo

setBoundaryLeft3D :: (Array U (((Z :. Int) :. Int):. Int) Double ) -> Double ->(IO (Array U DIM3 Double))
setBoundaryLeft3D array val = computeP $ traverse array id (\f (Z:. i:. j :. k) -> if i == 0  then val else f(Z:. i :. j :. k))

setBoundaryRight3D :: (Array U (((Z :. Int) :. Int):. Int) Double ) -> Double ->(IO (Array U DIM3 Double))
setBoundaryRight3D array val = computeP $ traverse array id (\f (Z:. i:. j :. k) -> if i == dimOne - 1  then val else f(Z:. i :. j :. k))
    where dimOne = dim !! 0
          dim = (listOfShape (extent array))

setBoundaryTop3D :: (Array U (((Z :. Int) :. Int):. Int) Double ) -> Double ->(IO (Array U DIM3 Double))
setBoundaryTop3D array val = computeP $ traverse array id (\f (Z:. i:. j :. k) -> if k == 0  then val else f(Z:. i :. j :. k))

setBoundaryBottom3D :: (Array U (((Z :. Int) :. Int):. Int) Double ) -> Double ->(IO (Array U DIM3 Double))
setBoundaryBottom3D array val = computeP $ traverse array id (\f (Z:. i:. j :. k) -> if k == dimThree - 1  then val else f(Z:. i :. j :. k))
    where dimThree = dim !! 2
          dim = (listOfShape (extent array))


setBoundaryUp3D :: (Array U (((Z :. Int) :. Int):. Int) Double ) -> Double ->(IO (Array U DIM3 Double))
setBoundaryUp3D array val = computeP $ traverse array id (\f (Z:. i:. j :. k) -> if j == 0  then val else f(Z:. i :. j :. k))


setBoundaryDown3D :: (Array U (((Z :. Int) :. Int):. Int) Double ) -> Double ->(IO (Array U DIM3 Double))
setBoundaryDown3D array val = computeP $ traverse array id (\f (Z:. i:. j :. k) -> if j == dimTwo - 1  then val else f(Z:. i :. j :. k))
    where dimTwo = dim !! 1
          dim = (listOfShape (extent array))

setBoundaryAll3D :: (Array U (((Z :. Int) :. Int):. Int) Double ) -> Double ->(IO (Array U DIM3 Double))
setBoundaryAll3D array val = computeP $ traverse array id (\f (Z:. i:. j :. k) -> if i == 0 || i == dimOne -1 || j == 0 || j == dimTwo - 1 || k == 0 || k == dimThree - 1 then val else f(Z:. i :. j :. k))
    where dimOne = dim!! 0
          dimTwo = dim !! 1
          dimThree = dim!! 2
          dim = (listOfShape (extent array))