How can I invert? a coordinate space? - geometry

Here's a problem that's been wrecking my brain for a while.
Given:
I have two coordinate spaces:
the global space G, and
a local space A, and
I know the position and rotation of A relative to G.
Question:
How can I programmatically calculate the position and rotation of G relative to A?
On graph paper, I can calculate this by hand:
if A relative to G is (4, 1) 90deg, then G relative to A is (-1, -4) -90deg
if A relative to G is (5, 0) 0deg, then G relative to A is (-5, 0) 0deg
... but I'm having trouble transferring this calculation to software.

In matrix form,
y = R x + t
where R is the rotation matrix and t the translation of the origin.
The reverse way,
x = R' (y - t) = R' y + (- R' t)
where R' is the inverse of R, and also its transpose.

Related

Haskell Diagrams: arrows with fixed orientation

I need to draw arrows between two arbitrary "nodes". The arrow ends needs to enter or exit the nodes from one of the four cardinal directions: N, S, E, W.
data Dir = N | S | E | W
deriving (Eq, Ord, Show)
cir, circles :: Diagram B
cir = circle 0.3 # showOrigin # lw thick
circles = (cir # named "1") ||| strutX 3 ||| (cir # named "2")
ctrlPoint :: Dir -> V2 Double
ctrlPoint N = r2 (0, 1)
ctrlPoint S = r2 (0, -1)
ctrlPoint E = r2 (1, 0)
ctrlPoint W = r2 (-1, 0)
-- This function should specify an arrow shaft entering nodes from directions dir1 and dir2
shaft :: Dir -> Dir -> Trail V2 Double
shaft dir1 dir2 = trailFromSegments [bézier3 (controlPoint dir1) (controlPoint dir2) (r2 (3, 0))]
example = circles # connect' (with ... & arrowShaft .~ shaft N S ) "1" "2"
In the picture above, the arrow enters correctly from North in the first circle, and South in the second.
However, if I setup the points vertically, everything is rotated:
circles = (cir # named "1") === strutY 3 === (cir # named "2")
This is not correct, because I wanted the arrow to enter from North and South, respectively. It seems the shaft of the arrow is rotated altogether...
How to write my function shaft :: Dir -> Dir -> Trail V2 Double?
Thanks
I found an answer using arrowFromLocatedTrail' instead:
-- control points for bézier curves
control :: Dir -> V2 Double
control N = r2 (0, 0.5)
control S = r2 (0, -0.5)
control E = r2 (0.5, 0)
control W = r2 (-0.5, 0)
-- shaft of arrows
shaft :: (P2 Double, Dir) -> (P2 Double, Dir) -> Located (Trail V2 Double)
shaft (p, d) (p', d') = trailFromSegments [bézier3 (control d) ((p' .-. p) - (control d')) (p' .-. p)] `at` p
-- create a single arrow
mkArrow :: (P2 Double, Dir) -> (P2 Double, Dir) -> Diagram B
mkArrow a b = arrowFromLocatedTrail' (with & arrowHead .~ dart
& lengths .~ veryLarge
& shaftStyle %~ lw thick) (shaft a b)
This version performs the necessary transformations:
bézier3 (control d) ((p' .-. p) + (control d')) (p' .-. p)
Here is the signature ofbézier:
bézier3 :: v n -> v n -> v n -> Segment Closed v n
It takes 3 vectors, named here V1, V2 and V3.
bézier curve are by default not located in Diagrams, they just specify how to move.
So, to draw the bézier curve, we set:
V1 = control d
V2 = (p' .-. p) + (control d')
V3 = p' .-. p
The resulting bézier curve will located at p.

ray tracing and finding the normal vector to the surface at the intersection point

When doing a ray trace with rayTraceP, I can find the point where a ray intersects with a diagram.
> rayTraceP (p2 (0, 0)) (r2 (1, 0)) ((p2 (1,-1) ~~ p2 (1,1))
Just (p2 (1.0, 0.0))
I want to use this to find not only the "collision point", but also the collision time and the normal vector to the surface at that point.
-- A Collision has a time, a contact point, and a normal vector.
-- The normal vector is perpendicular to the surface at the contact
-- point.
data Collision v n = Collision n (Point v n) (v n)
deriving (Show)
Given a start point for the ray and a velocity vector along the ray, I can find the contact point end using rayTraceP:
end <- rayTraceP start vel dia
And I can find the collision time using the distance between start and end:
time = distance start end / norm vel
But I'm stuck on finding the normal vector. I'm working within this function:
rayTraceC :: (Metric v, OrderedField n)
=> Point v n -> v n -> QDiagram B v n Any -> Maybe (Collision v n)
-- Takes a starting position for the ray, a velocity vector for the
-- ray, and a diagram to trace the ray to. If the ray intersects with
-- the diagram, it returns a Collision containing:
-- * The amount of time it takes for a point along the ray going at
-- the given velocity to intersect with the diagram.
-- * The point at which it intersects with the diagram.
-- * The normal vector to the surface at that point (which will be
-- perpendicular to the surface there).
-- If the ray does not intersect with the diagram, it returns Nothing.
rayTraceC start vel dia =
do
end <- rayTraceP start vel dia
let time = distance start end / norm vel
-- This is where I'm getting stuck.
-- How do I find the normal vector?
let normalV = ???
return (Collision time end normalV)
Some examples of what I want it to do:
> -- colliding straight on:
> rayTraceC (p2 (0, 0)) (r2 (1, 0)) (p2 (1,-1) ~~ p2 (1,1))
Just (Collision 1 (p2 (1, 0)) (r2 (-1, 0)))
> -- colliding from a diagonal:
> rayTraceC (p2 (0, 0)) (r2 (1, 1)) (p2 (1,0) ~~ p2 (1,2))
Just (Collision 1 (p2 (1, 1)) (r2 (-1, 0))
> -- colliding onto a diagonal:
> rayTraceC (p2 (0, 0)) (r2 (1, 0)) (p2 (0,-1) ~~ p2 (2,1))
Just (Collision 1 (p2 (1, 0)) (r2 (-√2/2, √2/2)))
> -- no collision
> rayTraceC (p2 (0, 0)) (r2 (1, 0)) (p2 (1,1) ~~ p2 (1,2))
Nothing
It is correct on everything in these examples except for the normal vector.
I have looked in the documentation for both Diagrams.Trace and Diagrams.Core.Trace, but maybe I'm looking in the wrong places.
There is no way to do this in general; it depends on what exactly you hit. There is a module Diagrams.Tangent for computing tangents of trails, but to compute the tangent at a given point you have to know its parameter with respect to the trail; and one thing we are missing at the moment is a way to convert from a given point to the parameter of the closest point on a given segment/trail/path (it's been on the to-do list for a while).
Dreaming even bigger, perhaps traces themselves ought to return something more informative---not just parameters telling you how far along the ray the hit are, but also information about what you hit (from which one could more easily do things like compute a normal vector).
What kinds of things are you computing traces of? There might be a way to take advantage of the particular details of your use case to get the normals you want in a not-too-terrible way.
Brent Yorgey's answer points out the Diagrams.Tangent module, and in particular normalAtParam, which works on Parameteric functions, including trails, but not all Diagrams.
Fortunately, many 2D diagram functions, like circle, square, rect, ~~, etc. can actually return any TrailLike type, including Trail V2 n. So a function with the type
rayTraceTrailC :: forall n . (RealFloat n, Epsilon n)
=>
Point V2 n
-> V2 n
-> Located (Trail V2 n)
-> Maybe (Collision V2 n)
Would actually work on the values returned by circle, square, rect, ~~, etc. if it could be defined:
> rayTraceTrailC
(p2 (0, 0))
(r2 (1, 0))
(circle 1 # moveTo (p2 (2,0)))
Just (Collision 1 (p2 (1, 0)) (r2 (-1, 0)))
And this function can be defined by breaking the trail up into a list of fixed segments which are either linear or bezier curves, using the fixTrail function. That reduces the problem to the simpler rayTraceFixedSegmentC.
rayTraceTrailC start vel trail =
combine (mapMaybe (rayTraceFixedSegmentC start vel) (fixTrail trail))
where
combine [] = Nothing
combine cs = Just (minimumBy (\(Collision a _ _) (Collision b _ _) -> compare a b) cs)
The rayTraceFixedSegmentC can use rayTraceP to calculate the contact point, but we can't find the normal vector right away because we don't know what the parameter is at that contact point. So punt further and add fixedSegmentNormalV helper function to the wish list:
rayTraceFixedSegmentC :: forall n . (RealFloat n, Epsilon n)
=>
Point V2 n
-> V2 n
-> FixedSegment V2 n
-> Maybe (Collision V2 n)
rayTraceFixedSegmentC start vel seg =
do
end <- rayTraceP start vel (unfixTrail [seg])
let time = distance start end / norm vel
let normalV = normalize (project (fixedSegmentNormalV seg end) (negated vel))
return (Collision time end normalV)
This fixedSegmentNormalV function just has to return a normal vector for a single segment going through a single point, without worrying about the vel direction. It can destruct the FixedSegment type, and if it's linear, that's easy:
fixedSegmentNormalV :: forall n . (OrderedField n)
=>
FixedSegment V2 n -> Point V2 n -> V2 n
fixedSegmentNormalV seg pt =
case seg of
FLinear a b -> perp (b .-. a)
FCubic a b c d ->
???
In the FCubic case, to calculate the parameter where the curve goes through pt, I'm not sure what to do, but if you don't mind approximations here we can just take a bunch of points along it and find the one closest to pt. After that we can call normalAtParam as Brent Yorgey suggested.
fixedSegmentNormalV seg pt =
case seg of
FLinear a b -> perp (b .-. a)
FCubic a b c d ->
-- APPROXIMATION: find the closest parameter value t
let ts = map ((/100) . fromIntegral) [0..100]
dist t = distance (seg `atParam` t) pt
t = minimumBy (\a b -> compare (dist a) (dist b)) ts
-- once we have that parameter value we can call a built-in function
in normalAtParam seg t
With this, the rayTraceTrailC function is working with this approximation. However, it doesn't work for Diagrams, only Located Trails.
It can work on the values returned by functions like circle and rect, but not on combined diagrams. So you have to keep those building blocks of diagrams separate, as trails, for as long as you need this collision ray tracing.
Using the normal vectors to reflect the rays (the outgoing ray has an equal angle from the normal vector) looks like this:

Haskell implementation of De-convolution (Richardson lucy)

I'm trying to implement an algorithm of de-convolution in Haskell and couldn't find a simpler one than Richardson Lucy. I looked up at the existing matlab/python implementation but am unable to understand from where to start or how exactly to implement.
The library I want to use is https://github.com/lehins/hip.
If someone can provide an outline of some implementation or some general idea about the functions with some code snippets, that would be very helpful to me.
Thanks in advance!
The algorithm is actually pretty straightforward. Using the notation on the Wikipedia page for Richardson-Lucy deconvolution, if an underlying image u0 was convolved by a kernel p to produce an observed image d, then you can iterate the function:
deconvolve p d u = u * conv (transpose p) (d / conv p u)
over u with an initial starting estimate (of d, for example) to get a progressively better estimate of u0.
In HIP, the actual one-step deconvolve function might look like:
deconvolve :: Image VS X Double
-> Image VS RGB Double
-> Image VS RGB Double
-> Image VS RGB Double
deconvolve p d u
= u * conv (transpose p) (d / conv p u)
where conv = convolve Edge
and you could use something like this:
let us = iterate (deconvolve p d) d
u10 = us !! 10 -- ten iterations
An example of a full program is:
import Graphics.Image as I
import Graphics.Image.Interface as I
import Prelude as P
blur :: Image VS X Double
blur = blur' / scalar (I.sum blur')
where blur' = fromLists [[0,0,4,3,2]
,[0,1,3,4,3]
,[1,2,3,3,4]
,[0,1,2,1,0]
,[0,0,1,0,0]]
deconvolve :: Image VS X Double
-> Image VS RGB Double
-> Image VS RGB Double
-> Image VS RGB Double
deconvolve p d u
= u * conv (transpose p) (d / conv p u)
where conv = convolve Edge
main :: IO ()
main = do
-- original underlying image
u0 <- readImage' "images/frog.jpg" :: IO (Image VS RGB Double)
-- the kernel
let p = blur
-- blurred imaged
let d = convolve Edge p u0
-- iterative deconvolution
let us = iterate (deconvolve p d) d
u1 = us !! 1 -- one iteration
u2 = us !! 20 -- twenty iterations
let output = makeImage (rows u0, cols u0 * 4)
(\(r,c) ->
let (i, c') = c `quotRem` cols u0
in index ([u0,d,u1,u2] !! i) (r,c'))
:: Image VS RGB Double
writeImage "output.jpg" output
which generates the following image of (left-to-right) the original frog, the blurred frog, a one-fold deconvolution, and a twenty-fold deconvolution.

Haskell draw image over image

I want to take two different images (taken from image files, like .png) and draw one over the other several times in different positions. The resulting image should be presented on screen or generate a new image file, whichever is easier. I´ll be taking that new image and drawing on it more with further operations
Is there any Haskell library that allows me to do this?
You can use JuicyPixels to do that sort of thing:
module Triangles where
import Codec.Picture
import LineGraphics
{-| Parameterize color smoothly as a function of angle -}
colorWheel :: Float -> Colour
colorWheel x = (r, g, b, a)
where
r = floor $ (cos x + 1) * (255 / 2)
g = floor $ (sin x + 1) * (255 / 2)
b = floor $ (cos (x+(pi/2)) + 1) * (255 / 2)
a = 255
{-| Draw a triangle centered about the point (x, y) -}
triangle :: Point -> Path
triangle (x, y) =
[ (x - k, y - k)
, (x + k, y - k)
, (x, y + k)
, (x - k, y - k)
]
where
size = 30
k = size / 2
{-|
Draw 'n' equally-spaced triangles at a radius of 'r' about a center
point, '(x, y)'.
-}
triangles :: Float -> Radius -> Vector -> Picture
triangles n r (x, y) =
[ (colorWheel theta, tri theta) | theta <- steps n ]
where
tri theta = triangle ((r * cos theta) + x, (r * sin theta) + y)
{-| Interpolate the range [0, 2pi] by 'n' steps -}
steps :: Float -> [Float]
steps n = map (\i -> i * (2*pi/n)) [0 .. n]
And we'll use this module of supporting code:
module LineGraphics (
Point, Vector, Line, Path, Picture, Colour, Radius,
black,
drawPicture,
) where
import Graphics.Rasterific hiding (Point, Vector, Line, Path, polygon)
import Graphics.Rasterific.Texture
import Codec.Picture
type Radius = Float
type Point = (Float, Float)
type Vector = (Float, Float)
type Line = (Point, Point)
type Path = [Point]
type Picture = [(Colour, Path)]
type Colour = (Int, Int, Int, Int) -- red, green, blue, opacity
black = (0, 0, 0, 255)
drawPicture :: Float -> Picture -> Image PixelRGBA8
drawPicture linewidth picture =
renderDrawing 800 800 (toColour black) $
mapM_ renderFn picture
where
renderFn (col, path) = withTexture (uniformTexture $ toColour col) (drawPath path)
drawPath points = stroke linewidth JoinRound (CapRound, CapStraight 0) $
polyline (map (\(x, y) -> V2 x y) points)
toColour (a,b,c,d) = PixelRGBA8
(fromIntegral a) (fromIntegral b) (fromIntegral c) (fromIntegral d)
And here's what we get:

Best way of finding aspect ratio

I'm writing a simple OpenGL game with Haskell. Whenever the user resizes the window I get their width and height. I need to calculate the largest width and height that fits inside their window while maintaining the W/H ratio of 1.6.
This is what I wrote. It works but I don't think it's the best way of doing it in Haskell. Can someone suggest some alternatives:
fixedRatio = 1.6
keepRatio (w,h) = head [(floor w',floor h') | w' <- [w, h*fixedRatio], h' <- [h, w/fixedRatio], w' <= w, h' <= h, w'/h' == fixedRatio ]
I'd do it with a guard (condition):
keepRatio (w,h) | w > expectedWidth = (floor expectedWidth, h)
| otherwise = (w, floor(fromIntegral w / fixedRatio))
where expectedWidth = fromIntegral h * fixedRatio
Try this:
keepRatio (w,h) = min sizeByWidth sizeByHeight
where sizeByWidth = (w, (w * 5) `div` 8)
sizeByHeight = ((h*8) `div` 5, h)
This assumes that you only need the aspect ratio to the nearest pixel.

Resources