“重载”值构造函数

Question

在"Making Our Own Types and Typeclasses"中，他们提供以下代码：

data Point = Point Float Float deriving (Show)  
data Shape = Circle Point Float | Rectangle Point Point deriving (Show)

surface :: Shape -> Float  
surface (Circle _ r) = pi * r ^ 2  
surface (Rectangle (Point x1 y1) (Point x2 y2)) = (abs $ x2 - x1) * (abs $ y2 - y1)  

nudge :: Shape -> Float -> Float -> Shape
nudge (Circle (Point x y) r) a b = Circle (Point (x+a) (y+b)) r  
nudge (Rectangle (Point x1 y1) (Point x2 y2)) a b = Rectangle (Point (x1+a) (y1+b)) (Point (x2+a) (y2+b))

main = do
    print (surface (Circle (Point 0 0) 24))
    print (nudge (Circle (Point 34 34) 10) 5 10)

目前，与构造函数匹配的模式在这一点上变得非常混乱

nudge (Rectangle (Point x1 y1) (Point x2 y2)) a b = ....

我们将Shape类型定义为：

data Shape = Circle Point Float | Rectangle Float Float Float Float deriving (Show)

然后即使我们对类型的性质失去了一点清晰度，模式匹配看起来也不那么杂乱，如下所示：

data Point = Point Float Float deriving (Show)  
data Shape = Circle Point Float | Rectangle Float Float Float Float deriving (Show)

surface :: Shape -> Float  
surface (Circle _ r) = pi * r ^ 2  
surface (Rectangle x1 y1 x2 y2) = (abs $ x2 - x1) * (abs $ y2 - y1)  

nudge :: Shape -> Float -> Float -> Shape
nudge (Circle (Point x y) r) a b = Circle (Point (x+a) (y+b)) r  
nudge (Rectangle x1 y1 x2 y2) a b = Rectangle (x1+a) (y1+b) (x2+a) (y2+b)

main = do
    print (surface (Circle (Point 0 0) 24))
    print (nudge (Circle (Point 34 34) 10) 5 10)

我的问题是是否可以同时使用

Rectangle Point Point

和

Rectangle Float Float Float Float

在同一段代码中（即值构造函数的某种“重载”），以便我们可以执行以下操作：

...
surface (Rectangle (Point x1 y1) (Point x2 y2)) = (abs $ x2 - x1) * (abs $ y2 - y1)  

...
nudge (Rectangle x1 y1 x2 y2) a b = Rectangle (x1+a) (y1+b) (x2+a) (y2+b)

其中“...”表示与上面代码中的相同。还有什么其他的技巧可以使符号在“轻推（矩形......）点”更紧凑吗？谢谢

Answer 1

一种选择是使用view patterns。让我举个简短的例子：

{-# LANGUAGE ViewPatterns #-}

data Point = Point Float Float
data Shape = Circle Point Float | Rectangle Point Point

rectangleAsPoints :: Shape -> Maybe (Point,Point)
rectangleAsPoints (Rectangle a b) = Just (a,b)
rectangleAsPoints _               = Nothing

rectangleFromPoints :: Point -> Point -> Shape
rectangleFromPoints = Rectangle

rectangleAsCoords :: Shape -> Maybe (Float,Float,Float,Float)
rectangleAsCoords (Rectangle (Point x y) (Point a b)) = Just (x,y,a,b)
rectangleAsCoords _                                   = Nothing

rectangleFromCoords :: Float -> Float -> Float -> Float -> Shape
rectangleFromCoords a b c d = Rectangle (Point a b) (Point c d)

surface (rectangleAsPoints -> Just (Point x1 y1, Point x2 y2)) =
  (abs $ x2 - x1) * (abs $ y2 - y1)
surface (Circle _ r) = pi * r ^ 2

nudge (rectangleAsCoords -> Just (x1,y1,x2,y2)) a b =
  rectangleFromCoords (x1+a) (y1+b) (x2+a) (y2+b)
nudge (Circle (Point x y) r) a b = Circle (Point (x+a) (y+b)) r

为了保持一致性，我将矩形视图实现为函数。这样，Rectangle类型的实际实现可以保持隐藏。

注意如何混合普通模式匹配和视图模式。

Answer 2

您可以使用类型类使函数表现为Point -> Point -> Rectangle和Float -> Float -> Float -> Float -> Rectangle，但我不会提倡它。收益会有很多麻烦。无论如何，我都不会想到你可以在模式匹配中使用这样一个重载的名称。

我看到它的方式，如果您只是通过解构它们并使用原始Point值来运行Float值，那么您实际上并不是真的得到那么多，所以你可以通过完全摆脱它来解决你的问题。

但是你错过了实现直接调整积分的功能的绝佳机会！

对于初学者，我会设置Offset类型来保存您的a和b值。然后你创建一个函数adjust :: Offset -> Point -> Point来进行组合。然后，您的nudge甚至不需要了解Point的内部结构来完成其工作！

例如（免责声明：我还没有实际编译过这个） ¹ ：

data Point = Point Float Float deriving (Show)
data Offset = Offset Float Float deriving (Show)
data Shape = Circle Point Float | Rectangle Point Point deriving (Show)

adjust :: Point -> Offset -> Point
adjust (Point x y) (Offset ox oy) = Point (x + ox) (y + oy)

nudge :: Shape -> Offset -> Shape
nudge (Circle c r) o = Circle (adjust c o) r  
nudge (Rectangle p1 p2) o = Rectangle (adjust p1 o) (adjust p2 o)

同样地，Point和Offset可能会有一整套操作。例如，offsetFrom :: Point -> Point -> Offset可能对您的surface函数有用。我曾经过度使用类型类来实现一系列运算符（|+|，|*|等等IIRC），它允许组合各种事物（例如，你可以添加Point并且Offset可以获得Point，您可以添加和减去Offset但不能Point s，您可以将Offset乘以标量但不是Point s等。不知道最后是否值得，但它使我的代码看起来像我的数学更多！

使用您当前的代码，您每次需要时都会在Point上再次有效地执行所有操作（包括nudge中相同等式中的相同调整操作两次，这是我的看法为什么它看起来非常糟糕）。

---

¹ 要使adjust和nudge这样的函数具有签名，其中＆＃34; main＆＃34;正在操作的东西是最后一个，所以adjust :: Offset -> Point -> Point和nudge :: Offset -> Shape -> Shape。这可以派上用场，因为部分应用adjust会给你一个点变换器＆＃34;使用Point -> Point类型，类似地，您可以部分应用nudge来获得＆＃34;形状变换器＆＃34;类型Shape -> Shape。

如果您有一组点或形状，并希望对所有点或形状应用相同的变换，这会有所帮助，例如：

data Shape = Polygon [Point]

adjust :: Offset -> Point -> Point
adjust (Offset ox oy) (Point x y) = Point (x + ox) (y + oy)

nudge :: Offset -> Shape -> Shape
nudge o (Polygon ps) = Polygon (map (adjust o) ps)

通常＆＃34;变形金刚＆＃34;使用类型Something -> Something只是对主数据结构有用的东西。因此，只要您有一个将一些辅助数据与Something结合起来生成新Something的函数，它就会变得非常有用，可以将Something作为最后一个参数，所以你有另一个简单的变换器函数源。

Answer 3

你想要的是不可能的。出于模式匹配的目的，您可以使用ViewPatterns作为多个构造函数的穷人替代，并使单个函数可以简化构造：

{-# LANGUAGE ViewPatterns #-}

-- Your pattern match aid
unRectangle :: Shape -> Maybe (Float, Float, Float, Float)
unRectangle (Rectangle (Point x1 y1) (Point x2 y2)) = Just (x1,y1,x2,y2)
unRectangle _ = Nothing

-- your construction aid
rectangle :: Float -> Float -> Float -> Float -> Shape
rectangle x y u v = Rectangle (Point x y) (Point u v)

surface (unRectangle -> Just (x1,y1,x2,y2)) = (abs $ x2 - x1) * (abs $ y2 - y1)
...
nudge (unRectangle -> Just (x1,y1,x2,y2)) = rectangle (x1+a) (y1+b) (x2+a) (y2+b)