Discussion :

[clmin]

Bonjour à tous,
je viens posez un problème auquel je suis souvent confrontée:

j'ai un tableau constitué d'un segment d'axe ainsi que de une ou plusieurs valeurs associées.
exemple

Debut	Fin	Valeur
1	5	w
3	10	x
7	9	y
11	13	z

correspond à ceci :


Je souhaite obtenir le même type de tableau, mais pour tous les morceaux de segments, c'est-à-dire :

Debut	Fin	Valeur
1	3	w
3	5	w+x
5	7	x
7	9	x+y
9	10	x
10	11	-
11	13	z

Jusqu'à présent, j'ai toujours pu y arriver... avec beaucoup de boucles, quelque chose qui est moins qu'idéal en R.
Je commence par trouver tous les couples de coordonnées (assez facile), ensuite je boucle.
Je peux utiliser merge dans certains cas (1-3 ou 3-5 par exemple), mais pas dans d'autres, comme (5-7). Je dois donc extraire du premier tableau toutes les lignes couvrant ce segment. Et refaire la même chose pour tous les couples ! Mes tableaux ont souvent des dizaines de milliers de lignes, donc c'est très long.

Connaîtriez-vous une manière pas trop lourde d'y arriver ? Un programme complexe ne me dérange pas, je veux juste que ce soit optimisé.

Merci

[dev_ggy]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
df <- c(data[,1], data[,2])
df<-sort(df)
seg = data.frame(deb=numeric(0), fin=numeric(0))
for (i in 1:(length(df)-1)){seg[i, 1]<-df[i]; seg[i, 2]<-df[i+1];}
seg[,3] = "" 
for (i in 1:(length(df)-1)){for (j in 1:length(data[,1])){if (data[j,1]<=seg[i,1] && seg[i,2]<=data[j,2]){if(is.na(seg[i,3])){seg[i,3]<-data[j,3]}else{seg[i,3]<-paste(seg[i,3],data[j,3])}}}}

attention si df a des doublons, il faut dédoublonner avant.

Bonne soirée,
Cordialement.

[clmin]

Merci, mais c'est plus ou moins ce que je faisais.
J’espérais qu'il y avait un moyen d'éviter la double boucle. Ma fonction actuelle n'est pas inexacte, juste très longue.
Y aurait-il un moyen d'utiliser merge, ou une fonction semblable ?
Ou bien une fonction qui fasse "intersection d'ensemble" ?
Je ne sais pas si ces fonctions existent, mais peut-être quelqu'un ici saurait.

[Sengar]

Sans boucle:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
d<-data.frame(debut=c(1,3,7,11),fin=c(5,10,9,13),valeur=c("w","x","y","z"))
n<-unique(c(d$debut,d$fin))
n<-n[order(n)]
 
d2<-expand.grid(valeur=d$valeur,debut=n[1:(length(n)-1)])
d2$fin<-n[match(d2$debut,n)+1]
 
d2$is.in<-d$debut[match(d2$valeur,d$valeur)]<=d2$debut & d$fin[match(d2$valeur,d$valeur)]>=d2$fin
d2<-d2[d2$is.in,]
 
aggregate(data=d2,valeur~debut+fin,paste)

Pas certain que ce soit plus rapide en terme d'execution (le gain de temps depend beaucoup du rapport entre le nombre de morceaux de segments et le nombre de valeurs).
Il sera intéressant de tester sur tes données pour voir ce qui va le plus vite entre les deux méthodes.

[clmin]

Merci, ça va faire de gros tableaux, mais je pense que ce sera moins long quand même.
O(nm) plutôt que O(n^2), ou quelque chose comme ça.
Je vais tester sur mes tableaux.

[juliatheric]

Venant de découvrir l'entrée, une réponse plutôt tardive.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
d <- data.frame(debut = c(1, 3, 7, 11), fin = c(5, 10, 9, 13), valeur = c("w", "x", "y", "z"))
p <- unique(c(d$debut, d$fin)
#dev_ggy
alternative_1 <- function() {
	df<-sort(p)
	seg <- data.frame(deb=numeric(0),fin=numeric(0))
	for (i in 1:(length(df)-1)){
		seg[i, 1]<-df[i]
		seg[i, 2]<-df[i+1]
	}
	seg[,3] <- ""
	for (i in 1:(length(df)-1)){
		for (j in 1:length(d[,1])){
			if (d[j,1]<=seg[i,1] && seg[i,2]<=d[j,2]){
				if(is.na(seg[i,3])){
					seg[i,3]<-d[j,3]
				} else{
					seg[i,3]<-paste(seg[i,3],d[j,3])
				}
			}
		}
	}
	seg
}
 
#Sengar
alternative_2 <- function() {
	n<-p[order(p)]
	d2<-expand.grid(valeur=d$valeur,debut=n[1:(length(n)-1)])
	d2$fin<-n[match(d2$debut,n)+1]
	d2$is.in<-d$debut[match(d2$valeur,d$valeur)]<=d2$debut & d$fin[match(d2$valeur,d$valeur)]>=d2$fin
	d2<-d2[d2$is.in,]
	aggregate(data=d2,valeur~debut+fin,paste)
}
 
alternative_3 <- function(x) {
	fct <- function(x) {
		extremites.courantes <- combn(sort(c(x, p[which(p < x)])), 2)
		localiser.intersections <- function(x) Position(function(y) y == x, extremites.courantes[1,])
		intersections <- sapply(unique(extremites.courantes[1,]), localiser.intersections)
		extremites.courantes[,intersections]
	}
	matrix(sapply(x, fct), nrow = 2)
}

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

> alternative_1()

  deb fin   V3
1   1   3    w
2   3   5  w x
3   5   7    x
4   7   9  x y
5   9  10    x
6  10  11     
7  11  13    z

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

> alternative_2()

  debut fin valeur
1     1   3      w
2     3   5   w, x
3     5   7      x
4     7   9   x, y
5     9  10      x
6    11  13      z

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

> alternative_3(13)

     [,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,]    1    3    5    7    9   10   11
[2,]    3    5    7    9   10   11   13

L'argument de alternative_3 permet de "modulariser" la manipulation des chemins menant à une extrémité donnée étant donné que le problème initial disait que les données réelles sont volumineuses. Exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

> alternative_3(9)

     [,1] [,2] [,3] [,4]
[1,]    1    3    5    7
[2,]    3    5    7    9

Mais la fonction ne gère pas (?encore?) la colonne des étiquettes rattachées aux segments; je n'ai pas saisi comment passer des étiquettes du tableau initial à celles du résultat. Un petit benchmark :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

> system.time(alternative_1())

   user  system elapsed 
  0.007   0.000   0.008

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

> system.time(alternative_2())

   user  system elapsed 
  0.005   0.000   0.005

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

> system.time(alternative_3(13))

   user  system elapsed 
  0.001   0.000   0.001

Il y a bien sûr plein de biais dans cela, le plus évident étant la non-gestion des étiquettes.

[clmin]

Merci, c'est beaucoup mieux que ce que j’utilisais !