英文:
In R Program, want to fill a matrix from vector values across rows at a a specific column with specific value
问题
在R程序中，我有一个包含0和1的矩阵。见下面：
0 1 0 1 0 0
0 1 1 0 0 0
0 0 0 1 0 1
0 1 1 0 1 0
0 0 0 0 0 1
我想按行填充矩阵，使用列出的值（c("J" "J" "A" "A" "A" "A" "...一直到矩阵结束"）但从每行的第一个1开始。见下面：
0 J J A A A
0 J J A A A
0 0 0 J J A
0 J J A A A
0 0 0 0 0 J
截至目前，我已经创建了一个值列表和一个确定第一个1所在位置的函数。我不知道如何将其应用于获得我想要的矩阵。
`pattern<- c("A","A","A","A","A")`
`pattern <- c("J","J", rep(pattern, length.out = ncol(Matrix)-2))`
`indices<- apply(Matrix, 1, function(row) min(which(row == 1)))`
英文:
In R Program, I have a matrix containing 0 and 1's. See Below
0 1 0 1 0 0
0 1 1 0 0 0
0 0 0 1 0 1
0 1 1 0 1 0
0 0 0 0 0 1
I want to fill the matrix byrow from values listed (c("J" "J" "A" "A" "A" "A" "... continue "A" until end of matrix") but begin at the first 1 in each row. See below:
0 J J A A A
0 J J A A A
0 0 0 J J A
0 J J A A A
0 0 0 0 0 J
As of now, I have created a values list and a function to determine where the first 1 is. I'm lost on how to apply this to get the matrix I want.
pattern<- c("A","A","A","A","A")
pattern <- c("J","J", rep(pattern, length.out = ncol(Matrix)-2))
indices<- apply(Matrix, 1, function(row) min(which(row == 1)))
答案1
得分: 0
获取零的第一部分，然后填充“J”，最后添加“A”。
t(apply(mat, 1, function(x){
res <- which(x == 1)[1] - 1
res <- replace(res, is.na(res), length(x))
c(x[0:res],
rep("J", min(c(2, (length(x) - res)))),
rep("A", max(c(0, (length(x) - res) - 2))))}))
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] "J" "J" "A" "A" "A" "A"
[2,] "0" "J" "J" "A" "A" "A"
[3,] "0" "J" "J" "A" "A" "A"
[4,] "0" "0" "0" "J" "J" "A"
[5,] "0" "J" "J" "A" "A" "A"
[6,] "0" "0" "0" "0" "0" "J"
[7,] "0" "0" "0" "0" "0" "0"
数据
mat <- structure(c(1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 1,
0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,
1, 0, 1, 0), dim = 7:6)
英文:
Get the first part of zeros, then fill the "J"s, finally add the "A"s.
t(apply(mat, 1, function(x){
res <- which(x == 1)[1] - 1
res <- replace(res, is.na(res), length(x))
c(x[0:res],
rep("J", min(c(2, (length(x) - res)))),
rep("A", max(c(0, (length(x) - res) - 2))))}))
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] "J" "J" "A" "A" "A" "A"
[2,] "0" "J" "J" "A" "A" "A"
[3,] "0" "J" "J" "A" "A" "A"
[4,] "0" "0" "0" "J" "J" "A"
[5,] "0" "J" "J" "A" "A" "A"
[6,] "0" "0" "0" "0" "0" "J"
[7,] "0" "0" "0" "0" "0" "0"
Data
mat <- structure(c(1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 1,
0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,
1, 0, 1, 0), dim = 7:6)
答案2
得分: 0
vec = c("J", "J", rep("A", ncol(m) - 2))
m |>
apply(MARGIN = 1, \(x) {
x = cumsum(x) > 0
y = rep("0", length(x))
y[x] = vec[seq_len(sum(x))]
y
}) |>
t()
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] "0" "J" "J" "A" "A" "A"
# [2,] "0" "J" "J" "A" "A" "A"
# [3,] "0" "0" "0" "J" "J" "A"
# [4,] "0" "J" "J" "A" "A" "A"
# [5,] "0" "0" "0" "0" "0" "J"
Using this sample data:
m = read.table(text = '0 1 0 1 0 0
0 1 1 0 0 0
0 0 0 1 0 1
0 1 1 0 1 0
0 0 0 0 0 1') |>
as.matrix()
<details>
<summary>英文:</summary>
vec = c("J", "J", rep("A", ncol(m) - 2))
m |>
apply(MARGIN = 1, (x) {
x = cumsum(x) > 0
y = rep("0", length(x))
y[x] = vec[seq_len(sum(x))]
y
}) |>
t()
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] "0" "J" "J" "A" "A" "A"
[2,] "0" "J" "J" "A" "A" "A"
[3,] "0" "0" "0" "J" "J" "A"
[4,] "0" "J" "J" "A" "A" "A"
[5,] "0" "0" "0" "0" "0" "J"
---
Using this sample data:
m = read.table(text = '0 1 0 1 0 0
0 1 1 0 0 0
0 0 0 1 0 1
0 1 1 0 1 0
0 0 0 0 0 1') |> as.matrix()
</details>
# 答案3
**得分**: 0
n <- ncol(m)
vec <- c("J", "J", rep("A", n - 2))
t(apply(mat, 1, \(x)c(numeric(which(x>0)[1]-1), vec)[seq(n)]))
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] "0" "J" "J" "A" "A" "A"
[2,] "0" "J" "J" "A" "A" "A"
[3,] "0" "0" "0" "J" "J" "A"
[4,] "0" "J" "J" "A" "A" "A"
[5,] "0" "0" "0" "0" "0" "J"
<details>
<summary>英文:</summary>
feels easier to just do:
n <- ncol(m)
vec <- c("J", "J", rep("A", n - 2))
t(apply(mat, 1, \(x)c(numeric(which(x>0)[1]-1), vec)[seq(n)]))
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] "0" "J" "J" "A" "A" "A"
[2,] "0" "J" "J" "A" "A" "A"
[3,] "0" "0" "0" "J" "J" "A"
[4,] "0" "J" "J" "A" "A" "A"
[5,] "0" "0" "0" "0" "0" "J"
</details>
# 答案4
**得分**: 0
以下是已翻译的内容：
A few vectorized options:
```R
m <- max.col(cbind(mat, 1L), "f")
m <- rbind(m - 1L, pmin(2L, ncol(mat) - m + 1L), pmax(0L, ncol(mat) - m - 1L))
matrix(c("0", "J", "A")[rep.int(row(m), m)], nrow(mat), ncol(mat), 1)
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] "0" "J" "J" "A" "A" "A"
#> [2,] "0" "J" "J" "A" "A" "A"
#> [3,] "0" "0" "0" "J" "J" "A"
#> [4,] "0" "J" "J" "A" "A" "A"
#> [5,] "0" "0" "0" "0" "0" "J"
或者
m <- max.col(cbind(mat, 1L), "f")
array(c("0", "J", "A")[(col(mat) >= m) + (col(mat) > m + 1L) + 1L], dim(mat))
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] "0" "J" "J" "A" "A" "A"
#> [2,] "0" "J" "J" "A" "A" "A"
#> [3,] "0" "0" "0" "J" "J" "A"
#> [4,] "0" "J" "J" "A" "A" "A"
#> [5,] "0" "0" "0" "0" "0" "J"
或者
matrix(
rep.int(c("0", "J", "A"), c(ncol(mat), 2L, ncol(mat) - 2L))[
sequence(rep(ncol(mat), nrow(mat)), ncol(mat) - max.col(cbind(mat, 1L), "f") + 2L)
], nrow(mat), ncol(mat), 1
)
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] "0" "J" "J" "A" "A" "A"
#> [2,] "0" "J" "J" "A" "A" "A"
#> [3,] "0" "0" "0" "J" "J" "A"
#> [4,] "0" "J" "J" "A" "A" "A"
#> [5,] "0" "0" "0" "0" "0" "J"
Benchmarking shows the advantage of using a vectorized approach. Define various approaches as functions:
f1 <- function(mat) {
m <- max.col(cbind(mat, 1L), "f")
m <- rbind(m - 1L, pmin(2L, ncol(mat) - m + 1L), pmax(0L, ncol(mat) - m - 1L))
matrix(c("0", "J", "A")[rep.int(row(m), m)], nrow(mat), ncol(mat), 1)
}
f2 <- function(mat) {
m <- max.col(cbind(mat, 1L), "f")
array(c("0", "J", "A")[(col(mat) >= m) + (col(mat) > m + 1L) + 1L], dim(mat))
}
f3 <- function(mat) {
d <- dim(mat)
matrix(
rep.int(c("0", "J", "A"), c(d[2], 2L, d[2] - 2L))[
sequence(rep(d[2], d[1]), d[2] - max.col(cbind(mat, 1L), "f") + 2L)
], d[1], d[2], 1
)
}
Andre <- function(mat) {
# from Andre Wildberg
t(apply(mat, 1, function(x){
res <- which(x == 1)[1] - 1
res <- replace(res, is.na(res), length(x))
c(x[0:res],
rep("J", min(c(2, (length(x) - res)))),
rep("A", max(c(0, (length(x) - res) - 2))))}))
}
Benchmark on a large-ish matrix.
mat <- matrix(sample(0:1, 1e5, 1, c(0.75, 0.25)), 1e4)
microbenchmark::microbenchmark(
f1 = f1(mat),
f2 = f2(mat),
f3 = f3(mat),
Andre = Andre(mat),
check = "equal"
)
#> Unit: milliseconds
#> expr min lq mean median uq max neval
#> f1 1.391700 1.894001 2.127106 1.967701 2.097001 7.966101 100
#> f2 1.616000 2.240750 2.691387 2.361451 2.590051 7.142301 100
#> f3 1.118401 1.570600 1.745991 1.619800 1.739251 5.924802 100
#> Andre 68.022601 70.696101 73.181934 72.200000 73.931750 117.784401 100
英文:
A few vectorized options:
m <- max.col(cbind(mat, 1L), "f")
m <- rbind(m - 1L, pmin(2L, ncol(mat) - m + 1L), pmax(0L, ncol(mat) - m - 1L))
matrix(c("0", "J", "A")[rep.int(row(m), m)], nrow(mat), ncol(mat), 1)
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] "0" "J" "J" "A" "A" "A"
#> [2,] "0" "J" "J" "A" "A" "A"
#> [3,] "0" "0" "0" "J" "J" "A"
#> [4,] "0" "J" "J" "A" "A" "A"
#> [5,] "0" "0" "0" "0" "0" "J"
Or
m <- max.col(cbind(mat, 1L), "f")
array(c("0", "J", "A")[(col(mat) >= m) + (col(mat) > m + 1L) + 1L], dim(mat))
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] "0" "J" "J" "A" "A" "A"
#> [2,] "0" "J" "J" "A" "A" "A"
#> [3,] "0" "0" "0" "J" "J" "A"
#> [4,] "0" "J" "J" "A" "A" "A"
#> [5,] "0" "0" "0" "0" "0" "J"
Or
matrix(
rep.int(c("0", "J", "A"), c(ncol(mat), 2L, ncol(mat) - 2L))[
sequence(rep(ncol(mat), nrow(mat)), ncol(mat) - max.col(cbind(mat, 1L), "f") + 2L)
], nrow(mat), ncol(mat), 1
)
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] "0" "J" "J" "A" "A" "A"
#> [2,] "0" "J" "J" "A" "A" "A"
#> [3,] "0" "0" "0" "J" "J" "A"
#> [4,] "0" "J" "J" "A" "A" "A"
#> [5,] "0" "0" "0" "0" "0" "J"
Benchmarking shows the advantage of using a vectorized approach. Define various approaches as functions:
f1 <- function(mat) {
m <- max.col(cbind(mat, 1L), "f")
m <- rbind(m - 1L, pmin(2L, ncol(mat) - m + 1L), pmax(0L, ncol(mat) - m - 1L))
matrix(c("0", "J", "A")[rep.int(row(m), m)], nrow(mat), ncol(mat), 1)
}
f2 <- function(mat) {
m <- max.col(cbind(mat, 1L), "f")
array(c("0", "J", "A")[(col(mat) >= m) + (col(mat) > m + 1L) + 1L], dim(mat))
}
f3 <- function(mat) {
d <- dim(mat)
matrix(
rep.int(c("0", "J", "A"), c(d[2], 2L, d[2] - 2L))[
sequence(rep(d[2], d[1]), d[2] - max.col(cbind(mat, 1L), "f") + 2L)
], d[1], d[2], 1
)
}
Andre <- function(mat) {
# from Andre Wildberg
t(apply(mat, 1, function(x){
res <- which(x == 1)[1] - 1
res <- replace(res, is.na(res), length(x))
c(x[0:res],
rep("J", min(c(2, (length(x) - res)))),
rep("A", max(c(0, (length(x) - res) - 2))))}))
}
Benchmark on a large-ish matrix.
mat <- matrix(sample(0:1, 1e5, 1, c(0.75, 0.25)), 1e4)
microbenchmark::microbenchmark(
f1 = f1(mat),
f2 = f2(mat),
f3 = f3(mat),
Andre = Andre(mat),
check = "equal"
)
#> Unit: milliseconds
#> expr min lq mean median uq max neval
#> f1 1.391700 1.894001 2.127106 1.967701 2.097001 7.966101 100
#> f2 1.616000 2.240750 2.691387 2.361451 2.590051 7.142301 100
#> f3 1.118401 1.570600 1.745991 1.619800 1.739251 5.924802 100
#> Andre 68.022601 70.696101 73.181934 72.200000 73.931750 117.784401 100
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论