3

まず、まず。ここに私のデータがあります：

lat <- c(12, 12, 58, 58, 58, 58, 58, 45, 45, 45, 45, 45, 45, 64, 64, 64, 64, 64, 64, 64)
long <- c(-14, -14, 139, 139, 139, 139, 139, -68, -68, -68, -68, -68, 1, 1, 1, 1, 1, 1, 1, 1)
sex <- c("M", "M", "M", "M", "F", "M", "M", "F", "M", "M", "M", "F", "M", "F", "M", "F", "F", "F", "F", "M")
score <- c(2, 6, 3, 6, 5, 4, 3, 2, 3, 9, 9, 8, 6, 5, 6, 7, 5, 7, 5, 1)

data <- data.frame(lat, long, sex, score)

データは次のようになります。

   lat long sex score
1   12  -14   M     2
2   12  -14   M     6
3   58  139   M     3
4   58  139   M     6
5   58  139   F     5
6   58  139   M     4
7   58  139   M     3
8   45  -68   F     2
9   45  -68   M     3
10  45  -68   M     9
11  45  -68   M     9
12  45  -68   F     8
13  45    1   M     6
14  64    1   F     5
15  64    1   M     6
16  64    1   F     7
17  64    1   F     5
18  64    1   F     7
19  64    1   F     5
20  64    1   M     1

私はこれを理解しようとして頭がいっぱいです。変数は、緯度、経度、性別、およびスコアです。各場所に同数の男性と女性を配置したいと考えています (つまり、経度と緯度が同じ)。たとえば、2 番目の場所 (行 3 ～ 7) には女性が 1 人しかいません。このメスを保持する必要があり、残りの個体から 1 匹のオスも保持する必要があります (おそらく無作為抽出による)。1 つの性別に関する情報しかない場所もあります。たとえば、最初の場所 (行 1 と 2) には男性に関するデータしかありません。この場所の行は削除する必要があります (女性がいないため)。計画通りに進むと、最終的なデータセットは次のようになります。

   lat2 long2 sex2 score2
1    58   139    F      5
2    58   139    M      4
3    45   -68    F      2
4    45   -68    M      3
5    45   -68    M      9
6    45   -68    F      8
7    64     1    M      6
8    64     1    F      5
9    64     1    F      7
10   64     1    M      1

どんな助けでも大歓迎です。

4

3 に答える 3

5

これが解決策lapplyです：

data[unlist(lapply(with(data, split(seq.int(nrow(data)), paste(lat, long))),
        # 'split' splits the sequence of row numbers (indices) along the unique
        # combinations of 'lat' and 'long'
        # 'lapply' applies the following function to all sub-sequences
        function(x) {
          # which of the indices are for males:
          male <- which(data[x, "sex"] == "M")
          # which of the indices are for females:
          female <- which(data[x, "sex"] == "F")
          # sample from the indices of males:
          s_male <- sample(male, min(length(male), length(female)))
          # sample from the indices of females:
          s_female <- sample(female, min(length(male), length(female)))
          # combine both sampled indices:
          x[c(s_male, s_female)]                
        })), ]
# The function 'lappy' returns a list of indices which is transformed to a vector
# using 'unlist'. These indices are used to subset the original data frame.

結果：

   lat long sex score
9   45  -68   M     3
11  45  -68   M     9
12  45  -68   F     8
8   45  -68   F     2
7   58  139   M     3
5   58  139   F     5
20  64    1   M     1
15  64    1   M     6
19  64    1   F     5
16  64    1   F     7
于 2012-12-07T18:13:44.097 に答える
2

以下は、緯度と経度の組み合わせの一時的な列を作成する簡単な方法です。この列に従って DF を分割し、各分割で M/F をカウントし、適切にサンプリングしてから、再結合します。

# First, We call the dataframe something other than "data" ;) 
mydf <- data.frame(lat, long, sex, score)

# create a new data frame with a temporary column, which concatenates the lat & long. 
mydf.new <- data.frame(mydf, latlong=paste(mydf$lat, mydf$long, sep=","))

# Split the data frame according to the lat-long location
mydf.splat <- split(mydf.new, mydf.new$latlong)

# eg, taking a look at one of our tables:
mydf.splat[[4]]

sampled <- 
  lapply(mydf.splat, function(tabl) {
    Ms <- sum(tabl$sex=="M")
    Fs <- sum(tabl$sex=="F")

    if(Fs == 0 || Ms ==0)    # If either is zero, we drop that location
      return(NULL)

    if(Fs == Ms)   # If they are both equal, no need to sample. 
      return(tabl)

    # If number of Females less than Males, return all Females 
    #    and sample from males in ammount equal to Females
    if (Fs < Ms)   
      return(tabl[c(which(tabl$sex=="F"), sample(which(tabl$sex=="M"), Fs)),   ])

    if (Ms < Fs)  # same as previous, but for Males < Femals
      return(tabl[c(which(tabl$sex=="M"), sample(which(tabl$sex=="F"), Ms)),   ])

    stop("hmmm... something went wrong.")  ## We should never hit this line, but just in case. 
  })

# Flatten into a single table
mydf.new <- do.call(rbind, sampled)

# Clean up
row.names(mydf.new) <- NULL  # remove the row names that were added
mydf.new$latlong <- NULL     # remove the temporary column that we added

結果

mydf.new

#    lat long sex score
# 1   45  -68   F     2
# 2   45  -68   F     8
# 3   45  -68   M     9
# 4   45  -68   M     3
# 5   58  139   F     5
# 6   58  139   M     3
# 7   64    1   M     6
# 8   64    1   M     1
# 9   64    1   F     7
# 10  64    1   F     5
于 2012-12-07T17:48:06.707 に答える
2

これは、値をリスト要素として返します。 

spl <- split(data, interaction(data$lat, data$long) ,drop=TRUE)
           # interaction creates all the two way pairs from those two vectors
           # drop is needed to eliminate the dataframes with no representation
res <- lapply(spl, function(x) { #First find the nuber of each gender to select
                        N=min(table(x$sex))  # then sample each sex separately
   rbind( x[ x$sex=="M" & row.names(x) %in% sample(row.names(x[x$sex=="M",] ), N) , ],
                 # One (or both) of these will be "sampling" all of that sex.
          x[ x$sex=="F" & row.names(x) %in% sample(row.names(x[x$sex=="F", ]), N) , ] )
                                } )
res
#------------
$`45.-68`  
   lat long sex score
9   45  -68   M     3
11  45  -68   M     9
8   45  -68   F     2
12  45  -68   F     8

$`12.-14` # So there were no women in this group and zero could be matched
[1] lat   long  sex   score
<0 rows> (or 0-length row.names)

$`45.1`
[1] lat   long  sex   score
<0 rows> (or 0-length row.names)

$`64.1`
   lat long sex score
15  64    1   M     6
20  64    1   M     1
16  64    1   F     7
17  64    1   F     5

$`58.139`
  lat long sex score
7  58  139   M     3
5  58  139   F     5

、、、しかし、データフレームとして使用したい場合は、次を使用できますdo.call(rbind, res)。

> do.call(rbind, res)
          lat long sex score
45.-68.10  45  -68   M     9
45.-68.11  45  -68   M     9
45.-68.8   45  -68   F     2
45.-68.12  45  -68   F     8
64.1.15    64    1   M     6
64.1.20    64    1   M     1
64.1.17    64    1   F     5
64.1.18    64    1   F     7
58.139.6   58  139   M     4
58.139.5   58  139   F     5
于 2012-12-07T19:49:12.673 に答える