r(a:b)=b++[a]
s=zip<*>r
(?)a=sum.zipWith(*)a
o(a,b)=r a?b-a?r b
(a,b)!(c,d)=(c-a,d-b)
(a,b)#(c,d)=a*d-b*c
x i a@(e,f)b j c d|let k@(g,h)=a!b;l=c!d;m=c!a;n=l#k;o=m#l/n;p=m#k/n;q|i>0=o<0||o>1|let=o<=0||o>=1;r|n==0||q||p<0||p*j>1=[]|let=[(e+o*g,f+o*h)]=r
(a&b)(c:e@(d:_))|let(f,g)=span(/=d)b;h=zip f$r$f++[d]=concat[[k,l]|(i,j)<-h,[[k],[l]]<-[x 1 i j 0 a<$>[c,d]],and[x 0 m n 1 a o==[]|o<-[k,l],(m,n)<-h,(m,n)/=(i,j)]]++(a&g)e
(_&_)_=[]
z a b=sum[o$unzip[c,a,d]|e@(f:_)<-[[c|c<-b,and[all(==c)$x 1 d e 1 a c|(d,e)<-s b]]],(c,d)<-s$a&until((f==).head)r b$e++[f]]/2
确切的解决方案（排除错误）。Haskell具有内置的精确有理算法。在线尝试！
请注意，对于示例房间，这815523/6710没有给出，814643/6710第一个墙的交点计算为(55/61, 363/61)。我相当确定这是正确的，因为（渐进地）Monte Carlo项收敛到相同的结果。
传说：
z light roomPoints
-- Main function, returns lit area.
-- Compute list of visible corners in the room, then calls (&).
(&) light roomPoints' visibleCorners
-- Compute visibility polygon. visibleCorners is the subset of points
-- that are visible from the light. The first point of roomPoints'
-- must coincide with the first visibleCorner.
x pEndpoints p1 p2 qSegment q1 q2
-- Intersect line segments (p1, p2) and (q1, q2).
-- If pEndpoints, exclude endpoints p1, p2.
-- If not qSegment, allow intersection to extend past q2 (i.e. raycast).
r -- Rotate list by one, used to construct closed loops etc.
s -- Construct closed loop
(!) -- Vector between two points
(?) -- Dot product
(#) -- Cross product
o -- Polygon area
奖励：用于测试的光泽度 GUI。单击要移动的点旁边。
import qualified Graphics.Gloss as G
import qualified Graphics.Gloss.Interface.IO.Interact as GI
solnPoly a b|let c@(d:_)=[c|c<-b,and[all(==c)$x 1 d e 1 a c|(d,e)<-s b]]=a&until((d==).head)r b$c++[d]
solnArea = z
main =
let fromRatP (x, y) = (fromRational x, fromRational y)
displayScale = 10
scalePoints = G.scale (fromInteger displayScale) (fromInteger displayScale)
displayMode = G.InWindow "" (512, 512) (0, 0)
drawBasePoly pointSz ps =
mconcat $ G.lineLoop ps :
[G.translate x y (G.circleSolid pointSz) | (x, y) <- ps]
drawVisPolyOf light ps =
G.color G.blue $ drawBasePoly 0.2 $ map fromRatP $ solnPoly light ps
drawLight (x, y) =
G.translate x y $
G.color G.yellow (G.circleSolid 0.5) <> G.circle 0.5
draw (light, ps) =
mconcat [
scalePoints $ drawLight (fromRatP light),
scalePoints $ drawBasePoly 0.4 (map fromRatP ps),
scalePoints $ drawVisPolyOf light ps,
G.translate (-200) (-50) $ G.scale 0.2 0.2 $
G.color G.blue $ G.text $ "Lit area: " ++ show (solnArea light ps)
]
event (GI.EventKey (GI.MouseButton GI.LeftButton) GI.Down _ (curx_, cury_)) (light, ps) =
let dist (x,y) (x',y') = (x'-x)^2 + (y'-y)^2
curx = curx_ / fromInteger displayScale
cury = cury_ / fromInteger displayScale
cursorR = (fromInteger$round curx, fromInteger$round cury)
maxDist = 3
snapAmount = 1
(d, i) = minimum [(dist p cursorR, i) | (p, i) <- zip (light : ps) [0..]]
snapTo n a = fromInteger$n*round(a/fromInteger n)
snapCursor = (snapTo snapAmount curx, snapTo snapAmount cury)
light' | i == 0 && d < maxDist^2 = snapCursor
| otherwise = light
ps' | i > 0 && d < maxDist^2 = take (i-1) ps ++ [snapCursor] ++ drop i ps
| otherwise = ps
in (light', ps')
event _ state = state
state0 =
((2, 2), [(0, 0), (10, 0), (10, 5), (20, 0), (20, 20), (15, 5),
(10, 10), (6, 10), (10, 12), (0, 12), (4, 10), (0, 10)])
in G.play displayMode G.white 60
state0
draw
event
(\_ -> id)
