Avete presente la suspance con cui vi lasciavo in
questo post? Bene, ecco la continuazione... ho implementato (e soprattutto collaudato) la possibilità di sfruttare i quattro operatori semplici di addizione, sottrazione, moltiplicazione e divisione per generare i modi possibili in cui, combinando due o più elementi della tabella iniziale di numeri, si può raggiungere il risultato richiesto.
Ne è venuto fuori un semplice progetto Excel, di cui descrivo lo scenario per poterlo ricostruire (non ho un server su cui depositare i file di esempio purtroppo):
- tabella numeri iniziale (con intestazione): colonna A;
- numero obiettivo: cella D2;
- cella (D4) con hyperlink che scatena il codice sottostante.
Codice del Foglio1:
'codice in Foglio1
Option Explicit
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim v As Variant, arr() As Variant
Dim i As Long, j As Long
If Target.Range(1) = Range("D4") Then
i = [COUNTA(A:A)] - 1
ReDim arr(i) As Variant
For j = 0 To i - 1
arr(j) = Cells(j + 2, "A").Value2
Next
i = 2
Range("G:G").ClearContents
Range("G1") = "Risultati:"
For Each v In Split(find_goal(arr, Range("D2")), vbNewLine)
Cells(i, "G") = v
Cells(i, "G").NumberFormat = "Text"
i = i + 1
Next
MsgBox "Procedura completata.", , [COUNTA(G:G)] - 1 & " operazioni"
End If
End Sub
Codice del Modulo1:
Option Explicit
' fondamentale lasciare gli spazi nella stringa, anche quello finale!
Private Const ALLOWED_OPERATORS = "+ - * / "
Private sTmp As String
Public Function find_goal(nums(), goal As Long) As String
Dim i As Long, j As Long
Dim s As String
Dim ac As Range
Dim k As Variant
Dim nops As Long
Dim m As String
Dim z As String
Dim t As String
Dim q As String
Dim n As Long
' calcola le combinazioni dei numeri della tabella iniziale
' raggruppandoli a coppie, terne, quaterne e così via
For j = 2 To UBound(nums)
s = s & get_combinations(nums, j)
Next
s = Left(s, Len(s) - 2)
' per ogni combinazione applica in sequenza (permutandoli)
' gli operatori della const ALLOWED_OPERATORS
' per esempio la combinazione "5 2" viene trasformata
' in sequenza in "5+2", "5-2", "5*2", "5/2"
' infine valuta l'espressione risultante
' se il risultato è uguale all'obiettivo lo conserva
' e lo restituisce al codice chiamante (in Foglio1)
For Each k In Split(s, vbNewLine)
nops = UBound(Split(k))
z = PermutationsN_P_R(nops)
For j = 1 To Len(z) Step nops
m = Mid(z, j, nops)
t = k
For n = 1 To nops
t = Replace(t, " ", Mid(m, n, 1), , 1)
Next
If Evaluate(t) = goal Then
q = q & t & vbNewLine
End If
Next
Next
find_goal = q
End Function
Public Function get_combinations(ByRef arr(), ByVal r As Long) As String
Dim n As Long, i As Long, j As Long
Dim idx() As Long
Dim s As String
'genera le combinazioni dei numeri nella tabella iniziale
'i numeri vengono combinati a gruppi di r elementi e
'sono separati da uno spazio che poi verrà riempito dagli operatori
'definiti nella const ALLOWED_OPERATORS
n = UBound(arr) - LBound(arr)
ReDim idx(r - 1) As Long
For i = 0 To r - 1
idx(i) = i
Next i
Do
s = ""
For j = 0 To r - 1
s = s & arr(idx(j)) & " "
Next j
get_combinations = get_combinations & Trim(s) & vbNewLine
' localizza il penultimo indice
i = r - 1
While (idx(i) = n - r + i)
i = i - 1
' termine delle iterazioni
If i < 0 Then
Exit Function
End If
Wend
' predispone il successivo ciclo
idx(i) = idx(i) + 1
For j = i + 1 To r - 1
idx(j) = idx(i) + j - i
Next j
Loop
End Function
' PGC Dez 2009
' Permutations of N elements taken 1 to p at a time
Function PermutationsN_P_R(n As Long) As String
Dim vElements As Variant
Dim vResult() As Variant
Dim s As String, i As Long
' genera le permutazioni degli operatori definiti nella costante iniziale
' in modo che vengano assegnati in sequenza agli spazi vuoti della stringa
' contenente la combinazione corrente
' la permutazione è ripetuta per cui si avrà +++, ---, ** e ////
vElements = Split(ALLOWED_OPERATORS)
sTmp = ""
ReDim vResult(n)
s = get_permutationsNPR(vElements, n - 1, vResult, 0, vbNullString)
PermutationsN_P_R = s
End Function
Private Function get_permutationsNPR(vElements As Variant, p As Long, vResult As Variant, iIndex As Integer, s As String) As String
Dim i As Long
' funzione ricorsiva di supporto a PermutationsN_P_R
' crea le permutazioni di n elementi dell'array di operatori
' a gruppi di r
sTmp = s
For i = 0 To UBound(vElements)
vResult(iIndex) = vElements(i)
If iIndex = p Then
sTmp = sTmp & Join(vResult, vbNullString)
Else
Call get_permutationsNPR(vElements, p, vResult, iIndex + 1, sTmp)
End If
Next i
get_permutationsNPR = sTmp
End Function
Penso che con questo sia tutto... divertiamoci magari con una sfida a tempo per vedere chi indovina più combinazioni nel minor tempo :)
posted @ domenica 4 novembre 2018 10:57