vineri, 18 octombrie 2019

Sorting & Grouping Vectors - VBA


'*****************************************************************
'Urmatorul cod va face:                                          *
'                                                                *
'1.Ordoneaza vectorul                                            *  
'2.Numara grupurile de valori ale vectorului                     *
'3.Calculeaza frecventa de aparitie a fiecarei valori din grup   *
'4.Ordoneaza frecventele de aparitie a valorilor vectorului      *
'5.Grupeaza frecventele de aparitie                              *
'6.Identifica un numar in ce grupa de frecvente se afla          *
'*****************************************************************

'*****************************************************************
'The following code will do:                                     *
'                                                                *
'1.Sort the vector                                               *  
'2.Number the groups of values of the vector                     *
'3.Count the frequency of occurrence of each value in the group  *
'4.Sort the frequencies of the vector values                     *
'5.Group the occurrence frequencies                              *
'6.Identify a number in which frequency group it is              *
'*****************************************************************

'source: https://code-for-vb.blogspot.com/2019/10/sorting-grouping-vectors-vba.html
'please to mention

Option Compare Database
Option Explicit

Private V() As Integer, VRez() As Integer
Private Nr  As Integer, NrGr   As Integer


Sub PornesteVector()
    Nr = InputBox("Introduceti numarul / Input number")
    CheamaVectorSort
End Sub

Sub CheamaVectorSort()
    Dim j          As Integer
    Dim strIni     As String 'acesta este sirul pe care il voi ordona / this is the string I want to sort
    Dim strSplit() As String

    strIni = "-1;4;-1;4;-7;-1;-7;-1;-5;-7;8"
    strSplit = Split(strIni, ";")

    ReDim V(UBound(strSplit)), VRez(UBound(strSplit))
    For j = LBound(strSplit) To UBound(strSplit)
        V(j) = strSplit(j)
        Debug.Print "V(" & j & ") = " & V(j)
    Next j

    For j = LBound(V) To UBound(V) - 1
        VectorSort
    Next j

    Debug.Print "sortez valorile vectorului / sort the vector values:"
    For j = LBound(V) To UBound(V)
        Debug.Print "V(" & j & ") = " & V(j)
        VRez(j) = V(j)
    Next j

    GrupuriV
End Sub

Sub VectorSort()
    Dim a, b, c, d, e
    Dim i As Integer
    Dim VN() As Integer

    ReDim VN(LBound(V) To UBound(V))
    'la prima iteratie compar primele doua valori ale vectorului V
    'inmagazinez valoarea mai mare intr-o variabila fixa (d)
    'si de la a doua iteratie, compar valoarea vectorului V cu valoarea reziduala d
    'la final, trec valorile vectorului nou VN ca valori ale vectorului V

    'at the first iteration I compare the first two values of the vector V
    'store the higher value in a fixed variable (d)
    'and from the second iteration, I compare the value of vector V with the residual value d
    'at the end, pass the values of the new vector VN as values of the vector V

    e = 0
    For i = LBound(V) + 1 To UBound(V)
        e = e + 1
    
        a = V(i)
        If e = 1 Then
           b = V(i - 1)
        Else
            b = d
        End If
    
        If a > b Then
           c = b
           VN(i) = a
        Else
            c = a
            VN(i) = b
        End If
    
        VN(i - 1) = c
        d = VN(i)
    Next i

    For i = LBound(V) To UBound(V)
        V(i) = VN(i)
    Next i
End Sub

Sub GrupuriV()
    Dim k As Integer, gr() As Integer, i As Integer, fr() As Integer, j As Integer
    Dim a As Byte

    Do
      k = 1
      For i = LBound(V) + 1 To UBound(V)
          If V(i) > V(i - 1) Then
             k = k + 1
          End If
      Next i

      Debug.Print k; "grupuri / groups"
      NrGr = k
  
      ReDim gr(k), fr(k)
      k = 1
      gr(1) = V(LBound(V))
      fr(k) = 1
      j = 1
  
      For i = LBound(V) + 1 To UBound(V)
          If V(i) > V(i - 1) Then
             k = k + 1
             j = 1
          Else
              j = j + 1
          End If
          gr(k) = V(i)
          fr(k) = j
      Next i

      Select Case a
      Case 0
           For i = 1 To k
               Debug.Print "gr(" & i & ") = " & gr(i), "freq(" & i & ") = " & fr(i)
           Next i

           ReDim V(k - 1)
           For i = 1 To k
               V(i - 1) = fr(i)
           Next i
       
           Debug.Print "sortez frecventele / sort the frequencies:"
           For i = LBound(V) To UBound(V) - 1
               VectorSort
           Next i
           For i = LBound(V) To UBound(V)
               Debug.Print "V(freq(" & i & ")) = " & V(i)
           Next i
  
      Case Else
           For i = 1 To k
               Debug.Print "gr(" & i & ") = " & gr(i)
           Next i
      End Select
  
      a = a + 1
    Loop Until a = 2

    ApartineV
End Sub

Sub ApartineV()
    Dim i As Integer, a As Integer

    For i = LBound(VRez) To UBound(VRez)
        If Nr = VRez(i) Then
           a = a + 1
        End If
    Next i

    Debug.Print "nr. " & Nr & " apartine gr. " & a & " din " & NrGr
    Debug.Print "no. " & Nr & " belong to gr. " & a & " from " & NrGr
End Sub


'Sa presupunem ca numarul introdus este 8 / Assume that the input number is 8.
'Rezultatul / The result:

V(0) = -1
V(1) = 4
V(2) = -1
V(3) = 4
V(4) = -7
V(5) = -1
V(6) = -7
V(7) = -1
V(8) = -5
V(9) = -7
V(10) = 8
sortez valorile vectorului / sort the vector values:
V(0) = -7
V(1) = -7
V(2) = -7
V(3) = -5
V(4) = -1
V(5) = -1
V(6) = -1
V(7) = -1
V(8) = 4
V(9) = 4
V(10) = 8
 5 grupuri / groups
gr(1) = -7    freq(1) = 3
gr(2) = -5    freq(2) = 1
gr(3) = -1    freq(3) = 4
gr(4) = 4     freq(4) = 2
gr(5) = 8     freq(5) = 1
sortez frecventele / sort the frequencies:
V(freq(0)) = 1
V(freq(1)) = 1
V(freq(2)) = 2
V(freq(3)) = 3
V(freq(4)) = 4
 4 grupuri / groups
gr(1) = 1
gr(2) = 2
gr(3) = 3
gr(4) = 4
nr. 8 apartine gr. 1 din 4
no. 8 belong to gr. 1 in 4

Niciun comentariu:

Trimiteți un comentariu