X Joe o chiunque lo sappia

[Oscar]

Joe lo sai come si applica il ridotto tipo N.1 N.2 N.3

Option Explicit
Sub Main
Dim A,B,C,D,E,Numeri
Numeri=10
For A = 1 To Numeri
For B = A + 1 To Numeri
For C = B + 1 To Numeri
For D = C + 1 To Numeri
For E = D + 1 To Numeri
Scrivi A & " " & B & " " & C & " " & D & " " & E
Next
Next
Next
Next
Next
End Sub

 

[joe]

Ciao Oscar,

Non sono in grado di capire la domanda.

Se intendi lo sviluppo combinatorio, senza ripetizioni, è come quello dell'ambo o del terno a seguire.

fino ad N per l'ultimo ciclo più interno e/o nidificato che considera un solo numero da 1 a N = 10.

N-1 per il secondo (ovvero per i 2 numeri o Ambo che dir si voglia)

N-2 per il for ancora più esterno (ovvero per i 3 numeri o per il Terno)

N-3 per la Quartina

N-4 per per il primo ciclo For-Next per le lunghette di 5 numeri.

 

[Oscar]

No ridotto N.1 intendo a garanzia 4 punti con 5 numeri indovinati dovrebbero rimanere circa 22 combinazioni anzichè 252

 

[Mike58]

Ciao Oscar, Joe, per svilupare una data combinazione in un sistema ridotto a garanzia n-1 n-2 etc, si potrebbe usare questo script presente in Test Spaziometria che allaccia e sviluppa le matrici di sistemi ridotti presenti in spaziometria.
ecco lo script e uno screenshot

Option Explicit
Sub Main
   Dim sFile
   Dim aRetColonne
   Dim nGaranzia,nClasse,nColonne,nQNumeri
   Dim k,e,sColonna
   sFile = ScegliFileSistema
   If sFile <> "" Then
      If GetMatriceSistemaRidotto(sFile,aRetColonne,nQNumeri,nColonne,nClasse,nGaranzia) Then
         Call Scrivi("File          : " & sFile)
         Call Scrivi("Per numeri    : " & FormatSpace(nQNumeri,8,True))
         Call Scrivi("Colonne       : " & FormatSpace(nColonne,8,True))
         Call Scrivi("Classe        : " & FormatSpace(nClasse,8,True))
         Call Scrivi("Garanzia      : " & FormatSpace(nGaranzia,8,True))
         Call Scrivi
         Call Scrivi("Sviluppo :",True)
         Call Scrivi
         For k = 1 To nColonne
            sColonna = ""
            For e = 1 To nClasse
               sColonna = sColonna & Format2(aRetColonne(k,e)) & "."
            Next
            sColonna = Left(sColonna,Len(sColonna) - 1)
            Call Scrivi(FormatSpace(k,5,True) & ") " & sColonna)
         Next
      End If
   End If
End Sub
Function ScegliFileSistema()
   Dim sDir
   Dim i
   sDir = GetDirectoryAppData & "sistemi\"
   ReDim aRetFiles(0)
   Call ElencoFileInDirectory(sDir,aRetFiles,".dat")
   i = ScegliOpzioneMenu(aRetFiles,,"Scegli file matrice")
   If i > 0 Then
      ScegliFileSistema = sDir & aRetFiles(i) & ".dat"
   End If
End Function

 

[Oscar]

Ciao Mke58 grazie per il tuo intervento

Io nella mia richiesta non ho specificato bene dove voglio arrivare , ho scritto 4 righe di codice per fare un esempio senza fare troppo casino

allora mi spiego meglio si tratta di un sistema condizionato ridotto , se ho delle condizioni nello sviluppo e alla fine applico una matrice , perdo la garanzia della matrice , quindi devo arrivare ad un ridotto semplice dove a condizioni soddisfatte il sistema mi da la garanzia di un punto in meno se è ridotto di un punto tipo N.1

 

[pfca]

Ciao Oscar vedi se riesci a sfruttare questo codice:

Sub Ridotto()
        Dim n, x, y, r, z, w, NrCol, casi As Integer
        Dim contanum As Byte
        Dim pronostico(10) 'numeri del pronostico
        Dim nr1, nr2, nr3, nr4, nr5 As Byte
        Dim ColT(NrCol, r)
        casi = 0
        For n = 1 To contanum - 4
            For x = n + 1 To contanum - 3
                For y = x + 1 To contanum - 2
                    For z = y + 1 To contanum - 1
                        For w = z + 1 To contanum
                            casi = casi + 1
                            ColT(casi, 1) = pronostico(n)
                            ColT(casi, 2) = pronostico(x)
                            ColT(casi, 3) = pronostico(y)
                            ColT(casi, 4) = pronostico(z)
                            ColT(casi, 5) = pronostico(w)
                        Next w
                    Next z
                Next y
            Next x
        Next n
        For n = 1 To casi
            nr1 = ColT(n, 1)
            nr2 = ColT(n, 2)
            nr3 = ColT(n, 3)
            nr4 = ColT(n, 4)
            nr5 = ColT(n, 5)
            Scrivi nr1 & " " & nr2 & " " & nr3 & " " & nr4 & " " & nr5
        Next n
    End Sub

Sviluppa 10 numeri in cinquine con la riduzione di -1.
Ciao Francesco

 

[Mike58]

Ciao Mke58 grazie per il tuo intervento

Io nella mia richiesta non ho specificato bene dove voglio arrivare , ho scritto 4 righe di codice per fare un esempio senza fare troppo casino

allora mi spiego meglio si tratta di un sistema condizionato ridotto , se ho delle condizioni nello sviluppo e alla fine applico una matrice , perdo la garanzia della matrice , quindi devo arrivare ad un ridotto semplice dove a condizioni soddisfatte il sistema mi da la garanzia di un punto in meno se è ridotto di un punto tipo N.1

Oscar io non uso questa sezione di spaziometria, ma potrebbe venirti utile (immagine 1)
Quello che vorresti con lo script è complicato
poi c'è anche un sottomenu > Sistemi > ImportaSistemi che ti permette di importare il sistema sviluppato file di testo e ridurlo alla garanzia, ma lo salva in file .Dat e non saprei poi come riaprirlo. (immagine 2)
ad ogni modo ti metto le videate e se qualcuno riesce a farlo funzionare bene , ritorna utile anche per me.
1

2

 

[Oscar]

Ringrazio tutti per l'interessamento

 

[Oscar]

Oscar io non uso questa sezione di spaziometria, ma potrebbe venirti utile (immagine 1)
Quello che vorresti con lo script è complicato
poi c'è anche un sottomenu > Sistemi > ImportaSistemi che ti permette di importare il sistema sviluppato file di testo e ridurlo alla garanzia, ma lo salva in file .Dat e non saprei poi come riaprirlo. (immagine 2)
ad ogni modo ti metto le videate e se qualcuno riesce a farlo funzionare bene , ritorna utile anche per me.
1

2

Ciao Mike si lo so che quello che sto cercando di fare è complicato
lo sapevo del programma in spaziometria ,poi programmi del genere se ne trovano anche in rete completamente gratis , ma io ho un programma mio e vorrei farlo girare sul mio
Grazie tanto per i tuoi interventi

 

[Oscar]

Ciao Oscar vedi se riesci a sfruttare questo codice:

Sub Ridotto()
        Dim n, x, y, r, z, w, NrCol, casi As Integer
        Dim contanum As Byte
        Dim pronostico(10) 'numeri del pronostico
        Dim nr1, nr2, nr3, nr4, nr5 As Byte
        Dim ColT(NrCol, r)
        casi = 0
        For n = 1 To contanum - 4
            For x = n + 1 To contanum - 3
                For y = x + 1 To contanum - 2
                    For z = y + 1 To contanum - 1
                        For w = z + 1 To contanum
                            casi = casi + 1
                            ColT(casi, 1) = pronostico(n)
                            ColT(casi, 2) = pronostico(x)
                            ColT(casi, 3) = pronostico(y)
                            ColT(casi, 4) = pronostico(z)
                            ColT(casi, 5) = pronostico(w)
                        Next w
                    Next z
                Next y
            Next x
        Next n
        For n = 1 To casi
            nr1 = ColT(n, 1)
            nr2 = ColT(n, 2)
            nr3 = ColT(n, 3)
            nr4 = ColT(n, 4)
            nr5 = ColT(n, 5)
            Scrivi nr1 & " " & nr2 & " " & nr3 & " " & nr4 & " " & nr5
        Next n
    End Sub

Sviluppa 10 numeri in cinquine con la riduzione di -1.
Ciao Francesco

Hei ciao Francesco che piacere risentirti
ho provato il tuo codice , non parte , ma l'idea mi sembra buona , è quello che sto cercando , domani vedo se trovo la soluzione per farlo girare poi ti faccio sapere
ciao un saluto e grazie

 

[pfca]

Ciao Oscar domani cerco in mattinata di completare il codice e ti invio anche la funzione per la riduzione che purtroppo manca nel codice che ti ho postato.
Francesco

 

[pfca]

Ciao Oscar, ho rivisto il codice che ieri avendo mal interpretato le tue esigenze ti avevo postato.
Il codice non è in Script, ma conoscendo le tue capacità sono sicuro che saprai adattarlo alle tue esigenze.

Public Class Form1
    Dim pronostico(10)    '10 Numeri da mettere in gioco
    Dim NrCol As Integer  'Numero colonne integrali
    Public ColRid As Integer 'Numero Colonne Ridotto
    Public Col(300)
    Public Col2(,), Col3(), ColW(), RedStep As Integer
    Public r As Byte  'Numeri per colonna
    Public n As Byte  'Numeri in gioco
    Public nr As Integer 'Numero colonne Ridotte
    Public rid As Byte 'Riduzione -1, -2, -3 etc.
    Public kRid, Col2H As Integer
    Public FlEx As Boolean
    Public CWCnt As Long
    Dim casi, y, x As Integer
    Dim kk As Byte
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        n = 10 'Numeri Sistema
        r = 5  'Sviluppo in Cinquine
        rid = 1 'Riduzione -1
        For xx = 1 To 10
            pronostico(xx) = xx
        Next xx
        MsgBox("Numri in gioco: " & pronostico(1) & " - " & pronostico(2) & " - " & pronostico(3) & " - " & pronostico(4) & " - " & pronostico(5) _
                & " - " & pronostico(6) & " - " & pronostico(7) & " - " & pronostico(8) & " - " & pronostico(9) & " - " & pronostico(10))

        NrCol = Fattoriale(10) / Fattoriale(r) / Fattoriale(10 - r) 'Numero Colonne Integrale
        MsgBox("Num. Colonne Integrale: " & NrCol)

        ReDim Col3(600)
        ReDim ColW(600)
        nr = 0
        kk = 1
        kRid = r + 1 + rid
        RedStep = 600
        ReDim Col2(r, RedStep)
        Dim SvilFin(,) As Byte
        Comb5(kk)
        MsgBox("Numero colonne sistema ridotto: " & ColRid) 'Numero colonne sistema ridotto
        '----------------------------
        ReDim SvilFin(ColRid, r)
        casi = 0
        For y = 0 To nr - 1
            casi = casi + 1
            For x = 0 To r - 1
                SvilFin(y, x) = pronostico(Val(Col2(x, y)))
            Next x
        Next y
        '----------------------------
        'Riduzione per Cinquine
        casi = 0
        For y = 0 To nr - 1
            casi = casi + 1
            MsgBox("  Giocata: " & casi.ToString("00") & ")    =  " & SvilFin(y, 0).ToString("00") & "   -   " & SvilFin(y, 1).ToString("00") _
                                 & "   -   " & SvilFin(y, 2).ToString("00") & "   -   " & SvilFin(y, 3).ToString("00") _
                                 & "   -   " & SvilFin(y, 4).ToString("00"))

        Next y
    End Sub
    Function Comb5(k)
        Dim j As Integer
        Dim rr As Integer
        Col(k) = Col(k - 1)
        While Col(k) < n - r + k  'n = numeri in gioco, r = Numeri per colonna
            Col(k) = Col(k) + 1
            If k < r Then
                Comb5(k + 1)
            Else
                nr = nr + 1
                For I = 1 To 300
                    Col3(I - 1) = 0
                Next I
                For I = 1 To r
                    Col3(Col(I) - 1) = Col(I)
                Next I
                FlEx = False
                For I = 1 To nr - 1
                    If nr < 2 Then Exit For
                    '--------------------------
                    For k = 1 To r - 1
                        ColW(k) = Col3(k)
                    Next
                    '--------------------------
                    For rr = 0 To 300
                        ColW(rr) = Col3(rr)
                    Next rr
                    '--------------------------
                    For j = 1 To r
                        ColW(Col2(j - 1, I - 1) - 1) = Col2(j - 1, I - 1)
                    Next j
                    '----------------------------
                    CWCnt = 0
                    For rr = LBound(ColW) To UBound(ColW)
                        If ColW(rr) <> 0 Then
                            CWCnt = CWCnt + 1
                        End If
                    Next rr
                    If CWCnt < kRid Then
                        FlEx = True : nr = nr - 1 : Exit For
                    End If
                    '-----------------------------
                Next I
                If FlEx = False Then
                    j = 0
                    For I = 1 To 300
                        If Val(Col3(I - 1)) > 0 Then
                            Col2(j, nr - 1) = Col3(I - 1)
                            j = j + 1
                        End If
                        If j >= r Then Exit For
                    Next I
                    If nr >= RedStep - 5 Then
                        RedStep = RedStep + 300
                        ReDim Preserve Col2(r, RedStep)
                    End If
                    ColRid = nr
                End If
            End If
        End While
    End Function
    Public Function Fattoriale(num As Double) As Double
        If num = 1 Then
            Fattoriale = 1
        Else
            Fattoriale = num * Fattoriale(num - 1)
        End If
    End Function
End Class

Il codice sviluppa per 10 numeri il relativo ridotto a -1 delle 22 colonne relative allo sviluppo in cinquine.
Spero ti sia chiaro altrimenti fai sapere.
Con stima,
Francesco

 

[Oscar]

Ciao Francesco
a me bastava anche solo la function di riduzione per capire cosa dovevo fare adesso ho dato uno sguardo veloce , che poi da function la trasformo in macro per il mio programma (sempre se ci riesco) , ma avevo già intuito che mi serviva una cosa del genere , perchè quello che avevo fatto io aveva una sola funzione e mi dava solo una parte delle colonne per poter arrivare alla copertura di 4 punti con 5 numeri indovinati , quindi stavo già studiando altre funzioni da aggiungere per poter arrivare alla garanzia del 100% (certo che non è una cosa subito semplice mi ci vorrà un pò di tempo)

Per ora ti ringrazio tanto
ciao Oscar

 

[pfca]

Ciao se ti serve una macro questa dovrebbe andare bene, bisogna inserire solo i 3 parametri in B1,B2 e B3,
come puoi capire dalla macro.



Francesco

 

[Oscar]

Francesco tu hai proprio tutto
Granzie ancora Oscar

 

[Oscar]

Urca Francesco è perfetto
appena testato alcune prove questo è di 11 numeri gaanzia 4
Grazie mi hai risolto un bel problema e risparmio di tempo
Che tra l'altro ho diversi programmi che ho fatto tipo nuovo totocalcio e calcio scommesse , che questi non prevedono nessuna riduzione
altri programmi che avevo creato uno per tutti i giochi , ma utilizzavo in tutti il ridotto assoluto con le matrici , oppure solo la parte condizionata , perchè applicando il ridotto assuluto ad un sistema condizionato mi perdeva la granzia

Adesso mi è venuto voglia di rifare quello del MilionDay sempre condizionato e allicando la riduzione

Un saluto Oscar

 

[Oscar]

Però ricontrollando la macro , non è applicabile a un sistema condizionato già esistente per poterlo ridurre , o sbaglio
la macro crea direttamente il sistema ridotto , o mi sto sbagliando

In teoria sviluppo il sistema condizionato , poi alla fine decido se applicare la riduzione o lasciarlo condizionato

 

[pfca]

Ciao Oscar
posso provare a ridurre un sistema già condizionato, però è da capire come hai detto tu quale garanzia si vuole avere.
Per cui ti troverai un sistema iniziale che se rispetta la condizione la deve rispettare integralmente, poi su questo sistema
si può andare a ridurre a -1 o -2.
Se ti serve posso vedere cosa combinare, fammi sapere.
Francesco

 

[Oscar]

Ciao Francesco
Si certo è come dici tu il sistema condizionato a condizioni rispettare realizza la vincita di prima categoria , poi si applica il ridotto 1 che garantisce una vincita di seconda categoria se ci riesci a piu scelte di riduzione tipo R1 - R2 altrimenti va bene anche solo R1 (io non ci sono riuscito )
tieni presente la posizione del sistema parte da "A1" a "E" la prima colonna andando in giù
Grazie di tutto
Oscar

 

[pfca]

Ciao Oscar ho provato su un ridotto condizionato a cercare lo sviluppo a -1, naturalmente lo sviluppo condizionato è integrale.
Da questo integrale cerco tutte quelle colonne che producono il -1 sul condizionato integrale e riesco a ridurre il numero di giocate che
a condizione rispettata al 100% daranno il punteggio di -1, potrei anche cercare il -2.
Avrei però bisogno se non ti crea difficoltà di un file di testo txt di un tuo sistema condizionato sviluppato integralmente e poi io ti invio
la riduzione, se la tua verifica conferma la mia ricerca ti invio la macro, altrimenti proverò qualcosa di diverso.
Francesco