Related
I have a data.frame containing 4 points, which creates a triangle when connected using geom_path:
library(ggplot2)
triangle = data.frame(x = c(0, 0.5, 1, 0),
y = c(0, 0.5, 0, 0))
ggplot(triangle, aes(x, y)) +
geom_path()
Now, I want to create a new data.frame (based on triangle), that has 4 points (e.g. xmin, xmax, ymin, ymax) that creates squares from the sides of the triangle (hence, this data.frame will have 3 rows (for each square) and 4 columns (for each point).
Here is an example:
Is it possible to do it without hard-coding the sides of the squares?
Since the squares will be at an angle, you probably need the output to be in terms of x, y co-ordinates of the vertices. This just requires a bit of trig. The following function takes a vector of x, y points representing a closed triangle and returns a data frame of the vertices of the squares on each side:
make_squares <- function(x, y) {
x1 <- x[-4]
x2 <- x[-1]
xdiff <- (x2 - x1)
y1 <- y[-4]
y2 <- y[-1]
ydiff <- (y2 - y1)
lengths <- sqrt(xdiff^2 + ydiff^2)
angles <- atan2(ydiff, xdiff)
x3 <- x2 - sin(angles) * lengths
x4 <- x1 - sin(angles) * lengths
y3 <- y2 + cos(angles) * lengths
y4 <- y1 + cos(angles) * lengths
df <- data.frame(x = round(c(x1, x2, x3, x4, x1), 3),
y = round(c(y1, y2, y3, y4, y1), 3),
square = rep(1:3, 5))
`row.names<-`(df[order(df$square),], NULL)
}
The output looks like this:
make_squares(triangle$x, triangle$y)
#> x y square
#> 1 0.0 0.0 1
#> 2 0.5 0.5 1
#> 3 0.0 1.0 1
#> 4 -0.5 0.5 1
#> 5 0.0 0.0 1
#> 6 0.5 0.5 2
#> 7 1.0 0.0 2
#> 8 1.5 0.5 2
#> 9 1.0 1.0 2
#> 10 0.5 0.5 2
#> 11 1.0 0.0 3
#> 12 0.0 0.0 3
#> 13 0.0 -1.0 3
#> 14 1.0 -1.0 3
#> 15 1.0 0.0 3
And you can use it in your plot like this:
ggplot(triangle, aes(x, y)) +
geom_path() +
geom_polygon(data = make_squares(triangle$x, triangle$y),
aes(group = square), fill = "green4", color = "black") +
coord_equal()
I'm trying to come up with a generic R function to produce figure (b) in the image, where x is the x-axis and g is the y-axis. I'm trying to come up with a function f with the prototype f(x, start_x, dx, init_g, end_g) where x is a vector of ints representing timesteps (e.g. 1:100), start_x represents the step to start the ramp, dx represents the distance between start_x and end of ramp. init_g is the starting value of the function on the vertical axis, and end_g is the value at the end of the ramp. The function will return the ramp which I can plot to get that figure.
If dx=0, we get a step function like in figure (a). Also, the ramp can slope down depending on whether end_g is more or less than init_g.
I don't care about figures (c) or (d) in the image. I just can't figure out what to do to get the part between start_x and start_x + dx. Thanks for the help.
It only takes four x and four g values to define a plot like this.
plot_fun <- function(x, start_x, dx, init_g, end_g) {
x <- c(x[1], start_x, start_x + dx, tail(x, 1))
g <- c(init_g, init_g, end_g, end_g)
plot(x, g, type = "l")
}
plot_fun(x = 1:100, start_x = 20, dx = 30, init_g = 2, end_g = 5)
plot_fun(x = 1:100, start_x = 20, dx = 0, init_g = 2, end_g = 5)
If you just want to generate a vector g of the same length as x that is needed to produce the plot, here is how that can work:
make_g <- function(x, start_x, dx, init_g, end_g) {
require(dplyr)
require(tidyr)
x_g <- data.frame(x = c(x[1], start_x + dx),
g = c(init_g, end_g))
x_g <- data.frame(x) %>%
left_join(x_g) %>%
fill(g, .direction = "down")
return(x_g$g)
}
make_g(x = 1:100, start_x = 20, dx = 30, init_g = 2, end_g = 5)
Joining, by = "x"
[1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 5 5 5 5
[55] 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5
I figured out something that seems to work, not sure exactly why. There's probably a more elegant way to do it.
f <- function(x, x0, dx, g0, g1) {
s <- (x0 - dx) * (g1-g0)/dx
ifelse(x < x0, g0,
ifelse(x < (x0+dx), (x-dx) * (g1 - g0)/dx + (g0 - s),
g1))
}
Here's a function that returns data that you can use to plot.
f <- function(x, start_x, dx, init_g, end_g, type = c("ramp", "step")) {
type <- match.arg(type)
y <- numeric(length(x))
if (!length(x)) return(y)
end_x <- start_x + dx
y[x < start_x] <- init_g
y[x > end_x] <- end_g
mid <- (x >= start_x & x <= end_x)
y[mid] <-
if (type == "ramp") {
approx(c(start_x, end_x), c(init_g, end_g), xout = x[mid])$y
} else c(rep(init_g, length(mid) - 1), end_g)
return(data.frame(x = x, y = y))
}
Demonstration:
plot(y ~ x, data = f(1:100, 50, 10, 10, 20, "ramp"), type = "b")
plot(y ~ x, data = f(1:100, 50, 10, 10, 20, "step"), type = "b")
I am trying to build a linear constraint that follows this logic
if either x1 = 1 or x2 =1 then y1 = 1
but if x1 = 0 and x2 = 0 then y1 = 0
if both x1 = 1 and x2= 1 then y1 = 1
Assumptions:
we are talking about integer-programming here
x1, x2 are binary-variables / integer-variables in [0, 1]
The truth-table looks like:
x1 x2 || y1
----------------
0 0 || 0
0 1 || 1
1 0 || 1
1 1 || 1
This is just:
y1 = x1 OR x2
This is trivially linearized (see relevant answer on cs.stackexchange.com):
y1 = binary-var / (could be integer-var too)
y1 <= x1 + x2
y1 >= x1
y1 >= x2
I'm trying to find how to solve quadratic problem in R with both equality and inequality constraints as well as with upper and lower bounds:
min 0.5*x'*H*x + f'*x
subject to: A*x <= b
Aeq*x = beq
LB <= x <= UB
I've checked 'quadprog' and 'kernlab' packages but ... I must be missing something as I have no idea how specify both 'A' and 'Aeq' for solve.QP() or ipop()
Here's a working example:
library('quadprog')
# min
# -8 x1 -16 x2 + x1^2 + 4 x2^2
#
# s.t.
#
# x1 + 2 x2 == 12 # equalities
# x1 + x2 <= 10 # inequalities (N.B. you need to turn it into "greater-equal" form )
# 1 <= x1 <= 3 # bounds
# 1 <= x2 <= 6 # bounds
H <- rbind(c(2, 0),
c(0, 8))
f <- c(8,16)
# equalities
A.eq <- rbind(c(1,2))
b.eq <- c(12)
# inequalities
A.ge <- rbind(c(-1,-1))
b.ge <- c(-10)
# lower-bounds
A.lbs <- rbind(c( 1, 0),
c( 0, 1))
b.lbs <- c(1, 1)
# upper-bounds on variables
A.ubs <- rbind(c(-1, 0),
c( 0,-1))
b.ubs <- c(-3, -6)
# solve
sol <- solve.QP(Dmat = H,
dvec = f,
Amat = t(rbind(A.eq, A.ge, A.lbs, A.ubs)),
bvec = c(b.eq, b.ge, b.lbs, b.ubs),
meq = 1) # this argument says the first "meq" rows of Amat are equalities
sol
> sol
$solution
[1] 3.0 4.5
$value
[1] -6
$unconstrained.solution
[1] 4 2
$iterations
[1] 3 0
$Lagrangian
[1] 10 0 0 0 12 0
$iact
[1] 1 5
I am seeking some simple (i.e. - no maths notation, long-form reproducible code) examples for the filter function in R
I think I have my head around the convolution method, but am stuck at generalising the recursive option. I have read and battled with various documentation, but the help is just a bit opaque to me.
Here are the examples I have figured out so far:
# Set some values for filter components
f1 <- 1; f2 <- 1; f3 <- 1;
And on we go:
# basic convolution filter
filter(1:5,f1,method="convolution")
[1] 1 2 3 4 5
#equivalent to:
x[1] * f1
x[2] * f1
x[3] * f1
x[4] * f1
x[5] * f1
# convolution with 2 coefficients in filter
filter(1:5,c(f1,f2),method="convolution")
[1] 3 5 7 9 NA
#equivalent to:
x[1] * f2 + x[2] * f1
x[2] * f2 + x[3] * f1
x[3] * f2 + x[4] * f1
x[4] * f2 + x[5] * f1
x[5] * f2 + x[6] * f1
# convolution with 3 coefficients in filter
filter(1:5,c(f1,f2,f3),method="convolution")
[1] NA 6 9 12 NA
#equivalent to:
NA * f3 + x[1] * f2 + x[2] * f1 #x[0] = doesn't exist/NA
x[1] * f3 + x[2] * f2 + x[3] * f1
x[2] * f3 + x[3] * f2 + x[4] * f1
x[3] * f3 + x[4] * f2 + x[5] * f1
x[4] * f3 + x[5] * f2 + x[6] * f1
Now's when I am hurting my poor little brain stem.
I managed to figure out the most basic example using info at this post: https://stackoverflow.com/a/11552765/496803
filter(1:5, f1, method="recursive")
[1] 1 3 6 10 15
#equivalent to:
x[1]
x[2] + f1*x[1]
x[3] + f1*x[2] + f1^2*x[1]
x[4] + f1*x[3] + f1^2*x[2] + f1^3*x[1]
x[5] + f1*x[4] + f1^2*x[3] + f1^3*x[2] + f1^4*x[1]
Can someone provide similar code to what I have above for the convolution examples for the recursive version with filter = c(f1,f2) and filter = c(f1,f2,f3)?
Answers should match the results from the function:
filter(1:5, c(f1,f2), method="recursive")
[1] 1 3 7 14 26
filter(1:5, c(f1,f2,f3), method="recursive")
[1] 1 3 7 15 30
EDIT
To finalise using #agstudy's neat answer:
> filter(1:5, f1, method="recursive")
Time Series:
Start = 1
End = 5
Frequency = 1
[1] 1 3 6 10 15
> y1 <- x[1]
> y2 <- x[2] + f1*y1
> y3 <- x[3] + f1*y2
> y4 <- x[4] + f1*y3
> y5 <- x[5] + f1*y4
> c(y1,y2,y3,y4,y5)
[1] 1 3 6 10 15
and...
> filter(1:5, c(f1,f2), method="recursive")
Time Series:
Start = 1
End = 5
Frequency = 1
[1] 1 3 7 14 26
> y1 <- x[1]
> y2 <- x[2] + f1*y1
> y3 <- x[3] + f1*y2 + f2*y1
> y4 <- x[4] + f1*y3 + f2*y2
> y5 <- x[5] + f1*y4 + f2*y3
> c(y1,y2,y3,y4,y5)
[1] 1 3 7 14 26
and...
> filter(1:5, c(f1,f2,f3), method="recursive")
Time Series:
Start = 1
End = 5
Frequency = 1
[1] 1 3 7 15 30
> y1 <- x[1]
> y2 <- x[2] + f1*y1
> y3 <- x[3] + f1*y2 + f2*y1
> y4 <- x[4] + f1*y3 + f2*y2 + f3*y1
> y5 <- x[5] + f1*y4 + f2*y3 + f3*y2
> c(y1,y2,y3,y4,y5)
[1] 1 3 7 15 30
In the recursive case, I think no need to expand the expression in terms of xi.
The key with "recursive" is to express the right hand expression in terms of previous y's.
I prefer thinking in terms of filter size.
filter size =1
y1 <- x1
y2 <- x2 + f1*y1
y3 <- x3 + f1*y2
y4 <- x4 + f1*y3
y5 <- x5 + f1*y4
filter size = 2
y1 <- x1
y2 <- x2 + f1*y1
y3 <- x3 + f1*y2 + f2*y1 # apply the filter for the past value and add current input
y4 <- x4 + f1*y3 + f2*y2
y5 <- x5 + f1*y4 + f2*y3
Here's the example that I've found most helpful in visualizing what recursive filtering is really doing:
(x <- rep(1, 10))
# [1] 1 1 1 1 1 1 1 1 1 1
as.vector(filter(x, c(1), method="recursive")) ## Equivalent to cumsum()
# [1] 1 2 3 4 5 6 7 8 9 10
as.vector(filter(x, c(0,1), method="recursive"))
# [1] 1 1 2 2 3 3 4 4 5 5
as.vector(filter(x, c(0,0,1), method="recursive"))
# [1] 1 1 1 2 2 2 3 3 3 4
as.vector(filter(x, c(0,0,0,1), method="recursive"))
# [1] 1 1 1 1 2 2 2 2 3 3
as.vector(filter(x, c(0,0,0,0,1), method="recursive"))
# [1] 1 1 1 1 1 2 2 2 2 2
With recursive, the sequence of your "filters" is the additive coefficient for the previous sums or output values of the sequence. With filter=c(1,1) you're saying "take the i-th component in my sequence x and add to it 1 times the result from the previous step and 1 times the results from the step before that one". Here's a couple examples to illustrate
I think the lagged effect notation looks like this:
## only one filter, so autoregressive cumsum only looks "one sequence behind"
> filter(1:5, c(2), method='recursive')
Time Series:
Start = 1
End = 5
Frequency = 1
[1] 1 4 11 26 57
1 = 1
2*1 + 2 = 4
2*(2*1 + 2) + 3 = 11
...
## filter with lag in it, looks two sequences back
> filter(1:5, c(0, 2), method='recursive')
Time Series:
Start = 1
End = 5
Frequency = 1
[1] 1 2 5 8 15
1= 1
0*1 + 2 = 2
2*1 + 0*(0*1 + 2) + 3 = 5
2*(0*1 + 2) + 0 * (2*1 + 0*(0*1 + 2) + 3) + 4 = 8
2*(2*1 + 0*(0*1 + 2) + 3) + 0*(2*(0*1 + 2) + 0 * (2*1 + 0*(0*1 + 2) + 3) + 4) + 5 = 15
Do you see the cumulative pattern there? Put differently.
1 = 1
0*1 + 2 = 2
2*1 + 0*2 + 3 = 5
2*2 + 0*5 + 4 = 8
2*5 + 0*8 + 5 = 15
I spent one hour in reading this, below is my summary, by comparison with Matlab
NOTATION: command in Matlab = command in R
filter([1,1,1], 1, data) = filter(data, [1,1,1], method = "convolution") ; but the difference is that the first 2 elements are NA
filter(1, [1,-1,-1,-1], data) = filter(data, [1,1,1], method = "recursive")
If you know some from DSP, then recursive is for IIR, convolution is for FIR