2012-12-31 11 views
5

Ich habe einen Datenrahmen z und ich möchte die neue Spalte auf der Grundlage der Werte von zwei alten Spalten von z erstellen. Im Anschluss wird der Prozess:erzeugen Spaltenwerte mit mehreren Bedingungen in R

>z<-cbind(x=1:10,y=11:20,t=21:30) 
> z<-as.data.frame(z) 
>z 
    x y t 
1 1 11 21 
2 2 12 22 
3 3 13 23 
4 4 14 24 
5 5 15 25 
6 6 16 26 
7 7 17 27 
8 8 18 28 
9 9 19 29 
10 10 20 30 

# erzeugen, um die Spalte q die auf die Werte der Spalte gleich t mal 4 Wenn x=3 und für andere Werte von x, es auf die Werte der Spalte t gleich ist.

for (i in 1:nrow(z)){ 
    z$q[i]=if (z$x[i]==4) 4*z$t[i] else z$t[i]} 

Aber mein Problem ist, dass ich mehrere Bedingungen anwenden möchten:

Zum Beispiel möchte ich so etwas bekommen:

(If x=2, q=t*2; x=4, q=t*4; x=7, q=t*3; for other it is equal to t) 

> z 
    x y t q 
1 1 11 21 21 
2 2 12 22 44 
3 3 13 23 23 
4 4 14 24 96 
5 5 15 25 25 
6 6 16 26 26 
7 7 17 27 81 
8 8 18 28 28 
9 9 19 29 29 
10 10 20 30 30 

Wie kann ich die zweite Ausgabe erhalten mit die Schleifen oder irgendeine andere Methode?

+1

Außerdem ist es besser, 'ifelse' zu ​​verwenden als die' for' Schleife, die Sie hatten. Statt '(für i in 1: Länge (x)) y [i] <- if ... else ...' Sie können 'nur tun y <- ifelse (logisch, true, false)' –

+1

@ Señor: Aufgrund Ihres Vorschlags habe ich die Antwort auf meine eigene Frage gepostet. Vielen Dank! – Metrics

Antwort

3

Generieren Sie einen Vervielfacher Vektor:

tt <- rep(1, max(z$x)) 
tt[2] <- 2 
tt[4] <- 4 
tt[7] <- 3 

Und hier ist Ihre neue Spalte:

> z$t * tt[z$x] 
[1] 21 44 23 96 25 26 81 28 29 30 

> z$q <- z$t * tt[z$x] 
> z 
    x y t q 
1 1 11 21 21 
2 2 12 22 44 
3 3 13 23 23 
4 4 14 24 96 
5 5 15 25 25 
6 6 16 26 26 
7 7 17 27 81 
8 8 18 28 28 
9 9 19 29 29 
10 10 20 30 30 

Das wird nicht funktionieren, wenn es in z$x negative Werte sind.

Edited

Hier ist eine Verallgemeinerung des oben genannten, in dem eine Funktion verwendet wird, den Multiplikator-Vektor zu erzeugen. Tatsächlich erstellen wir eine Funktion basierend auf Parametern.

Wir wollen die folgenden Werte zu transformieren:

2 -> 2 
4 -> 4 
7 -> 3 

Andernfalls wird ein Standardwert von 1 genommen wird.

Hier ist eine Funktion, die die gewünschte Funktion erzeugt:

f <- function(default, x, y) { 
    x.min <- min(x) 
    x.max <- max(x) 
    y.vals <- rep(default, x.max-x.min+1) 
    y.vals[x-x.min+1] <- y 

    function(z) { 
    result <- rep(default, length(z)) 
    tmp <- z>=x.min & z<=x.max 
    result[tmp] <- y.vals[z[tmp]-x.min+1] 
    result 
    } 
} 

Hier ist, wie wir sie verwenden:

x <- c(2,4,7) 
y <- c(2,4,3) 

g <- f(1, x, y) 

g ist die Funktion, die wir wollen. Es sollte klar sein, dass jede Abbildung über die x und y Parameter zu f geliefert werden kann.

g(z$x) 
## [1] 1 2 1 4 1 1 3 1 1 1 

g(z$x)*z$t 
## [1] 21 44 23 96 25 26 81 28 29 30 

Es sollte klar sein, das funktioniert nur für ganzzahlige Werte.

+0

Vielen Dank Matthew. – Metrics

3

Basierend auf Anregung von Señor:

> z$q <- ifelse(z$x == 2, z$t * 2, 
     ifelse(z$x == 4, z$t * 4, 
     ifelse(z$x == 7, z$t * 3, 
          z$t * 1))) 
> z 
    x y t q 
1 1 11 21 21 
2 2 12 22 44 
3 3 13 23 23 
4 4 14 24 96 
5 5 15 25 25 
6 6 16 26 26 
7 7 17 27 81 
8 8 18 28 28 
9 9 19 29 29 
10 10 20 30 30 
10

von durch Rekursion einen verschachtelten ifelse Zweckbau, können Sie die Vorteile beiden Lösungen bisher angeboten bekommen: ifelse schnell und können mit jeder Art von Daten arbeiten , während @ Matthews Lösung funktionaler ist, aber auf ganze Zahlen beschränkt und möglicherweise langsam ist.

decode <- function(x, search, replace, default = NULL) { 

    # build a nested ifelse function by recursion 
    decode.fun <- function(search, replace, default = NULL) 
     if (length(search) == 0) { 
     function(x) if (is.null(default)) x else rep(default, length(x)) 
     } else { 
     function(x) ifelse(x == search[1], replace[1], 
              decode.fun(tail(search, -1), 
                 tail(replace, -1), 
                 default)(x)) 
     } 

    return(decode.fun(search, replace, default)(x)) 
} 

Beachten Sie, wie die decode-Funktion nach der SQL-Funktion benannt wird. Ich möchte eine Funktion wie diese es an der Basis R-Verpackung ... Hier sind ein paar Beispiele seiner Verwendung veranschaulicht:

decode(x = 1:5, search = 3, replace = -1) 
# [1] 1 2 -1 4 5 
decode(x = 1:5, search = c(2, 4), replace = c(20, 40), default = 3) 
# [1] 3 20 3 40 3 

Für Ihr spezielles Problem:

transform(z, q = decode(x, search = c(2,4,7), replace = c(2,4,3), default = 1) * t) 

# x y t q 
# 1 1 11 21 21 
# 2 2 12 22 44 
# 3 3 13 23 23 
# 4 4 14 24 96 
# 5 5 15 25 25 
# 6 6 16 26 26 
# 7 7 17 27 81 
# 8 8 18 28 28 
# 9 9 19 29 29 
# 10 10 20 30 30 
+0

Sehr schön. Ich dachte daran, eine rekursive Funktionsdefinition wie diese zu machen, ließ sie aber für "später", was niemals hätte sein können. –

+0

Noch schöner, wenn man das so verallgemeinert, dass 'search' eine Liste von Vektoren von Zielen sein kann (zB' search = list (c ("apple", "orange"), c ("Karotte", "Kartoffel")), replace = c ("fruit", "root") '(oder auch' search = list (obst = c ("apple", "orange"), root = c ("karotte", "kartoffel")) ', obwohl (Das funktioniert nur bei String-Ersetzungen.) Ich denke, das 'car'-Paket hat einen' recode' für Faktoren, aber es ist string-basiert und klobig ... –

1

Sie können auch Spiel nutzen, um mach das. Ich neige dazu, dies viel zu verwenden, während Parameter wie col, pch und CEX auf Punkte in Scatterplots Zuordnung

searchfor<-c(2,4,7) 
replacewith<-c(2,4,3) 

# generate multiplier column 
# q could also be an existing vector where you want to replace certain entries 
q<-rep(1,nrow(z)) 
# 
id<-match(z$x,searchfor) 
id<-replacewith[id] 
# Apply the matches to q 
q[!is.na(id)]<-id[!is.na(id)] 
# apply to t 
z$q<-q*z$t 
3

Hier eine einfache Lösung mit nur einem ifelse Befehl lautet:

Berechnen Sie den Multiplikator von t:

ifelse(z$x == 7, 3, z$x^(z$x %in% c(2, 4))) 

Der komplette Befehl:

transform(z, q = t * ifelse(x == 7, 3, x^(x %in% c(2, 4)))) 

    x y t q 
1 1 11 21 21 
2 2 12 22 44 
3 3 13 23 23 
4 4 14 24 96 
5 5 15 25 25 
6 6 16 26 26 
7 7 17 27 81 
8 8 18 28 28 
9 9 19 29 29 
10 10 20 30 30 
2

Ich mochte die Antwort „dinre“ gebucht flodel Blog wirklich:

for (i in 1:length(data_Array)){ 
data_Array[i] <- switch(data_Array[i], banana="apple", orange="pineapple", "fig") 
} 

Mit Warnungen über die Hilfeseite für switch sorgfältig für Integer-Argumente zu lesen.

2

Sie können es in

  • Basis R
  • mit einer Zeile
  • , in dem die Abbildung ist ziemlich klar im Code
  • keine Hilfsfunktionen (ok, eine anonyme Funktion lesen)
  • Ansatz arbeitet mit Negativen
  • Ansatz funktioniert mit jedem atomaren Vektor (reals, Zeichen)

wie folgt aus:

> transform(z,q=t*sapply(as.character(x),function(x) switch(x,"2"=2,"4"=4,"7"=3,1))) 
    x y t q 
1 1 11 21 21 
2 2 12 22 44 
3 3 13 23 23 
4 4 14 24 96 
5 5 15 25 25 
6 6 16 26 26 
7 7 17 27 81 
8 8 18 28 28 
9 9 19 29 29 
10 10 20 30 30 
1

Hier ist eine Version einer SQL-decode in R für Zeichenvektoren (ungetestet mit Faktoren), die ebenso wie die SQL-Version arbeitet. d. h. es benötigt eine beliebige Anzahl von Ziel-/Ersatzpaaren und optional das letzte Argument, das als Standardwert fungiert (beachten Sie, dass der Standardwert die NAs nicht überschreibt).

Ich kann es sehen ziemlich nützlich in Verbindung mit dplyr ‚s mutate Betrieb zu sein.

> x <- c("apple","apple","orange","pear","pear",NA) 

> decode(x, apple, banana) 
[1] "banana" "banana" "orange" "pear" "pear" NA  

> decode(x, apple, banana, fruit) 
[1] "banana" "banana" "fruit" "fruit" "fruit" NA  

> decode(x, apple, banana, pear, passionfruit) 
[1] "banana"  "banana"  "orange"  "passionfruit" "passionfruit" NA    

> decode(x, apple, banana, pear, passionfruit, fruit) 
[1] "banana"  "banana"  "fruit"  "passionfruit" "passionfruit" NA 

Hier ist der Code, den ich verwenden, mit einem Kern ich hier auf dem Laufenden halten werde (link).

decode <- function(x, ...) { 

    args <- as.character((eval(substitute(alist(...)))) 

    replacements <- args[1:length(args) %% 2 == 0] 
    targets  <- args[1:length(args) %% 2 == 1][1:length(replacements)] 

    if(length(args) %% 2 == 1) 
    x[! x %in% targets & ! is.na(x)] <- tail(args,1) 

    for(i in 1:length(targets)) 
    x <- ifelse(x == targets[i], replacements[i], x) 

    return(x) 

}