Réaffectation d'un nombre sur tirage aléatoire de cellule

Le 08/08/2011 à 15:33

Bonjour à tous,

J'ai écumé les forums afin de trouver une réponse à ma question mais je n'ai pas encore trouvé et donc me voici!

Je travaille sous un logiciel de SIGs (ArcGIS) sur des rasters (pour faire simple des sortes d'images).

J'ai converti ce fichier en .txt que j'ai ensuite importé sous excel.

La matrice compte 5007 colonnes et 7725 lignes. Chaque cellule correspond à un pixel de mon image et son emplacement et donc très important. On y trouve des -9999 (NoData) qui correspondent à une l'absence de valeurs dans l'image et des nombres de 1 à 11 correspondant à un type d'occupation du sol (cultures, jachères, etc...).

Je souhaite faire une répartition aléatoire de croûtes sur mes occupations du sol. Par exemple, je sais que sur les cultures j'ai 15% de la surface qui est occupé par des croûtes A/sur culture et 3% par des croûtes B/sur cultures. Mes cultures ont la valeur 1.

Je souhaite donc pouvoir sélectionner aléatoirement 3% des 1 (cultures) afin d'y affecter une nouvelle valeur (par exemple : 1_B). Il faut également que mes cellules conservent le même emplacement car le fichier sera ensuite réintroduit dans ArcGis!

Je ne sais pas trop comment m'y prendre. J'espère que quelqu'un pourra m'aider!

Merci d'avance,

Oror

Le 08/08/2011 à 16:35

Bonjour,

Pourquoi tu n'utilise pas tout simplement la fonction recherche de excel (Ctrl+F) puis tu fais remplacer 1 par 6 par exemple?

(Attention il faut aller dans option et cocher "Totalité du contenu de la cellule)

Le 08/08/2011 à 17:01

Bonsoir,

Voici une macro qui devrait te faire ça :

Sub Galopin()
Dim i%, S$, o As Range
S = ActiveSheet.UsedRange.Address
i = WorksheetFunction.CountIf(Range(S), 1) * 3 / 100
For Each o In Range(S)
  k = WorksheetFunction.RandBetween(1, 50)
  If k < 3 Then
  o = 2 ' Ici au lieu de 2 mettre une valeur de remplacement
  i = i - 1
  If i = 0 Then Exit For
  End If
Next
End Sub

Nota : J'ai testé avec la valeur de remplacement numérique ( 2 )

Si tu utilises une valeur String "1_B" par exemple, ne pas oublier de mettre les guillemets :

o = "1_B"

[Edit] Correction d'une erreur à la ligne :

i = WorksheetFunction.CountIf(Range(S), 1) * 3 / 100

(Le 1 sur cette ligne est le nombre à remplacer)

A+

Le 09/08/2011 à 11:15

OUAH!

Galopin, ça marche du tonnerre ou presque...

J'ai fait un magnifique copier-coller du script et j'ai fait la modif que tu as indiqué en bas du message, mais je ne sais pas pourquoi, lorsque j'exécute le tout, il me remplace 3% de toutes mes valeurs, pas seulement mes 1 ou mes 2 mais aussi mes -9999. Y a-t-il une raison?

En tout cas un grand merci car c'est déjà une sacré avancée!

MERCI,

Oror

Le 09/08/2011 à 12:55

Bonjour,

C'est l'inconvénient de ne pas joindre de fichier !

J'ai essayé de reconstituer un fichier en collant de manière aléatoire 10 000 x 1

mais je n'ai pas collé de valeur dans les autres cases donc j'ai bien eu 300 x 1 modifiés :

Les autres cellules étant vides n'ont pas réagi...

YAKA rajouter une condition :

Sub Galopin()
Dim i%, S$, o As Range
S = ActiveSheet.UsedRange.Address
i = WorksheetFunction.CountIf(Range(S), 1) * 3 / 100
For Each o In Range(S)
if o = 1 Then
  k = WorksheetFunction.RandBetween(1, 50)
  If k < 3 Then
  o = 2 ' Ici au lieu de 2 mettre une valeur de remplacement
 i = i - 1
  If i = 0 Then Exit For
  End If
End if
Next
End Sub

A+

[Edit] Non testé ! Mébon... ça devrait faire le joint ! Sinon joindre un fichier test.

Le 09/08/2011 à 13:16

Ca le fait tout à fait!!! J'ai testé, ça fonctionne parfaitement!

Merci beaucoup. Y a plus qu'à cliquer : problème résolu!

Oror

Le 09/08/2011 à 14:14

En fait, je me suis rendu compte que ce n'est pas aussi aléatoire que je l'escomptai : Les item remplacés sont très proche de la première ligne.

Je suis en train de plancher sur quelque chose de plus équilibré.

A+

[Edit]

Voici une version avec un aleatoire amélioré :

Sub GalopinV2()
Dim i&, S$, kC%, kR%, kkC%, kkR%
Application.ScreenUpdating = False
With ActiveSheet
S = .UsedRange.Address
kC = .UsedRange.Columns.Count 'Nbre de colonnes
kR = .UsedRange.Rows.Count    'Nbre de lignes
End With
i = WorksheetFunction.CountIf(Range(S), 1) * 3 / 100 'pourcentage cible
Do
  kkC = WorksheetFunction.RandBetween(1, kC)
  kkR = WorksheetFunction.RandBetween(1, kR)
If Cells(kkR, kkC) = 1 Then
  Cells(kkR, kkC) = 2 ' Mettre une valeur de remplacement
  i = i - 1
  If i <= 0 Then Exit Do
End If
Loop
End Sub

Durée d'exécution environ une minute (pour 1 900 000 occurences de 1) soit env 57 000 modifications...

Le 09/08/2011 à 16:42

Que demande le peuple...

Moi j'ai 39 millions de cellules sur mon fichier (d'où la difficulté de le mettre en exemple!) et j'en ai trois comme ça!

Je suppose que ton script peut même se mettre en modèle sous ArcGIS puisque nous disposons également de visual basic mais là pour le coup, ça va tourner très lentement...

Merci encore

Oror

Le 09/08/2011 à 18:21

ménon, ménon : j'ai travaillé sur les 39 000 000 de cellules dans lesquelles il avait 20 % de 1 (1 900 0000) ce qui représente 57 000 remplacements.

Donc le temps ne devrait pas beaucoup changer sauf si tu as 30 ou 40 % de 1 ce qui me parait improbable.

Par contre une modification significative des 3 % entraine une augmentation proportionnelle :

J'ai 2 minutes pour 6 %

Important :

Dans tous les cas il faut modifier la deuxième ligne comme suit :

Dim i&, S$, kC%, kR%, kkC%, kkR%

A+

Le 10/08/2011 à 09:43

Parfait! je l'ai testé et ça fonctionne bien, mais je me rends compte que j'ai oublié un facteur... (difficile de penser à tout en même temps...).

En fait je voudrais faire plusieurs opérations sur le même chiffre. Par exemple, 1% des 1 deviennent des "b" et 2% deviennent des "A". Je peux évidemment le faire de manière successive en recalculant à chaque fois l'effectif de départ pour savoir quel % je cherche à transformer. Mais du coup l'effectif se réduit et le nombre de tirages se réduit à chaque fois ce qui fait que le côté aléatoire est un peu biaisé...

J'ai essayé de rajouter des lignes dans ton dernier script pour faire cette opération en une seule fois mais pas moyen, mon cerveau est HERMÉTIQUE.... Je sollicite une dernière fois de l'aide. Mais si c'est trop compliqué et que ce n'est pas possible de faire des tirages en simultané, je retournerai sur mes bons vieux calculs qui sont un peu plus dans mes cordes!

Merci à toi Galopin et à tous pour votre aide. C'est vraiment cool de trouver des gens aussi sympathiques et prêts à vous aider. Et promis, après j'essaye de m'y mettre vraiment à tout ce langage info!

Oror

Le 10/08/2011 à 11:46

bonjour,

Il y a différente manière de voir les choses...

Probablement la plus simple est de dire on fait un remplacement global des 3% de (1) en B

et ensuite on remplace 33% de B en A. On a bien ainsi 1% de A et 2 % de B par rapport à (1)...

Cette macro a été modifiée pour te permettre ce genre de modification successive : Tous les paramètres ont été placés en tête.

Sub GalopinV3()
Dim a As Byte, b As Byte, c!, S$, kC%, kR%, kkC%, kkR%
a = 1           'valeur à remplacer
b = 21           'valeur de remplacement"
c = 3           'pourcentage cible
Application.ScreenUpdating = False
With ActiveSheet
S = .UsedRange.Address
kC = .UsedRange.Columns.Count
kR = .UsedRange.Rows.Count
End With
i = WorksheetFunction.CountIf(Range(S), a) * c / 100
Do
  kkC = WorksheetFunction.RandBetween(1, kC)
  kkR = WorksheetFunction.RandBetween(1, kR)
If Cells(kkR, kkC) = a Then
  Cells(kkR, kkC) = b
  i = i - 1
  If i <= 0 Then Exit Do
End If
Loop
End Sub

Attention ! Comme tu peux le constater je n'utilise que des valeurs numériques. "A" et "B" ne font pas bon ménage et feraient planter la macro... Libre à toi, si c'est indispensable, d'utiliser pour terminer l'outil de recherche/remplacement d'Excel pour remplacer tous les 21 par "B" et tous les 22 par "A"

Cet outil est très rapide : 15 secondes environ pour remplacer 57 000 x 21 par des "B"

Une dernière remarque. Tu peux utiliser un pourcentage décimal. Par exemple si tu veux faire un deuxième tour et remplacer 1/3 des 21 par des 22 par exemple, tu écriras :

Sub GalopinV3()
Dim a As Byte, b As Byte, c!, S$, kC%, kR%, kkC%, kkR%
a = 1           'valeur à remplacer
b = 21           'valeur de remplacement"
c = 3.33           'pourcentage cible

en utilisant le point comme séparateur décimal...

A+

Le 12/08/2011 à 12:56

C'est super.

Un grand merci à toi.

Bonne continuation!

Oror

Rechercher des sujets similaires à "reaffectation nombre tirage aleatoire"