画像処理

衝動的に、画像を生成したくなったので。
PGMファイルを使って、図形を描画してみました。

画像の大きさは100*100として、次のように値を設定しました。

poses = [(x,y) | x <-[1..width] , y <- [1..height]]
width,height :: Float
width = 100
height = 100

colorMax = 255

--中心からの距離関数
dist (x,y) = sqrt ((width/2-x)^2 + (height/2-y)^2)

maxDist = sqrt ((width/2)^2 + (height/2)^2)

まずはグラデーション。
単純な線形変換を施しただけ。

circle :: [Int]
circle = map gradation poses

gradation :: (Float,Float) -> Int
gradation pos = floor $ colorMax*dist pos /maxDist

続いて、同心円で二値を切り替えてみました

distAreas = map (\x -> (x,x-10)) [maxDist,maxDist-10..0] :: [(Float,Float)]

wbCircle :: [Int]
wbCircle = map switchWB poses

switchWB :: (Float,Float) -> Int
switchWB (x,y) = if index `mod` 2 == 0 then 0 else floor colorMax where
    index = fst.head.filter (findArea (x,y)) $ zip [1..] distAreas
    findArea pos (n,(a1,a2)) = dist pos <= a1 && a2 < dist pos

画像はこんな感じ

最後に、曲線で遊ぼう1を参考にして、渦巻き模様を描きました。
このモジュールでは座標を(Float,Float)で扱っているので、
ここでは一度(Int,Int)で比較することにしました。

angles = [0,0.02..8*pi]

involuteFunc theta
 = (2*theta*cos theta+width/2 , 2*theta*sin theta+height/2)

involutePoses = nub $ map (mapTuple (floor.(+0.5)).involuteFunc) angles :: [(Int,Int)]

mapTuple f (a,b) = (f a,f b)

involuteLine invPoses values pos
 = values ++ if any (== mapTuple floor pos) invPoses then [0] else [floor colorMax]

involute :: [Int]
involute = foldl (involuteLine involutePoses) [] poses

結果はこれ

今気づきましたが、全部円ですね笑

少なくとも、簡単な変換な生成はこのような感じで行うことができます。