2012-12-31 5 views
5

Ho un dataframe z e voglio creare la nuova colonna in base ai valori di due vecchie colonne di z. Segue è il processo:genera valori di colonna con più condizioni 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 

# generano la colonna q che è uguale ai valori della colonna t volte 4 se x=3 per altri valori di x, è pari ai valori della colonna t.

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

Ma, il mio problema è che voglio applicare più condizioni:

Per esempio, voglio ottenere qualcosa del genere:

(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 

Come faccio ad avere la seconda uscita con i loop o qualsiasi altro metodo?

+1

Inoltre, è meglio usare 'ifelse' del ciclo' for' che si è avuto. Invece di '(per i in 1: length (x)) y [i] <- if ... else ...' puoi semplicemente fare 'y <- ifelse (logico, vero, falso)' –

+1

@ Señor: Sulla base del tuo suggerimento, ho postato la risposta alla mia domanda. Grazie! – Metrics

risposta

3

generare un vettore moltiplicatore:

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

Ed ecco la nuova colonna:

> 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 

Questo non funziona se ci sono valori negativi in ​​z$x.

Edited

Ecco una generalizzazione di quanto sopra, in cui una funzione viene utilizzato per generare il vettore moltiplicatore. In effetti, creiamo una funzione basata su parametri.

vogliamo trasformare i seguenti valori:

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

In caso contrario è preso un predefinito di 1.

Ecco una funzione che genera la funzione desiderata:

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 
    } 
} 

Ecco come lo usiamo:

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

g <- f(1, x, y) 

g è la funzione che vogliamo. Dovrebbe essere chiaro che qualsiasi mappatura può essere fornita tramite i parametri x e a f.

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 

Dovrebbe essere chiaro questo funziona solo per i valori interi.

+0

Grazie mille Matthew. – Metrics

3

Sulla base della proposta del 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

Con la costruzione di un nidificato ifelse funzionale mediante ricorsione, è possibile ottenere i benefici di entrambe le soluzioni proposte finora: ifelse è veloce e può lavorare con qualsiasi tipo di dati , mentre la soluzione di @ Matthew è più funzionale ma limitata agli interi e potenzialmente lenta.

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)) 
} 

Nota come la funzione decode prende il nome la funzione SQL. Vorrei che una funzione come questo ha reso al pacchetto R di base ... qui ci sono un paio di esempi che illustrano il suo utilizzo:

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 

Per il vostro problema particolare:

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

Molto bello. Stavo pensando di fare una definizione di funzione ricorsiva come questa, ma l'ho lasciata per "dopo" che potrebbe non essere mai stata. –

+0

Ancora più bello se generalizzi questo in modo che 'search' possa essere una lista di vettori di bersagli (es.' Cerca = elenco (c ("mela", "arancione"), c ("carota", "patata")), replace = c ("fruit", "root") '(o anche' search = list (fruit = c ("mela", "orange"), root = c ("carota", "patata")) ', sebbene che funziona solo per le sostituzioni di stringhe). Penso che il pacchetto 'car' abbia un' recode' per i fattori, ma è basato su stringhe e clunky ... –

1

È inoltre possibile utilizzare la corrispondenza per Fai questo. Io tendo ad usare questo molto mentre l'assegnazione di parametri come Col, PCH e CEX a punti in grafici a dispersione

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

Qui è una soluzione semplice con un solo ifelse comando:

calcolare il moltiplicatore di t:

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

il comando completo:

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

Mi è piaciuto molto la risposta "dinre" postato il blog di per flodel:

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

Con avvertimenti circa la lettura della pagina di aiuto per switch attenzione per argomenti interi.

2

È possibile farlo in

  • base di R
  • con una linea
  • in cui la mappatura è abbastanza chiaro da leggere il codice
  • nessuna funzione di supporto (ok, una funzione anonima)
  • approccio funziona con i negativi
  • approccio funziona con qualsiasi vettore atomica (reali, personaggi)

come questo:

> 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

Ecco una versione di SQL decode in R per i vettori di caratteri (non testato con fattori) che opera proprio come la versione di SQL. vale a dire un numero arbitrario di coppie target/sostitutive e l'ultimo argomento opzionale che funge da valore predefinito (si noti che l'impostazione predefinita non sovrascrive le NA).

Posso vedere che è piuttosto utile in combinazione con l'operazione mutatedplyr.

> 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 

Ecco il codice che sto utilizzando, con un succo terrò aggiornati qui (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) 

}