R Language
Delad funktion

Grundläggande användning av split

split gör det möjligt att dela upp en vektor eller en data.frame i skopor med avseende på en faktor / gruppvariabler. Denna ventilation till skopor har formen av en lista som sedan kan användas för att tillämpa gruppvis beräkning ( for öglor eller lapply / sapply ).

Det första exemplet visar användningen av split på en vektor:

Överväg följande bokstävervektor:

testdata <- c("e", "o", "r", "g", "a", "y", "w", "q", "i", "s", "b", "v", "x", "h", "u")

Målet är att separera dessa bokstäver i voyels och consonants , dvs dela dem i enlighet med bokstavstyp.

Låt oss först skapa en gruppvektor:

 vowels <- c('a','e','i','o','u','y')
 letter_type <- ifelse(testdata %in% vowels, "vowels", "consonants") 

Observera att letter_type har samma längd som vår testdata . Nu kan vi split denna testdata i de två grupperna, vowels och consonants :

split(testdata, letter_type)
#$consonants
#[1] "r" "g" "w" "q" "s" "b" "v" "x" "h"

#$vowels
#[1] "e" "o" "a" "y" "i" "u"

Därför är resultatet en lista med namn som kommer från vår gruppvektor / letter_type .

split har också en metod för att hantera data.frames.

Tänk till exempel iris :

data(iris)

Genom att använda split kan man skapa en lista som innehåller en data.frame per iris-specifikation (variabel: arter):

> liris <- split(iris, iris$Species)
> names(liris)
[1] "setosa"     "versicolor" "virginica"
> head(liris$setosa)
  Sepal.Length Sepal.Width Petal.Length Petal.Width Species
1          5.1         3.5          1.4         0.2  setosa
2          4.9         3.0          1.4         0.2  setosa
3          4.7         3.2          1.3         0.2  setosa
4          4.6         3.1          1.5         0.2  setosa
5          5.0         3.6          1.4         0.2  setosa
6          5.4         3.9          1.7         0.4  setosa

(innehåller endast data för setosa-gruppen).

Ett exempel på operation skulle vara att beräkna korrelationsmatris per iris specie; man skulle sedan använda lapply :

> (lcor <- lapply(liris, FUN=function(df) cor(df[,1:4])))

    $setosa
             Sepal.Length Sepal.Width Petal.Length Petal.Width
Sepal.Length    1.0000000   0.7425467    0.2671758   0.2780984
Sepal.Width     0.7425467   1.0000000    0.1777000   0.2327520
Petal.Length    0.2671758   0.1777000    1.0000000   0.3316300
Petal.Width     0.2780984   0.2327520    0.3316300   1.0000000

$versicolor
             Sepal.Length Sepal.Width Petal.Length Petal.Width
Sepal.Length    1.0000000   0.5259107    0.7540490   0.5464611
Sepal.Width     0.5259107   1.0000000    0.5605221   0.6639987
Petal.Length    0.7540490   0.5605221    1.0000000   0.7866681
Petal.Width     0.5464611   0.6639987    0.7866681   1.0000000

$virginica
             Sepal.Length Sepal.Width Petal.Length Petal.Width
Sepal.Length    1.0000000   0.4572278    0.8642247   0.2811077
Sepal.Width     0.4572278   1.0000000    0.4010446   0.5377280
Petal.Length    0.8642247   0.4010446    1.0000000   0.3221082
Petal.Width     0.2811077   0.5377280    0.3221082   1.0000000

Sedan kan vi hämta per grupp de bästa paret med korrelerade variabler: (korrelationsmatris omformas / smälts, diagonal filtreras ut och val av bästa post utförs)

> library(reshape)
> (topcor <- lapply(lcor, FUN=function(cormat){
   correlations <- melt(cormat,variable_name="correlatio); 
   filtered <- correlations[correlations$X1 != correlations$X2,];
   filtered[which.max(filtered$correlation),]
}))    

$setosa
           X1           X2     correlation
2 Sepal.Width Sepal.Length       0.7425467

$versicolor
            X1           X2     correlation
12 Petal.Width Petal.Length       0.7866681

$virginica
            X1           X2     correlation
3 Petal.Length Sepal.Length       0.8642247

Observera att en beräkning utförs på en sådan gruppvis nivå, man kan vara intresserad av att stapla resultaten, vilket kan göras med:

> (result <- do.call("rbind", topcor))

                     X1           X2     correlation
setosa      Sepal.Width Sepal.Length       0.7425467
versicolor  Petal.Width Petal.Length       0.7866681
virginica  Petal.Length Sepal.Length       0.8642247

Använd split i split-applicera-kombinera paradigmet

En populär form av dataanalys är split-applicera-kombinera , där du delar dina data i grupper, tillämpar någon form av behandling på varje grupp och kombinerar sedan resultaten.

Låt oss överväga en dataanalys där vi vill få de två bilarna med de bästa miles per gallon (mpg) för varje cylindertal (cyl) i det inbyggda mtcars-datasättet. Först delar vi upp mtcars dataramen med cylinderantalet:

(spl <- split(mtcars, mtcars$cyl))
# $`4`
#                 mpg cyl  disp  hp drat    wt  qsec vs am gear carb
# Datsun 710     22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1
# Merc 240D      24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2
# Merc 230       22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2
# Fiat 128       32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1
# ...
# 
# $`6`
#                 mpg cyl  disp  hp drat    wt  qsec vs am gear carb
# Mazda RX4      21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4
# Mazda RX4 Wag  21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
# Hornet 4 Drive 21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
# Valiant        18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
# ...
# 
# $`8`
#                      mpg cyl  disp  hp drat    wt  qsec vs am gear carb
# Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
# Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4
# Merc 450SE          16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3
# Merc 450SL          17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3
# ...

Detta har returnerat en lista över dataramar, en för varje cylinderantal. Som indikerats av utgången, kunde vi få relevanta dataramar med spl$`4` , spl$`6` och spl$`8` (vissa kanske tycker det är mer visuellt tilltalande att använda spl$"4" eller spl[["4"]] istället).

Nu kan vi använda lapply att gå igenom denna lista och tillämpa vår funktion som extraherar bilarna med de bästa 2 mpg-värdena från vart och ett av listelementen:

(best2 <- lapply(spl, function(x) tail(x[order(x$mpg),], 2)))
# $`4`
#                 mpg cyl disp hp drat    wt  qsec vs am gear carb
# Fiat 128       32.4   4 78.7 66 4.08 2.200 19.47  1  1    4    1
# Toyota Corolla 33.9   4 71.1 65 4.22 1.835 19.90  1  1    4    1
# 
# $`6`
#                 mpg cyl disp  hp drat    wt  qsec vs am gear carb
# Mazda RX4 Wag  21.0   6  160 110 3.90 2.875 17.02  0  1    4    4
# Hornet 4 Drive 21.4   6  258 110 3.08 3.215 19.44  1  0    3    1
# 
# $`8`
#                    mpg cyl disp  hp drat    wt  qsec vs am gear carb
# Hornet Sportabout 18.7   8  360 175 3.15 3.440 17.02  0  0    3    2
# Pontiac Firebird  19.2   8  400 175 3.08 3.845 17.05  0  0    3    2

Slutligen kan vi kombinera allt tillsammans med rbind . Vi vill ringa rbind(best2[["4"]], best2[["6"]], best2[["8"]]) , men detta skulle vara tråkigt om vi hade en enorm lista. Som ett resultat använder vi:

do.call(rbind, best2)
#                      mpg cyl  disp  hp drat    wt  qsec vs am gear carb
# 4.Fiat 128          32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1
# 4.Toyota Corolla    33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1
# 6.Mazda RX4 Wag     21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
# 6.Hornet 4 Drive    21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
# 8.Hornet Sportabout 18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
# 8.Pontiac Firebird  19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2

Detta returnerar resultatet av rbind (argument 1, en funktion) med alla elementen i best2 (argument 2, en lista) passerade som argument.

Med enkla analyser som den här kan det vara mer kompakt (och kanske mycket mindre läsbart!) Att göra hela split-applicera-kombinera i en enda kodrad:

do.call(rbind, lapply(split(mtcars, mtcars$cyl), function(x) tail(x[order(x$mpg),], 2)))

Det är också värt att notera att lapply(split(x,f), FUN) alternativt kan ramas in med funktionen ?by By:

by(mtcars, mtcars$cyl, function(x) tail(x[order(x$mpg),], 2))
do.call(rbind, by(mtcars, mtcars$cyl, function(x) tail(x[order(x$mpg),], 2)))