Cycles de "1"

bonsoir , j'ai ecris le bout de code suivant qui consiste à partir tableau à une dimension de type array contenant des "0" et des"1"

à dénombrer le nombre de cycles formés par des "1", chaque cycle de "1" de longueur k est encadré par au moins deux 0"

Sub cycles_de_1()
t = Array(0, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 1, 0)
Do
 k = 0
  If t(i) = 1 Then
   Do
    k = k + 1
   Loop Until t(i + k) <> 1
   n = n + 1
   w = w & " , " & k
   i = i + k
   Else
   i = i + 1
  End If
Loop Until i > UBound(t)
MsgBox n & " cycle(s) de 1 de longueurs :" & w
End Sub

mon code marche bien tand que je termine mon tableau par un "0" , en effet si je place un "1" à la fin de mon tableau

Loop Until t(i + k) <> 1

perd son sens . , c'est pas genant de ponctuer le tableau par un zero pour que ca tourne

mais existe t il une autre possibilité de faire sans quoi je garde cette astuce , Merci à vous .

Bonjour,

j'ai seulement ajouté cette ligne avant le msgbox

If t(UBound(t)) = 1 Then w = w & " , " & 1
Sub cycles_de_1()
t = Array(0, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1)
Do
 k = 0
  If t(i) = 1 Then
   Do
    k = k + 1

   Loop Until t(i + k) <> 1
   n = n + 1
   w = w & " , " & k
   i = i + k
   Else
   i = i + 1
  End If
Loop Until i = UBound(t)
If t(UBound(t)) = 1 Then w = w & " , " & 1
MsgBox n & " cycle(s) de 1 de longueurs :" & w
End Sub

re,

il y a un erreur sur ma solution précédente si le tableau fini par plusieurs 1

alors voici une nouvelle proposition,

Sub cycles_de_1()
t = Array(0, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 1, 1, 1)
Do
    k = 0

    If t(i) = 1 Then

        Do
         k = k + 1
         If t(UBound(t)) = 1 Then If i + k = UBound(t) Then n = n + 1: w = w & " , " & k + 1: GoTo fin
        Loop Until t(i + k) = 0

        n = n + 1
        w = w & " , " & k
        i = i + k
    Else

        i = i + 1
    End If

Loop Until i = UBound(t)
fin:
MsgBox n & " cycle(s) de 1 de longueurs :" & w
End Sub

Merci pour votre réponse , mais j'ai testé votre dernier code avec le tableau suivant :

t = Array(0, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1) qui devrait me retourner 6 cycles de "1" de longueurs 1,3,2,1,2,1

mais il me retourne 5 cycles de longueurs 1,3,2,1,2

toutefois cela marche avec l'astuce du 0 placé en fait de tableau sur mon code de depart

je ne sais pas si tu as vu que j'ai fait un autre correction sur la ligne

If t(UBound(t)) = 1 Then If i + k = UBound(t) Then n = n + 1: w = w & " , " & k + 1: GoTo fin

oui justement j'ai repris l’intégralité de votre code corrigé mais cette fois ci avec le tableau :

t = Array(0, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1) qui devrait me retourner 6 cycles de "1" de longueurs 1,3,2,1,2,1

mais me retourne seulement 5 cycles de longueurs 1,3,2,1,2

re,

un autre essaie... corriger

Sub test()
t = Array(0, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1)
For i = LBound(t) To UBound(t)
txt = txt & t(i)
Next i
r = Split(txt, "0")
For y = LBound(r) To UBound(r)
If r(y) <> "" Then n = n + 1: w = w & " , " & Len(r(y))
Next y
MsgBox n & " cycle(s) de 1 de longueurs :" & w
End Sub

merci pour vos réponses , j'ai tenté personnellement ceci et ca marche bien

Sub cycle_de_1()
t = Array(1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1)
For i = 0 To UBound(t)
If t(i) = 0 Then
t(i) = " "
End If
w = w & t(i)
Next
MsgBox w
s = split(w, " ")
For j = 0 To UBound(s)
If s(j) <> "" Then
v = v & " " & Len(s(j))
n = n + 1
End If
Next
MsgBox n & " " & "cycle(s) de 1 de longueurs :" & v
End Sub

..au final ca à meme l'air d'etre semblable à votre réponse , Merci encor

Bonjour à tous,

Une autre piste:

Sub cycles_de_UN()
  Dim i&, n1&, nseq&, t, s$
  t = Array(0, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1)
  For i = LBound(t) To UBound(t)
    If t(i) = 1 Then
      n1 = n1 + 1
    Else
      If n1 > 0 Then: s = s & ", " & n1: nseq = nseq + 1: n1 = 0
    End If
  Next i
  If n1 > 0 Then s = s & ", " & n1: nseq = nseq + 1
  MsgBox nseq & " cycle(s) de 1 de longueurs : " & Mid(s, 3)
End Sub
Rechercher des sujets similaires à "cycles"