Aggregate avec condition

Version imprimable

10/01/2016, 22h00
fcka0001

Aggregate avec condition
Bonjour,
pour agréger et en sommant sur N les lignes suivantes :
Code:

1 2 3 4 V1 LIB1 V2 LIB2 N a b c d 10 a b c d 20
je lance la commande suivante pour obtenir : a b c d 30

Code:

aggregate(N~V1+LIB1+V2+LIB2, data=tableau,sum)

Je voudrai maintenant agréger en sommant sur N uniquement les lignes bijectives du type:
Code:

1 2 3 4 V1 LIB1 V2 LIB2 N a b c d 10 c d a b 20
Etant débutant, je ne sais pas trop comment m'y prendre. Quelqu'un peut-il svp me mettre sur une piste;)

Bonjour,

Si j'ai bien compris, tu voudrais qu'un tableau comme celui-là :
Code:

1 2 3 4 5 6 V1 LIB1 V2 LIB2 N a b c d 10 d b a c 20 b d a c 15 a a c d 12 d a c a 10
donne un tableau comme cela :
Code:

1 2 3 V1 LIB1 V2 LIB2 N a b c d 45 a a c d 22
Est-ce bien cela ?

13/01/2016, 23h19
fcka0001

aggregate avec condition
bonsoir,
dans l'idée oui, à ceci près que V1 et V2 sont liées à LIB1 et LIB2 (ce sont des codes insee et des libellés de commune). Mon pb me semble un peu plus simple.

Il me semble que j'ai trouvé une solution:

Coma représente des tableaux de codes Origine Destination et n le nombre de liaisons
Comb représente des tableaux de codes Destination Origine et n le nombre de liaisons

Mon objectif est de sommer pour chaque couple O-D le nombre total n de liaisons, sans prendre en compte le sens des liaisons.

j'ai commencé par supprimer les O-D où coma = comb
Code:

1 2 Rcomb<-comb[which(comb$coma!=comb$comb),] Rcoma<-coma[which(coma$coma!=coma$comb),]
j'ai créé une vecteur :

Code:

z<-c("comb", "libb", "coma", "liba", "n")

qui m'a permis de permuter les colonnes dans l'un des tableaux (j'ai choisi Rcomb)

Code:

pRcomb<-(Rcomb[,z])

j'ai ensuite renommé les colonnes de Rcomb de façon à avoir les noms de colonnes dans le même ordre que dans le tableau Coma (seules les valeurs ont au final permuté).

Code:

names(pRcomb)<-c("coma", "liba", "comb", "libb", "n")

j'ai uni les tableaux Coma et Rcomb

Code:

barreau<- rbind.data.frame(Rcoma, pRcomb)

puis j'ai agrégé les lignes en sommant sur n

Code:

f2s<-aggregate(n~coma+liba+comb+libb, data=barreau,sum)

Cela a l'air de fonctionner (il faut que je vérifie encore), mais ma méthode n'est certainement pas très orthodoxe ... , je n'ai par exemple pas fait "d'aggregate avec condition":(...)
14/01/2016, 12h00
fcka0001

aggregation avec condition

après vérification cela ne fonctionne pas :oops::oops::oops:

donc j'en reviens au début, j'ai un tableau du type :
x y N
A B n1
C D n2
F G n3
B A n4
Z V n5

je voudrai obtenir :

A B (ou BA peu importe) n1+n4
C D n2
F G n3
Z V n5

si quelqu'un a une idée, je suis preneur.

Bonjour,
En reprenant à partir du dernier message (#4) et en faisant de la pub pour dplyr (pub car la même chose peut être faite sans la bibliothèque) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
library("dplyr")
 
donnees <- data.frame(
    x = c("A", "C", "F", "B", "Z"),
    y = c("B", "D", "G", "A", "V"),
    N = sample(5),
    stringsAsFactors = FALSE)
 
print(donnees)
 
indices_comb <- na.exclude(charmatch(donnees$x, donnees$y))
 
cibles <- slice(donnees, indices_comb)
 
resultat <- slice(donnees, -indices_comb)
 
resultat <- bind_rows(resultat, list(
    x = cibles$x[1L],
    y = cibles$y[1L],
    N = sum(cibles$N))
)
 
print(resultat)

> print(donnees)
  x y N
1 A B 1
2 C D 5
3 F G 4
4 B A 2
5 Z V 3

> print(resultat)
Source: local data frame [4 x 3]

      x     y     N
  (chr) (chr) (int)
1     C     D     5
2     F     G     4
3     Z     V     3
4     B     A     3

Reste à avoir si cela est généralisable aux données réelles que vous avez.

15/01/2016, 15h02
faubry
Partant de l'hypothèse que les deux colonnes x et y du tableau sont des chaines de caractères, on peut commencer par transformer le tableau comme suit :
Code:

1 2 3 4 5 6 sort.col <- function( col.1, col.2) { ifelse( col.1 < col.2, col.1, col.2) } tab.result <- transform( tab.result, x=sort.col( x, y), y=sort.col( y, x))
puis appliquer sur le résultat la fonction aggregate.

En effet, R sait ordonner des chaînes de caractères selon l'ordre lexicographique et donc les ordonner selon cet ordre. Par contre, il différencie les minuscules des majuscules. Les fonctions tolower ou toupper permettent de mettre les chaînes de caractères en minuscules ou en majuscules.

Si ces colonnes sont des facteurs, il suffit de les remplacer par des chaînes de caractères avec la commande suivante :

Code:

tab.result$x <- as.character( tab.result$x)

Par contre, cette transformation est inutile dans le cas de l'utilisation des fonctions de transformation de casse tolower et toupper car elles commencent par transformer leur argument en chaînes de caractères avant de changer de casse.
16/01/2016, 19h40
fcka0001

aggregate avec condition
bonsoir, merci pour votre aide précieuse (cela ne fonctionne pas encore tout à fait).

j'ai testé la méthode de juliatheric (je n'ai pas compris l'autre méthode)

avec 2 lignes identiques, cela fonctionne mais avec d'autres couples de lignes identiques, cela ne fonctionne plus.

j'ai ajouté deux autres lignes dans "donnees" :
donnees
x y N
1 A B 3
2 C D 6
3 F G 2
4 B A 5
5 Z V 1
6 D C 4

la recherche des lignes bijectives se passe bien
"cibles"
x y N
1 B A 5
2 D C 4
3A B 3
4 C D 6
Code:

1 2 resultat <- slice(donnees, -indices_comb)
x y N
1 F G 2
2 Z V 1

jusque là c'est OK,

mais ensuite cela ne fonctionne plus :
Code:

1 2 resultat <- bind_rows(resultat, list(x = cibles$x[1L], y = cibles$y[1L], N = sum(cibles$N)))
x y N
(chr) (chr) (int)
1 F G 2
2 Z V 1
3 B A 18

le couple D C est omis.

Je vais rechercher un moyen de sélectionner les N/2 1ères lignes de "cibles" pour m'en servir dans la fonction bind_rows.
16/01/2016, 22h00
fcka0001

aggregate avec condition

ce n'est pas une bonne idée... l'ordre des lignes de "cibles" dépend de celui de "donnees":oops:

Comme je n'étais pas sûr des données réelles à votre disposition, la dernière fois, je vous ai laissé des pistes. Maintenant que vous avez confirmé qu'on peut travailler avec ces données-là, voici une solution complète.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
initialiser <- function() {
    stopifnot(all(sapply(c("dplyr", "foreach"), require, character.only = TRUE)))
 
    return(data.frame(
        x = c("A", "C", "F", "B", "Z", "D", "M", "Q"),
        y = c("B", "D", "G", "A", "V", "C", "X", "H"),
        N = sample.int(8L),
        stringsAsFactors = FALSE)
    )
}
 
rassembler <- function(entrees, nomVar1, nomVar2, nomVar3, operation,
                       initChar = "Ω", initNum = -9999) {
 
    appariement <- charmatch(entrees[[nomVar1]], entrees[[nomVar2]])
 
    tailleInitiale <- sum(dim(entrees))
 
    finis <- rep(initChar, tailleInitiale)
 
    sorties <- list(rep(initChar, tailleInitiale),
                    rep(initChar, tailleInitiale),
                    rep(initNum, tailleInitiale))
    names(sorties) <- c(nomVar1, nomVar2, nomVar3)
 
    compteur <- parcours <- 0L
 
    foreach(i = seq_along(entrees[[nomVar1]]), j = appariement) %do% {
        if (!(entrees[i, nomVar1] %in% finis)) {
            compteur <- compteur + 1L
            parcours <- parcours + 1L
            sorties[[nomVar1]][compteur] <- finis[parcours] <- entrees[i, nomVar1]
            parcours <- parcours + 1L
            sorties[[nomVar2]][compteur] <- finis[parcours] <- entrees[i, nomVar2]
            sorties[[nomVar3]][compteur] <- operation(entrees[i, nomVar3], entrees[j, nomVar3])
        }
    }
 
    utilFiltre <- function(conteneur, valeurExclue) {
        Filter(function(z) z != valeurExclue, conteneur)
    }
 
    message(paste0("Eléments traités : ",
               paste(utilFiltre(finis, initChar), collapse = ","),
               "\n"))
 
    sorties[c(1L, 2L)] <- lapply(sorties[c(1L, 2L)], utilFiltre, initChar)
    sorties[[3L]] <- utilFiltre(sorties[[3L]], initNum)
    return(as.data.frame(sorties, stringsAsFactors = FALSE))
}
 
donnees <- initialiser()
sousResultatsSansRepetions <- dplyr::filter(donnees, !(x %in% y))
sousResultatsAvecRepetitions <- rassembler(dplyr::filter(donnees, x %in% y), "x", "y", "N", sum)
resultat <- bind_rows(sousResultatsSansRepetions, sousResultatsAvecRepetitions)

> print(donnees)
  x y N
1 A B 6
2 C D 7
3 F G 4
4 B A 2
5 Z V 8
6 D C 5
7 M X 3
8 Q H 1
> print(resultat)
Source: local data frame [6 x 3]

      x     y     N
  (chr) (chr) (dbl)
1     F     G     4
2     Z     V     8
3     M     X     3
4     Q     H     1
5     A     B     8
6     C     D    12
>

La solution me semble assez détaillée pour se passer de commentaire ; ce qui serait un peu inhabituel est la notion d'itérateurs avec la méthode foreach provenant de la bibliothèque du même nom. La méthode rassembler est assez générique : elle fait abstraction des noms des variables du jeu de données et applique une fonction arbitraire sur les valeurs des observations que vous appelez «bijectives». Par contre, il faudra adapter cette solution pour tenir compte des cas où des couples (x, y) sont répétés plus de deux fois, comme ici :

Code:

1
2
3
4
5
donneesAvecRepetitions <- data.frame(
    x = c("A", "C", "F", "B", "Z", "D", "B", "M", "Q"),
    y = c("B", "D", "G", "A", "V", "C", "A", "X", "H"),
    N = sample.int(9L),
    stringsAsFactors = FALSE)

18/01/2016, 23h21
fcka0001

aggregate avec condition

Bonsoir,
Tout d'abord, un grand merci à juliatheric
l'exemple fonctionne parfaitement.

Avec mes données (elles ne comportent pas de couple (x,y) répétés plusieurs fois), le programme va jusqu'au bout mais il y a un souci :?!!
mon fichier "donnees" comporte 9303 lignes, le fichier "sousResultatsAvecRepetitions" 425 et le fichier "sousResultatsSansRepetions" 784.
le fichier "resultat" compte quant à lui 1209 lignes (la somme des deux fichiers intermédiaires).
A mon avis, je "perds" beaucoup trop des lignes en cours de route dans le fichier "sousResultatsSansRepetions"... avant l'étape finale.
Cela explique à mon avis le fait que les valeurs N du fichier résultat soient si petites (max 96) alors que la valeur N max de mon fichier 'donnees' dépasse les 5600.

ps: à quoi correspondent les valeurs de initChar et initNum ? initChar =

Code:

"Ω"

, initNum =

Code:

-9999

merci encore pour votre aide.

De rien !
Dans le code en soi, je ne vois pas d'où une perte de données pourrait survenir. Il est plutôt probable que ce soient les données qui ne sont pas exactement adaptées au code. Peut-être qu'indiquer les sorties de l'instruction suivante pourrait aider à y voir plus clair.

Code:

str(donnees_reelles)

En plus, si vous modifiez la ligne commençant par message, dans la fonction rassembler, pour qu'elle soit
Code:

1 2 3 message(paste0("Eléments traités : ", paste(utilFiltre(finis, initChar), collapse = ","), "\nNombre d'opérations faites : ", compteur, "\n"))
quels sont les messages laissés sur la console après un appel de rassembler avec les données réelles ?

Quant à la valeur que contient initChar, c'est une entité HTML, j'avais voulu initialiser tous les vecteurs de caractères par un caractère au hasard, Ω par exemple. Mais visiblement le rendu dans la zone de code ne supporte pas l'Unicode. De même, -9999 sert à initialiser des objets de mode numeric ; il y a cependant une erreur : mon intention initiale était plutôt d'écrire -9999L mais je m'égare (c'est un autre sujet).

Pourquoi réserver au préalable de l'espace pour les objets alors qu'on peut remplir un objet de façon naïve, en concaténant chaque nouvelle valeur à sa fin ? Parce qu'ainsi faire n'est pas performant ; il vaut mieux utiliser les indices, surtout si les données sont assez volumineuses. Voici un petit benchmark.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 concatener <- function(taille = 1000L) { x <- rep("qqch", taille) for (i in seq_len(taille)) { x <- append(x, as.character(i)) } invisible(x) } indexer <- function(taille = 1000L) { x <- character(taille * 2L) x[seq_len(taille)] <- rep("qqch", taille) for (i in seq_len(taille)) { x[i + taille] <- as.character(i) } invisible(x) } #Vérifier si réellement les deux fonctions donnent les mêmes sorties. all.equal(concatener(), indexer()) library(rbenchmark) colonnes_affichees <- seq_len(3L) benchmark(concatener(), indexer(), replications = 10L, columns = colonnes_affichees) benchmark(concatener(), indexer(), columns = colonnes_affichees) benchmark(concatener(), indexer(), replications = 1000L, columns = colonnes_affichees)
> benchmark(concatener(), indexer(), replications = 10L, columns = colonnes_affichees)
          test replications user.self
1 concatener()           10     0.213
2    indexer()           10     0.026
> benchmark(concatener(), indexer(), columns = colonnes_affichees)
          test replications user.self
1 concatener()          100     2.284
2    indexer()          100     0.272
> benchmark(concatener(), indexer(), replications = 1000L, columns = colonnes_affichees)
          test replications user.self
1 concatener()         1000    23.845
2    indexer()         1000     2.824
>
Je vous laisse conclure.

25/01/2016, 00h55
fcka0001

aggregate forum

Bonjour,
Je n'ai pas encore conclu :aie:

mon fichier de données ne comporte pas de doublons de ce type x: (B,A), (B,A) ou y: (A,B), (A,B)

Citation:

donneesAvecRepetitions <- data.frame(
x = c("A", "C", "F", "B", "Z", "D", "B", "I", "Q"),
y = c("B", "M", "G", "A", "V", "C", "A", "W", "H"),
N = sample.int(9L), stringsAsFactors = FALSE)

mais sa structure est la suivante (et tous les autres cas de figure sont possibles):

Citation:

donneesAvecRepetitions <- data.frame(
x = c("A", "C", "F", "B", "Z", "D", "B", "M", "Q"),
y = c("B", "M", "G", "W", "B", "C", "A", "A", "H"),
N = sample.int(9L), stringsAsFactors = FALSE)

Le programme de juliathery trouve les couples (A,B) et ( B,A) mais les couples (x,A), (A,y), (x,B), (B,y), (W,y), (x,W) ne sont bien pas pris en compte.
J'ai remarqué qu'en en ajoutant des données de ce type dans le programme de juliathiery, les couples (A,B) et (B,A) ne sont plus traités correctement non plus (la somme sur N devient inexacte).

Je suis bien bloqué de nouveau. Je ne suis peut-être pas loin, mais si quelqu'un a une idée, merci d'avance...

ps: pour répondre aux questions de juliathery

la structure de mon fichier "données" est la suivante

Citation:

str(donnees)
'data.frame': 9303 obs. of 3 variables:
$ x: chr "01049" "01053" "01063" "01173" ...
$ y: chr "83082" "83071" "83067" "83137" ...
$ N: num 3.93 2.83 3.96 7.7 4.09 ...

le benchmark avec ce même fichier donne ceci:

Citation:

library(rbenchmark)
> colonnes_affichees <- seq_len(3L)
> benchmark(concatener(), indexer(), replications = 10L, columns = colonnes_affichees)
test replications user.self
1 concatener() 10 0.07
2 indexer() 10 0.02
> benchmark(concatener(), indexer(), columns = colonnes_affichees)
test replications user.self
1 concatener() 100 0.78
2 indexer() 100 0.14
> benchmark(concatener(), indexer(), replications = 1000L, columns = colonnes_affichees)
test replications user.self
1 concatener() 1000 8.02
2 indexer() 1000 1.54[/I]

Bonjour,
L'idée générale est de

repérer les élément de X qui sont identiques à ceux de Y,
sauvegarder quelque part les indices dans X et dans Y à chaque fois qu'il y a cette identité,
appliquer une opération particulière au jeu de données dans sa partie correspondant à ces indices et
garder l'autre partie intacte.

La dernière fois, la fonction rassembler ne se préoccupait que du cas exposé à ce moment-là. Si d'autres conditions sont ajoutées, il suffit de reprendre l'idée générale et de tenir compte des nouvelles conditions. Vous pouvez ignorer la partie de benchmark, j'abordais une autre problématique : la manière d'accumuler les résultats au fur et à mesure. ici-bas, un code reprenant l'idée générale :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
rassembler <- function(entrees, nomVar1, nomVar2, nomVar3, operation = sum) {
 
    stopifnot(all(sapply(c("dplyr", "foreach", "magrittr"),
                         require, character.only = TRUE)))
 
    utilTraiterRep <- function(numLignes) {
        tmp <- slice(entrees, numLignes)
        buff <- tmp[[nomVar1]] %>% unique %>% sort %>% paste(collapse = "/")
        val <- list(buff, buff, tmp[[nomVar3]] %>% operation)
        names(val) <- c(nomVar1, nomVar2, nomVar3)
        val
    }
 
    appariement <- sapply(entrees[[nomVar1]], grep, entrees[[nomVar2]])
 
    sorties <- data.frame(
        entrees[[nomVar1]] %>% mode %>% vector,
        entrees[[nomVar2]] %>% mode %>% vector,
        entrees[[nomVar3]] %>% mode %>% vector,
        stringsAsFactors = FALSE)
    names(sorties) <- c(nomVar1, nomVar2, nomVar3)
 
    foreach(i = seq_along(entrees[[nomVar1]]), j = appariement) %do% {
        if (length(j) > 0L) {
            sorties <- bind_rows(sorties, utilTraiterRep(c(i, j)))
 
        } else {
            sorties <- suppressMessages(full_join(sorties, slice(entrees, i)))
        }
    }
 
    return(sorties)
}
 
donnees <- data.frame(
    x = c("A", "C", "F", "B", "Z", "D", "M", "Q"),
    y = c("B", "D", "G", "A", "V", "C", "X", "H"),
    N = sample.int(8L),
    stringsAsFactors = FALSE)
 
donneesAvecRepetitions <- data.frame(
    x = c("A", "C", "F", "B", "Z", "D", "B", "M", "Q"),
    y = c("B", "M", "G", "W", "B", "C", "A", "A", "H"),
    N = sample.int(9L), stringsAsFactors = FALSE)
 
 
resultatsSansRepetitions <- rassembler(donnees, "x", "y", "N")
resultatsAvecRepetitions <- rassembler(donneesAvecRepetitions, "x", "y", "N")

> print(donnees)
  x y N
1 A B 2
2 C D 5
3 F G 7
4 B A 3
5 Z V 8
6 D C 6
7 M X 4
8 Q H 1
> print(resultatsSansRepetitions)
Source: local data frame [8 x 3]

      x     y     N
  (chr) (chr) (dbl)
1   A/B   A/B     5
2   C/D   C/D    11
3     F     G     7
4   A/B   A/B     5
5     Z     V     8
6   C/D   C/D    11
7     M     X     4
8     Q     H     1
> print(donneesAvecRepetitions)
  x y N
1 A B 2
2 C M 9
3 F G 7
4 B W 4
5 Z B 3
6 D C 1
7 B A 6
8 M A 5
9 Q H 8
> print(resultatsAvecRepetitions)
Source: local data frame [9 x 3]

      x     y     N
  (chr) (chr) (dbl)
1 A/B/M A/B/M    13
2   C/D   C/D    10
3     F     G     7
4 A/B/Z A/B/Z     9
5     Z     B     3
6     D     C     1
7 A/B/Z A/B/Z    11
8   C/M   C/M    14
9     Q     H     8
>

À noter qu'une étape d'élimination des doublons s'impose dans resultatsSansRepetitions. Si resultatsAvecRepetitions ne convient pas, faire des retouches dans rassembler.

26/01/2016, 13h54
fcka0001

bonjour,
à Juliathery: merci sincèrement pour votre aide et vos conseils, mais le résultat que je recherche n'est pas encore atteint:

avec le jeu de données comme print(donneesAvecRepetitions)

Citation:

x y N
1 A B 2
2 C M 9
3 F G 7
4 B W 4
5 Z B 3
6 D C 1
7 B A 6
8 M A 5
9 Q H 8
10 E O 1
11 O E 3

mon objectif serait d'obtenir
> print(donneesAvecRepetitions)

Citation:

x y N
1 A B 8
2 C M 9
3 F G 7
4 B W 4
5 Z B 3
6 D C 1
7 M A 5
8 Q H 8
9 E O 4

ces couples AB et BA ou OE et EO représentent des flux doubles sens que je vais ensuite représenter sous forme de "barreau" (en non de flèches) dans une carte, en cumulant le nombre de liaisons N, de A vers B et de B vers A; de O vers E et de E vers O.
Je m'y replonge après demain ...

Dans ce cas, c'est la solution en #9 qui doit être modifiée. Les modifications sans chercher à raccourcir le code (c'est possible mais au prix de l'illisibilité) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
rassembler <- function(entrees, nomVar1, nomVar2, nomVar3, operation = sum,
                          initTexte = "æ", initNombre = -921473) {
 
    stopifnot(all(sapply(c("foreach", "magrittr"), require, character.only = TRUE)))
 
    appariement <- sapply(entrees[[nomVar1]], grep, entrees[[nomVar2]])
 
    cibles <- which(and(
        entrees[, nomVar1] %in% entrees[, nomVar2],
        entrees[, nomVar2] %in% entrees[, nomVar1]))
 
    tailleInitiale <- nrow(entrees)
 
    finis <- rep(initNombre, tailleInitiale)
 
    confinement <- new.env(parent = emptyenv())
 
    confinement$sorties <- list(rep(initTexte, tailleInitiale),
                    rep(initTexte, tailleInitiale),
                    rep(initNombre, tailleInitiale))
    names(confinement$sorties) <- c(nomVar1, nomVar2, nomVar3)
 
    confinement$cptElements <- cptFlux <- 0L
 
    ajouterSortie <- function(val1, val2, val3) {
        confinement$cptElements <- confinement$cptElements + 1L
        confinement$sorties[[nomVar1]][confinement$cptElements] <- val1
        confinement$sorties[[nomVar2]][confinement$cptElements] <- val2
        confinement$sorties[[nomVar3]][confinement$cptElements] <- val3
    }
 
    foreach(i = seq_along(entrees[[nomVar1]]), j = appariement) %do% {
 
        if (all(length(j) > 0L, not(i %in% finis))) {
            tmp <- entrees[j, ]
            cible <- which(tmp[, nomVar1] == entrees[i, nomVar2])
 
            if (length(cible) > 0L) {
                cptFlux <- cptFlux + 1L
                finis[cptFlux] <- i
                cptFlux <- cptFlux + 1L
                finis[cptFlux] <- cibles[entrees[cibles, nomVar1] == entrees[i, nomVar2]]
 
                ajouterSortie(entrees[i, nomVar1],
                              entrees[i, nomVar2],
                              operation(entrees[i, nomVar3], tmp[cible, nomVar3]))
 
            } else {
                ajouterSortie(entrees[i, nomVar1], entrees[i, nomVar2], entrees[i, nomVar3])
 
            }
        } else if (not(i %in% finis)) {
            ajouterSortie(entrees[i, nomVar1], entrees[i, nomVar2], entrees[i, nomVar3])
        }
    }
 
    utilFiltre <- function(conteneur, valeurExclue) {
        Filter(function(z) z != valeurExclue, conteneur)
    }
 
    finis <- utilFiltre(finis, initNombre)
    confinement$sorties[c(1L, 2L)] <- lapply(confinement$sorties[c(1L, 2L)], utilFiltre, initTexte)
    confinement$sorties[[3L]] <- utilFiltre(confinement$sorties[[3L]], initNombre)
 
    message(paste0("Lignes originales à flux : ",
                   paste(finis, collapse = ", "),
                   "\nNombre de flux : ", length(finis) / 2L, "\n"))
 
    return(as.data.frame(confinement$sorties, stringsAsFactors = FALSE))
}
 
donnees <- data.frame(
    x = c("A", "C", "F", "B", "Z", "D", "M", "Q"),
    y = c("B", "D", "G", "A", "V", "C", "X", "H"),
    N = sample.int(8L),
    stringsAsFactors = FALSE)
 
donneesAvecRepetitions <- data.frame(
    x = c("A", "C", "F", "B", "Z", "D", "B", "M", "Q", "E", "O"),
    y = c("B", "M", "G", "W", "B", "C", "A", "A", "H", "O", "E"),
    N = sample.int(11L), stringsAsFactors = FALSE)
 
print(donnees)
suppressMessages(rassembler(donnees, "x", "y", "N"))

> print(donneesAvecRepetitions)
   x y  N
1  A B 11
2  C M  7
3  F G  5
4  B W  2
5  Z B  9
6  D C  1
7  B A  6
8  M A 10
9  Q H  4
10 E O  8
11 O E  3
> rassembler(donneesAvecRepetitions, "x", "y", "N")
Lignes originales à flux : 1, 7, 10, 11
Nombre de flux : 2

  x y  N
1 A B 17
2 C M  7
3 F G  5
4 B W  2
5 Z B  9
6 D C  1
7 M A 10
8 Q H  4
9 E O 11
>

30/01/2016, 00h05
fcka0001

agregate avec condition

Bonjour,
Merci encore une nouvelle fois, la solution en #15 est celle que je recherche !
J'ai testé avec le programme en ajoutant des lignes dans l'exemple, en inversant les lignes, etc: le programme fonctionne.

Avec mes données, le programme va au bout mais le message suivant apparait :

"There were 50 or more warnings (use warnings() to see the first 50)"
Messages d'avis :
1: In eval(expr, envir, enclos) :
number of items to replace is not a multiple of replacement length
2: In eval(expr, envir, enclos) :
number of items to replace is not a multiple of replacement length
3: In eval(expr, envir, enclos) :
number of items to replace is not a multiple of replacement length
....

de quoi cela peut-il venir?
30/01/2016, 16h11
juliatheric

Bonjour,
Les avertissements disent que le code a tenté d'assigner à un objet des valeurs n'ayant pas les dimensions adéquates. Si cela ne vous pose pas de problème, on peut désormais passer aux données réelles. Vous pouvez les envoyer en pièce jointe.
D'après les sorties de str(donnees) que vous avez précédemment indiquées, R stockera les données sur environ 224 Ko. C'est une taille assez petite pour passez sur le forum en pièce jointe. Une des options suivantes fera l'affaire

1- fichier texte (d'extension .txt)

Code:

write.table(donnees, "données.txt", quote = FALSE, sep = "\t", row.names = FALSE, fileEncoding = "UTF-8")

Le fichier obtenu devrait faire environ 55.8 Ko, c'est sous la limite des 64 Ko que pose le forum, il passerait donc.

2- une archive : .7z, .bz2, .gz, .rar, .tar, .zip
Si la première option échoue, mettre le fichier données.tx dans une archive dont le type est un des six indiqués ci-dessus, la taille limite étant dans tous les cas de 2 Mo. Comme il y a de la marge, en profiter pour placer les données sous une forme reproductible :

Code:

save(donnees, file = "données.RData")

Mettre donc dans l'archive les fichiers données.tx et données.RData. Par exemple :

Code:

zip("données.zip", c("données.RData", "données.tab"))

P.S. La deuxième option a mes préférences.
30/01/2016, 18h55
fcka0001

1 pièce(s) jointe(s)

bonjour,
ci-joint l'archive

ps.: cela pourrait servir à quelqu'un:
j'ai rencontré un pb pour faire le zip (” had status 127") que j'ai réglé en suivant ce tuto
http://stackoverflow.com/questions/2...had-status-127

1 pièce(s) jointe(s)

Alors, la principale source des avertissements était que, contrairement au message #10, il y a bel et bien des couples (x, y) répétés. Le précédent code partait de la supposition que tout couple n'apparaîtrait qu'une seule fois et ça faussait donc les résultats. Cela dit, je n'avais pas fait la recherche des ressemblances dans les deux directions, (x ⟶ y) et (x ⟵ y), et ça aussi faussait les résultats. Le code ici-bas devrait corriger le tir ; je n'en colle que la fonction rassembler, le code complété avec des exemples se trouve dans la pièce jointe.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
rassembler <- function(entrees, fichierIndices, operation = sum) {
    stopifnot(all(sapply(c("dplyr", "foreach", "magrittr", "rlist"), require, character.only = TRUE)))
 
    confinement <- new.env(parent = emptyenv())
 
    tailleInitiale <- nrow(entrees)
    confinement$sorties <- list(x = character(tailleInitiale),
                                y = character(tailleInitiale),
                                N = numeric(tailleInitiale))
    confinement$finis <- numeric(tailleInitiale)
    confinement$symetries <- vector("list", tailleInitiale)
    confinement$nomsSym <- character(tailleInitiale)
    confinement$cptElmts <- confinement$cptFinis <- 0L
 
    actualiserSorties <- function(indices) {
        decalage <- length(indices)
        confinement$finis[seq(from = confinement$cptFinis + 1L,
                              by = 1L,
                              length.out = decalage)] <- indices
        confinement$cptFinis <- confinement$cptFinis + decalage
 
        confinement$cptElmts <- confinement$cptElmts + 1L
 
        confinement$symetries[[confinement$cptElmts]] <- indices
        confinement$nomsSym[confinement$cptElmts] <- unique(entrees$x[indices]) %>% paste(collapse = "-")
 
        confinement$sorties[["x"]][confinement$cptElmts] <- entrees$x[indices][1L]
        confinement$sorties[["y"]][confinement$cptElmts] <- entrees$y[indices][1L]
        confinement$sorties[["N"]][confinement$cptElmts] <- operation(entrees$N[indices])
    }
 
    foreach(i = entrees$x, j = entrees$y, k = seq_along(entrees$x)) %do% {
        if (!(k %in% confinement$finis)) {
            tmpSens <- grep(i, entrees$y, fixed = TRUE)
            tmpAntiSens <- grep(j, entrees$x, fixed = TRUE)
 
            if (all(length(tmpSens) > 0L,
                    length(indicesSym <- tmpSens[tmpSens %in% tmpAntiSens]) > 0L)) {
 
                l <- grep(i, entrees$x, fixed = TRUE)
 
                indRep <- l[entrees$y[l] %in% j]
 
                invIndices <- tmpAntiSens[tmpAntiSens %in% tmpSens]
 
                c(indicesSym, invIndices, indRep) %>% unique %>% sort %>% actualiserSorties
 
            } else {
                actualiserSorties(k)
            }
        }
    }
 
    effectifs <- seq_len(confinement$cptElmts)
 
    confinement$symetries <- confinement$symetries[effectifs]
    names(confinement$symetries) <- confinement$nomsSym[effectifs]
    list.serialize(confinement$symetries, fichierIndices, type = "json", pretty = TRUE)
 
    invisible(data_frame(x = confinement$sorties$x[effectifs],
                         y = confinement$sorties$y[effectifs],
                         N = confinement$sorties$N[effectifs]))
}

Quelques remarques sur la fonction.

Elle donne des sorties « silencieusement » : elles doivent être assignées quelque part (dans une variable, etc.) afin d'être réutilisable.
Elle a un effet de bord de créer un fichier JSON contenant les indices des couples (x, y).
Le contenu du fichier JSON peut-être rechargé dans une session R, voir la pièce attachée. Le JSON est traité comme une liste dont les libellés sont les noms des (x, y), séparés par des tirets et dont les valeurs sont les indices dans donnees où ces couples apparaissent.

02/02/2016, 23h54
fcka0001

aggregate avec condition

Bonsoir,

:merci: à Juliatheric !.

Le programme fonctionne parfaitement !

J'ai mis du temps avant de répondre car j'ai rencontré un nouveau pb, mais lié cette fois au fichier source de données (un double espace avant certains mots qui n'existait pas dans le fichier de l'an dernier...).
Si cela peut servir à quelqu'un, j'ai pu supprimer ce "double espace" avec la commande suivante :

Code:

gsub('[[:space:]]+', ' ', mon_fichier$ma_variable)

.
Pour en revenir au programme, je suis loin d'avoir tout compris, je vais essayer de le décrypter.

@ bientôt
03/02/2016, 16h26
juliatheric

Merci à vous aussi, c'était agréable d'interagir avec vous.