funzioni lotto in basic

[i legend]

buon giorno a tutti gli utenti del forum

se qualcuno è interessato potremmo raccogliere il codice di alcune funzioni lotto senza dover ricorrere necessariamente

alle formule anche se sono più veloci.

 'N.B: le formule eseguono i calcoli molto più velocemente  delle funzioni compilate dall'utente
  
  'questa funzione trova la figura di un numero

function fig(a as integer) as integer

        if (a)=0 then
        fig=0
            elseif a>0 and (a) mod 9=0 then
            fig=9
                elseif a>0 and (a) mod 9<>0 then
                fig= (a) mod 9
        end if
end function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' questa funzione ci permette di eseguire svariati calcoli con la regola del fuori 90 es
' fuori90( somma(a1:c15)*d12)  tutta la formula restituisce valore a

function Fuori90(a as long) as integer

   if (a) mod 90=0 then
          Fuori90=90
       else
          Fuori90= (a) mod 90
end if

end function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''

rem questa funzione trova la decina cabalistica di un numero

function decina(a as integer) as integer

dim b as string

  b=format(a,"00")

if a =90 then
   decina=0
       else
   decina=val(left(b,1)
end if

end function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'questa funzione trova la cadenza di un numero ma la formula: destra(a,1) è migliore

function cadenza(a as integer) as integer

        cadenza=right(a,1)

end function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

function Vertibile(a as integer) as integer

  dim b as string,Ris as string

       b=format(a,"00")

          if b="09" then
                ris="90"
                      elseif left(b,1)=right(b,1) then
                               ris=left(b,1)&"9"
                                         elseif right(b,1)="9" then
                                       ris =left(b,1)&left(b,1)
                                else
                                ris=right(b,1)&left(b,1)
             end if

vertibile=val(ris)

end function

queste sono funzioni che ho scritto ( ma non essendo un asso),se volete correggerle o migliorarle fate pure.

Cordiali saluti

I Legend

Aggiungo altre funzioni :

rem questa funzione calcola la distanza ciclometrica tra due estratti

function dis45(a as integer,b as integer) as integer

dis45=abs(a-b)

If dis45>45 then dis45=90-dis45

End function

Rem  questa funzione unisce la decina del primo estratto con l'unita del secondo estratto


Function Uni_Da_Ub(a as integer, b as integer) as integer

dim c as string
dim d as string

C=format(a,"00")
d=format(b,"00")
Uni_Da_Ub=Int(left(c,1)&right(d,1))

if uni_da_ub>90 then uni_da_ub =uni_da_ub mod 90
if uni_da_ub=0 then uni_da_ub = 90

end function

Rem  questa funzione unisce l' unità del primo estratto con la decina del secondo estratto


Function Uni_Ua_Db(a as integer, b as integer) as integer

dim c as string
dim d as string

C=format(a,"00")
d=format(b,"00")
Uni_Ua_Db=Int(Right(c,1)&left(d,1))

if uni_Ua_Db>90 then uni_Ua_Db =uni_Ua_Db mod 90
if uni_Ua_Db=0 then uni_Ua_Db = 90

end function

Verificare sempre sono funzioni che non utilizzo spesso potrebbero esserci degli errori

Cordiali saluti ,
in particolar modo a miguelma e stefania che ci hanno regalato
un codice di livello superiore

I Legend

 

[arcor]

ciao legend la cosa sembra interessante anche se io purtroppo di queste cose e di programmazione non ne capisco nulla.magari con l'aiuto di altri utenti e di luigi (se vuole) cercheremo di mettere in pratica la tua idea.

 

[Alien.]

OTTIMA IDEA,una volta sapevo programmare in basic ma dopo anni non ricordo più un .......tubo.
ho wint 7 con 64 bit.....devo scaricare il basic..................?
grazie.

 

[i legend]

buon giorno
grazie arcor e Alien, queste sono semplici funzioni per poter fare piccole ricerche con qualsiasi foglio di calcolo,che possono tornare utili se qualcuno non vuole usare
le formule che a volte diventano lunghe, e si rischiano errori.Come si evince non sono una cima neanche io, ma mi diverte ragionare sulle cose.
cordiali saluti

I Legend

 

[Alien.]

ciao ma scusa che tipo di basic è ? io usavo il g basic

 

[i legend]

Buon giorno Alien, è il basic che si usa in excel oppure open office no essendoci riferimenti al foglio di lavoro possono andare bene per entrambi. Cordiali saluti I Legend

 

[claudio8]

Innanzitutto un saluto a tutti i partecipanti a questo forum, in particolare al Faraone LuigiB, ai tutti quelli che mi hanno conosciuto, nessuno escluso ed a tutii inuovi.
Questo post mi ha fatto ricordare i tempi del commodore64 a cassetta....
Una domanda mi sorge spontanea nel leggere questo post: tutto sto lavoro di ricerca, a che pro? Non è già tutto presente, questo ed altro in Spaziometria?
Ps: non è mia intenzione fare polemica, ma la curiosità mi giustifica la domanda.

 

[i legend]

buona serata anche a lei claudio8,

Non vedo nessuna vena polemica nella sua domanda. utilizzo per le mie ricerche per puro divertimento un foglio di calcolo.

alcune cose le ho imparate per ,(tentativi ) e pr ovviare a scrivere formule chilometriche .

se altri possono trovarlo utile e usufruirne mi fa piacere condividere .

se invece queste formule sono già presenti nel forum, mi spiace aver aperto un post ripetitivo.

Se così fosse mi potrebbe indicare cortesemente il link?

Cordiali saluti

I Legend.

 

[claudio8]

I legend, potresti specificare meglio come le usi nel foglio di calcolo, magari inviando un piccolo esempio? grazie.

Che io sappia non c'è un post con queste funzioni, io mi riferivo al programma di Luigi (Spaziometria con le funzioni di script)

Saluti

 

[i legend]

buon giorno claudio8, solitamente uso queste funzioni per studiare il quadro estrazionale.

non ho spaziometria ,ma dalle immagini postate ho riscontrato che tutto questo e moltissimo altro è gia presente nel programma.

Quando queste funzioni mi servivano non le ho trovate, così ho voluto metterle a disposizione di altri, che come me si divertono a fare delle piccolissime cose.

sicuramente possono essere compilate meglio. Se qualcuno vuol farlo , personalmente amo imparare.

Cordiali saluti

I Legend

 

[i legend]

Buon giorno a tutti gli utenti,

qualcuno potrebbe compilare 2 funzioni per piramidare una serie di numeri?

so che qui siamo nel mondo della cabala,e, magari moltissimi lo riterranno inutile ma mi piacerebbe imparare a scriverne il codice.

Ci ho provato ma ho scritto un papiro, improponibile.(Funziona ma è lentissimo)

in pratica
una funzione per 2 numeri
una per tre numeri
una per quattro numeri
una per cinque numeri
una finale che racchiude tutte

i numeretti sono formattati "00" e questo non so se ne falsi il risultato.

Parametri :
se si inserisce una sola cella di questa si fa la figura.
Pir_10Celle(a as integer, optional b as integer,optional c as integer,......optional l as integer) as integer

end function

2° funzione:
se c'è un solo valore inserito di questa si fa la figura
Pir1Cella(a as string)as integer

end Function

Qualora fosse possibile chiedo che non si facciano riferimenti specifici al foglio di lavoro ma solo ai parametri passati.

excel , open office ,libre office e altri software purtroppo non combacian


ringrazio anticipatamente chiunque volesse collaborare

Cordiali saluti

I Legend

 

[stefaniavirgus]

ciao , prova a fare cosi


in excel per usarla si scrive dentro una cella ad esempio :

=piramide(A1&B1&C1)

in questo caso le celle a1 ,b1 , c1 contengono 3 numeri
in pratica puoi piramidare tutti i numeri che vuoi perche
i numeri dentro le celle si concatenano nel momento in cui si chiama la funzione.

Function Piramide(StringaNumeri As String) As Integer

    Dim sRet As String, sTmp As String, k As Long, sNumero As String
    
    sRet = StringaNumeri
    
    Do While Len(sRet) > 2
        sTmp = ""
        For k = 1 To Len(sRet) Step 2
            sNumero = Trim(Mid(sRet, k, 2))
            If Len(sNumero) = 2 Then
                sTmp = sTmp & Fuori9(Val(Left(sNumero, 1)) + Val(Right(sNumero, 1)))
            Else
                sTmp = sTmp & sNumero
            End If
        Next
        sRet = sTmp
    Loop
    
    If Val(sRet) > 90 Then
        Piramide = Val(sRet) Mod 90
    Else
        Piramide = Val(sRet)
    End If
    
End Function
Private Function Fuori9(n As Integer) As Long

    If n > 9 Then
        Fuori9 = n Mod 9
    Else
        Fuori9 = n
    End If
End Function

 

[miguelma87]

Ciao. Prova anche questo.
La chiamata alla funzione conterrà i numeri da piramidare Es. Piramide= Pir_fig(12,23,45,.....)

Function Pir_fig(ParamArray Numeri() As Variant)
    ReDim Vet_Numeri(UBound(Numeri))
    conta = 0
    For k = LBound(Numeri) To UBound(Numeri)
         If IsNull(Numeri(k)) = False Then
            Vet_Numeri(conta) = Numeri(k)
            conta = conta + 1
         End If
    Next k
    Num_linee_pir = conta
    ReDim Vet_fig(conta)
    ReDim Vet_linee(Num_linee_pir, conta)
    For k = 0 To conta - 1
       Vet_linee(conta, k + 1) = figura(Vet_Numeri(k))
    Next k
    For Linea = Num_linee_pir - 1 To 1 Step -1
       For num = 1 To Linea
         Vet_linee(Linea, num) = (Vet_linee(Linea + 1, num) + Vet_linee(Linea + 1, num + 1)) Mod 9
       Next num
    Next Linea
    Pir_fig = Vet_linee(1, 1)
    If Pir_fig = 0 Then Pir_fig = 9
End Function

Function figura(n1)
 If n1 > 9 Then
        figura = (CInt(Left(n1, 1)) + CInt(Right(n1, 1))) Mod 9
 Else
        figura = n1
 End If
 If figura = 0 Then figura = 9
 End Function

ciao.

 

[i legend]

Buona serata stefaniavirgus,la ringrazio per la sua partecipazione.

ho provato ad eseguire il codice, non so se dipenda da open office ma la funzione fuori9 nel caso 18,27 ecc mi restituisce 0.

ho adattato il codice ma il calcolo della piramide non mi torna.

le faccio un esempio.

Bari

21

[TD="width: 86"] 16 [/TD]
[TD="width: 86"] 72 [/TD]
[TD="width: 86"] 2 [/TD]
[TD="width: 86"] 44 [/TD]

piramide=>74

eseguo piramide,


eseguo piramide,

211672244 32749468 5924415 526856 78542 6496 146 51

forse eseguiamo la piramide in modo differente.

sarebbe utile se anche altri utenti ci dessero la loro opinione.

nel frattempo le rinnovo i miei più cordiali saluti

grazie

I Legend

 

[i legend]

Buona serata miguelma87 è un piacere risentirla,e leggere il suo codice.
E' elegante e raffinato , se sono aggettivi che si possono abbinare ad un codice.
è un incentivo allo studio.

Purtroppo star basic non supporta il param array.
cercherò di ovviare a questo problema anche per chi come me non utilizza excel.

la ringrazio ancora e le porgo i miei più

Cordiali saluti

I Legend

 

[stefaniavirgus]

ciao , scusami anche io sto imparando la funzione fuori9 hai ragione l'ho scritta sbagliata, vabbe quando un numero è maggiore di 9 ed è divisibile per 9 allora deve dare 9
penso che la correzione sia facile.
Per il resto la piramide che io sappia si calcola unendo tutte le cifre dei numeri e prendendole due a due e si sommano unita e decina doi ogni cifra col fuori9, il tutto si ripete fino ad ottenere un solo numero.

 

[miguelma87]

Ciao.
Ho modificato la funzione eliminando ParamArray. E' un po' meno flessibile della precedente ( che tra l'altro piramida le figure e non le cifre come ho visto dal tuo esempio) ed accetta fino ad un max di 5 numeri in ingresso. Eventualmente modifichi la dimensione degli array interni per un numero maggiore.
La chiamata alla funzione sarà del tipo Piramide=Pir_Cifre(34,12,25,6,13). Vedi se funziona.

Function Pir_Cifre(n1, Optional n2, Optional n3, Optional n4, Optional n5)
    Dim Vet_Numeri(5): Dim Vet_Cifre(10)
    Vet_Numeri(1) = n1: Vet_Numeri(2) = n2: Vet_Numeri(3) = n3: Vet_Numeri(4) = n4: Vet_Numeri(5) = n5
    conta = 0
    For k = 1 To 5
       If Not IsMissing(Vet_Numeri(k)) Then
         Select Case Vet_Numeri(k)
            Case 0: conta = conta
            Case 1 To 9
                    conta = conta + 1
                    Vet_Cifre(conta) = Vet_Numeri(k)
            Case 10 To 90
                    conta = conta + 1
                    Vet_Cifre(conta) = Left(Vet_Numeri(k), 1)
                    conta = conta + 1
                    Vet_Cifre(conta) = Right(Vet_Numeri(k), 1)
         End Select
       End If
    Next k
    Num_linee_pir = conta - 1
    ReDim Vet_linee(Num_linee_pir, conta)
    For k = 1 To conta
       Vet_linee(Num_linee_pir, k) = Vet_Cifre(k)
    Next k
    For Linea = Num_linee_pir - 1 To 1 Step -1
       For num = 1 To Linea + 1
         Vet_linee(Linea, num) = (Vet_linee(Linea + 1, num) + Vet_linee(Linea + 1, num + 1)) Mod 9
       Next num
    Next Linea
    Pir_Cifre = (Vet_linee(1, 1) * 10 + Vet_linee(1, 2)) Mod 90
    If Pir_Cifre = 0 Then Pir_Cifre = 90
    
End Function

 

[i legend]

Buon giorno stefania ,buon giorno miguelma

e buon giorno a tutti gli utenti del forum.

Grazie per i vostri codici.

x stefania, risolto il fuori9 senza alcun problema, la procedura della piramidazione è coretta , non so perchè non torni il risultato.
proverò ancora.

x miguelma,grazie per la modifica,perchè funzioni anche in star basic con il redim, bisogna dichiararlo

 dim Vet_Linee(1,1) as integer

spero che l'istruzione sia corretta

Rinnovo i complimenti per il vostro codice.
oltre una funzione in più ho avuto l'occasione per imparare qualcosa.
grazie anche per questo.

un cordiale saluto a voi e a tutti gli altri utenti.

I Legend

 

[i legend]

rem questa funzione calcola la distanza ciclometrica tra due estratti

function dis45(a as integer,b as integer) as integer

dis45=abs(a-b)

If dis45>45 then dis45=90-dis45

End function

Rem  questa funzione unisce la decina del primo estratto con l'unita del secondo estratto


Function Uni_Da_Ub(a as integer, b as integer) as integer

dim c as string
dim d as string
dim e as integer
C=format(a,"00")
d=format(b,"00")
e=Int(left(c,1)&right(d,1))

if e>90 then 
uni_da_ub =e mod 90
 else
 uni_da_ub=e
 end if
 
if e =0 then uni_da_ub = 90

end function

Rem  questa funzione unisce l' unità del primo estratto con la decina del secondo estratto


Function Uni_Ua_Db(a as integer, b as integer) as integer

dim c as string
dim d as string

C=format(a,"00")
d=format(b,"00")
Uni_Ua_Db=Int(Right(c,1)&left(d,1))

if uni_Ua_Db>90 then uni_Ua_Db =uni_Ua_Db mod 90
if uni_Ua_Db=0 then uni_Ua_Db = 90

end function

Controllare sempre perchè sono funzioni che non utilizzo spesso,anche se possono sempre tornare utili per ricerche e per divertirsi.

un cordiale saluto a tutti

e in particolar modo agli utenti che hanno contribuito al post regalandoci codici e sapere di un altro livello.


I Legend

 

[i legend]

Buona giornata a tutti,
ecco un esempio di quello che possiamo fare con le funzioni che stiamo scrivendo,


casi rintracciati 33, casi analizzati 11


a Miguelma invece chiedo come posso fare ,in modo che la funzione pir_cifre non mi restituisca errore quando si imbatte in un buco estrazionale ossia un Estrazione vuota(0,0,0,0,0).

grazie in anticipo.

Cordiali saluti

I legend