Saya memiliki matriks 3 kolom. Untuk setiap baris, nilai yang tidak hilang akan dipilih, - jika tidak ada nilai yang ditemukan di kolom 1, kolom 2 akan dicari, kemudian kolom 3, dan urutan akan diberikan oleh pengguna.

Saya cukup senang dengan pendekatan ifelse bersarang saya yang berbelit-belit - Sayangnya, ini tergantung pada panjang kolom yang sama. Tetapi jumlah kolom harus fleksibel (dengan demikian jumlah pernyataan ifelse bersarang fleksibel) - Artinya, jika pengguna hanya memilih satu atau dua kolom, NA akan menghasilkan meskipun kolom yang tidak diinginkan berisi nilai.

foo_mat <- structure(c(
  NA, 30L, 15, 0, NA, 100L, 87L, NA, 0, NA, 2L, NA,
  10, 0, NA
), .Dim = c(5L, 3L), .Dimnames = list(NULL, c(
  "a", "b", "c"
)))

foo <- function(x, preced) {
    ifelse(!is.na(x[, preced[1]]), x[, preced[1]],
      ifelse(!is.na(x[, preced[2]]), x[, preced[2]],
        x[, preced[3]]
      )
    )
}

foo_mat
#>       a   b  c
#> [1,] NA 100  2
#> [2,] 30  87 NA
#> [3,] 15  NA 10
#> [4,]  0   0  0
#> [5,] NA  NA NA

foo(foo_mat, c("a", "c", "b"))
#> [1]  2 30 15  0 NA

foo(foo_mat, preced = c("b", "a"))
#> Error in x[, preced[3]]: subscript out of bounds #(of course)

# desired output
#> [1]  100 87 15 0 NA
r
4
tjebo 24 Desember 2020, 00:18

4 jawaban

Jawaban Terbaik

Basis R:

apply(foo_mat[,c("a","c","b")], 1, function(z) c(na.omit(z), NA)[1])
# [1]  2 30 15  0 NA

Fungsi-anon adalah proses dua langkah:

  • pertama, hapus semua NA, sehingga kita dapat mengambil nilai non-NA pertama
  • kedua, memungkinkan na.omit(.) akan mengembalikan integer(0), yang bukan yang Anda inginkan, jadi c(., NA)[1] memastikan bahwa setelah na.omit(.), kami selalu memiliki setidaknya satu nilai di vektor c(.), dan kita menginginkan yang pertama; jika na.omit tidak menghasilkan apa-apa, maka setidaknya kita memiliki NA.

Melakukan baris-bijaksana ini dilakukan dengan apply(foo_mat, 1, ...). Anda mengontrol urutan preferensi dengan mengatur ulang kolom yang masuk ke data apply, seperti dalam penggunaan foo_mat[,c("a","c","b")] saya.

Sebagai fungsi:

foo <- function(data, preced = names(data)) apply(data[,preced,drop=FALSE], 1, function(z) c(na.omit(z), NA)[1])
foo(foo_mat, c("a", "c", "b"))
# [1]  2 30 15  0 NA

(drop=FALSE bersifat defensif. Basis R default, perilaku foo_mat[,"a"] adalah vektor, bukan matriks 1-kolom. Ini merusak banyak hal, termasuk apply. Jadi, tambahkan drop=FALSE mencegah perilaku pengurangan default.)

Alternatif yang kira-kira secepat jawaban lainnya:

foo <- function(data, preced) apply(data[,preced,drop=FALSE], 1, function(z) z[!is.na(z)][1])

Fungsionalitas yang sama, panggilan lebih sedikit, logika sederhana.

(Atribusi: alternatif ini adalah kombinasi karya dari @tmfmnk, @Tjebo, dan saya. Terima kasih!)

4
r2evans 24 Desember 2020, 02:11

Berikut adalah fungsi foo yang berfungsi sesuai kebutuhan dengan contoh yang diposting.

foo <- function(x, preced){
  apply(x[, preced], 1, function(y){
    w <- !is.na(y)
    if(any(w)) y[w][1] else NA
  })
}

foo(foo_mat, c("a", "c", "b"))
#[1]  2 30 15  0 NA
foo(foo_mat, preced = c("b", "a"))
#[1] 100  87  15   0  NA
4
Rui Barradas 23 Desember 2020, 21:36

Daripada ifelse bersarang, mungkin lebih baik membuat fungsi dengan coalesce

foo <- function(data, preced) {
        do.call(dplyr::coalesce, as.data.frame(data[, preced]))
       }


foo(foo_mat, c("a", "c", "b"))
#[1]  2 30 15  0 NA
foo(foo_mat, c("b", "a"))
#[1] 100  87  15   0  NA

coalesce secara otomatis mengambil non-NA pertama untuk setiap baris berdasarkan kolom dalam kumpulan data yang dipilih


Atau kita dapat menggunakan opsi vektor di base R dengan max.col

foo1 <- function(data, preced) {
         tmp <- data[, preced]
         i1 <- seq_len(nrow(tmp))
         j1 <- max.col(!is.na(tmp), "first")
         out <- tmp[cbind(i1, j1)]
         out
    }

foo1(foo_mat, c("a", "c", "b"))
#[1]  2 30 15  0 NA
foo1(foo_mat, c("b", "a"))
#[1] 100  87  15   0  NA
3
akrun 23 Desember 2020, 21:39

Opsi yang secara logis dekat dengan opsi dari @ r2evans:

vec <- c("b", "c", "a")
apply(foo_mat[, vec], 1, function(x) x[which(!is.na(x))][1])

[1] 100  87  10   0  NA

Atau sedikit disederhanakan:

apply(foo_mat[, vec], 1, function(x) x[!is.na(x)][1])
3
tmfmnk 23 Desember 2020, 21:43