Saya memiliki bingkai data yang berisi kolom Perbedaan usia (AgeDiff). Bingkai data terlihat seperti:

library("dplyr")

test <- data.frame("Age1"=c(42, 48, 58, 25, 53, 55, 32, 58, 71, 24, 48, 48, 64, 55, 45, 55, 34, 33, 51, 22), 
                   "Age2"=c(8, 2, 1, 16, 14, 1, 11, 14, 0, 5, 2, 10, 16, 13, 3, 4, 8, 13, 8, 5)) 
test <- test %>%
mutate(AgeDiff = Age1 - Age2)

Untuk fungsi yang saya tulis, pengguna dapat memasukkan selisih minimum penolakan dan/atau selisih maksimum penolakan. Perbedaan usia apa pun yang lebih kecil dari/lebih besar dari salah satu ambang membuat perbedaan usia "di luar cakupan".

Dalam pekerjaan yang saya lakukan, setiap perbedaan usia kurang dari 18 tahun atau lebih tua dari 54 tahun adalah "di luar jangkauan". Secara kebetulan (saya menggunakan generator angka acak untuk kedua set usia), ada dua perbedaan usia yang terlalu muda, dan dua perbedaan usia yang terlalu tua.

Saya dapat menemukan maksimum "terlalu muda" atau "terlalu tua", misalnya dengan membandingkan

TooYoung <- test %>%
filter(AgeDiff < 18) %>%
summarise(Count = n()) %>%
pull(Count)

Dengan

TooOld <- test %>%
filter(AgeDiff > 54) %>%
summarise(Count = n()) %>%
pull(Count)

Dan kemudian cari tahu nilai mana yang lebih besar. Lebih besar dari TooYoung dan TooOld memberi saya jumlah baris yang perlu saya tukar dalam data test.

Saya dapat (pra) mengurutkan bingkai data test sehingga nilai AgeDiff naik:

test <- test %>%
arrange(AgeDiff)

Itu memberi saya urutan yang saya inginkan, di mana bingkai data diurutkan dari paling ekstrim AgeDiff minimum hingga paling ekstrim AgeDiff maksimum. Sekarang yang ingin saya lakukan adalah menukar nilai Age1 paling atas dan paling bawah untuk maksimum TooYoung dan TooOld. Karena saya memiliki 2 sebagai jumlah minimum "di luar ruang lingkup" maksimum saya dalam contoh ini, saya perlu menukar:

  • Age1 di baris 1 dengan Age1 di baris 20
  • Age1 di baris 2 dengan Age1 di baris 19

Tidak masalah jika swap menghasilkan "di luar cakupan" AgeDiff.

Bingkai data untuk swap bisa berapa pun panjangnya. Jumlah swap yang akan dibuat bisa berapa saja, termasuk 0. Jadi masalahnya menjadi, untuk setiap nilai swap >0,

  • Age1 di baris 1 dengan Age1 di nrow(foo)
  • Age1 di baris 2 dengan Age1 di nrow(foo)-1
  • dan seterusnya untuk jumlah swap yang akan dilakukan.

AgeDiff akan dihitung ulang setelah swap dilakukan. Ada variabel lain dalam bingkai data saya, seperti Sex, jadi sangat penting bahwa hanya nilai Age1 yang ditukar.

Pengurutan ulang baris tidak penting. Satu-satunya persyaratan adalah solusi untuk menukar pasangan nilai Age1 yang benar.

Saya telah mencari pertanyaan serupa, tetapi yang saya temukan sangat berbeda. Pertanyaan lainnya adalah dua -baris swap untuk persentase awal bingkai data, pertukaran dua nilai yang diketahui satu sama lain, menukar seluruh baris, menukar dua baris yang dipilih secara acak, < a href="https://stackoverflow.com/questions/58716319/swapping-data-frame-values-randomly-between-different-deciles-of-the-data-frame">pertukaran nilai berdasarkan variabel pengelompokan. Dalam masalah saya, jumlah swap akan dihitung dengan pasti, tetapi jumlahnya bervariasi antar populasi, nilai Age1 yang akan ditukar akan berbeda, jumlah nilai Age1 yang akan ditukar harus persis maksimum " out of scope" count, dan tidak ada variabel pengelompokan.

Diedit untuk menambahkan: dengan asumsi Anda memiliki data saya dan telah melakukan pengaturan, Anda akan melihat bahwa baris 1 terlihat seperti:

Age1    Age2    AgeDiff
25      16      9

Dan baris 20 terlihat seperti:

Age1    Age2    AgeDiff
71      0       71

Post swap dua baris ini akan menjadi: baris 1:

Age1    Age2    AgeDiff
71      16      9

Baris 20:

Age1    Age2    AgeDiff
25      0       71

Jadi hanya dua nilai Age1 yang ditukar.

Kemudian baris 2 dan baris 19 bertukar, untuk berakhir dengan

Baris 2

Age1    Age2    AgeDiff
58      5       17

Dan untuk baris 19

Age1    Age2    AgeDiff
22      1       57

Kolom AgeDiff diabaikan karena dihitung ulang setelah menyelesaikan swap.

(Saya juga melewatkan bahwa bingkai data awal juga seharusnya disebut tes, sekarang saya telah memperbaikinya.)

1
Michelle 1 Juli 2020, 13:23

1 menjawab

Jawaban Terbaik

Saya yakin ada cara yang jauh lebih rapi untuk melakukan ini, tetapi ....

library("dplyr")
test <- data.frame("Age1"=c(42, 48, 58, 25, 53, 55, 32, 58, 71, 24, 48, 48, 64, 55, 45, 55, 34, 33, 51, 22), 
                   "Age2"=c(8, 2, 1, 16, 14, 1, 11, 14, 0, 5, 2, 10, 16, 13, 3, 4, 8, 13, 8, 5)) 
test <- test %>%
  mutate(AgeDiff = Age1 - Age2) %>% 
  arrange(AgeDiff) %>% 
  dplyr::mutate(row_no = row_number())
test

swap <- function(df) {
  TooYoung <- df %>%
    filter(AgeDiff < 18) %>%
    summarise(Count = n()) %>%
    pull(Count)
  
  TooOld <- df %>%
    filter(AgeDiff > 54) %>%
    summarise(Count = n()) %>%
    pull(Count)
  
  top_bottom <- max(TooYoung, TooOld)
  
  df2 <- df %>% 
    filter(row_number() > max(row_number()) - top_bottom | row_number() <= top_bottom) %>% 
    mutate(final_age1 = Age1) %>% 
    dplyr::select(final_age1, row_no)
  df2$row_no <- sort(df2$row_no, decreasing = T)
  
  df_final <- df %>% 
    left_join(df2) %>% 
    mutate(final_age1 = ifelse(is.na(final_age1), Age1, final_age1)) %>% 
    dplyr::select(-Age1, -row_no)
             
  df_final
}
swap(test)

Yang menurut saya memberi Anda apa yang Anda inginkan?

# Joining, by = "row_no"
#    Age2 AgeDiff final_age1
# 1    16       9         71
# 2     5      17         58
# 3     5      19         24
# 4    13      20         33
# 5    11      21         32
# 6     8      26         34
# 7     8      34         42
# 8    10      38         48
# 9    14      39         53
# 10   13      42         55
# 11    3      42         45
# 12    8      43         51
# 13   14      44         58
# 14    2      46         48
# 15    2      46         48
# 16   16      48         64
# 17    4      51         55
# 18    1      54         55
# 19    1      57         22
# 20    0      71         25
1
user63230 1 Juli 2020, 11:32