Base 8 sans 0 et 1

Vous débutez et vous avez besoin d'aide ? N'hésitez pas à poser vos questions
Lord Nelson
Messages : 355
Inscription : dim. 01/déc./2013 15:29

Re: Base 8 sans 0 et 1

Message par Lord Nelson »

Voici le code pour coder et décoder un nombre base 8 sans 0 ni 1
Un très grand merci à Demivec pour son code:

Code : Tout sélectionner

; Codé par Demivec du forum PB le 26/10/2014
Procedure.Q NombreBase8(Nombre.Q)
  Protected i, j, k, NombreSortie.Q
  Static Dim NombreBase(21)
 
  If Nombre < 0: ProcedureReturn: EndIf
 
  i = 0
  While Nombre > 0
    NombreBase(i) = Nombre & %111
    Nombre >> 3
    i + 1
  Wend
 
  If i > 0
    i - 1
  Else
    NombreBase(0) = 0
  EndIf
  NombreBase(0) + 1

  Select i
    Case 2 To 21
      For j = 1 To i
        If NombreBase(j) = 0 And NombreBase(i) > 0
          NombreBase(j) = 8
          NombreBase(j + 1) - 1
          For k = j + 1 To i
            If NombreBase(k) >= 0
              Break
            EndIf
           
            NombreBase(k) + 8
            NombreBase(k + 1) - 1
          Next
        EndIf
      Next
  EndSelect
 
  While NombreBase(i) = 0 And i > 0
    i - 1
  Wend
 
  For j = i To 0 Step -1
    NombreSortie = NombreSortie * 10 + NombreBase(j) + 1
  Next
   
  ProcedureReturn NombreSortie.Q
EndProcedure

; Codé par Demivec du forum PB le 26/10/2014
Procedure.Q Base8Dec(Nombre.Q)
  Protected i, j, k, NombreSortie.Q
  Static Dim NombreBase(21)

  i = -1
  While Nombre > 0
    i + 1
    NombreBase(i) = (Nombre % 10) - 1
    Nombre / 10
  Wend
  NombreBase(0) - 1

  Select i
    Case 2 To 21
      For j = 1 To i
        If NombreBase(j) < 8
          Continue
        Else
          For k = j To i
            NombreBase(k) - 8                         
            If k + 1 > i
              i + 1
            EndIf
           
            NombreBase(k + 1) + 1
            If NombreBase(k + 1) < 8
              Break
            EndIf
          Next
        EndIf
      Next
  EndSelect
 
  For j = i To 0 Step -1
    NombreSortie = NombreSortie << 3 | NombreBase(j)
    NombreBase(j) = 0
  Next
 
  ProcedureReturn NombreSortie
EndProcedure

For Nombre.Q = 0 To 1000
   Debug "" + Nombre.Q + " = " + NombreBase8(Nombre.Q) + " = " + Base8Dec(NombreBase8(Nombre.Q))
Next
Répondre