how to goal seek in R - r

I am attempting to write a function in R to determine the distance between two circles with known radii (r0 and r1) and a given area of overlap.
I first wrote a function to determine the area of overlap.
overlap <- function(x0=0, y0=0, r0, x1, y1=0, r1) {
#plot two circles and calculate the area of overlap
#doesn't work if one circle completely overlaps the other!
library("plotrix", lib.loc="~/R/win-library/3.2")
xmin = min(x0 - r0, x1 - r1)
xmax = max(x0 + r0, x1 + r1)
ymin = min(y0 - r0, y1 - r1)
ymax = max(y0 + r0, y1 + r1)
plot(c(x0,x1), c(y0,y1), xlim=c(xmin, xmax), ylim=c(ymin, ymax), asp=1)
draw.circle(x=x0, y=y0, radius=r0)
draw.circle(x=x1, y=y1, radius=r1)
d = sqrt((x1-x0)^2 + (y1-y0)^2) #distance between centroids
CBA = acos((r1^2 + d^2 - r0^2)/(2*r1*d))
CBD = 2 * CBA
CAB = acos((r0^2 + d^2 - r1^2)/(2*r0*d))
CAD = 2 * CAB
area = .5 * (r1^2 * (CBD - sin(CBD)) + r0^2 * (CAD - sin(CAD)))
return(area)
}
I want to write another function that includes the overlap function and takes 3 areas as input.
dist_between <- function(a_not_b, b_not_a, a_and_b) {
r0 <- sqrt((a_not_b + a_and_b)/pi)
r1 <- sqrt((b_not_a + a_and_b)/pi)
#minimize a_and_b - overlap(r0=r0, x1=?, r1=r1) by changing x1
return(x1)
}
I want to be able to enter something like dist_between(60, 30, 10) and have the function return the value 5.805.
I think the optim function would suit my needs but I'm not sure how to begin.

This is the line of code needed to approximate the solution for x1.
x1 <- optimize(function(x) abs(overlap(r0=r0, x1=x, r1=r1)-a_and_b), interval=c(0,r0+r1))

Related

How to calculate coordinates of tangent points?

I need to make a svg file for a project and I need some parameters that I haven't figured out how to calculate yet.
I have a point of coordinates x1,y1 and a circumference with a center of coordinates x2,y2 with radius r. The point x1,y1 is outside the circumference. How do I calculate the coordinates of the points belonging to the circumference (x3,y3 and x4,y4) from which the two tangent lines would pass? The outer point (x1,y1) will never touch the circumference and will never belong to the circumference.
This is the drawing to make the concept better understood, in red the values to be calculated.
Tangents scheme
Shift coordinate system to make origin in circle center (to get simpler equations). Now point is
x1' = x1 - x2
y1' = y1 - y2
Solve the next equation system (point belongs to circumference and radius is perpendicular to tangent)
x^2 + y^2 = r^2
(x - x1') * x + (y - y1') * y = 0
for unknown x, y.
To get final result, add x2, y2 to solution results (should be two solutions)
import math
def tangpts(px, py, cx, cy, r):
px -= cx
py -= cy
r2 = r*r
r4 = r2*r2
a = px*px+py*py
b = -2*r2*px
c = r4 - r2*py*py
d = b*b-4*a*c
if d < 0:
return None
d = math.sqrt(d)
xx1 = (-b - d) / (2*a)
xx2 = (-b + d) / (2*a)
if (abs(py) > 1.0e-8):
yy1 = (r2 - px * xx1) / py
yy2 = (r2 - px * xx2) / py
else:
yy1 = math.sqrt(r2 - xx1*xx1)
yy2 = -yy1
return((xx1+cx,yy1+cy),(xx2+cx,yy2+cy))
print(tangpts(0.5, 0.5, 0, 0, 1))
print(tangpts(1, 1, 0, 0, 1))
print(tangpts(0, 0, -3, -3, 3))
print(tangpts(2, 0, 0, 0, 1))
print(tangpts(0, 1, 0, 0, 1))
>>>
None #point inside
((0.0, 1.0), (1.0, 0.0)) #common case
((-3.0, 0.0), (0.0, -3.0)) #common case
((0.5, 0.8660254037844386), (0.5, -0.8660254037844386)) #py is zero case
((0.0, 1.0), (0.0, 1.0)) # single tangent case - point at circumference
In order to post the python code for the solution, I'm copying the explanation originally in comments:
The center of the circle is P2(x2, y2), the radius is r. The unknown point P3(x3, y3) satisfies the equation of the circle:
(x3-x2)^2 + (y3-y2)^2 = r^2 (1).
The tangent P1P3 is perpendicular to the radius of the circle P2P3. So apply the Pythagorean theorem to the triangle P1P2P3:
a) the distance between P1 and P2 is (x1-x2)^2 + (y1-y2)^2,
b) the distance between P1 and P3 is (x1-x3)^2 + (y1-y3)^2
c) the distance P2P3 is r, the radius
(x1-x3)^2 + (y1-y3)^2 + r^2 = (x1-x2)^2 + (y1-y2)^2 (2)
We have thus to solve the equations (1) and (2) for x3 and y3.
We now separate the unknowns (a linear relation between x3 and y3 can be obtained by (1)-(2) => (x3-x2)(x1-x2) + (y3-y2)(y1-y2) = r^2), and we get the two equations of second degree.
The python implementation:
import math
def tangentPoints(x1, y1, x2, y2, r):
a = (y1-y2)**2+(x1-x2)**2
bx = -r**2 * (x1-x2)
cx = r**2 * (r**2-(y1-y2)**2)
sqDeltax = math.sqrt(bx**2 - a*cx)
x3 = x2 + (-bx + sqDeltax)/a
x4 = x2 + (-bx - sqDeltax)/a
by = -r**2 * (y1-y2)
cy = r**2 * (r**2 - (x1-x2)**2)
sqDeltay = math.sqrt(by**2 - a*cy)
y3 = y2 + (-by - sqDeltay)/a
y4 = y2 + (-by + sqDeltay)/a
return (x3, y3), (x4, y4)

Find xy coordinates of a point knowing its distance to other 2 points

I'm writing a code in R to calculate the xy coordinates of point, using the law of cosines.
I have two reference points (1 and 2) which the xy coordinates are known. I want to find the coordinates of the other point (3). I know the distances 3-1, 3-2 and 1-2, but I don't know the angles between them.
Thanks in advance for any help!
I've tried some trigonometric equations I've found on web and Rohlf&Archie 1978 paper, but they don't work.
You haven't told us your set-up exactly, but it sounds as though you have two known x, y, co-ordinates:
x1 <- 1
x2 <- 5
y1 <- 3
y2 <- 6
And known distances between these two points plus a third point:
d12 <- 5
d13 <- 8
d23 <- 5
We can draw them like this:
plot(c(x1, x2), c(y1, y2), xlim = c(0, 12), ylim = c(0, 12))
text(c(x1, x2), c(y1, y2) + 0.5, labels = c('1', '2'))
Now, it's obviously easy to calculate the angle between the horizontal line and the segment joining points 1 and two - it's just the arctangent of the slope:
abline(h = y1, lty = 2)
theta <- atan2(y2 - y1, x2 - x1)
segments(x1, y1, x1 + d12 * cos(theta), y1 + d12 * sin(theta), lty = 2)
Now, although we don't know where point 3 is, we can use the law of cosines to calculate the angle 3-1-2 like this:
angle_312 <- acos((d12^2 + d13^2 - d23^2)/(2 * d12 * d13))
To get this in terms of angle from the horizontal we can do:
angle_13 <- angle_312 - theta
This allows us to work out the co-ordinates of point 3:
x3 <- x1 + d13 * cos(angle_13)
y3 <- y1 + d13 * sin(angle_13)
We can draw this point on our plot as follows:
points(x3, y3)
text(x3, y3 + 0.5, '3')
And we can show that it is correct by drawing circles of the correct radius around points one and two. Point 3 should be at the meeting point of the two circles:
polygon(x1 + dist_1_3 * cos(seq(0, 2 * pi, length = 100)),
y1 + dist_1_3 * sin(seq(0, 2 * pi, length = 100)), lty = 2)
polygon(x2 + dist_2_3 * cos(seq(0, 2 * pi, length = 100)),
y2 + dist_2_3 * sin(seq(0, 2 * pi, length = 100)), lty = 2)
Note that there is a second solution at the other point where the circles meet: in this case we would get that by changing angle_13 <- angle_312 - theta to angle_13 <- angle_312 + theta:
angle_13 <- angle_312 + theta
x3 <- x1 + d13 * cos(angle_13)
y3 <- y1 + d13 * sin(angle_13)
points(x3, y3)
text(x3, y3 + 0.5, '3')
Suppose we are using the following conditions:
pointA <- c(x1 = 1, y1 = 1)
pointC <- c(x2 = 4, y2 = 1)
AC <- sqrt(
(pointA[["x1"]] - pointC[["x2"]])^2 +
(pointA[["y1"]] - pointC[["y2"]])^2
)
AB <- 4
BC <- 5
We are looking for coordinates of point B (points B1 and B2) (x3 and y3 / x3' and y3').
First we find cos and sin of angle C (ACB1 == ACB2 as CB1==CB2==a; AB1==AB2==c and AC=b is common):
cosC <-(AC^2 + BC^2 - AB^2) / (2*AC*BC)
sinC <- sqrt(1-cosC^2)
It is obvious that there are two possible solutions for the conditions.
Then the points will be
pointB1 <- c(x3 = pointC[["x2"]] + BC*cosC,
y3 = pointC[["y2"]] + BC*sinC)
pointB2 <- c(x3 = pointC[["x2"]] - BC*cosC,
y3 = pointC[["y2"]] - BC*sinC)
Now we can check the results:
> sqrt(
+ (pointB1[["x3"]] - pointC[["x2"]])^2 +
+ (pointB1[["y3"]] - pointC[["y2"]])^2
+ )
[1] 5
> sqrt(
+ (pointB2[["x3"]] - pointC[["x2"]])^2 +
+ (pointB2[["y3"]] - pointC[["y2"]])^2
+ )
[1] 5
The advantage of this solution that we do not call low precision acosfunction as well as other trigonometric functions. And use cosC / sinC as temporary variables only.

Add labels to the center of a geom_curve line (ggplot)

Is there any way to add a label on or near the center of a geom_curve line? Currently, I can only do so by labeling either the start or end point of the curve.
library(tidyverse)
library(ggrepel)
df <- data.frame(x1 = 1, y1 = 1, x2 = 2, y2 = 3, details = "Object Name")
ggplot(df, aes(x = x1, y = y1, label = details)) +
geom_point(size = 4) +
geom_point(aes(x = x2, y = y2),
pch = 17, size = 4) +
geom_curve(aes(x = x1, y = y1, xend = x2, yend = y2)) +
geom_label(nudge_y = 0.05) +
geom_label_repel(box.padding = 2)
I would love some way to automatically label the curve near coordinates x=1.75, y=1.5. Is there a solution out there I haven't seen yet? My intended graph is quite busy, and labeling the origin points makes it harder to see what's happening, while labeling the arcs would make a cleaner output.
I've come to a solution for this problem. It's large and clunky, but effective.
The core problem is that geom_curve() does not draw a set path, but it moves and scales with the aspect ratio of the plot window. So short of locking the aspect ratio with coord_fixed(ratio=1) there is no way I can easily find to predict where the midpoint of a geom_curve() segment will be.
So instead I set about finding midpoint for a curve, and then forcing the curve to go through that point which I would later label. To find the midpoint I had to copy two functions from the grid package:
library(grid)
library(tidyverse)
library(ggrepel)
# Find origin of rotation
# Rotate around that origin
calcControlPoints <- function(x1, y1, x2, y2, curvature, angle, ncp,
debug=FALSE) {
# Negative curvature means curve to the left
# Positive curvature means curve to the right
# Special case curvature = 0 (straight line) has been handled
xm <- (x1 + x2)/2
ym <- (y1 + y2)/2
dx <- x2 - x1
dy <- y2 - y1
slope <- dy/dx
# Calculate "corner" of region to produce control points in
# (depends on 'angle', which MUST lie between 0 and 180)
# Find by rotating start point by angle around mid point
if (is.null(angle)) {
# Calculate angle automatically
angle <- ifelse(slope < 0,
2*atan(abs(slope)),
2*atan(1/slope))
} else {
angle <- angle/180*pi
}
sina <- sin(angle)
cosa <- cos(angle)
# FIXME: special case of vertical or horizontal line ?
cornerx <- xm + (x1 - xm)*cosa - (y1 - ym)*sina
cornery <- ym + (y1 - ym)*cosa + (x1 - xm)*sina
# Debugging
if (debug) {
grid.points(cornerx, cornery, default.units="inches",
pch=16, size=unit(3, "mm"),
gp=gpar(col="grey"))
}
# Calculate angle to rotate region by to align it with x/y axes
beta <- -atan((cornery - y1)/(cornerx - x1))
sinb <- sin(beta)
cosb <- cos(beta)
# Rotate end point about start point to align region with x/y axes
newx2 <- x1 + dx*cosb - dy*sinb
newy2 <- y1 + dy*cosb + dx*sinb
# Calculate x-scale factor to make region "square"
# FIXME: special case of vertical or horizontal line ?
scalex <- (newy2 - y1)/(newx2 - x1)
# Scale end points to make region "square"
newx1 <- x1*scalex
newx2 <- newx2*scalex
# Calculate the origin in the "square" region
# (for rotating start point to produce control points)
# (depends on 'curvature')
# 'origin' calculated from 'curvature'
ratio <- 2*(sin(atan(curvature))^2)
origin <- curvature - curvature/ratio
# 'hand' also calculated from 'curvature'
if (curvature > 0)
hand <- "right"
else
hand <- "left"
oxy <- calcOrigin(newx1, y1, newx2, newy2, origin, hand)
ox <- oxy$x
oy <- oxy$y
# Calculate control points
# Direction of rotation depends on 'hand'
dir <- switch(hand,
left=-1,
right=1)
# Angle of rotation depends on location of origin
maxtheta <- pi + sign(origin*dir)*2*atan(abs(origin))
theta <- seq(0, dir*maxtheta,
dir*maxtheta/(ncp + 1))[c(-1, -(ncp + 2))]
costheta <- cos(theta)
sintheta <- sin(theta)
# May have BOTH multiple end points AND multiple
# control points to generate (per set of end points)
# Generate consecutive sets of control points by performing
# matrix multiplication
cpx <- ox + ((newx1 - ox) %*% t(costheta)) -
((y1 - oy) %*% t(sintheta))
cpy <- oy + ((y1 - oy) %*% t(costheta)) +
((newx1 - ox) %*% t(sintheta))
# Reverse transformations (scaling and rotation) to
# produce control points in the original space
cpx <- cpx/scalex
sinnb <- sin(-beta)
cosnb <- cos(-beta)
finalcpx <- x1 + (cpx - x1)*cosnb - (cpy - y1)*sinnb
finalcpy <- y1 + (cpy - y1)*cosnb + (cpx - x1)*sinnb
# Debugging
if (debug) {
ox <- ox/scalex
fox <- x1 + (ox - x1)*cosnb - (oy - y1)*sinnb
foy <- y1 + (oy - y1)*cosnb + (ox - x1)*sinnb
grid.points(fox, foy, default.units="inches",
pch=16, size=unit(1, "mm"),
gp=gpar(col="grey"))
grid.circle(fox, foy, sqrt((ox - x1)^2 + (oy - y1)^2),
default.units="inches",
gp=gpar(col="grey"))
}
list(x=as.numeric(t(finalcpx)), y=as.numeric(t(finalcpy)))
}
calcOrigin <- function(x1, y1, x2, y2, origin, hand) {
# Positive origin means origin to the "right"
# Negative origin means origin to the "left"
xm <- (x1 + x2)/2
ym <- (y1 + y2)/2
dx <- x2 - x1
dy <- y2 - y1
slope <- dy/dx
oslope <- -1/slope
# The origin is a point somewhere along the line between
# the end points, rotated by 90 (or -90) degrees
# Two special cases:
# If slope is non-finite then the end points lie on a vertical line, so
# the origin lies along a horizontal line (oslope = 0)
# If oslope is non-finite then the end points lie on a horizontal line,
# so the origin lies along a vertical line (oslope = Inf)
tmpox <- ifelse(!is.finite(slope),
xm,
ifelse(!is.finite(oslope),
xm + origin*(x2 - x1)/2,
xm + origin*(x2 - x1)/2))
tmpoy <- ifelse(!is.finite(slope),
ym + origin*(y2 - y1)/2,
ifelse(!is.finite(oslope),
ym,
ym + origin*(y2 - y1)/2))
# ALWAYS rotate by -90 about midpoint between end points
# Actually no need for "hand" because "origin" also
# encodes direction
# sintheta <- switch(hand, left=-1, right=1)
sintheta <- -1
ox <- xm - (tmpoy - ym)*sintheta
oy <- ym + (tmpox - xm)*sintheta
list(x=ox, y=oy)
}
With that in place, I calculated a midpoint for each record
df <- data.frame(x1 = 1, y1 = 1, x2 = 10, y2 = 10, details = "Object Name")
df_mid <- df %>%
mutate(midx = calcControlPoints(x1, y1, x2, y2,
angle = 130,
curvature = 0.5,
ncp = 1)$x) %>%
mutate(midy = calcControlPoints(x1, y1, x2, y2,
angle = 130,
curvature = 0.5,
ncp = 1)$y)
I then make the graph, but draw two separate curves. One from the origin to the calculated midpoint, and another from the midpoint to the destination. The angle and curvature settings for both finding the midpoint and drawing these curves are tricky to keep the result from obviously looking like two different curves.
ggplot(df_mid, aes(x = x1, y = y1)) +
geom_point(size = 4) +
geom_point(aes(x = x2, y = y2),
pch = 17, size = 4) +
geom_curve(aes(x = x1, y = y1, xend = midx, yend = midy),
curvature = 0.25, angle = 135) +
geom_curve(aes(x = midx, y = midy, xend = x2, yend = y2),
curvature = 0.25, angle = 45) +
geom_label_repel(aes(x = midx, y = midy, label = details),
box.padding = 4,
nudge_x = 0.5,
nudge_y = -2)
Though the answer isn't ideal or elegant, it scales with a large number of records.
Maybe annotations would help here (see: http://ggplot2.tidyverse.org/reference/annotate.html)
library(tidyverse)
library(ggrepel)
df <- data.frame(x1 = 1, y1 = 1, x2 = 2, y2 = 3, details = "Object Name")
ggplot(df, aes(x = x1, y = y1, label = details)) +
geom_point(size = 4) +
geom_point(aes(x = x2, y = y2),
pch = 17, size = 4) +
geom_curve(aes(x = x1, y = y1, xend = x2, yend = y2)) +
geom_label(nudge_y = 0.05) +
geom_label_repel(box.padding = 2) +
annotate("label", x=1.75, y=1.5, label=df$details)

Plotting a 2D polar mesh with ggplot2

I have data that is computed on a 2D polar mesh:
# The mesh created is in two dimensions: r and theta.
# Mesh steps in theta are regular, while mesh steps in r are more refined
# close to the origin
nb.theta <- 50
theta.max <- 130
theta <- seq(0, theta.max, length.out = nb.theta)
nb.r <- 80
# r goes from r0 to rMax
q0 <- 1.1
z <- seq(1, nb.r)
rMax <- 30
r0 <- rMax / (q0 ^ nb.r - 1)
r <- r0 * (q0 ^ z - 1)
# Now let's add some data
mesh <- as.data.frame(expand.grid(r = r, theta = theta))
mesh$value <- mesh$r * mesh$theta / theta.max
Now, I want to plot the mesh in R (preferably with ggplot2). I tried:
ggplot(mesh, aes(r, theta, color = value)) + geom_point() + coord_polar(theta = "y")
But the result is far from satisfactory:
Ideally, I would like to have cells filled and not just points. I also would like the plot not to be a full circle: I only have data from 0 to 130 degrees.
Is this possible?
This should solve the circle issue:
ggplot(mesh, aes(r, theta, color = value)) +
geom_point() +
coord_polar(theta = "y") +
scale_y_continuous(limits=c(0,360))
We can use geom_tile rather than geom_point so that we fill the mesh. We need to calculate the width of each window. Here I've just set it to r/10 which is approximately correct. You will be able to calculate it exactly.
Adding ylim ensures that only part of the circle is filled.
mesh <- expand.grid(r = r, theta = theta)
mesh$value <- mesh$r * mesh$theta / theta.max
mesh$width <- mesh$r/10
ggplot(mesh, aes(r, theta, fill = value, width = width)) +
geom_tile() +
coord_polar(theta = "y") +
ylim(0, 360)
NB expand.grid returns a data.frame, so we don't need to convert it.

Draw a polygon colored like this in R or Matlab

http://www.texample.net/tikz/examples/lindenmayer-systems/
My sample code shown below, I don't know how to colored with hue color.
plot.koch <- function(k,col="blue"){
plot(0,0,xlim=c(0,1), ylim=c(-sqrt(3)/6,sqrt(3)/2), asp = 1,type="n",xlab="", ylab="")
plotkoch <- function(x1,y1,x2,y2,n){
if (n > 1){
plotkoch(x1,y1,(2*x1+x2)/3,(2*y1+y2)/3,n-1);
plotkoch((2*x1+x2)/3,(2*y1+y2)/3,(x1+x2)/2-(y1-y2)*sqrt(3)/6,(y1+y2)/2-(x2-x1) *sqrt(3)/6,n-1);
plotkoch((x1+x2)/2-(y1-y2)*sqrt(3)/6,(y1+y2)/2-(x2-x1)*sqrt(3)/6,(2*x2+x1)/3,(2 *y2+y1)/3,n-1);
plotkoch((2*x2+x1)/3,(2*y2+y1)/3,x2,y2,n-1)
}
else {
x=c(x1,(2*x1+x2)/3,(x1+x2)/2-(y1-y2)*sqrt(3)/6,(2*x2+x1)/3,x2);
y=c(y1,(2*y1+y2)/3,(y1+y2)/2-(x2-x1)*sqrt(3)/6,(2*y2+y1)/3,y2);
polygon(x,y,type="l",col=col)
}
}
plotkoch(0,0,1,0,k)
plotkoch(0.5,sqrt(3)/2,0,0,k)
plotkoch(1,0,0.5,sqrt(3)/2,k)
}
plot.koch(3, col=3)
Here's a method using spatial objects in R, with sp, rgeos and raster packages in the mix.
Slight modifications to the function to return the x,y coordinates to the user (and in the correct order):
koch <- function(k) {
yy <- xx <- numeric(0)
Koch <- function(x1, y1, x2, y2, n) {
if (n > 1){
Koch(x1, y1, (2*x1+x2)/3, (2*y1+y2)/3, n-1);
Koch((2*x1+x2)/3, (2*y1+y2)/3, (x1+x2)/2-(y1-y2)*sqrt(3)/6,
(y1+y2)/2-(x2-x1) *sqrt(3)/6, n-1);
Koch((x1+x2)/2-(y1-y2)*sqrt(3)/6, (y1+y2)/2-(x2-x1)*sqrt(3)/6,
(2*x2+x1)/3, (2 *y2+y1)/3, n-1);
Koch((2*x2+x1)/3, (2*y2+y1)/3, x2, y2, n-1)
}
else {
x <- c(x1, (2*x1+x2)/3, (x1+x2)/2-(y1-y2)*sqrt(3)/6, (2*x2+x1)/3, x2);
xx <<- c(xx, x)
y <- c(y1, (2*y1+y2)/3, (y1+y2)/2-(x2-x1)*sqrt(3)/6, (2*y2+y1)/3, y2);
yy <<- c(yy, y)
}
}
Koch(0, 0, 1, 0, k)
Koch(1, 0, 0.5, sqrt(3)/2, k)
Koch(0.5, sqrt(3)/2, 0, 0, k)
xy <- data.frame(x=xx, y=yy)
rbind(unique(xy), xy[1, ])
}
Create a colour ramp:
colr <- colorRampPalette(hcl(h=seq(0, 360, len=100), c=100))
Use koch function to get vertices:
xy <- koch(4)
Load spatial packages and create SpatialPolygons object from fractal and plot it once to set up the plot area.
library(sp)
library(rgeos)
library(raster)
poly <- SpatialPolygons(list(Polygons(list(Polygon(xy)), 1)))
plot(poly)
Plot a series of segments with desired origin and large enough radius to cover the fractal polygon (here we use radius r <- 1).
r <- 1
mapply(function(theta, col) {
segments(0.5, 0.3, 0.5 + r*cos(theta), 0.3 + r*sin(theta), lwd=3, col=col)
}, seq(0, 360, length=1000)*pi/180, colr(1000))
Create a second polygon of the difference between the plot area and the fractal polygon, and plot this (with col='white') to mask out the unwanted gradient area.
plot(gDifference(as(extent(par('usr')), 'SpatialPolygons'), poly),
col='white', border='white', add=TRUE)
Plot the polygon once more.
plot(poly, add=TRUE)
Here's my attempt at solving your question. Currently it draws the color also outside of the snowflake. If you can figure out if points are inside or outside the snowflake, you should be able to just remove outside points in the df_fill.
Here I'm first creating the data.frame used for plotting the polygon. Then I'm creating the data.frame for the background color. And finally I'm using ggplot2 to plot the data.
# creating relevant data
data.koch <- function(k){
df <- data.frame(x = 0,
y = 0,
grp = 0)
plotkoch <- function(x1, y1, x2, y2, n, data){
if (n==1) {
x=c(x1,(2*x1+x2)/3,(x1+x2)/2-(y1-y2)*sqrt(3)/6,(2*x2+x1)/3,x2)
y=c(y1,(2*y1+y2)/3,(y1+y2)/2-(x2-x1)*sqrt(3)/6,(2*y2+y1)/3,y2)
df <- rbind(data, data.frame(x, y, grp=max(data$grp)+1))
}
if (n > 1){
df <- plotkoch(x1,y1,(2*x1+x2)/3,(2*y1+y2)/3,n-1, data = data)
df <- plotkoch((2*x1+x2)/3,(2*y1+y2)/3,(x1+x2)/2-(y1-y2)*sqrt(3)/6,(y1+y2)/2-(x2-x1) *sqrt(3)/6,n-1, data=df)
df <- plotkoch((x1+x2)/2-(y1-y2)*sqrt(3)/6,(y1+y2)/2-(x2-x1)*sqrt(3)/6,(2*x2+x1)/3,(2 *y2+y1)/3,n-1, data=df)
df <- plotkoch((2*x2+x1)/3,(2*y2+y1)/3,x2,y2,n-1, data=df)
}
return(df)
}
df <- plotkoch(0,0,1,0,k, data = df)
df <- plotkoch(0.5,sqrt(3)/2,0,0,k, data = df)
df <- plotkoch(1,0,0.5,sqrt(3)/2,k, data = df)
return(df)
}
# plotting functon
plot.koch <- function(k){
stopifnot(require(ggplot2))
if (is.data.frame(k)) df <- k
else df <- data.koch(k)
# filling data (CHANGE HERE TO GET ONLY INSIDE POINTS)
l <- 500
df_fill <- expand.grid(x=seq(0, 1, length=l),
y=seq(-sqrt(3)/6, sqrt(3)/2, length=l))
df_fill[, "z"] <- atan2(-df_fill[, "y"] + sqrt(3)/6, df_fill[, "x"] - 0.5) + pi/2
df_fill[df_fill[, "z"] < 0, "z"] <- df_fill[df_fill[, "z"] < 0, "z"] + 2*pi
# plotting
ggplot(df, aes(x, y, group=grp)) +
geom_raster(data = df_fill,
aes(fill=z, group=NULL),
hjust = 0,
vjust = 0,
linetype='blank') +
geom_path(data=df, size=1) +
scale_fill_gradientn(colours = rainbow(30), guide = 'none') +
scale_x_continuous(name = '', limits = c(0, 1), expand=c(0, 0)) +
scale_y_continuous(name = '', limits = c(-sqrt(3)/6,sqrt(3)/2), expand=c(0, 0)) +
coord_fixed() +
theme_bw() +
theme(axis.line = element_blank(),
panel.grid = element_blank(),
axis.ticks = element_blank(),
axis.text = element_blank())
}
#
p <- plot.koch(4)
print(p)
I would do it like this:
for any drawed pixel obtain its position x,y
compute the angle=atan2(y-y0,x-x0)
where x0,y0 is the koch's snowflake mid position
compute the color based on angle
if you use HSV then hue=angle and compute the target color value (I assume RGB). If you want the visible spectra colors you can try mine:
RGB values of visible spectrum
Just convert the angle range angle=<0,2*Pi> [rad] to wavelength l=<400,700> [nm] so:
l = 400.0 + (700.0-400.0)*angle/(2.0*M_PI)
render the pixel
[Notes]
not using R nor Matlab so you need to code it yourself. The angle may need some shifting to match your coordinate system for example:
const angle0=???; // some shift constant [rad]
angle+=angle0; // or angle=angle0-angle; if the direction is oposite
if (angle>=2.0*M_PI) angle-=2.0*M_PI;
if (angle< 0.0) angle+=2.0*M_PI;
If you drawing this as polygon then you need to compute color per vertex not per pixel but then you can get to problems because this is not convex polygon. So how to ensure the mid point color ??? I am afraid you will need to use some sort of triangulation because simple triangle fan will fail ...
The only thing that is obvious is to fill the color for whole space and then draw the outline with black color then flood fill all non black pixels from outside with white color
It's my solution with grid package.
##data
koch <- function(k) {
yy <- xx <- numeric(0)
Koch <- function(x1, y1, x2, y2, n) {
if (n > 1) {
Koch(x1, y1, (2 * x1 + x2)/3, (2 * y1 + y2)/3, n - 1)
Koch((2 * x1 + x2)/3, (2 * y1 + y2)/3, (x1 + x2)/2 - (y1 -
y2) * sqrt(3)/6, (y1 + y2)/2 - (x2 - x1) * sqrt(3)/6,
n - 1)
Koch((x1 + x2)/2 - (y1 - y2) * sqrt(3)/6, (y1 + y2)/2 -
(x2 - x1) * sqrt(3)/6, (2 * x2 + x1)/3, (2 * y2 + y1)/3,
n - 1)
Koch((2 * x2 + x1)/3, (2 * y2 + y1)/3, x2, y2, n - 1)
} else {
x <- c(x1, (2 * x1 + x2)/3, (x1 + x2)/2 - (y1 - y2) * sqrt(3)/6,
(2 * x2 + x1)/3, x2)
xx <<- c(xx, x)
y <- c(y1, (2 * y1 + y2)/3, (y1 + y2)/2 - (x2 - x1) * sqrt(3)/6,
(2 * y2 + y1)/3, y2)
yy <<- c(yy, y)
}
}
Koch(0, 0, 1, 0, k)
Koch(1, 0, 0.5, sqrt(3)/2, k)
Koch(0.5, sqrt(3)/2, 0, 0, k)
xy <- data.frame(x = (xx - min(xx))/(max(xx) - min(xx)), y = (yy -
min(yy))/(max(yy) - min(yy)))
rbind(unique(xy), xy[1, ])
}
xy <- koch(5)
##Plot
library(grid)
grid.newpage()
pushViewport(dataViewport(xy$x, xy$y), plotViewport(c(1, 1, 1, 1)))
for (i in 1:nrow(xy)) {
grid.path(x = c(xy[i, 1], xy[i + 1, 1], mean(xy$x)),
y = c(xy[i, 2], xy[i + 1, 2], mean(xy$y)),
gp = gpar(col = rainbow(nrow(xy))[i],
fill = rainbow(nrow(xy))[i]))
}

Resources