To keep my script records clean, I'd like to output vector inputs with rep() instead of repeated values in chain. Please see my example below, using dput():
v<-c(rep(1,2), rep(2,4), rep(NA,5))
dput(v)
>c(1, 1, 2, 2, 2, 2, NA, NA, NA, NA, NA)
unknown_function(v)
>c(rep(1,2), rep(2,4), rep(NA,5))
Surely trivial, but I cannot find any simple solution. Suggestions for unknown_function(), please?
rle will compute the values and lengths and from that we can paste it together:
with(rle(format(v)), paste0("c(", toString(paste0("rep(", values, ",", lengths, ")")), ")"))
## [1] "c(rep( 1,2), rep( 2,4), rep(NA,5))"
You can write a function using the stucture of rle and change it to crunch also NA and combine it with the method from #g-grothendieck.
dputRle <- function (x, nmin=3) {
if (!is.vector(x) && !is.list(x))
stop("'x' must be a vector of an atomic type")
n <- length(x)
if (n <= 1L)
return(x)
y <- x[-1L] != x[-n] | is.na(x[-1L]) != is.na(x[-n])
i <- c(which(y), n)
lengths = diff(c(0L, i))
paste0("c(", toString(unlist(sapply(seq(i), function(y) {
if(lengths[y] <= nmin) {rep(x[i[y]], lengths[y])
} else {paste0("rep(", x[i[y]], ",", lengths[y], ")")}
}))), ")")
}
v <- c(rep(1,2), rep(2,4), rep(NA,5), 1)
dputRle(v, 1)
#[1] "c(rep(1,2), rep(2,4), rep(NA,5), 1)"
dputRle(v)
#"c(1, 1, rep(2,4), rep(NA,5), 1)"
v <- 1
dputRle(v)
#[1] 1
v <- numeric(0)
dputRle(v)
#numeric(0)
Or alternative.
dputRle2 <- function (x) {
if (!is.vector(x) && !is.list(x))
stop("'x' must be a vector of an atomic type")
n <- length(x)
if (n <= 1L)
return(x)
y <- x[-1L] != x[-n] | is.na(x[-1L]) != is.na(x[-n])
i <- c(which(y), n)
paste0("rep(c(", toString(x[i]), "), c(", toString(diff(c(0L, i))), "))")
}
v <- c(rep(1,2), rep(2,4), rep(NA,5), 1)
dputRle2(v)
#[1] "rep(c(1, 2, NA, 1), c(2, 4, 5, 1))"
There are some ways to use rle with c and rep. All of the following will produce the same vector.
c(1, 2, 2, 3, 3, 3)
c(1, rep(2, 2), rep(3, 3))
c(1, rep(c(2, 3), c(2, 3)))
rep(c(1, 2, 3), c(1, 2, 3))
rep(1:3, 1:3)
Related
I have data as follows:
alist <- list()
vec <- c(1, 2, 3)
I want to put a value (in this case an object), into a sublist. But when I do:
for (i in 1:length(vec)) {
alist[[i]][1] <- vec
}
this is for some reason not allowed: Error in *tmp* [[i]] : subscript out of bounds.
Do I have to intialise every sublist? If so, what is the syntax for doing that?
Desired outcome:
desired_out <- list( list(alist = c(1, 2, 3) ), list(alist = c(1, 2, 3) ), list(alist = c(1, 2, 3) ))
EDIT:
An attempt to create a reproducible example for the entire loop (my actual data is a loop within a loop):
alist <- list()
vec <- c(1, 2, 3)
for (j in 1:2) {
for (i in 1:length(vec)) {
alist[[i]][j] <- vec
}
}
Create an empty list with length then fill it in:
x <- vector(mode = "list", length = 3)
for (j in 1:2) {
for (i in 1:length(vec)) {
# notice double square brackets
x[[ i ]][[ j ]] <- vec
}
}
This does what you ask for, but I think your example is still to minimal for your original nested loop problem:
alist <- list()
vec <- c(1, 2, 3)
for (i in 1:length(vec)) {
alist[[i]] <- list(alist = vec)
}
desired_out <- list(
list(alist = c(1, 2, 3)),
list(alist = c(1, 2, 3)),
list(alist = c(1, 2, 3))
)
identical(alist, desired_out)
#> [1] TRUE
Created on 2021-11-05 by the reprex package (v2.0.1)
I'd like to add toAdd to the diagonal of every element of list a. How can I do this? I tried
diag(a) = lapply(a, function(x) (toAdd + diag(x)))
but it doesn't work.
CODE:
a =list(
matrix(1:4, 2, 2),
matrix(5:8, 2, 2))
toAdd = list(
c(1, 3),
c(1, 2)
)
DESIRED OUTCOME:
out =list(
matrix(c(2, 2, 3, 5), 2, 2),
matrix(c(6, 6, 7, 9), 2, 2))
Try with Map
Map(function(x, y) {diag(y) <- x + diag(y); y}, toAdd, a)
Or use
Map(function(x, y) `diag<-`(y, diag(y) + x), toAdd, a)
I'm trying to subtract each unique pair-wise ps from the for loop in my function below. To do so, I first find unique pair-wise ps using combn(p, 2) and second use outer to subtract each unique pair from each other.
In both steps, I get error. Is there a fix for the error?
prop <- function(n, yes, a, b = a){
p <- list()
for(i in 1:length(n)){
p[[i]] <- rbeta(2, a[i] + yes[i], b[i] + (n[i] - yes[i]))
}
outer(combn(p, 2), FUN = "-") # Gives Error
}
prop(n = c(10, 20, 30), yes = rep(5, 3), a = rep(1, 3))
By default, it is simplify = TRUE in combn. So, even though the output is a list, it is simplified to have a dim attribute by converting each of the the list as elements in a matrix. As the m is 2, there are 2 list elements for each comparison, extract those elements using [[ and subtract
combn(p, 2, FUN = function(x) x[[1]]- x[[2]])
-full function
prop <- function(n, yes, a, b = a){
p <- list()
for(i in 1:length(n)){
p[[i]] <- rbeta(2, a[i] + yes[i], b[i] + (n[i] - yes[i]))
}
combn(p, 2, FUN = function(x) x[[1]]- x[[2]])
}
prop(n = c(10, 20, 30), yes = rep(5, 3), a = rep(1, 3))
If we wanted to include another argument how
prop <- function(n, yes, a, b = a, how= "one.two"){
delta <- switch(how,
one.two = function(x) x[[1]] - x[[2]],
two.one = function(x) x[[2]] - x[[1]])
p <- list()
for(i in 1:length(n)){
p[[i]] <- rbeta(2, a[i] + yes[i], b[i] + (n[i] - yes[i]))
}
out <- combn(p, 2, FUN = delta)
nm1 <- paste0("p", combn(seq_along(p), 2, FUN = paste, collapse="-"))
colnames(out) <- nm1
out
}
prop(n = c(10, 20, 30), yes = rep(5, 3), a = rep(1, 3), how = "one.two")
prop(n = c(10, 20, 30), yes = rep(5, 3), a = rep(1, 3), how = "two.one")
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)
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]
}
}