彭罗斯瓷砖的图示

# 彭罗斯铺砌的图表 来源：https://readerunner.wordpress.com/2021/09/13/diagrams-for-penrose-tiles/ 图：leftFilledSun6 *2026年6月更新* 这篇博客关于绘制罗杰·彭罗斯风筝与飞镖瓦片构成的无限非周期镶嵌中的有限区域。最初写作时尚未开发出 Haskell 包（PenroseKiteDart），该包现已可在 Hackage 上获取。更多信息和发展可见文末。为使本文与后续发展保持兼容，我已做小幅更新（它也不再是一个完整的 literate Haskell 文件）。 ## 引言 在与 Stephen Huggett 合作研究彭罗斯铺砌的某些数学性质时，我意识到需要快速渲染铺砌图形。我认为*Haskell Diagrams*在这里会很有用，而事实证明这是一个极好的选择。二维向量非常适合描述铺砌操作，而它们正是 diagrams 包的一部分。 下面使用的 Haskell 代码借助 Haskell Diagrams 包绘制风筝与飞镖铺砌。它还实现了 `compChoices` 和 `decompPatch`，用于构造铺砌（下文解释）。 首先，在 Haskell 中使用 diagrams 包需要以下 5 行代码： ```haskell {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} import Diagrams.Prelude import Diagrams.Backend.SVG.CmdLine ``` 我们还将导入一个半瓦模块（后续说明）： ```haskell import HalfTile ``` ## 合法铺砌 以下是风筝与飞镖瓦片。 图：风筝与飞镖 右侧副本上的红色标记线仅用于说明瓦片组合成合法（非周期）铺砌的规则。显然，边只有长度相等时才能拼接在一起。如果所有瓦片都按右侧所示标有红线，那么瓦片相接的顶点处，要么全有红线，要么全无红线。这防止了简单地将风筝顶部置于飞镖底部形成菱形，从而可能产生周期铺砌。 所有边的长度都是黄金分割 `phi` 的幂，我们将其写作 `phi`。 ```haskell phi :: Double phi = (1.0 + sqrt 5.0) / 2.0 ``` 因此，若短边为单位长度，则长边长为 `phi`。黄金分割还有一个有趣性质：`phi^2 = phi + 1`，于是 `1/phi = phi-1`，`phi^3 = 2phi + 1`，`1/phi^2 = 2-phi`。 图中所有角度都是 `tt`（即 `36 deg` 或 `1/10 转`）的倍数。我们使用 `ttangle` 来表示这样的角度（例如，180 度是 `ttangle 5`）。 ```haskell ttangle :: Int -> Angle Double ttangle n = (fromIntegral (n `mod` 10))*^tt where tt = 1/10 @@ turn ``` ## 瓦片片 为了实现 `compChoices` 和 `decompPatch`，我们需要使用半瓦。现在我们定义这些半瓦于独立导入的模块 `HalfTile` 中，包含左飞镖、右飞镖、左风筝、右风筝四个构造子： ```haskell data HalfTile rep -- 在 HalfTile 模块中定义 = LD rep | RD rep | LK rep | RK rep ``` 其中 `rep` 是类型变量，允许不同的表示方式。但在此处，我们想使用一个更具体的类型，称为 `Piece`。 ```haskell type Piece = HalfTile [V2 Double] ``` 这里，半瓦采用简单的二维向量表示，以提供方向和缩放。（*2026年更新*：最初使用单个向量表示半瓦的接合边，现在改用两个向量的列表。） 两个二维向量的列表表示半瓦的两条边（不包括半瓦拼接时的*接合边*）。飞镖的原点是尖端，风筝的原点是锐角尖端（图中用红点标记）。 这就是我们使用的全部 4 个片。它们沿 x 轴方向定向，接合边对齐。在图中它们被旋转了 90 度，使得接合边垂直（并标有标签）。 ```haskell ldart, rdart, lkite, rkite :: Piece ldart = LD [v', v ^-^ v'] where v = unitX v' = phi*^rotate (ttangle 9) v rdart = RD [v', v ^-^ v'] where v = unitX v' = phi*^rotate (ttangle 1) v lkite = LK [v', v ^-^ v'] where v = phi*^unitX v' = rotate (ttangle 1) v rkite = RK [v', v ^-^ v'] where v = phi*^unitX v' = rotate (ttangle 9) v ``` 图：四种半瓦片 可能令人困惑的是，我们对飞镖的左右与风筝的左右看法不同（从原点看）。图中右飞镖在左飞镖之前，左风筝在右风筝之前。因此，在一整块瓦片中，顺时针绕原点，右飞镖在左飞镖之前，但左风筝在右风筝之前。 绘制片时，最简单的情况是只绘制每片的两个瓦片边（而不是接合边）。它们是瓦片的 `drawnEdges`。我们还可以使用瓦片的 `joinVector`（即绘制边的向量和）。`drawnEdges` 从每片的原点开始排序。 ```haskell drawnEdges :: Piece -> [V2 Double] joinVector :: Piece -> V2 Double ``` 现在，绘制一个片的两条外边缘线： ```haskell drawPiece :: Piece -> Diagram B drawPiece = strokeLine . fromOffsets . drawnEdges ``` 或者只绘制接合边： ```haskell drawJoin :: Piece -> Diagram B drawJoin piece = strokeLine $ fromOffsets [joinVector piece] ``` 或者绘制环绕一片的所有三条边： ```haskell drawRoundPiece :: Piece -> Diagram B drawRoundPiece = strokeLoop . closeLine . fromOffsets . drawnEdges ``` 有时我们希望绘制两条边缘，但用浅色虚线表示接合边： ```haskell drawjPiece :: Piece -> Diagram B drawjPiece = drawPiece <> (lw ultraThin . joinDashing . drawJoin) where joinDashing = normalized 0.003 `atLeast` output 1.0 ``` 要填充半瓦片，可以使用 `fillOnlyPiece`，它只填充而不显示半瓦片的边缘（通过将线宽设为 none）： ```haskell fillOnlyPiece :: Colour Double -> Piece -> Diagram B fillOnlyPiece col piece = drawRoundPiece piece # fc col # lw none ``` 我们也使用 `fillPieceDK`，它用给定颜色填充飞镖和风筝，并用 `drawPiece` 绘制边缘： ```haskell fillPieceDK :: Colour Double -> Colour Double -> Piece -> Diagram B fillPieceDK dcol kcol piece = drawPiece piece <> fillOnlyPiece col piece where col = case piece of (LD _) -> dcol (RD _) -> dcol (LK _) -> kcol (RK _) -> kcol ``` 针对整块瓦片的另一种填充操作，我们计算了一个由瓦片原点开始顺时针排列的完整半瓦片四条边的列表。这允许填充整块瓦片颜色，但它依赖于先前的变换保持角度不变（因为定义中用到了角度，此处未展示）： ```haskell wholeTileEdges :: Piece -> [V2 Double] ``` 要用颜色填充整块瓦片（飞镖用 `dcol`，风筝用 `kcol`），现在我们使用 `leftFillPieceDK`。此函数仅使用左片来识别整块瓦片，忽略右片，这样瓦片不会被重复填充，并使用 `wholeTileEdges`： ```haskell leftFillPieceDK :: Colour Double -> Colour Double -> Piece -> Diagram B leftFillPieceDK dcol kcol c = case c of (LD _) -> (strokeLoop $ glueLine $ fromOffsets $ wholeTileEdges c) # fc dcol (LK _) -> (strokeLoop $ glueLine $ fromOffsets $ wholeTileEdges c) # fc kcol _ -> mempty ``` 通过使 `Piece` 可变换，我们可以重用通用的变换操作。这需要以下4行代码： ```haskell type instance N (HalfTile a) = N a type instance V (HalfTile a) = V a instance Transformable a => Transformable (HalfTile a) where transform t ht = fmap (transform t) ht ``` 因此我们可以缩放和旋转一个片（正角度为逆时针方向），但在它们被定位（作为 Patches）之前不能平移。 ```haskell scale :: Double -> Piece -> Piece rotate :: Angle Double -> Piece -> Piece ``` ## 拼块 一个拼块是已定位片（每个带一个2D点）的列表： ```haskell type Patch = [Located Piece] ``` 要将整个拼块转换为图表，使用某个函数 `pd` 绘制片，我们使用 `drawWith`： ```haskell class Drawable a where drawWith :: (Piece -> Diagram B) -> a -> Diagram B instance Drawable Patch where drawWith pd = position $ fmap (viewLoc . mapLoc pd) ``` 这里 `mapLoc` 将函数应用于已定位片中的片——此处生成一个已定位图表，而 `viewLoc` 从已定位图表中返回点与图表的对。最后 `position` 将点与图表的对列表合并成单个图表。（此处使用类定义是为后续更多实例做准备。） 我们现在定义最常见的特殊情况： ```haskell draw :: Drawable a => a -> Diagram B draw = drawWith drawPiece drawj :: Drawable a => a -> Diagram B drawj = drawWith drawjPiece fillDK :: Drawable a => Colour Double -> Colour Double -> a -> Diagram B fillDK c1 c2 = drawWith (fillPieceDK c1 c2) ``` 拼块自动推断为可变换，因此我们也可以缩放拼块、按向量平移拼块、按角度旋转拼块（例如）： ```haskell scale :: Double -> Patch -> Patch rotate :: Angle Double -> Patch -> Patch translate :: V2 Double -> Patch -> Patch ``` 为辅助创建具有五重旋转对称性的拼块，我们将基本拼块的5个副本组合在一起（依次旋转 `ttangle 2` 的倍数）： ```haskell penta :: Patch -> Patch penta p = concatMap copy [0..4] where copy n = rotate (ttangle (2*n)) p ``` 使用此函数需谨慎，以免产生无意义的拼块。但有两个特例： ```haskell sun, star :: Patch sun = penta [rkite `at` origin, lkite `at` origin] star = penta [rdart `at` origin, ldart `at` origin] ``` 下图展示了一些示例拼块，使用 `draw` 绘制。第一个是 `star`，第二个是 `sun`。 图：瓦片拼块 目前创建拼块的工具可能显得有限（且无助于确保合法铺砌），但还有一个更大的问题。 ## 正确铺砌 不幸的是，正确铺砌——即可以无限延伸的铺砌——并不仅仅是合法铺砌那么简单。仅有合法铺砌是不够的，因为一个看似（合法）的瓦片放置选择可能会产生非局部后果，与远处拼块中的选择发生冲突，导致拼块无法扩展。这说明构造正确拼块远非易事。 无限多种可能的无限铺砌确实有一些显著的性质。任何有限拼块（来自其中之一）会出现在所有其他铺砌中（无限多次），并且在无限铺砌中任何点的一个相当小的半径内都会出现。（详情见文末链接。） 这就是为什么我们需要一种不同的方法来构造更大的拼块。有两种重要的过程用于创建拼块，即 `inflate`（也称为 *compose* 或组合）和 `decompose`（分解）。 要理解这些过程，请看下图。 图：实验 这里*小*瓦片以一种不寻常的方式绘制：边缘用虚线，但风筝的长边用实线强调，飞镖的接合边用红线标记。从中你可能能辨认出一幅更大尺度风筝与飞镖的拼块。这就是从小尺度拼块膨胀而来的拼块。反之，更大的风筝与飞镖分解成更小尺度的那些。 ## 分解 由于分解规则是唯一确定的，我们可以将其表示为拼块上的简单函数： ```haskell decompPatch :: Patch -> Patch decompPatch = concatMap decompPiece ``` 其中 `decompPiece` 函数作用于已定位片，并产生该片所包含的更小已定位片的列表。例如，一个大的右飞镖会同时产生一个更小的右飞镖和一个更小的左风筝。分解一个已定位片还处理了新片的定位、缩放和旋转。（*2026年修订版，避免使用角度*）： ```haskell decompPiece :: Located Piece -> [Located Piece] decompPiece lp = case viewLoc lp of (p, RD [z1,z2]) -> [ LK [s1, s2 ] `at` p , RD [z2, negate s2] `at` (p .+^ z1) ] where s1 = (phi-1) *^ z1 s2 = sumV [z1,z2] ^-^ s1 (p, LD [z1,z2]) -> [ RK [s1, s2 ] `at` p , LD [z2, negate s2] `at` (p .+^ z1) ] where s1 = (phi-1) *^ z1 s2 = sumV [z1,z2] ^-^ s1 (p, RK [z1,z2]) -> [ RD [s1, s2] `at` p , LK [s4, negate s2] `at` (p .+^ z1) , RK [z2, s3] `at` (p .+^ z1) ] where j = sumV [z1,z2] s1 = (phi-1) *^ j s2 = (2-phi) *^ z1 ^-^ s1 s3 = (phi-2) *^ j s4 = (1-phi) *^ z1 (p, LK [z1,z2]) -> [ LD [s1, s2] `at` p , RK [s4, negate s2] `at` (p .+^ z1) , LK [z2, s3] `at` (p .+^ z1) ] where j = sumV [z1,z2] s1 = (phi-1) *^ j s2 = (2-phi) *^ z1 ^-^ s1 s3 = (phi-2) *^ j s4 = (1-phi) *^ z1 other -> error $ "decompPiece: " ++ show other ++ "/n" ``` 下图展示了右飞镖和右风筝的情况。左片的对称图可以从这些推得，故未图示。 图：分解与组合 有了 `decompPatch` 操作，我们可以从一个简单的正确拼块开始，反复分解得到越来越精细的拼块。（每次分解将瓦片缩小因子 `1/phi`，但我们可以随时重新缩放。） 下图展示了每个片如何分解，每个片下方有4步分解。 图：片的四次分解 ```haskell thePieces = [ldart, rdart, lkite, rkite] fourDecomps = hsep 1 $ fmap decomps thePieces # lw thin where decomps pc = vsep 1 $ fmap drawj $ take 5 $ decompositionsP [pc `at` origin] ``` 我们利用了可以创建任何拼块的无限精细分解列表的事实： ```haskell decompositionsP :: Patch -> [Patch] decompositionsP = iterate decompPatch ``` 我们可以得到拼块的 n 重分解，即分解列表中的第 n 项。 例如，这里是 `sun` 的无限分解版本列表： ```haskell suns = decompositionsP sun ``` 开头展示的彩色铺砌正是 `sun` 的 6 次分解，使用 `leftFillPieceDK` 显示： ```haskell leftFilledSun6 :: Diagram B leftFilledSun6 = drawWith (leftFillPieceDK red darkviolet) sun6 # lw thin ``` 之前展示的（用实验方式绘制）强调出更大风筝与飞镖的图也是 `suns!!6`，但这次瓦片用 `experiment` 绘制： ```haskell experimentFig = drawWith experiment (suns!!6) # lw thin experiment :: Piece -> Diagram B experiment pc = emph pc <> (drawRoundPiece pc # dashingN [0.002,0.002] 0 # lw ultraThin) where emph pc = case pc of (LD v) -> (strokeLine . fromOffsets) [v] # lc red -- 强调飞镖的接合边，用红色 (RD v) -> (strokeLine . fromOffsets) [v] # lc red (LK v) -> (strokeLine . fromOffsets) [rotate (ttangle 1) v] -- 强调风筝的长边 (RK v) -> (strokeLine . fromOffsets) [rotate (ttangle 9) v] ``` ## 组合选择 你可能期望组合（也