Say I have some sequence consisting of 2 numbers:
seq <- c(0, 1, 1, 1, 0, 0)
Assume I'd want to plot this into a graph in the following way:
My graph (x, y) starts in (0, 0) and has one straight line to (1, 0).
Then, the sequence comes in action:
If the number is a 0, I turn left with 1 coordinate, if the number is a 1, I turn right with 1 coordinate.
So for the example sequence, I start with:
(0, 0) -> (1, 0) -> (1, 1) -> (1, 2) -> (1, 1) -> (1, 0) etc.
It's better to draw this if you want a good idea of what I mean with turning left and right.
How would I get these points into a plot? Any tips?
Plot example of the sequence:
x = c(0, 1, 1, 1, 0, 0)
m = cbind(x = c(0, 1),
y = c(0, 0))
flag_xy = 1 #Track whether to add to x- or y- coordinate
for (i in x){
flag_direction = diff(tail(m, 2)) #Track which way the line is facing
if (i == 0){
if (flag_xy == 1){
m = rbind(m, tail(m, 1) + c(0, flag_direction[,1] * 1))
} else{
m = rbind(m, tail(m, 1) + c(flag_direction[,2] * -1, 0))
}
flag_xy = flag_xy * -1
} else{
if (flag_xy == 1){
m = rbind(m, tail(m, 1) + c(0, flag_direction[,1] * -1))
} else{
m = rbind(m, tail(m, 1) + c(flag_direction[,2]* 1, 0))
}
flag_xy = flag_xy * -1
}
}
graphics.off()
plot(m, asp = 1)
lines(m)
m
# x y
# 0 0
# 1 0
#[2,] 1 1
#[2,] 2 1
#[2,] 2 0
#[2,] 1 0
#[2,] 1 -1
#[2,] 2 -1
Related
I have made a matrix with values 1 and 0, and I want to check if there is one or more rows identical to (0, 0, 0, 0, 0, 0, 0, 0, 0, 0).
How can I do this?
Here's my code so far for making the matrix:
moeda <- c(0, 1)
n <- 100
casosTotais <- 0
casosFav <- 0
caras <- c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0) ## the vector to compare with
matriz <- matrix(nrow = n, ncol = 10)
i <- 1
lin <- 1
col <- 1
while(i <= n * 10){
matriz[lin, col] <- sample(moeda,1)
if(col==10){
lin <- lin + 1
col <- col - 10
}
i <- i + 1
col <- col + 1
}
matriz
I will first assume a general caras with zeros and ones:
## a vector of TRUE/FALSE; TRUE means a row of `matriz` is identical to `caras`
comp <- colSums(abs(t(matriz) - caras)) == 0
Then if caras is a simply a vector of zeros:
## a vector of TRUE/FALSE; TRUE means a row of `matriz` only contains zeros
comp <- rowSums(matriz) == 0
If you want to summarize the comparison:
To know which rows of matriz are identical to caras, do which(comp).
To know if any row of matriz is identical to caras, do any(comp).
To know how many rows of matriz is identical to caras, do sum(comp).
Note: You can generate this random matrix using:
## an n x 10 random matrix of zeros and ones
matriz <- matrix(rbinom(n * 10, size = 1, prob = 0.5), ncol = 10)
Suppose I have the following system of inequalities:
-2x + y <= -3
1.25x + y <= 2.5
y >= -3
I want to find multiple tuples of (x, y) that satisfy the above inequalities.
library(Rglpk)
obj <- numeric(2)
mat <- matrix(c(-2, 1, 1.25, 1, 0, 1), nrow = 3)
dir <- c("<=", "<=", ">=")
rhs <- c(-3, 2.5, -3)
Rglpk_solve_LP(obj = obj, mat = mat, dir = dir, rhs = rhs)
Using the above code only seems to return 1 possible solution tuple (1.5, 0). Is possible to return other solution tuples?
Edit: Based on the comments, I would be interested to learn if there are any functions that could help me find the corner points.
Actually to understand the possible answers for the given question we can try to solve the system of inequalities graphically.
There was a nice answer concerning plotting of inequations in R at stackowerflow. Using the given aproach we can plot the following graph:
library(ggplot2)
fun1 <- function(x) 2*x - 3 # this is the same as -2x + y <= -3
fun2 <- function(x) -1.25*x + 2.5 # 1.25x + y <= 2.5
fun3 <- function(x) -3 # y >= -3
x1 = seq(-1,5, by = 1/16)
mydf = data.frame(x1, y1=fun1(x1), y2=fun2(x1),y3= fun3(x1))
mydf <- transform(mydf, z = pmax(y3,pmin(y1,y2)))
ggplot(mydf, aes(x = x1)) +
geom_line(aes(y = y1), colour = 'blue') +
geom_line(aes(y = y2), colour = 'green') +
geom_line(aes(y = y3), colour = 'red') +
geom_ribbon(aes(ymin=y3,ymax = z), fill = 'gray60')
All the possible (infinite by number) tuples lie inside the gray triangle.
The vertexes can be found using the following code.
obj <- numeric(2)
mat <- matrix(c(-2, 1.25, 1, 1), nrow = 2)
rhs <- matrix(c(-3, 2.5), nrow = 2)
aPoint <- solve(mat, rhs)
mat <- matrix(c(-2, 0, 1, 1), nrow = 2)
rhs <- matrix(c(-3, -3), nrow = 2)
bPoint <- solve(mat, rhs)
mat <- matrix(c(1.25, 0, 1, 1), nrow = 2)
rhs <- matrix(c(2.5, -3), nrow = 2)
cPoint <- solve(mat, rhs)
Note the order of arguments of matrices.
And you get the coordinates:
> aPoint
[,1]
[1,] 1.6923077
[2,] 0.3846154
> bPoint
[,1]
[1,] 0
[2,] -3
> cPoint
[,1]
[1,] 4.4
[2,] -3.0
All the codes below are with base R only (no need library(Rglpk))
1. Corner Points
If you want to get all the corner points, here is one option
A <- matrix(c(-2, 1.25, 0, 1, 1, -1), nrow = 3)
b <- c(-3, 2.5, 3)
# we use `det` to check if the coefficient matrix is singular. If so, we return `Inf`.
xh <-
combn(nrow(A), 2, function(k) {
if (det(A[k, ]) == 0) {
rep(NA, length(k))
} else {
solve(A[k, ], b[k])
}
})
# We filter out the points that satisfy the constraint
corner_points <- t(xh[, colSums(A %*% xh <= b, na.rm = TRUE) == length(b)])
such that
> corner_points
[,1] [,2]
[1,] 1.692308 0.3846154
[2,] 0.000000 -3.0000000
[3,] 4.400000 -3.0000000
2. Possible Tuples
If you want to have multiple tuples, e.g., n=10, we can use Monte Carlo simulation (based on the obtained corner_points in the previous step) to select the tuples under the constraints:
xrange <- range(corner_points[, 1])
yrange <- range(corner_points[, 2])
n <- 10
res <- list()
while (length(res) < n) {
px <- runif(1, xrange[1], xrange[2])
py <- runif(1, yrange[1], yrange[2])
if (all(A %*% c(px, py) <= b)) {
res[length(res) + 1] <- list(c(px, py))
}
}
and you will see n possible tuples in a list like below
> res
[[1]]
[1] 3.643167 -2.425809
[[2]]
[1] 2.039007 -2.174171
[[3]]
[1] 0.4990635 -2.3363637
[[4]]
[1] 0.6168402 -2.6736421
[[5]]
[1] 3.687389 -2.661733
[[6]]
[1] 3.852258 -2.704395
[[7]]
[1] 1.7571062 0.1067597
[[8]]
[1] 3.668024 -2.771307
[[9]]
[1] 2.108187 -1.365349
[[10]]
[1] 2.106528 -2.134310
First of all, the matrix representing the three equations needs a small correction, because R fills matrices column by column :
-2x + y <= -3
1.25x + y <= 2.5
y >= -3
mat <- matrix(c(-2, 1.25, 0, 1, 1, 1), nrow = 3
# and not : mat <- matrix(c(-2, 1, 1.25, 1, 0, 1), nrow = 3)
To get different tuples, you could modify the objective function :
obj <- numeric(2) results in an objective function 0 * x + 0 * y which is always equal to 0 and can't be maximized : the first valid x,y will be selected.
Optimization on x is achieved by using obj <- c(1,0), resulting in maximization / minimization of 1 * x + 0 * y.
Optimization on y is achieved by using obj <- c(0,1).
#setting the bounds is necessary, otherwise optimization occurs only for x>=0 and y>=0
bounds <- list(lower = list(ind = c(1L, 2L), val = c(-Inf, -Inf)),
upper = list(ind = c(1L, 2L), val = c(Inf, Inf)))
# finding maximum x: obj = c(1,0), max = T
Rglpk_solve_LP(obj = c(10,0), mat = mat, dir = dir, rhs = rhs,bound=bounds, max = T)$solution
# [1] 4.4 -3.0
# finding minimum x: obj = c(1,0), max = F
Rglpk_solve_LP(obj = c(10,0), mat = mat, dir = dir, rhs = rhs,bound=bounds, max = F)$solution
#[1] 0 -3
# finding maximum y: obj = c(0,1), max = T
Rglpk_solve_LP(obj = c(0,1), mat = mat, dir = dir, rhs = rhs,bound=bounds, max = T)$solution
#[1] 1.6923077 0.3846154
For a class I must create a piecewise function defined in the following way:
2x-2 , x < -1
0 , -1 <= X <= 1
x^(2)-1, x > 1
I have tried an ifelse sequence but I cant seem to make it work. I've also tried an if, elseif, else sequence, but that only seems to use the first function to calculate answers.
The end goal is to have this:
pwfun(c(-2, 0.5, 3))
2 0 8
A piece-wise function like below?
pwfun <- function(x) ifelse(x < -1, 2 * x - 2, ifelse(x <= 1, 0, x**2 - 1))
such that
> pwfun(c(-2, 0.5, 3))
[1] -6 0 8
pwfun <- function(x) ifelse(x < -1, (x * x) -2, ifelse(x <= 1, 0, x**2 - 1))
> pwfun(c(-2, 0.5, 3))
[1] -2 0 8
The above edit to ThomasIsCoding's answer gives you what you want, but I would use this approach because it communicates it's intent better:
library(dplyr)
df <- data.frame(x = c(-2, 0.5, 3))
pwfunc <- function(data){
data %>%
mutate(y =
case_when(x < -1 ~ -2,
x > 0 & x <= 1 ~ 0,
TRUE ~ x**2 - 1)) ## TRUE in a case_when basically
## means "everything that isnt caught by my specified conditions
## becomes..." so it works like the "else" clause
}
Then just call the function on your data:
df <- data.frame(x = c(-2, 0.5, 3))
pwfunc(data)
And get:
I'm creating a function with several conditions and now, I want to mutate several variables based on them.
I need to create several variables that correspond to the parity of a woman in that year. First, I created a variable p2009, which would be calculated subtracting p2010 by V2009 (the number of children that she had in 2009). This interaction creates negative results that I need to replace based on some conditions. For example: if p2009 is an equal -1, I need to readjust the p2009 variable to the total number of children, TOTALNV that she had.
To illustrate, imagine someone that in 2010 has a parity equal to 4. She had a child in 2009. So, her p2009 would be 4 (p2010 - 1 (v2009).
These are my functions, sorry, it is pretty horrible.
varp2010 <- function(y, w){ #x = p2010, y = V2010, w = TotalNV
(ifelse(y == 1, w,
ifelse(y == 0, 0,
ifelse(y == 2, (w-1),
ifelse(y == 3, (w-2),
ifelse(y == 4, (w-3),
ifelse(y == 5, (w-4),
ifelse(y == 6, (w-5), 0))))))))
varp2009 <- function(y, w, z){
(ifelse(y == (-1), w,
ifelse(y == -2, (w-1),
ifelse(y == -3, (w-2),
ifelse(y == -4, (w-3),
ifelse(y == -5, (w-4),
ifelse(y == -6, (w-5),
ifelse(z == 0, 0, y))))))))
}
I created the variables called sum to be easy to work with
sum2008 = TOTALNV-v2010, sum2007 = TOTALNV-v2010-v2009
And this is my mutate function:
BH_final_All_Wn <- BH_final_All_Wn %>%
mutate(pr2010 = varp2010(y = V2010, w = TOTALNV),
pr2009 = pr2010 - V2009 %>%
varp2009(y = pr2009, w = TOTALNV, z = V2009),
pr2008 = pr2009 - V2008 %>%
varp2009(y = pr2008, w = sum2008, z = V2008),
pr2007 = pr2008 - V2007 %>%
varp2009(y = pr2007, w = sum2007, z = V2007),
pr2006 = pr2007 - V2006 %>%
varp2009(y = pr2006, w = sum2006, z = V2006),
pr2005 = pr2006 - V2005 %>%
varp2009(y = pr2005, w = sum2005, z = V2005),
pr2004 = pr2005 - V2004 %>%
varp2009(y = pr2004, w = sum2004, z = V2004),
pr2003 = pr2004 - V2003 %>%
varp2009(y = pr2003, w = sum2003, z = V2003),
pr2002 = pr2003 - V2002 %>%
varp2009(y = pr2002, w = sum2002, z = V2002),
pr2001 = pr2002 - V2001 %>%
varp2009(y = pr2001, w = sum2001, z = V2001),
pr2000 = pr2001 - V2000 %>%
varp2009(y = pr2000, w = sum2000, z = V2000),
pr1999 = pr2000 - V1999 %>%
varp2009(y = pr1999, w = sum1999, z = V1999),
pr1998 = pr1999 - V1998 %>%
varp2009(y = pr1998, w = sum1998, z = V1998),
pr1997 = pr1998 - V1997 %>%
varp2009(y = pr1997, w = sum1997, z = V1997),
pr1996 = pr1997 - V1996 %>%
varp2009(y = pr1996, w = sum1996, z = V1996))
My data is too big, around 300000 observations.
This is a small sample with the variables that I am using.
V2010 <- c(0, 1, 0, 0, 1, 0, 0)
V2009 <- c(0, 0, 1, 0, 0, 0, 0)
V2008 <- c(0, 0, 1, 0, 0, 0, 0)
TOTALNV <- c(12, 2, 2, 0, 1, 0, 0)
df <- data.frame(TOTALNV, V2010, V2009, V2008)
I will be thankful if someone suggests the easiest way to do this.
I am expecting a result like this:
TOTALNV V2010 V2009 V2008 pr2010 pr2009 pr2008
1 12 0 0 0 0 0 0
2 2 1 0 0 2 0 0
3 2 0 1 1 0 2 1
4 0 0 0 0 0 0 0
5 1 1 0 0 1 0 0
6 0 0 0 0 0 0 0
7 0 0 0 0 0 0 0
Best
for example I have data like this
x<-c(0,0,1,1,1,1,0,0,1,1,0,1,1,1)
I want find the longest sequence of "1" by considering the start and end position, in this case should be (3,6)
How to do this in R
thanks all
Here's an approach that uses seqle from the "cgwtools" package:
library(cgwtools)
y <- seqle(which(x == 1))
z <- which.max(y$lengths)
y$values[z] + (sequence(y$lengths[z]) - 1)
# [1] 3 4 5 6
You can use range if you just wanted the "3" and "6".
seqle "extends rle to find and encode linear sequences".
Here's the answer as a function:
longSeq <- function(invec, range = TRUE) {
require(cgwtools)
y <- seqle(which(invec == 1))
z <- which.max(y$lengths)
out <- y$values[z] + (sequence(y$lengths[z]) - 1)
if (isTRUE(range)) range(out) else out
}
Usage would be:
x <- c(0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 0, 1, 1, 1)
longSeq(x)
# [1] 3 6
longSeq(x, range = FALSE)
# [1] 3 4 5 6
And, with KFB's example input:
y <- c(0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1)
longSeq(y)
# [1] 9 11
You can do this easily with base R too using rle and inverse.rle combination
Creating the funciton
longSeq2 <- function(x, range = TRUE){
temp <- rle(x == 1)
temp$values <- temp$lengths == max(temp$lengths[temp$values == TRUE])
temp <- which(inverse.rle(temp))
if (isTRUE(range)) range(temp) else temp
}
Testing
x <- c(0,0,1,1,1,1,0,0,0,0,0,0,0,1,1,0,1,1,1)
longSeq2(x)
## [1] 3 6
longSeq2(x, range = FALSE)
## [1] 3 4 5 6
y <- c(0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1)
longSeq2(y)
## [1] 9 11
longSeq2(y, range = FALSE)
## [1] 9 10 11