-
Articoli
-
Ciao Dopo La richiesta di scrivere su foglio ecco la mia soluzione.
In allegato il relativo foglio di calcolo.
Option Explicit Sub PalindromiPrimiDecEBin() Dim VettoreNumeriPrimi() Dim Numero As Long Dim Divisore As Long Dim NumeroPrimo As Boolean Dim Index As Integer Dim ContaDecPalin As Integer Dim TextDecPalin As String Dim ContaBinPalin As Integer Dim TextBinPalin As String Dim ContaDeBPalin As Integer Dim TextDeBPalin As String Dim NumMax ' Il Vettore VettoreNumeriPrimi ha 5 posizioni che sono ' VettoreNumeriPrimi(1, X) = il Numero Primo in notazione decimale ' VettoreNumeriPrimi(2, X) = il Numero Primo in notazione binaria ' VettoreNumeriPrimi(3, X) = Booleano= True se il Numero Primo in notazione decimale è palindromo ' VettoreNumeriPrimi(4, X) = Booleano= True se il Numero Primo in notazione binaria è palindromo ' VettoreNumeriPrimi(5, X) = Booleano= True se sia il numero in notazione decimale che in notazione binaria sono palindromo ReDim VettoreNumeriPrimi(5, 1) VettoreNumeriPrimi(1, 1) = 2 VettoreNumeriPrimi(2, 1) = DecToBin(2) VettoreNumeriPrimi(3, 1) = True VettoreNumeriPrimi(4, 1) = False VettoreNumeriPrimi(5, 1) = False With Application .DisplayStatusBar = True .Cursor = xlWait End With NumMax = InputBox("Inserisci il numero massimo che vuoi esaminare", "Numero Max", 10000) With Worksheets("Palindromi") .Range("A1").Select .Range("A1") = "Analisi tra il Numero 2 e il numero " & NumMax .Range("A5", "N" & WorksheetFunction.Max(5, .Cells(Rows.Count, 1).End(xlUp).Row)).ClearContents End With Application.Calculation = xlCalculationManual Application.EnableEvents = False Application.StatusBar = "sto Cercando i Numeri Primi E stabilendo se sono Palindromi Salvando in Un Vettore" Application.ScreenUpdating = False For Numero = 3 To NumMax NumeroPrimo = True For Divisore = 1 To UBound(VettoreNumeriPrimi, 2) If ((Numero Mod VettoreNumeriPrimi(1, Divisore)) = 0) Then NumeroPrimo = False Exit For End If Next Divisore If NumeroPrimo Then ReDim Preserve VettoreNumeriPrimi(5, UBound(VettoreNumeriPrimi, 2) + 1) VettoreNumeriPrimi(1, UBound(VettoreNumeriPrimi, 2)) = Numero VettoreNumeriPrimi(2, UBound(VettoreNumeriPrimi, 2)) = DecToBin(Numero) VettoreNumeriPrimi(3, UBound(VettoreNumeriPrimi, 2)) = (VettoreNumeriPrimi(1, UBound(VettoreNumeriPrimi, 2)) = StrReverse(VettoreNumeriPrimi(1, UBound(VettoreNumeriPrimi, 2)))) VettoreNumeriPrimi(4, UBound(VettoreNumeriPrimi, 2)) = (VettoreNumeriPrimi(2, UBound(VettoreNumeriPrimi, 2)) = StrReverse(VettoreNumeriPrimi(2, UBound(VettoreNumeriPrimi, 2)))) VettoreNumeriPrimi(5, UBound(VettoreNumeriPrimi, 2)) = VettoreNumeriPrimi(3, UBound(VettoreNumeriPrimi, 2)) And VettoreNumeriPrimi(4, UBound(VettoreNumeriPrimi, 2)) End If Next Numero ContaDecPalin = 0 TextDecPalin = "" ContaBinPalin = 0 TextBinPalin = "" ContaDeBPalin = 0 TextDeBPalin = "" Application.ScreenUpdating = True Application.StatusBar = "sto preparando il Foglio" Application.ScreenUpdating = False With Worksheets("Palindromi") .Range("A1") = "Analisi tra il Numero 2 e il numero " & NumMax For Index = 1 To UBound(VettoreNumeriPrimi, 2) If Index Mod 100 = 1 Then Application.ScreenUpdating = True Application.StatusBar = "sto Scrivendo sul folgio, sto elaborando i numeri tra " & Index - 1 & " e " & Index + 100 - 1 & " su " & UBound(VettoreNumeriPrimi, 2) Application.ScreenUpdating = False End If .Cells(Index + 4, 1) = VettoreNumeriPrimi(1, Index) .Cells(Index + 4, 2) = VettoreNumeriPrimi(2, Index) .Cells(Index + 4, 3) = IIf(VettoreNumeriPrimi(3, Index), "Palindromo", "") .Cells(Index + 4, 4) = IIf(VettoreNumeriPrimi(4, Index), "Palindromo", "") .Cells(Index + 4, 5) = IIf(VettoreNumeriPrimi(5, Index), "Palindromo", "") If VettoreNumeriPrimi(1, Index) > 1 Then If VettoreNumeriPrimi(3, Index) Then ContaDecPalin = ContaDecPalin + 1 TextDecPalin = TextDecPalin & vbCrLf & VettoreNumeriPrimi(1, Index) .Cells(Rows.Count, 7).End(xlUp).Offset(1, 0) = VettoreNumeriPrimi(1, Index) .Cells(Rows.Count, 8).End(xlUp).Offset(1, 0) = VettoreNumeriPrimi(2, Index) End If If VettoreNumeriPrimi(4, Index) Then ContaBinPalin = ContaBinPalin + 1 TextBinPalin = TextBinPalin & vbCrLf & VettoreNumeriPrimi(2, Index) & " (" & VettoreNumeriPrimi(1, Index) & ")" .Cells(Rows.Count, 10).End(xlUp).Offset(1, 0) = VettoreNumeriPrimi(1, Index) .Cells(Rows.Count, 11).End(xlUp).Offset(1, 0) = VettoreNumeriPrimi(2, Index) End If If VettoreNumeriPrimi(5, Index) Then ContaDeBPalin = ContaDeBPalin + 1 TextDeBPalin = TextDeBPalin & vbCrLf & VettoreNumeriPrimi(1, Index) & " | " & VettoreNumeriPrimi(2, Index) .Cells(Rows.Count, 13).End(xlUp).Offset(1, 0) = VettoreNumeriPrimi(1, Index) .Cells(Rows.Count, 14).End(xlUp).Offset(1, 0) = VettoreNumeriPrimi(2, Index) End If End If Next Index End With Application.ScreenUpdating = True Application.DisplayAlerts = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True MsgBox "I numeri Palindromi tra i numero primi maggiori di 7 e minori di 10000" & vbCrLf & "in base 10 sono: " & vbCrLf & ContaDecPalin & vbCrLf & vbCrLf & "Ovvero: " & vbCrLf & TextDecPalin MsgBox "I numeri Palindromi tra i numero primi maggiori di 7 e minori di 10000" & vbCrLf & "in base 2 sono: " & vbCrLf & ContaBinPalin & vbCrLf & vbCrLf & "Ovvero: " & vbCrLf & TextBinPalin MsgBox "I numeri Palindromi tra i numero primi maggiori di 7 e minori di 10000 " & vbCrLf & "sia in base 10 che in base 2 sono: " & vbCrLf & ContaDeBPalin & vbCrLf & vbCrLf & "Ovvero: " & vbCrLf & TextDeBPalin With Application .StatusBar = False .Cursor = xlDefault End With End Sub Function DecToBin(NumeroDec) As String Dim MioNumDec Dim MioNumBIn MioNumDec = NumeroDec MioNumBIn = "" Do MioNumBIn = (MioNumDec Mod 2) & MioNumBIn MioNumDec = MioNumDec \ 2 Loop Until MioNumDec = 0 DecToBin = MioNumBIn End FunctionPer verificare che i i numeri siano primi non serve dividere per tutti i numeri fino a n-1 si può velocizzare arrivando alla radicequadrata di n e per numeri alti dovrebbe fare la differenza
Hai ragione, me ne ero scordato
.Vedrò di implementarlo nel mio codice.
Grazie.
Come faccio a misurare il tempo per le performance?
Ho sia un portatile vecchio di 10 anni ed il super mostro che ho acquistato un paio di mesi fa.
Imposto una variabile globale, formato TIME, prima ed ultima istruzione e poi faccio la sottrazione?
Ma alla fine la mia soluzione è corretta o no? Io ho trovato una sola occorrenza che abbia sia il numero decimale ed il numero binario palindromi.
Come faccio a misurare il tempo per le performance?
Ho modificato il codice della function fPrimo,con nMax di 100.000 sono passato da 4,34 secondi a 0,81 secondi
(allegato file modificato):`Function fPrimo(ByVal nNum As Long) As Boolean Dim j As Long fPrimo = True If nNum Mod 2 = 0 Then fPrimo = False Else For j = 3 To Sqr(nNum) Step 2 If nNum Mod j = 0 Then fPrimo2 = False Exit For End If Next j End If End Function`Grazie @scossa stasera provo a misurare il tempo di esecuzione coi 2 PC.
Tu quante occorrenze hai trovato?
sono passato da 4,34 secondi a 0,81 secondi
Fischia! Chiamalo miglioramento
Tu quante occorrenze hai trovato?
Fischia! Chiamalo miglioramento
con nMax = 1.000.000 si passsa da oltre 5 minuti a 44 secondi:
@scossa non me ne volere ma non devono essere entrambi palindromi?
Sbaglio mio scusa, non avevo visto la parte di destra della foto
Quindi mi confermi una occorrenza, stasera misurerò le performance.
scossa non me ne volere ma non devono essere entrambi palindromi?
Infatti, guarda il dato in G:H ("b10 e b2"): 313 base 10 che è 100111001 in base 2.
Infatti, guarda il dato in G:H ("b10 e b2"): 313 base 10 che è 100111001 in base 2.
Sisi ti avevo risposto sopra, pardon!!
313 base 10 che è 100111001 in base 2.
Quindi, posssiamo affermare,che in un range da 1 a 1000000 c'è solo un numero PALINDROMO in base 10 e in base 2
Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )Pero mi sorge un dubbio. Questo numero Decimale che ha queste caratteristiche vi ricorda qualcosa?
Il mio avatar è un indizio, ancora uno sforzo
<
Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )br>
Pero mi sorge un dubbio. Questo numero Decimale che ha queste caratteristiche vi ricorda qualcosa?
Sììììììì!!!! la targa della macchina di Paperino!
Sììììììì!!!! la targa della macchina di Paperino!
questo era lo scopo della sfida(da parte mia)
Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )Bravo scossa che ha vinto anche il Jackpot
(io lo sapevo già, era una chicca che mi aveva confidato Albatros)
Direi che possiamo concludere qui... giro solo un'ultima domanda ad Albatros: se hai tempo, dopo aver analizzato i diversi codici, ce n'è uno che ti piace di più per eleganza, concisione, raffinatezza, performance, raggiungimento dello scopo, eccetera? Daresti un tuo parere?
Ricordo che questa sfida è fine a se stessa e non prevede "premi" ma la soddisfazione della partecipazione!
E ricordo anche che prossimamente ce ne saranno altre, e che se volete proporre qualcosa potete farlo anche in autonomia.
Questa è la mia proposta!!!
Allego file di test
Option Explicit Dim i As Long Dim iRow As Integer Sub NumPalindromi() Dim nDecimale, nBinario As Double Application.ScreenUpdating = False MsgBox "Calcolo dei numeri Palindromi in base 10 e il loro binario" & String(2, vbCr) & _ "Speriamo di aver azzeccato!!", vbInformation, "Calcolo nr. palindromi" Range("A:C").ClearContents Range("A1:C1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With With Selection.Font .Color = -16776961 .TintAndShade = 0 End With Selection.Font.Bold = True Cells(1, 1) = "Numeri primi in base 10" Cells(1, 2) = "Numeri binari palindromi corrispondenti ai numeri" & _ " palindormi in base 10" Cells(1, 3) = "Palindromo" Columns(2).Select Selection.NumberFormat = "0" Range("A1").Select iRow = 2 For i = 1 To 10000 If i = StrReverse(i) Then Cells(iRow, 1).Value = i NumeriPrimi iRow = iRow + 1 End If Next i Application.ScreenUpdating = True End Sub Sub NumeriPrimi() Dim iNum As Integer Dim iRadiceDiNumero As Integer Dim iDiv As Integer Dim blNumPrimo As Boolean Dim nBinario As Double 'Un numero è primo se maggiore di 1 ed è divisibile solo per se stesso o per 1 'es._1: (8/8=1; 8:1=8; 8/4=2; 8/2=4) 8 non è un numero primo 'es._2: (11/11=1; 11/1=11; tutti i divisori oltre 11 e 1 darebbero come risultato 'un numero con il resto perciò 11 non è un numero primo e sicuramente sara un numero dispari tranne il nr. 2 blNumPrimo = True 'per trovare il numero primo devo fare la radice quadrata del Numero, dal risultato che ottengo mi prendo la parte intera 'il numero ottenuto identificherà quante volte dovrò dividere il Numero partendo da 3 fino al numero intero della radice 'es.: Numero=31---> ^31=5,56... mi prendo solo l'intero (quindi 5) 'divido 11 31 per 5, poi per 4, e infine per 3 'se da queste divisioni esiste almeno una che da resto "0" allora il numero non è PRIMO iRadiceDiNumero = Int(Sqr(i)) '<-----in una stringa mi ricavo la radice quadrata del numero For iDiv = 3 To iRadiceDiNumero '<------passo al decifrare il numero di iterazioni del ciclo FOR, se va da 3 a un numero inferiore allora il numero è sicuro PRIMO If i Mod iDiv = 0 Then '<----quì mi trovo perché la radice quadrata del numero è superiore al 3 quindi le iterzioni vanno da 3 a salire blNumPrimo = False '<----se il resto della divisione tra il numero e il dividendo del momento da come risultato 0 allora vuol dire che il numero è divisibile non solo per se stesso e 1, quindi non è un numero PRIMO Exit For '<----il numero non è PRIMO quindi esco dal ciclo e passo al prossimo numero End If Next iDiv If blNumPrimo = True Then nBinario = ConversioneDecToBin(i) If nBinario = StrReverse(nBinario) Then Cells(iRow, 2) = nBinario Cells(iRow, 3) = "Palindromo" End If End If End Sub Function ConversioneDecToBin(ByVal x As Integer) As Double Dim intero As Integer Dim decimale As String Dim divisione As Double Dim Risultato As String 'i numeri binari derivano dalla divisione del numero per 2 e se il risultato 'da resto allora si segna "1" altrimenti "0" 'poi si prosegue e si divide la parte intera del quozione ancora per 2 e si continua come sopra 'finché non si arriverà alla divisione = 0/2 'ad esempio il numero binario di "8" si ottiene facendo: '8/2 = 4 (0) '4/2 = 2 (0) '2/2 = 1 (0) '1/2 = 0,5 (1) '0/2 = non esiste risultato 'il numero binario di "8" è il contrario dei risultati ottenuti sopra quindi è "1000" While x > 0 divisione = x / 2 If x Mod 2 = "0" Then decimale = "0" Risultato = Risultato & decimale Else intero = Int(divisione) Risultato = Risultato & "1" End If x = Int(divisione) Wend ConversioneDecToBin = StrReverse(Risultato) End FunctionQuesta è la mia proposta!!!
Direi buona anche questa!
0,81 secondi
Il mio pc dice 0,03 secondi
Allora ho esagerato e ho impostato una ricerca sul primo miliardo di numeri interi. Ma temo di aver preteso troppo... pc inchiodato
Il mio pc dice 0,03 secondi
Ma su 10.000, il mio 0,81 secondi era su 100.000
Finalmente posso andare a dormire soddisfatto
Notebook :
Mostro :
Riporto il codice modificato, i relativi commenti alla fine :
Option Explicit Private Sub cmbEstraPalindromi_Click() 'Dichiara le variabili/oggetti Dim rngCella As Range Dim Numero As Long, Tempo As Double Dim NumeroBinario As String 'Inizializza le variabili/oggetti Set rngCella = Calcolo.Range("A2") Tempo = Timer 'Cicla da 11 a 1.000.000 For Numero = 11 To 1000000 'Verifica che sia un numero palindromo If isPalindromo(CStr(Numero)) Then 'Verifica che sia un numero primo If isPrimo(Numero) Then NumeroBinario = ConvertiInBinario(Numero) 'Verifica che sia un numero palindromo binario If isPalindromo(NumeroBinario) Then rngCella.Value = Numero rngCella.Offset(0, 1).Value = NumeroBinario 'Sposta la cella di una riga in basso Set rngCella = rngCella.Offset(1) End If End If End If 'Riporta il tempo trascorso per 10K e 100K If Numero = 10000 Then Calcolo.Range("D1").Value = Timer - Tempo If Numero = 100000 Then Calcolo.Range("D2").Value = Timer - Tempo If Numero = 1000000 Then Calcolo.Range("D3").Value = Timer - Tempo Next Numero 'Libera la memoria Set rngCella = Nothing End Sub Private Function isPalindromo(ByVal NumeroStringa As String) As Boolean 'Dichira le variabili/oggetti Dim Pos As Integer 'Verifica che il numero sia almeno di 2 caratteri If Len(NumeroStringa) > 1 Then 'Cicla il NumeroStringa dalla posizione 1 alla metà della lunghezza della stessa For Pos = 1 To CInt(Len(NumeroStringa) / 2) 'Verifica che il numero sia palindromo If Mid(NumeroStringa, Pos, 1) <> Mid(NumeroStringa, Len(NumeroStringa) - Pos + 1, 1) Then isPalindromo = False Exit Function End If Next Pos isPalindromo = True End If End Function Private Function isPrimo(ByVal Numero As Long) As Boolean 'Dichiara le variabili/oggetti Dim Ciclo As Long 'Verifica che il numero sia Pari If Numero Mod 2 = 0 Then isPrimo = False Exit Function End If 'Cicla i numeri dispari fino al numero interessato For Ciclo = 3 To Numero Step 2 'Verifica che il numero sia Pari If Numero Mod Ciclo = 0 And Ciclo <> Numero Then isPrimo = False Exit Function End If Next Ciclo 'Numero è primo isPrimo = True End Function Private Function ConvertiInBinario(ByVal Numero As Long) As String 'Dichiara le variabili/oggetti Dim Ciclo As Integer, Parziale As Long, Totale As Long Dim Binario As String 'Inizializza le variabili/oggetti Totale = 0 Binario = "" 'Ciclo dell'esponente For Ciclo = 19 To 0 Step -1 Parziale = (2 ^ Ciclo) 'Cerca il bit più significativo If Numero >= Parziale + Totale Then Binario = Binario & "1" Totale = Totale + Parziale Else Binario = Binario & "0" End If Next Ciclo 'Ritorna la stringa del numero in binario ConvertiInBinario = Mid(Binario, InStr(1, Binario, 1)) End FunctionHo creato la variabile "Tempo as Double" che conterrà il tempo di partenza.
Ho modificato i 3 IF per la verifica del numero, da 3 confronti con 2 AND a 3 confronti annidati. Questo perché ero convinto che il compilatore di Excel eseguisse lo "short....non ricordo", come avviene in C.
Praticamente in C :
If isPalindromo(CStr(Numero)) And isPrimo(Numero) And IsPalindromoBinario(Numero) Thenprima verifica "isPalindromo", se è Falso non esegue gli altri confronti ma ritorna giustamente False.
Invece in VBA, questo non succede, mi sono accorto che eseguiva comunque gli altri 2 confronti nonostante il primo fosse False (terribile...si potrebbero creare scenari inaspettati, avevo tempi abissali anche col Mostro!!!!).
Ho ottimizzato ulteriormente il codice eliminando la function "isPalindromoBinario", creando dapprima il numero binario salvato come stringa e poi lo passo semplicemente alla "isPalindromo" risparmiando un secondo ciclo di conversione.
Goodnight my new friends
OT per lo staff - raga ieri ho compilato il modulo per contattarvi per delle info. Se ho sbagliato a mandarlo, ci riprovo. Grazie
Ho combinato casini coi Tag
adesso non vorrei modificare più prima che il post vada tra lo Spam.Potreste cortesemente sistemarli voi, potreste cancellare anche la frase "e così via in cascata" errata.
grazie
Ottimo lavoro, però ...
prima verifica "isPalindromo", se è Falso non esegue gli altri confronti
le regole del gioco erano diverse:
il quesito chiede di trovare in un RANGE che va da 1 a 10000, i numeri primi(1231), una volta trovati questi numeri primi ...
Ora devo uscire, quando torno provo a semplificare il mio codice, giusto per curiosità.
Ciao A tutti
Per fare un attimo i precisini
Quindi, posssiamo affermare,che in un range da 1 a 1000000 c'è solo un numero PALINDROMO in base 10 e in base 2
L'affermazione è formalmente sbagliata
quella Corretta è
possiamo affermare, che in un range da 1 a 1000000 ci sono 5 numeri PALINDROMI in base 10 e in base 2 (1\1, 3\11, 5\101 7\111, e 313\10011001).
Oppure
possiamo affermare, che in un range da >7 a 1000000 c'è solo un numero PALINDROMO in base 10 e in base 2 (313\10011001)
Ciao @luca73, i moderatori hanno escluso i numeri 1, 3, 5 e 7 perché questi sono primi ma non palindromi essendo composti da un solo numero
infatti se ci fai caso, il mio range di ricerca va da 11 a 1MCiao @lucasr,
E' quello che ho scritto la frase era formalmnete errata nel senso che i numeri inferiori al 7 andavano esclusi.....
Ma era giusto per fare una "polemica" inutile e rimanere sul contesto che rimane quello di scrivere un programma e imparare.
Io oggi metto in cascina l'utilizzo di Collection, Array e Collection generata con Function
Hai ragione! C'è stato un po' di confusione nei primi post, poi rettificati in modo corretto
Io oggi metto in cascina l'utilizzo di Collection, Array e Collection generata con Function
Non ricordo se lo scrissi qui o in un altro forum, per me una giornata senza ridere e/o imparare qualsiasi cosa, è una giornata vuota
Login
Registrati
