3

假设我有一些像这样组织在网格中的数据(尺寸可能会有所不同,但网格的一侧始终是n**2):

0 1 2 3
4 5 6 7
8 9 A B
C D E F 

我想要实现的是拥有一个列表,其中包含以不同方式表示的相同数据,即分成列、行或(最重要的)单元格,即

0 1 | 2 3
4 5 | 6 7
----+----
8 9 | A B
C D | E F

因此,如果我执行一些操作,我将能够获取以下列表中的数据:

[[0, 1, 4, 5],
 [2, 3, 6, 7],
 [8, 9, C, D],
 [A, B, E, F]]

在哪里订购无关紧要。

我想用它来构建一个镜头,它能够根据不同类型的表示来设置值。这可以通过在命令式语言中使用指针或引用来实现(如果适用)。

除了细节之外,我想知道是否有一种通用方法可以使相同的内部数据以不同的方式表示。

到目前为止,这是我得到的,[Int]用作内部表示和转换函数来获取特定的“视图”:

import Data.List (transpose)

data Access = Rows | Columns | Cells

isqrt :: Int -> Int
isqrt = floor . sqrt . fromIntegral

group :: Int -> [a] -> [[a]]
group _ [] = []
group n l
  | n > 0 = (take n l) : (group n (drop n l))
  | otherwise = error "inappropriate n"

representAs :: [Int] -> Access -> [[Int]]
representAs list    Rows = group (isqrt . length $ list) list
representAs list Columns = transpose $ list `representAs` Rows
representAs list   Cells = let row_width  = isqrt . length $ list
                               cell_width = isqrt row_width
                               drops = map (\x -> cell_width 
                                                  * row_width
                                                  * (x `quot` cell_width)
                                                + cell_width 
                                                  * (x `rem` cell_width)
                                           ) [0..row_width-1]
                           in  (map ( (map snd)
                                    . (filter ( (==0)
                                              . (`quot` cell_width)
                                              . (`rem` row_width)
                                              . fst)
                                      )
                                    . (zip [0..])
                                    . (take (row_width * cell_width))
                                    . (`drop` list)
                                    ) drops
                               )

main = mapM_ (putStrLn . show) ([1..16] `representAs` Cells)

我的问题基于与此相同的想法但那里的答案仅涉及内存问题,而不是构造问题。此外,如果我要在几个表示中以不同的方式存储相同的数据,据我所知,我将不得不更新所有这些数据以设置新值。

4

3 回答 3

3

首先,正如user2407038在评论中提到的那样,List它不是一个非常有效的数据结构,尤其是对于您正在尝试做的事情。所以我将提供一个使用 boxed Vectorfrom vector包的实现,这显然具有恒定时间查找的优势。

其次,在用函数式语言编程时,你不能像用命令式语言那样思考。在 Haskell 中,您应该选择一种在处理数据方面最有效的数据结构,并将实际表示委托给对该数据进行操作的函数。我的意思是(因为没有突变,除非你真的需要它)你不能设置一个值并期望它在数据的所有表示中发生变化,而是应该将数据存储在单个数据结构中并且所有对该数据进行操作的函数会考虑它的表示。

在下面的实现中,它始终将数据存储为平面Vector,并让所有操作的函数都MyGrid考虑它的当前表示Access。您可能更愿意将其传递Access给函数,而不是使其成为MyGrid数据类型的一部分,但我做出这个选择只是为了简单。

import qualified Data.Vector as V

data Access = Rows | Columns | Cells

data MyGrid a = MyGrid { side :: Int -- square grid with each side = N
                       , view :: Access 
                       , vect :: V.Vector a }

这种方法允许您创建适当的构造函数,执行所有完整性检查,例如:

-- | Constructs a grid from a list, while making sure no elements are lost.
fromList :: [a] -> Access -> MyGrid a
fromList ls a = MyGrid { side = if side'*side' == length ls
                                then if even side'
                                     then side'
                                     else error "grid cannot be split in the middle"
                                else error "list cannot be represented as a square grid"
                       , view = a
                       , vect = V.fromList ls } where
  side' = floor . sqrt . fromIntegral . length $ ls

另一个构造函数可能是使用函数通过使用网格的索引和当前表示来生成元素的构造函数:

fromFunction :: Int -> Access -> ((Int, Int) -> a) -> MyGrid a

现在,这是处理表示的最重要部分,即从网格中检索元素:

index :: MyGrid a -> (Int, Int) -> a
index grid (i, j) =
  case view grid of
    Rows    -> vect grid V.! (i * side grid + j)
    Columns -> vect grid V.! (j * side grid + i)
    Cells   -> vect grid V.! if even i then k else k - d where
      n = side grid
      d = n `div` 2
      k = (i + j `div` d) * n + j `mod` d

现在您可以使用该函数来处理数据的表示,例如将其转换为列表列表,描述其打印方式或映射方式等:

toLists :: MyGrid a -> [[a]]
toLists grid = map (map (index grid)) [[(j, i) | i <- [0..n]] | j <- [0..n]]
  where n = side grid - 1

instance Show a => Show (MyGrid a) where
  show grid = unlines . map show $ toLists grid

instance Functor MyGrid where
  fmap f grid = grid { vect = V.map f $ vect grid}

现在允许您处理MyGrid的当前表示(通过使用show,fmap等):

λ> fromList [0..15] Rows
[0,1,2,3]
[4,5,6,7]
[8,9,10,11]
[12,13,14,15]

λ> succ <$> fromList [0..15] Columns
[1,5,9,13]
[2,6,10,14]
[3,7,11,15]
[4,8,12,16]

λ> fromList [0..15] Cells
[0,1,4,5]
[2,3,6,7]
[8,9,12,13]
[10,11,14,15]

这是我对如何将单元格拆分为边大于 的网格所做的假设4。也许网格应该有一个具有 权力的一面2,也许细胞应该是22我无法推断。只需将数学调整为您需要的,但我选择以Cells这种方式拆分更大的网格:

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 | 27 28 29
30 31 32 | 33 34 35

如果您在正确的单元格拆分方面需要进一步的帮助,请使用一些示例来编辑问题应该如何完成,我将调整实现。

于 2016-04-11T06:09:55.573 回答
1

为了后代和将来的参考,我将根据收集到的想法发布一个实现。整个答案是一个有文化的 Haskell程序,可以保存*.lhs并运行(尽管由于格式化,它需要额外的行来分隔代码和文本)。

> {-# LANGUAGE TemplateHaskell, FlexibleContexts #-}

> import Control.Lens (makeLenses, lens, (^.), ix, (.~), (.=), (^?), (%~))

> import qualified Data.Vector as V
> import Data.Vector.Lens (sliced)

> import Data.Maybe (fromJust)
> import Data.Function ((&))
> import Data.List (sortBy)

数据表示访问器:

  • 单元格是不重叠的正方形,因此每个单元格中的元素数等于网格边;
  • 行只是分成网格边长度块的数据;
  • 列是转置的行。

> data Access = Rows | Columns | Cells

数据结构本身,一个示例表示将是

 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

单个细胞在哪里,例如

 1  2  3
10 11 12
19 20 21

单元格始终包含与行或列相同数量的元素。

> data MyGrid a = MyGrid { _cell :: Int -- size of cell in grid, whole grid 
>                                       -- is a square of width `cell^2`
>                        , _vect :: V.Vector a -- internal data storage
>                        }
> makeLenses ''MyGrid 

将给定表示和单元大小的二维索引转换为内部

> reduce_index_dimension :: Access -> Int -> (Int, Int) -> Int
> reduce_index_dimension a s (x,y) = 
>   case a of
>     Cells   -> (y`rem`s)
>              + (x`rem`s) * s
>              + (y`quot`s) * s^2
>              + (x`quot`s) * s^3
>     Rows    -> x * s * s + y
>     Columns -> y * s * s + x

将给定表示和像元大小的内部索引转换为 2D

> increase_index_dimension :: Access -> Int -> Int -> (Int, Int)
> increase_index_dimension a s i = 
>   case a of
>     Cells   -> ( s *   i `quot` s^3
>                +      (i  `rem` s^2) `quot` s
>                , s * ((i `quot` s^2)  `rem` s)
>                +       i  `rem` s  )
>     Rows    -> ( i  `rem` s^2
>                , i `quot` s^2)
>     Columns -> ( i `quot` s^2
>                , i  `rem` s^2)

从列表构造一个网格,同时确保没有元素丢失。

> fromList :: [a] -> MyGrid a
> fromList ls = MyGrid { _cell = if side'^2 == length ls
>                                then if cell'^2 == side'
>                                     then cell'
>                                     else error "can't represent cell as a square"
>                                else error "can't represent list as a square"
>                      , _vect = V.fromList ls } where
>   side' = floor . sqrt . fromIntegral . length $ ls  -- grid width
>   cell' = floor . sqrt . fromIntegral $ side'        -- cell width

将给定的表示转换为内部

> convert :: Access -> [[a]] -> [a]
> convert from list = map snd
>                   . sortBy compare_index
>                   . map reduce_index 
>                   . concatMap prepend_index 
>                   . zip [0..] $ list
>   where
>     size                        = floor . sqrt . fromIntegral . length $ list
>     prepend_index (a, xs)       = zipWith (\b c -> ((a, b), c)) [0..] xs
>     reduce_index  (i, x)        = (reduce_index_dimension from size i, x)
>     compare_index (i, _) (j, _) = compare i j

从另一个网格构造一个网格,考虑表示

> fromListsAs :: Access -> [[a]] -> MyGrid a
> fromListsAs a l = MyGrid { _cell = if allEqualLength l
>                                    then if cell'^2 == side'
>                                         then cell'
>                                         else error "can't represent cell as a square"
>                                    else error "lists have different length or do not fit"
>                          , _vect = V.fromList . convert a $ l } where
>   side' = length l
>   cell' = floor . sqrt . fromIntegral $ side'        -- cell width
>   allEqualLength xs = and $ map ((== side') . length) (tail xs)

在同一物体上组合镜头,请参阅Haskell 使用第一级镜头创建复杂镜头

> (x ^>>= f) btofb s = f (s ^. x) btofb s

镜头聚焦在具有给定二维索引的给定表示中指向的元素

> lens_as a i = cell ^>>= \s -> vect . sliced (reduce_index_dimension a s i) 1 . ix 0

转换为二维表示

> toListsAs :: MyGrid a -> Access -> [[a]]
> toListsAs g a = [[fromJust $ g^?(lens_as a (x, y)) | y <- [0..n]] | x <- [0..n]]
>   where n = (g^.cell)^2 - 1

默认值

> toLists :: MyGrid a -> [[a]]
> toLists g = g `toListsAs` Rows

> instance Show a => Show (MyGrid a) where
>   show grid = unlines . map show . toLists $ grid

> instance Functor MyGrid where
>   fmap f grid = grid & vect %~ V.map f

完整性检查

> main = mapM_ (putStrLn . show) (fromList [0..(+80)0] `toListsAs` Cells)
于 2016-04-14T21:30:01.940 回答
0

低效的实现可能会引发更好的想法

column,row :: Int -> [((Int,Int),a)] -> [a]
column n xs = map snd $ filter (\((_,y),_) -> y==n) xs 
row n xs = map snd $ filter (\((x,_),_) -> x==n) xs   

cell :: Int -> Int -> [((Int,Int),a)] -> [a] 
cell n m xs = map snd $ filter (\((x,y),_) -> (div x 2 == n) && (div y 2==m)) xs

这里索引 4x4 矩阵的元素

> let a = zipWith (\x y -> ((div y 4,mod y 4),x)) [0..15] [0..]

单元格是 2x2 块

> cell 1 1 a 
[10,11,14,15]

> cell 0 0 a                                                   
[0,1,4,5]

> column 2 a                
[2,6,10,14]

> row 1 a 
[4,5,6,7]
于 2016-04-11T02:53:46.350 回答