如何在Haskell中使用可变数据高效建模关系

Question

我有一个类似于this的问题。然而，它涉及大量更新，我不确定IxSet是否是解决方案。

基本上，我正在编写一个应用程序来优化仓库布局。没有数据库或其他任何东西；只是需要操纵和生成文件的简单数据。仓库由不同尺寸的货架组成，货架上放置了不同尺寸的盒子，目标是找到最佳的布局（或至少是一个好的布局），让所有盒子都适合。

基本模型（实际上并不重要）是：

data Dimension = Dimension {length::Double, width::Double, height::Double}
data Box = Box  {boxId :: Int,  boxDim:: Dimension }
data Shelf = Shelf {shelfId :: Int, shelfDim :: Dimension, postion :: ... }

现在，第一个问题是有一个货架图。有些货架是背靠背的。我需要知道这一点，因为一个货架的深度可以调整（这会相反地修改背面的货架）。我还需要知道相对的货架和下一个货架。

最有效的建模方法是什么？

我的第一个想法是：

data Shelf = Shelf { ... , backShelf :: Maybe Shelf 
                         , frontShelf :: Maybe Shelf
                         , nextShelf :: Maybe Shelf
                   }

现在，在Haskell中，数据是不可变的，那么我该如何更新Shelf？我的意思是，想象一下，如果我有一个Shelf列表；如果我修改一个Shelf，那么我需要更新所有副本吗？

我的第二个想法是使用id代替：

newtype ShelfId = Int
data Shelf = Shelf { ..., backShelfId :: Maybe ShelfId ... }

或者我应该使用外部图表？例如

 back, front, next :: [(shelfId, shelfId)]

第二个问题是如何建模一个盒子属于一个货架的事实。

可能的方法有：

  data Box = Box { ..., shelf :: Shelf }

或者

  data Box = Box { ..., shelfId :: Maybe ShelfId }   

或

  data Shelf = Shelf { ..., boxes = [Box] }

或者

  data Shelf = Shelf { ..., boxIds = [BoxId] }

一个外部图表。

 boxToShelf :: [(BoxId, ShelfId)]

此外，正如我所说的，这些操作涉及大量的更新；我可能会逐个向每个架子添加盒子，这在不可变数据中可能非常低效。

我想到的另一种解决方案是使用STRef或等效物：

data Box = { ..., shelf :: STRef Shelf }

感觉使用指针，所以可能不是一个好主意。

更新

这不是XY问题，也不是玩具问题。这是一个真实的应用程序，用于一个真实的仓库（大约有100个货架和3000个箱子）。它需要能够绘制和加载现有数据（箱子及其位置）。优化只是其中的一部分，可能会半手动完成。

因此，我的问题是关于表示可变对象之间关系而不是基本的组合问题。

- mb14

---

如果您提供一个只有少量货架和箱子的示例问题，并解释最佳解决方案及其原因，那将非常有帮助。 - ErikR

我确定，但是怎么做呢？例如，在场景data Shelf = ... boxes :: [Box], backShelf :: Maybe Shelf}中，修改一个盒子涉及到修改包含该盒子的货架以及所有引用它的货架，以及引用它们的货架等等... - mb14

请参阅如何在Haskell中表示图形？。 - Daniel Wagner

似乎该问题可以使用传统的组合搜索方法解决。您的问题有多大——即货架和箱子数量？ - ErikR

我记得这个东西是从哪里看到的。哦，对了，在这里。看来你想尽可能多地获得互联网积分。 - Shoe

Answer 1

了解优化算法的工作原理会有所帮助。

问题的核心是一个数据结构，它跟踪哪些盒子在哪些架子上（反之亦然）。我们称其为“配置”。

组合搜索算法通过探索所有可能的配置空间，从旧配置创建新配置。在任何时候，内存中都有几个配置 - 每个递归搜索的堆栈框架一个。

另一方面，像局部搜索这样的算法只有一个（全局）数据结构，它使用启发式或随机性变异，直到找到足够好的解决方案。

你的算法最像哪种？

更新：请注意，并非所有用例都可以使用单个表示。对于存储数据，您只需要架子到盒子的映射。对于显示，您可能会发现也有反向映射（盒子->架子）。而对于优化，您可能需要使用可变数组来模拟问题以进行有效的更新。

更新2：我建议尝试持久化数据结构方法，看看它的效果如何。

type BoxId = Int
type ShelfId = Int

data Shelf = Shelf { ... just the dimensions of the shelf ... }
data Box   = Box { ... just the dimensions of the box ... }

data Configuration = {
    shelves       :: IntMap Shelf,    -- map from shelf id to shelf characterstics
    boxes         :: IntMap Box,      -- map from box id to box characteristics
    boxesForShelf :: IntMap [BoxId],  -- map from shelf id to box ids
    shelfForBox   :: IntMap ShelfId   -- map from box id to shelf id (or 0)
}

然后编写这个函数：

assignBox :: BoxId -> ShelfId -> Configuration -> Configuration

为了提高效率，你也可以写类似于：

assignBoxes :: [BoxId] -> ShelfId -> Configuration -> Configuration

请随意编写其他针对您使用情况中出现的Configuration的大规模更新进行优化的功能。

您可能会发现在Box结构中具有BoxId（Shelf结构也一样）很方便......但您不一定需要它。但是，箱子和货架之间的关系最好用单独的映射来处理。

我将boxesForShelf定义为IntMap [BoxId]，只是因为听起来每个货架上只有少量箱子。也许这不是有效的。

希望这有所帮助。

- ErikR

---

该算法可能是半手动的。用户可以拖放相同类别的盒子，这些盒子将自动填充（选择最佳方向）货架（货位）等一系列。主要限制是它像真实的仓库一样。你不能只是因为算法已经决定了就移动1000个盒子。有些盒子需要留在原地，即使这不是最优的。 - mb14

每个架子大约有20个盒子，所以不算多。是否有更高效的映射方式（例如没有间隙的数组）？ - mb14

@mb14，Data.IntMap 是一个 Patricia trie。它不像数组那样紧凑，但它允许有效的持久化修改。可变数组或向量始终是一种选择，但使用它们会将您的算法推入 ST 或 IO，从而限制灵活性。如果您决定使用可变数组/向量，则应使用“未装箱”版本，以实现紧凑性并避免减慢垃圾收集器的速度。 - dfeuer

Answer 2

为什么不使用 persistent？ 我已经为您准备了一个示例应用程序，以 cabal 包的形式提供，您可以在此处使用 https://github.com/gxtaillon/Shelves。

Persistent 遵循类型安全和简洁的声明性语法的指导原则。其他一些不错的特性包括：

• 与数据库无关。对 PostgreSQL、SQLite、MySQL 和 MongoDB 有一流支持，具有实验性的 Redis 支持。
• 方便的数据建模。Persistent 允许您建模关系并以类型安全的方式使用它们。默认的类型安全 persistent API 不支持联接，从而支持更多的存储层。通过使用原始 SQL 层（几乎没有类型安全），可以实现联接和其他 SQL 特定功能。另外一个库 Esqueleto 在 Persistent 数据模型之上构建，添加了类型安全的联接和 SQL 功能。
• 自动执行数据库迁移

一旦您知道需要存储哪些数据，您将拥有一个工作数据库，并能够开始开发优化算法，而无需担心性能、可扩展性或重新发明轮子。

模型 - 一个包含您的数据库架构定义的文件。

Shelf
    hrId Text
    length Double
    width Double
    height Double
    UniqueShelf hrId
    deriving Show
Box
    hrId Text
    length Double
    width Double
    height Double
    UniqueBox hrId
    deriving Show
Storage
    shelfId ShelfId
    boxId BoxId
    UniqueStorage shelfId boxId
    deriving Show

Model.hs - 在这里导入models并生成相应的类型

{-# LANGUAGE EmptyDataDecls             #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}
module Model where
import Database.Persist.Quasi
import Database.Persist.TH
import ClassyPrelude

share [mkPersist sqlSettings, mkMigrate "migrateAll"]
    $(persistFileWith upperCaseSettings "models")

Main.hs - 一个示例应用程序

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Model
import Control.Monad.IO.Class  (liftIO)
import Database.Persist.Sqlite hiding (master, Connection)

main :: IO ()
main = runSqlite ":memory:" $ do
    runMigration migrateAll

    myShelfId <- insert $ Shelf "ABCD.123" 10.0 1.5 2.0
    thatBoxId <- insert $ Box "ZXY.098" 1.0 1.0 1.0
    thisBoxId <- insert $ Box "ZXY.099" 2.0 1.0 1.0

    _ <- insert $ Storage myShelfId thatBoxId
    _ <- insert $ Storage myShelfId thisBoxId

    myStorage <- selectList [StorageShelfId ==. myShelfId] []
    liftIO $ print (myStorage :: [Entity Storage])

    update myShelfId [ShelfWidth +=. 0.5]

    thatBox <- get thatBoxId
    liftIO $ print (thatBox :: Maybe Box)
    myShelf <- get myShelfId
    liftIO $ print (myShelf :: Maybe Shelf)

这将会输出类似下面的内容：

Migrating: [...]
[Entity {entityKey = StorageKey {unStorageKey = SqlBackendKey {unSqlBackendKey = 1}}, entityVal = Storage {storageShelfId = ShelfKey {unShelfKey = SqlBackendKey {unSqlBackendKey = 1}}, storageBoxId = BoxKey {unBoxKey = SqlBackendKey {unSqlBackendKey = 1}}}},Entity {entityKey = StorageKey {unStorageKey = SqlBackendKey {unSqlBackendKey = 2}}, entityVal = Storage {storageShelfId = ShelfKey {unShelfKey = SqlBackendKey {unSqlBackendKey = 1}}, storageBoxId = BoxKey {unBoxKey = SqlBackendKey {unSqlBackendKey = 2}}}}]
Just (Box {boxHrId = "ZXY.098", boxLength = 1.0, boxWidth = 1.0, boxHeight = 1.0})
Just (Shelf {shelfHrId = "ABCD.123", shelfLength = 10.0, shelfWidth = 2.0, shelfHeight = 2.0})

- gxtaillon

Answer 3

所以让我们先考虑最简单的情况：矩形需要容纳一些矩形，不允许叠放。然后当我们把一个矩形放在旧“书架”上时，我们可以提供一个新的“书架”：

newtype Box = Box Int Int Int deriving (Eq, Ord, Show)
newtype Shelf = Shelf Int Int Int deriving Show
type ShelfID = Int
type BoxID = Int
type ShelfBox = (ShelfID, BoxID)

fitsOn :: (Int, Box) -> (Int, Shelf) -> Maybe (ShelfID, Shelf)
fitsOn (bid, Box bw bh) (sid, Shelf sw sh) 
   | bw <= sw && bh <= sh = Just (sid, Shelf (sw - bw) sh)
   | otherwise = Nothing

可能最有效的方法是从最宽的盒子开始进行深度优先搜索：

import Data.IntMap.Strict (IntMap, (!))
import Data.IntMap.Strict as IntMap
import Data.List (sort)

collect (mx : mxs) = case mx of 
    Just x -> x : collect mxs
    Nothing -> collect mxs

-- need to feed something like `IntMap.fromList $ zip [0..] $ sort bs` to `boxes`:
search :: IntMap Box -> IntMap Shelf -> [ShelfBox] -> Maybe [ShelfBox]
search boxes shelves acc 
    | IntMap.empty boxes = Just acc
    | otherwise = case collect $ (map process) options of
        [] -> Nothing
        (x : xs) -> Just x
    where (box, boxes') = IntMap.deleteFindMax boxes
          options = collect [box `fitsOn` shelf | shelf <- IntMap.toList shelves]
          process (sid, s') = search boxes' (IntMap.insert sid s') ((sid, fst box) : acc)

现在我们如何将两个货架叠放在一起，总高度为H，但除此之外高度是独立的呢？我们可以将这两个货架一起写入我们的货架列表中：

vert_shelves other_shelves h w = [Shelf w (h - i) : Shelf w i : other_shelves | i <- [0..h - 1]]

如果你想要多層盒子，你需要從fitsOn (上下和旁邊) 產生兩個矩形，然後嘗試將“上方”盒子與任何來自同一架並且高度相同的其他盒子合併，這將需要重新設計。如果您還想要無限數量的盒子，那就有點棘手，得重寫如何傳遞這些可能性。

- CR Drost

---

这不是一个 XY 问题。我不是在寻求优化问题的解决方案，而是如何表示现实世界的数据。请查看我的更新。 - mb14

此外，[ShelfBox] 表示并不防止一个箱子属于多个货架。 - mb14

啊哈。对不起，我误解了你。 - CR Drost

仅仅通过上面的玩具示例的工作过程就可以看出，你可能需要的数据结构类似于从ShelfID到BoxIDs列表的映射，从ShelfID到货架的地板尺寸的映射，一个未上架的盒子列表，而且每个货架可能需要在空间中有一个位置。你对可变深度的要求可能最好通过让一个Shelf存在于一个二维的ShelfSpace盒子中来实现？SQL数据库可以很好地强制执行“一个盒子不属于多个货架”的规则，但在Haskell中这可能不太自然。我认为你可能希望在逻辑中考虑这一点。 - CR Drost

Answer 4

听起来你需要一个关系型数据库管理系统（RDBMS）。如果你不想在Haskell中实现它（你可能不应该这样做），那么我建议你使用优秀的免费Postgres，并使用Opaleye以类型安全和可组合的方式从Haskell与其通信。[免责声明：我编写了Opaleye。]

- Tom Ellis