vecAdd (i0, j0) (i1, j1) = (i0 + i1, j0 + j1)
vecSub (i0, j0) (i1, j1) = (i0 - i1, j0 - j1)
inRect ((r, c), (rn, cn)) (pr, pc) = pr &>= r pr &< r + rn pc &>= c pc &< c + cn
move vec g = g . (`vecSub` vec)
inset rect g0 g1 = p -&> if inRect rect p then g0 p else g1 p
draw ((r, c), (rn, cn)) g = do
forM_ [r..r+rn-1] $
-&> do
forM_ [c..c+cn-1] $ c -&> do
putStr $ g (r, c)
putStr "
"
simpleTriangle = ((r, c) -&> if (r, c) == (0, 0) then "△" else if (r, c) == (0, 1) then "" else " ")
sierpinskiTriangle 0 = simpleTriangle
sierpinskiTriangle n = let
t = sierpinskiTriangle (n-1)
h = 2 ^ (n-1)
sz = (h, 2*h)
lpos = (h, 0)
rpos = (h, 2*h)
in inset (lpos, sz) (move lpos t) . inset (rpos, sz) (move rpos t) $ move (0, h) t
drawTriangle n = draw ((0, 0), (2^n, 2^(n+1))) $ sierpinskiTriangle n
--- play ground ---
dot (r, c) = if (r, c) == (0, 0) then "X" else " "
d = draw ((0, 0), (10, 10))
t0 = simpleTriangle
t = sierpinskiTriangle
dt = drawTriangle
main = do
forM_ [0..5] $
-&> do
putStrLn $ "
Sierpinski Triangle " ++ show n ++ ":"
drawTriangle n
運行效果:
稍微說一下:
這裡做了幾個抽象:
1. 點 和 向量: type Point = (Int, Int), type Vec = (Int, Int); 為了簡單直接用tuple表示點和向量. 2. 矩形: type Rect = (Point, Vec); 這裡用矩形的左上角坐標表示位置, 用左上角到右下角的向量表示矩形的尺寸. 3. 圖形: type Graph = Point -&> Pixel; 注意這裡把圖形定義為了一個 "點到像素的函數". 4. 像素: type Pixel = String; 因為是在控制台上畫圖, 所以把像素定義為字元串.
center n = map ((spaces ++) . (++ spaces))
where spaces = replicate (2 ^ (n - 1)) " "
-- | Impletement print function in normal recursive form with new operators
sierpinskiS :: Int -&> [[Char]]
sierpinskiS 0 = ["△"]
sierpinskiS n = center n s
===
(s ||| s)
where s = sierpinskiS (n - 1)
addVec2 (r1, c1) (r2, c2) = (r1 + r2, c1 + c2)
subVec2 (r1, c1) (r2, c2) = (r1 - r2, c1 - c2)
inrect (xr, xc) ((r, c), (rn, cn)) = xr &>= r xr &< r + rn xc &>= c xc &< c + cn
move vec g = g . (`subVec2` vec)
draw ((r, c), (rn, cn)) g = do
forM_ [r..r+rn-1] $
-&> do
forM_ [c..c+cn-1] $ c -&> do
putStr $ g (r, c)
putStr "
"
sierpinskiT 0 = triangle
sierpinskiT n = condImage &<$&> inTop n &<*&> move (0, h) t
&<*&> (condImage &<$&> inBotL n &<*&> move (h, 0) t
&<*&> (condImage &<$&> inBotR n &<*&> move (h, 2*h) t
&<*&> blank))
where
t = sierpinskiT (n-1)
inTop n p = p `inrect` ((0, h), (h, 2*h))
inBotL n p = p `inrect` ((h, 0), (h, 2*h))
inBotR n p = p `inrect` ((h, 2*h), (h, 2*h))
h = 2 ^ (n-1)
condImage cond t1 t2 = if cond then t1 else t2
drawTriangle n = draw ((0, 0), (2^n, 2^(n+1))) $ sierpinskiT n
再次改進後的代碼如下
import Data.Monoid
type Graph a = (Int, Int) -&> a
type Vec2 = (Int, Int)
newtype CharPixel = CharPixel { getStr :: String }
instance Monoid CharPixel where
mempty = CharPixel " "
CharPixel " " `mappend` CharPixel " " = CharPixel " "
CharPixel " " `mappend` CharPixel a = CharPixel a
CharPixel a `mappend` CharPixel b = CharPixel a
addVec2 (r1, c1) (r2, c2) = (r1 + r2, c1 + c2)
subVec2 (r1, c1) (r2, c2) = (r1 - r2, c1 - c2)
inrect (xr, xc) ((r, c), (rn, cn)) = xr &>= r xr &< r + rn xc &>= c xc &< c + cn
move vec g = g . (`subVec2` vec)
draw ((r, c), (rn, cn)) g = do
forM_ [r..r+rn-1] $
-&> do
forM_ [c..c+cn-1] $ c -&> do
putStr $ g (r, c)
putStr "
"
sierpinskiT 0 p = triangle p
sierpinskiT n p = if p `inrect` ((0, 0), (h, w)) then
(centerT n t `above` (t `beside` t)) p
else
mempty
where
t = sierpinskiT (n-1)
above = aboveT n
beside = besideT n
h = 2 ^ n
w = 2 ^ (n+1)
aboveT :: Monoid a =&> Int -&> Graph a -&> Graph a -&> Graph a
aboveT n t1 t2 = t1 &<&> move (2 ^ (n-1), 0) t2
besideT :: Monoid a =&> Int -&> Graph a -&> Graph a -&> Graph a
besideT n t1 t2 = t1 &<&> move (0, 2 ^ n) t2
centerT n = move (0, 2 ^ (n-1))
drawTriangle n = draw ((0, 0), (2^n, 2^(n+1))) (getStr . sierpinskiT n)
-- drawTriangle n = draw ((0, 0), (2^n, 2^(n+1))) . fmap (maybe " " id) $ sierpinskiT n
參考書目： Robert Sedgewick Kevin Wayne, Introduction to Programming in Java -- An Interdisciplinary Approach, pp. 231-235, Section 2.2, Program 2.2.3. 可參看：Libraries and Clients
/*繪製謝爾賓斯基三角形的方法
p：正三角形中心點坐標，len：三角形邊長，depth：遞歸深度*/
function SierpinskiTriangle(p,len,depth){
var r=len/Math.sqrt(3);
//記錄當前端點，默認為左下角頂點坐標
var currentPoint={x:p.x-len/2, y:p.y+r/2};
//記錄當前方向角
var currentAngle=0;
//旋轉方法，將下次畫線的方向逆時針旋轉
function turn(angle){
currentAngle+=angle;
}
//畫線方法，根據當前端點和畫線方向繪製
function draw_line(length){
var angle=currentAngle/180*Math.PI;
currentPoint.x+=length*Math.cos(angle);
currentPoint.y-=length*Math.sin(angle);
context.lineTo(currentPoint.x,currentPoint.y);
}
//開始畫折線，如果深度是偶數便可直接繪製折線，否則需要以斜60度為初始方向
context.moveTo(currentPoint.x,currentPoint.y);
if (depth%2==0){
curve(depth,len,-60);
}else{
turn(60);
curve(depth,len,-60);
}
function curve(order,length,angle)
{
if (order==0){
draw_line(length);
}else{
//遞歸畫三段折線
curve(order-1,length/2,-angle);
turn(angle);
curve(order-1,length/2,angle);
turn(angle);
curve(order-1,length/2,-angle);
}
}
}
// Sierpinski Triangle (https://en.wikipedia.org/wiki/Sierpinski_triangle) - Shader 2015 by JT
// shortest codegolfed 127char version by FabriceNeyret2
void mainImage( out vec4 o, vec2 I )
{
I /= iResolution.xy;
o -= o;
I.x-=.5*I.y;
for(int i = 0; i &< 9; i++)
I = 2.*fract(I),
I.x&>=1.I.y&>=1. ? o++ : o;
}
