Comparing Vector Values - r

`I'm wondering how I would go about altering this code so that corresponding values of both vectors cannot be equal. As an example: if x = (1, 2, 2, 4, 8, 1, 7, 9, 5, 10) and y = (3, 2, 7, 8, 4, 10, 4, 8, 2, 1), the second values for both vectors equal 2. Is there any way I can tell R to re-sample in this second spot in vector x until it is not the same value in vector y?
x <- c(1:10)
y <- c(1:10)
sample_x <- sample(x, length(10), replace = TRUE)
z <- sample_x > y`

You could do:
while(any(x == y)) x <- sample(x)
Edit: Now I realize x and y probably come from a similar sample call with replace = TRUE, here is an interesting approach that avoids a while loop. It uses indices and modulo to ensure that the two samples do not match:
N <- 1:10 # vector to choose from (assumes distinct values)
L <- 20 # sample size - this might be length(N) as in your example
n <- length(N)
i <- sample(n, L, replace = TRUE)
j <- sample(n-1, L, replace = TRUE)
x <- N[i]
y <- N[1 + (i + j - 1) %% n]

while (any(ind <- x==y))
x[ind] <- sample(N, sum(ind), TRUE)
where N is what you are sampling from (or the max integer)
The advantage here is that if you do not need to resample all of x, then this will converge more quickly.

You can use function permn from library combinat to generate all permutations of vector of length 10.
ind <- permn(10)
xy_any_equal <- sapply(ind, function(i) any(x[i] == y))
if(sum(xy_any_equal) < length(xy_any_equal)) x_perm <- x[head(ind[!xy_any_equal],1)[[1]]]
exists(x_perm)

Related

Providing the correct match for a list in a list of lists in R

I have a list of lists in R:
a <- list(x=0, y=c(1,2,3), z=4)
b <- list(x=1, y=c(1,2,3), z=44)
c <- list(x=2, y=c(1,2,3), z=444)
L <- list(a,b,c)
For a given list, say
l <- list(x=0, y=c(1,2,3), z=4)
I know want to find the correct index of L where we find the corresponding list that equals l.
Of course, I can use a loop, but since Lis very large, I need a faster solution.
(And is a list even the right choice here?)
We can use stack with identical from base R
which(sapply(L, function(x) identical(stack(l), stack(x))))
#[1] 1
Or more compactly
which(sapply(L, identical, l))
#[1] 1
Using mapply to compare each element one by one with l. If you unlist it, all should be TRUE. Using which around an sapply finally gives the number of the matching element.
f <- function(x) all(unlist(mapply(`==`, x, l)))
which(sapply(L, f))
# [1] 1
Data:
L <- list(list(x = 0, y = c(1, 2, 3), z = 4), list(x = 1, y = c(1,
2, 3), z = 44), list(x = 2, y = c(1, 2, 3), z = 444))
l <- list(x = 0, y = c(1, 2, 3), z = 4)
Perhaps you can try mapply like below
> which(mapply(identical, L, list(l)))
[1] 1

create a matrix in `R` and each element in that matrix is another matrix

Is there a way to create a matrix in R and each element in that matrix is another matrix? I used to do that in Python, but when I do
X <- matrix(rep(0,200),nrow=200,ncol=1)
for (i in 1:200){ X[i,] <-matrix(rep(0,32),nrow=8,ncol=4)}
It is not working in R.
Thanks!
You may use
X <- matrix(vector("list", 200))
which is just
X <- matrix(list()[rep(1, 200)], nrow = 200, ncol = 1)
with
for (i in 1:200)
X[i, ] <- list(matrix(rep(0,32), nrow = 8, ncol = 4))
or
for (i in 1:200)
X[i, ][[1]] <- matrix(rep(0,32), nrow = 8, ncol = 4)
Then each matrix entry will be a list containing a matrix.
If all the submatrices are the same shape, you could use an array:
X = array(0, dim = c(200, 8, 4))
Here are some dimensions
> dim(X)
[1] 200 8 4
> dim(X[1,,])
[1] 8 4

Matrix vector multiplication only if column and row are different

I'm implementing the Jacobi iterative method to solve linear systems Ax = b
I have the following code:
data.a <- c(3, -1, 1, 3, 6, 2, 3, 3, 7)
A <- matrix(data.a, nrow = 3, ncol = 3, byrow = TRUE)
b <- c(1, 0, 4)
Xo <- c(0,0,0)
X <- c(0, 0, 0)
#A is the matrix:
#3 -1 1
#3 6 2
#3 3 7
#b is the column vector:
#[1, 0, 4]
#and Xo is the previous X computed
for(i in 1:nrow(A)){
sum = 0
for(j in 1:ncol(A)){
if(j != i){
sum = sum + A[i,j]*Xo[j]
}
}
X[i] = -(1/A[i,i])*(sum - b[i])
}
The thing is, because I only multiply and sum up the values A[i][j]*Xo[j] for j != i
I am using nested for-loops and use the auxiliar variable sum.
My question is: Could I use something like
A[i,] %*% Xo
to compute the values of the sum without the nested-for loops?
edit: I found a solution
X[i] = -(1/A[i,i])*(A[i,]%*%Xo - A[i,i]*Xo[i] - b[i])
# I subtracted the term A[i,i]*Xo[i] from the product A*Xo
You can even remove the first loop by making a matrix R, whose elements are equal to A except that diagonal elements are zeros.
update <- function(x, A, b) {
D <- diag(diag(A))
R <- A - D
sums <- R %*% x
x <- (b - sums) / diag(D)
x
}
data.a <- c(3, -1, 1, 3, 6, 2, 3, 3, 7)
A <- matrix(data.a, nrow = 3, ncol = 3, byrow = TRUE)
b <- c(1, 0, 4)
x <- c(0, 0, 0)
for (i in 1:100) x <- update(x, A, b)
x
# verify the answer is correct
solve(A, b)

How to plot points aligned at different angles and connect these by a line?

I am trying to simulate the shape of the rings from a trunk section in R, but each time that I want to approach the real shape it get more difficult. I started doing it with four radii measurements, and I got a nice solution (see here).
However, now I want to plot more than four radii but at different angles, and connect these points with a line simulating the rings like this sketch that I did:
My first approach was to rotate the matrix of data, but I could not make that all radii started in the same position (0,0). I also tried to rate the axes without success.
That is why I would like to ask for some direction to do it, and finally calculate the area of each ring.
Any help will be welcome
I am using the spline.poly function from here.
spline.poly
spline.poly <- function(xy, vertices, k=3, ...) {
# Assert: xy is an n by 2 matrix with n >= k.
# Wrap k vertices around each end.
n <- dim(xy)[1]
if (k >= 1) {
data <- rbind(xy[(n-k+1):n,], xy, xy[1:k, ])
} else {
data <- xy
}
# Spline the x and y coordinates.
data.spline <- spline(1:(n+2*k), data[,1], n=vertices, ...)
x <- data.spline$x
x1 <- data.spline$y
x2 <- spline(1:(n+2*k), data[,2], n=vertices, ...)$y
# Retain only the middle part.
cbind(x1, x2)[k < x & x <= n+k, ]
}
DATA
df = data.frame(A = c(1, 4, 5, 8, 10),
B = c(1, 3, 7, 9, 10),
C = c(2, 6, 8, 9, 10),
D = c(1, 3, 4, 7, 9),
E = c(1, 2, 3, 4, 5))
DRAW
#Calculate angles based on number of columns
angles = 0:(NCOL(df) - 1) * 2*pi/NCOL(df)
#Calculate x and y corresponding to each radial distance
toplot = lapply(1:NCOL(df), function(i){
data.frame(x = df[,i]*cos(angles[i]),
y = df[,i]*sin(angles[i]))
})
#Split toplot and merge back together the same rows
toplot2 = lapply(toplot, function(x) data.frame(x, ID = sequence(NROW(x))))
toplot2 = do.call(rbind, toplot2)
toplot2 = split(toplot2, toplot2$ID)
#Create empty plot
graphics.off()
plot(do.call(rbind, toplot), type = "n", axes = FALSE, ann = FALSE, asp = 1)
#Allow drawing outside the plot region just in case
par(xpd = TRUE)
#Draw polygons
lapply(toplot2, function(a){
polygon(spline.poly(xy = cbind(a$x, a$y), vertices = 100, k = 3))
})
#Draw points
lapply(toplot, function(a){
points(a)
})
#Draw radial lines
lapply(toplot, function(a){
lines(a)
})
AREA
area_data = lapply(toplot2, function(a){
spline.poly(xy = cbind(a$x, a$y), vertices = 100, k = 3)
})
library(geometry)
lapply(area_data, function(P) polyarea(P[,1], P[,2]))
#$`1`
#[1] 4.35568
#$`2`
#[1] 38.46985
#$`3`
#[1] 96.41331
#$`4`
#[1] 174.1584
#$`5`
#[1] 240.5837

Divide vector with grouping vector

I have two vectors, which I would like to combine in one dataframe. One of the vectors values needs to be divided into two columns. The second vector nc informs about the number of values for each observation. If nc is 1, only one value is given in values (which goes into val1) and 999 is to be written in the second column (val2).
What is an r-ish way to divide vector value and populate the two columns of df? I suspect I miss something very obvious, but can't proceed at the moment...Many thanks!
set.seed(123)
nc <- sample(1:2, 10, replace = TRUE)
value <- sample(1:6, sum(nc), replace = TRUE)
# result by hand
df <- data.frame(nc = nc,
val1 = c(6, 3, 4, 1, 2, 2, 6, 5, 6, 5),
val2 = c(999, 5, 999, 6, 1, 999, 6, 4, 4, 999))
Here's an approach based on this answer:
set.seed(123)
nc <- sample(1:2, 10, replace = TRUE)
value <- sample(1:6, sum(nc), replace = TRUE)
splitUsing <- function(x, pos) {
unname(split(x, cumsum(seq_along(x) %in% cumsum(replace(pos, 1, pos[1] + 1)))))
}
combineValues <- function(vals, nums) {
mydf <- data.frame(cbind(nums, do.call(rbind, splitUsing(vals, nums))))
mydf$V3[mydf$nums == 1] <- 999
return(mydf)
}
df <- combineValues(value, nc)
I think this is what you are looking for. I'm not sure it is the fastest way, but it should do the trick.
count <- 0
for (i in 1:length(nc)) {
count <- count + nc[i]
if(nc[i]==1) {
df$val1[i] <- value[count]
df$val2[i] <- 999
} else {
df$val1[i] <- value[count-1]
df$val2[i] <- value[count]
}
}

Resources