Excel e gli applicativi Microsoft Office Sfida numero 3: numeri primi gemelli

Login Registrati
Stai vedendo 25 articoli - dal 1 a 25 (di 53 totali)
  • Autore
    Articoli
  • #13824 Score: 0 | Risposta

    vecchio frac
    Senior Moderator
      238 pts

      Per questa sfida (proposta da Albatros54) parliamo della solitudine dei numeri primi.

      I numeri primi possono essere separati da milioni e milioni di numeri o anche da uno solo; in ogni caso, non si toccano (sfiorano) mai, a parte il 2 e il 3. Cioè c'è sempre almeno un numero in mezzo a due numeri primi. Questo fatto è servito da metafora per dare il titolo ad un classico della letteratura recente, "La solitudine dei numeri primi", di Paolo Giordano.
      In uno dei paragrafi del romanzo si esplicita questa metafora: "...In un corso del primo anno Mattia aveva studiato che tra i numeri primi ce ne sono alcuni ancora più speciali. I matematici li chiamano primi gemelli: sono coppie di numeri primi che se ne stanno vicini, anzi, quasi vicini, perché fra di loro vi è sempre un numero pari che impedisce loro di toccarsi per davvero. 
      Numeri come l'11 e il 13 , come il 17 e il 19 , il 41 e il 43, ... Mattia pensava che lui ed Alice erano cosi, due primi gemelli, soli e perduti, vicini ma non abbastanza per sfiorarsi davvero."

      Ecco lo spunto per la sfida numero 3: "Trovare tutti i numeri primi gemelli che si trovano nei primi diecimila numeri interi".
      Forse è troppo facile? tentare non nuoce!

      Un vincolo per la sfida è che occorre far verificare al codice se un numero è primo oppure no, quindi sono vietate tabelle di appoggio (recuperare su internet i numeri primi che si trovano nei primi diecimila numeri sarebbe troppo facile). Sono ammesse tutte le funzioni di VBA e tutte le formule di Excel.

      Le proposte verranno accettate solo fra cinque giorni da adesso: quindi potrete pubblicare i vostri post da sabato prossimo 16 marzo a partire dalle ore 20. Questa discussione viene chiusa da ora e riaperta al momento giusto.

      Eventuali richieste di chiarimento potranno essere fatte in chat o con una mail alla Redazione (i chiarimenti importanti verranno aggiunti a questa discussione).

      Il vincitore verrà stabilito mediante sondaggio aperto a tutta la comunità: il sondaggio durerà qualche giorno (verrà stabilito al momento della chiusura della sfida). Solo le risposte che arriveranno in questa discussione verranno prese in considerazione.
      In caso di parità si terrà conto del criterio cronologico: vince chi pubblica per primo la sua soluzione, ma tenete conto che soluzioni successive annullano le precedenti! Infatti ognuno può pubblicare tutte le soluzioni che vuole, ma solo l'ultima postata verrà tenuta in considerazione in caso di parità di voti ottenuti.

      Il vincitore avrà la soddisfazione di aver partecipato e di aver illustrato qualche tecnica magari nuova o interessante. Riceverà anche una piccola coppa accanto al proprio nick! Inoltre avrà l'onore di proporre la sfida successiva!

      Quindi pronti? ...via! cominciate a pensarci, ci rivediamo qui a partire da sabato prossimo!

      #13987 Score: 0 | Risposta

      vecchio frac
      Senior Moderator
        238 pts

        Sfida aperta! Pubblicate! 😀

        #13988 Score: 0 | Risposta

        scossa
        Partecipante
          18 pts

          Ciao,

          la mia proposta è basata su

          • la UDF bPrimo che restituisce True se il numero in input è un numero primo, altrimenti False.
          • la sub GemelliCoppieArr che utilizza un array e che espone su due colonne (A e B) le coppie di numeri primi gemelli.
          
          Function bPrimo(ByVal nVal As Long) As Boolean
            Dim j As Long
            Dim vRet As Boolean
            
            If nVal < 2 Then
              vRet = False
            Else
              vRet = True
              For j = 2 To (nVal ^ 0.5) 
                If nVal Mod j = 0 Then
                  vRet = False
                  Exit For
                End If
              Next
            End If
            bPrimo = vRet
          End Function
          
          Sub GemelliCoppieArr()
            Dim arrGemelli As Variant, ws As Worksheet
            Dim k As Long, nLastPrimo As Long, i As Long
            Dim nLast As Long
            
            Set ws = ThisWorkbook.Worksheets("Foglio1")
            nLast = Int(nMax / Log(nMax) / 4 * IIf(nLast > 1000000, 2, 1)) + 3 ' vedi nota
            ws.Range("A3:B" & Rows.Count).ClearContents
            Application.ScreenUpdating = False
            arrGemelli = ws.Range("A3:B" & nLast).Value
            nLastPrimo = 2
            
            For k = 3 To nMax
              If bPrimo(k) Then
                If k - nLastPrimo = 2 Then
                  i = i + 1
                  arrGemelli(i, 1) = nLastPrimo
                  arrGemelli(i, 2) = k
                End If
                nLastPrimo = k
              End If
            Next
            ws.Range("A3:B" & nLast).Value = arrGemelli
            Erase arrGemelli
            Set ws = Nothing
            Application.ScreenUpdating = True
          End Sub
          

           

          La scelta di esporli in coppia mi sembra quella formalmente più corretta; in alternativa la sub GemelliArr li espone su un'unica colonna:

          
          Sub GemelliArr()
            Dim arrGemelli As Variant, ws As Worksheet
            Dim k As Long, nLastPrimo As Long, i As Long
            Dim nLast As Long, nSkip As Byte
          
            Set ws = ThisWorkbook.Worksheets("Foglio1")
            nLast = Int(nMax / Log(nMax) / 2 * IIf(nLast > 1000000, 2, 1)) + 3 ' vedi nota
            ws.Range("D3:D" & Rows.Count).ClearContents
            Application.ScreenUpdating = False
            arrGemelli = Range("D3:D" & nLast).Value
            nLastPrimo = 2
            For k = 3 To nMax
              If bPrimo(k) Then
                If k - nLastPrimo = 2 Then
                  i = i + nSkip
                  arrGemelli(i, 1) = nLastPrimo
                  i = i + 1
                  arrGemelli(i, 1) = k
                  nSkip = 0
                Else
                  nSkip = 1
                End If
                nLastPrimo = k
              End If
            Next
            ws.Range("D3:D" & nLast).Value = arrGemelli
            Erase arrGemelli
            Set ws = Nothing
            Application.ScreenUpdating = True
          End Sub
          

           

          Ho provato anche una versione utlizzando Dictionary, le prestazioni sono quasi identiche alla versione array:

          
          Sub GemelliDict()
            Dim dictGemelli As Object 'oppure Scripting.Dictionary se mettiamo il riferimento a Microsoft Scripting Runtime
            Dim k As Long, nLastPrimo As Long
            Dim aVals As Variant
           
            Range("C3:D" & Rows.Count).ClearContents
            Application.ScreenUpdating = False
            Set dictGemelli = CreateObject("Scripting.Dictionary") 'New Dictionary
            nLastPrimo = 2
            
            For k = 3 To nMax
              If bPrimo(k) Then
                If k - nLastPrimo = 2 Then
                  dictGemelli.Add Str(nLastPrimo) & Str(k), Array(nLastPrimo, k)
                End If
                nLastPrimo = k
              End If
            Next
            aVals = dictGemelli.Items
            Range("C3:D" & dictGemelli.Count + 2).Value = Application.Transpose(Application.Transpose(aVals))
            Set dictGemelli = Nothing
            Application.ScreenUpdating = True
          End Sub
          
          

           

          N.B.: attenzione, dichiarare in testa al modulo la costante nMax per impostare il valore superiore dell'intervallo di numeri da elaboratre:

          
          Const nMax As Long = 10000  ' limite superiore intervallo di ricerca dei gemelli,
                                      ' variare a piacere
          

           

          una nota riguardo l'istruzione nLast = Int(nMax / Log(nMax) / 4 * IIf(nLast > 1000000, 2, 1)) + 3
          x/log(x) è una buona approssimazione del numero di numeri primi non maggiori di x; i numeri primi gemelli sono meno di 1/2 dei n. primi e quindi le coppie sono meno di 1/4 dei n. primi nell'intervallo in esame (il + 3 è l'offset del range)

          #13992 Score: 0 | Risposta

          vecchio frac
          Senior Moderator
            238 pts

            Abbiamo scatenato scossa 😛   

            #13993 Score: 0 | Risposta

            vecchio frac
            Senior Moderator
              238 pts

              La mia proposta è molto più banale  

              Public Function is_prime(num As Variant) As Boolean
              Dim i As Long
               
                  If (num = 1) Or (num = 2) Or (num = 3) Then
                      is_prime = True
                      Exit Function
                  End If
                  
                  If (num < 1) Or (num <> CLng(num)) Then
                      is_prime = False
                      Exit Function
                  End If
                  
                  For i = 2 To CLng(Sqr(num))  
                      If num Mod i = 0 Then
                          is_prime = False
                          Exit Function
                      End If
                  Next i
                  
                  is_prime = True
                  
              End Function
               
               
              Sub test_VF()
              Dim i As Long
              Dim ri As Long
              Dim t1 As Single
              Dim j As Long, t As Long
              
                  Worksheets("foglio2").Select
                  Range("A:B").ClearContents
                  
                  Cells(1, "A") = 1
                  Cells(1, "B") = 2
                  Cells(2, "A") = 2
                  Cells(2, "B") = 3
              
                  ri = 3
                  
                  For i = 3 To 10000
                      If is_prime(i) <> False Then
                          If is_prime(i + 2) <> False Then
                              Cells(ri, "A") = i
                              Cells(ri, "B") = i + 2
                              ri = ri + 1
                          End If
                      End If
                  Next i
                  MsgBox "Fatto"
              End Sub
              #13995 Score: 0 | Risposta

              Marius44
              Moderatore
                51 pts

                Salve a tutti

                le mie proposte (ma per la verità è una sola in quattro varianti) è la seguente

                Option Explicit
                
                Sub NumeriPrimiGemelli()
                Dim numeri(1 To 5000) As Integer, gemelli() As Integer
                Dim i As Long, j As Long, a As Long
                Dim starting As Single, finished As Single
                
                Range("A:B").ClearContents
                starting = Timer
                For i = 1 To 10000
                  If Application.IsOdd(i) Then
                    a = a + 1
                    numeri(a) = i
                  End If
                Next i
                For i = UBound(numeri) To 2 Step -1
                  For j = i - 1 To 2 Step -1
                    If numeri(i) / numeri(j) = Int(numeri(i) / numeri(j)) Then
                      numeri(i) = 0
                      GoTo prox
                    End If
                  Next j
                prox:
                Next i
                'assegna matrice escludendo lo zero
                a = 1
                For i = 1 To UBound(numeri)
                  If numeri(i) <> 0 Then
                    ReDim Preserve gemelli(1 To a)
                    gemelli(a) = numeri(i)
                    a = a + 1
                  End If
                Next i
                gemelli(1) = 2
                a = 0
                For i = 2 To UBound(gemelli) - 1
                  If gemelli(i - 1) + 2 = gemelli(i) Then
                    a = a + 1
                    Cells(a, 1) = gemelli(i - 1)
                    Cells(a, 2) = gemelli(i)
                  End If
                Next i
                finished = Timer
                Range("M3") = finished - starting
                End Sub
                
                Sub StessaCella_uno()
                Dim numeri(1 To 5000) As Integer, gemelli() As Integer
                Dim i As Long, j As Long, a As Long
                Dim starting As Single, finished As Single
                Range("D:D").ClearContents
                starting = Timer
                For i = 1 To 10000
                  If Application.IsOdd(i) Then
                    a = a + 1
                    numeri(a) = i
                  End If
                Next i
                For i = UBound(numeri) To 2 Step -1
                  For j = i - 1 To 2 Step -1
                    If numeri(i) / numeri(j) = Int(numeri(i) / numeri(j)) Then
                      numeri(i) = 0
                      GoTo prox
                    End If
                  Next j
                prox:
                Next i
                'assegna matrice escludendo lo zero
                a = 1
                For i = 1 To UBound(numeri)
                  If numeri(i) <> 0 Then
                    ReDim Preserve gemelli(1 To a)
                    gemelli(a) = numeri(i)
                    a = a + 1
                  End If
                Next i
                gemelli(1) = 2
                a = 0
                For i = 2 To UBound(gemelli) - 1
                  If gemelli(i - 1) + 2 = gemelli(i) Then
                    a = a + 1
                    Cells(a, 4) = gemelli(i - 1) & " - " & gemelli(i)
                  End If
                Next i
                finished = Timer
                Range("M4") = finished - starting
                End Sub
                
                Sub StessaCella_due()
                Dim numeri(1 To 5000) As Integer, gemelli() As Integer
                Dim i As Long, j As Long, a As Long, b As Long
                Dim starting As Single, finished As Single
                Dim ctr As Boolean
                a = 1
                Range("I:I").ClearContents
                starting = Timer
                numeri(1) = 1
                numeri(2) = 2
                a = 3
                'avvio ciclo per creare matrice dal n.3 in poi
                For i = 3 To 10000
                  If Application.IsOdd(i) Then 'se è dispari
                    ctr = False
                    For j = a - 1 To 2 Step -1
                      If i / numeri(j) = Int(i / numeri(j)) And i <> numeri(j) Then
                        ctr = True
                        Exit For
                      End If
                    Next j
                    If ctr = False Then 'non è divisibile per i precedenti
                      If i - numeri(a - 1) = 2 Then
                        b = b + 1
                        Cells(b, 9) = numeri(a - 1) & " - " & i 'scrive gemelli
                      End If
                      numeri(a) = i 'assegna alla matrice
                      a = a + 1
                    End If
                  End If
                Next i
                finished = Timer
                Range("M5") = finished - starting
                End Sub
                
                Sub StessaCella_tre()
                Dim numeri(1 To 5000) As Integer, gemelli() As String
                Dim i As Long, j As Long, a As Long, b As Long
                Dim starting As Single, finished As Single
                Dim ctr As Boolean
                a = 1
                Range("K:K").ClearContents
                starting = Timer
                numeri(1) = 1
                numeri(2) = 2
                a = 3
                'avvio ciclo per creare matrice dal n.3 in poi
                For i = 3 To 10000
                  If Application.IsOdd(i) Then 'se è dispari
                    ctr = False
                    For j = a - 1 To 2 Step -1
                      If i / numeri(j) = Int(i / numeri(j)) And i <> numeri(j) Then
                        ctr = True
                        Exit For
                      End If
                    Next j
                    If ctr = False Then 'non è divisibile per i precedenti
                      If i - numeri(a - 1) = 2 Then
                        b = b + 1
                        ReDim Preserve gemelli(1 To b)
                        gemelli(b) = numeri(a - 1) & " - " & i
                        'Cells(b, 9) = numeri(a - 1) & " - " & i 'scrive gemelli
                      End If
                      numeri(a) = i 'assegna alla matrice
                      a = a + 1
                    End If
                  End If
                Next i
                For i = 1 To UBound(gemelli)
                  Cells(i, 11) = gemelli(i)
                Next i
                finished = Timer
                Range("M6") = finished - starting
                'Stop
                End Sub
                
                

                Allego il file

                Ciao,

                Mario

                 

                Allegati:
                You must be logged in to view attached files.
                #13997 Score: 0 | Risposta

                vecchio frac
                Senior Moderator
                  238 pts

                  Grande Marius   

                  #13998 Score: 0 | Risposta

                  Mirko
                  Partecipante
                    2 pts

                    Salve

                    Uno non è un numero primo...

                    i numeri gemelli non comprendono la serie (1-2) e (2-3)

                    Questa la macro che utilizzo:

                    Option Explicit
                    
                    Sub TestCollection()
                        Application.ScreenUpdating = False
                        Dim X As Long, Test   As Long, Pos() As Variant, First() As Byte
                        Const ToNumber        As Long = 10000
                        Dim collMarks         As New Collection
                        First = ChrW(1) & ChrW(257) & String(ToNumber / 2, ChrW(256))
                        Test = 3
                        Do While Test <= ToNumber
                          For X = 2 * Test To ToNumber Step Test
                            First(X) = 0
                          Next
                          Test = Test + 1 - (Test > 2)
                        Loop
                        With collMarks
                          Test = 0
                          For X = 1 To ToNumber
                            If First(X) = 1 Then
                              If Test + 2 = X Then
                                .Add X
                              End If
                              Test = X
                            End If
                          Next
                          ReDim Pos(1 To .Count + 1, 1 To 2)
                          For X = 1 To .Count
                              Pos(X, 1) = .item(X) - 2
                              Pos(X, 2) = .item(X)
                          Next
                          Pos(1, 1) = "< Numeri gemelli >"
                          Pos(1, 2) = ""
                          Cells(1, 1).Resize(.Count, 2).Value = Pos
                        End With
                    '    Application.ScreenUpdating = True
                    End Sub
                    #13999 Score: 0 | Risposta

                    vecchio frac
                    Senior Moderator
                      238 pts

                      Grazie della partecipazione Mirko! Io nel mio codice ho lasciato volutamente le coppie (1, 2) e (2, 3) anche se non sono strettamente "numeri primi gemelli", perchè non son separati da un numero (al più sono fratellastri), però tecnicamente 1 è numero primo, infatti soddisfa la condizione di "essere divisibile per se stesso e per uno" 😛

                      In ogni caso, poichè non c'è in palio un supercomputer quantistico offerto da Admin, accetteremo sia le soluzioni con, che le soluzioni senza, i primi tre numeri 🙂

                      #14003 Score: 0 | Risposta

                      scossa
                      Partecipante
                        18 pts

                        duplicato

                        #14004 Score: 0 | Risposta

                        vecchio frac
                        Senior Moderator
                          238 pts

                          scossa ha scritto:

                          Velocissima la soluzione proposta da Mirko!!

                          Non ho ancora messo insieme le soluzioni per provare i tempi però sono curioso anche io! 🙂

                          Sull'ammissibilità di 1 a numero primo.... mi hanno già cazzuolato in privato quindi ok, mi arrendo   

                          #14006 Score: 0 | Risposta

                          albatros54
                          Moderatore
                            81 pts

                            Sol.1: PRIMI GEMELLI CON MATRICE

                            'faccio partire la matrice da 1
                            Option Base 1
                            Option Explicit
                            Sub numeripimiconmatrice()
                            
                                Dim numero As Double
                                Dim i As Double
                                Dim a As Double
                                Dim primo As Boolean
                                Dim row As Integer, lastrow As Integer
                                Dim lista As Range
                                Dim cl As Variant
                                Dim meno As Integer
                                Dim Matrice() As Double
                                Dim j As Long, d As Long, totale As Long
                                j = 1
                                row = 2
                                numero = 10000    'InputBox("inserire un numero")
                                ActiveSheet.usedrange.Clear
                                For i = 2 To numero
                                    primo = True
                                    'Quindi, per verificare se un numero  è primo è
                                    'sufficiente provare a dividerlo per tutti gli interi
                                    'minori di esso
                                    For a = 2 To i - 1
                                        If (i Mod a = 0) Then
                                            primo = False
                                        End If
                                    Next
                                    If (primo = True) Then
                                        ReDim Preserve Matrice(j)
                                        Matrice(j) = i
                                        j = j + 1
                                    End If
                                Next
                                a = 2
                                lastrow = Cells(Rows.Count, 1).End(xlUp).row
                                Set lista = Range("a2:a" & lastrow)
                                For d = LBound(Matrice) To UBound(Matrice) - 1
                                    meno = Matrice(d + 1) - Matrice(d)
                                    If meno = 2 Then
                            
                                        Cells(a, 2) = "[" & Matrice(d) & " ; " & Matrice(d + 1) & "]"
                                        a = a + 1
                            
                                    Else
                                    End If
                                Next
                                With Range("a1:b1").Font
                                    With Range("a1:b1").Interior
                                        .Pattern = xlSolid
                                        .PatternColorIndex = xlAutomatic
                                        .ThemeColor = xlThemeColorAccent5
                                        .TintAndShade = -0.249946592608417
                                        .PatternTintAndShade = 0
                                    End With
                            
                            
                                    .Name = "Calibri"
                                    .FontStyle = "Corsivo grassetto"
                                    .Size = 20
                                    .Strikethrough = False
                                    .Superscript = False
                                    .Subscript = False
                                    .OutlineFont = False
                                    .Shadow = False
                                    .Underline = xlUnderlineStyleNone
                                    .ThemeColor = xlThemeColorAccent2
                                    .TintAndShade = 0.399975585
                                    .ThemeFont = xlThemeFontMinor
                                End With
                                totale = UBound(Matrice)
                                Cells(1, 1).Value = "I Numeri Primi da 2 a 10000 sono " & totale
                                lastrow = Cells(Rows.Count, 2).End(xlUp).row - 1
                                Cells(1, 2).Value = "Primi Gemelli sono " & lastrow
                                Columns("A:B").EntireColumn.AutoFit
                                Columns("A:B").Select
                                With Selection
                                    .HorizontalAlignment = xlCenter
                                    .VerticalAlignment = xlBottom
                                End With
                                Range("a1").Select
                            End Sub
                            

                            Sol2: PRIMI GEMELLI CON COLONNA

                            Option Explicit
                            
                            Sub numeripimidefinitivo()
                            'con appoggio su colonna dei numeri primi
                            Dim numero As Double
                            Dim i As Double
                            Dim a As Double
                            Dim primo As Boolean
                            Dim row As Integer, lastrow As Integer, lastrow1 As Long
                            Dim lista As Range
                            Dim cl As Variant
                            Dim meno As Integer
                            
                            row = 2
                            numero = 10000 'InputBox("inserire un numero")
                            ActiveSheet.usedrange.Clear
                            For i = 2 To numero
                            primo = True
                            'Quindi, per verificare se un numero  è primo è
                            'sufficiente provare a dividerlo per tutti gli interi
                            'minori di esso
                            For a = 2 To i - 1
                            If (i Mod a = 0) Then
                            primo = False
                            End If
                            Next
                            If (primo = True) Then
                            'MsgBox (i)
                            
                            Cells(row, 1) = i
                            row = row + 1
                             
                            End If
                             Next
                            
                             a = 2
                             lastrow = Cells(Rows.Count, 1).End(xlUp).row
                             Set lista = Range("a2:a" & lastrow)
                             For Each cl In lista
                             meno = cl.Offset(1, 0) - cl
                             If meno = 2 Then
                             'MsgBox "trovato"
                              Cells(a, 2) = "[" & cl & " ; " & cl.Offset(1, 0) & "]"
                              a = a + 1
                             
                             Else
                            End If
                             Next
                            lastrow1 = Cells(Rows.Count, 1).End(xlUp).row - 1
                            With Range("a1:b1").Font
                            With Range("a1:b1").Interior
                                    .Pattern = xlSolid
                                    .PatternColorIndex = xlAutomatic
                                    .ThemeColor = xlThemeColorAccent5
                                    .TintAndShade = -0.249946592608417
                                    .PatternTintAndShade = 0
                                End With
                                    
                               
                                    .Name = "Calibri"
                                    .FontStyle = "Corsivo grassetto"
                                    .Size = 20
                                    .Strikethrough = False
                                    .Superscript = False
                                    .Subscript = False
                                    .OutlineFont = False
                                    .Shadow = False
                                    .Underline = xlUnderlineStyleNone
                                    .ThemeColor = xlThemeColorAccent2
                                    .TintAndShade = 0.399975585
                                    .ThemeFont = xlThemeFontMinor
                            End With
                            Cells(1, 1).Value = "I Numeri Primi da 2 a 10000 sono  " & lastrow1
                            lastrow = Cells(Rows.Count, 2).End(xlUp).row - 1
                            Cells(1, 2).Value = "Primi Gemelli sono " & lastrow
                            Columns("A:B").EntireColumn.AutoFit
                             Columns("A:B").Select
                                With Selection
                                    .HorizontalAlignment = xlCenter
                                    .VerticalAlignment = xlBottom
                                     End With
                                      Range("a1").Select
                            End Sub

                             

                            Nota a margine:"tutti i numeri naturali sono divibili per l'unita e per se stessi...quindi non sono numeri primi  

                             

                             [Edit by ADMIN -- riuscito ad inserire il codice sostituendo le parentesi tonde con quadre alla riga Cells(a, 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 )
                            Allegati:
                            You must be logged in to view attached files.
                            #14014 Score: 0 | Risposta

                            vecchio frac
                            Senior Moderator
                              238 pts

                              Adesso mi sembra allegato regolarmente, però non saprei risolvere il messaggio di errore... forse Admin ha una risposta 🙂

                              E mi piace la tua deduzione logica (anche se intendevi dire che tutti i numeri SONO numeri primi) 😀

                              #14021 Score: 0 | Risposta

                              vecchio frac
                              Senior Moderator
                                238 pts

                                Niente da fare, nemmeno togliendo la prima riga di codice commentata.

                                #14024 Score: 0 | Risposta

                                albatros54
                                Moderatore
                                  81 pts

                                  ho provato ad inserire un codice diverso, nella sezione "area51" e non ho avuto alcun problema.

                                  Il codice incriminato sicuramnete è quello che ho postato con il file, pero non riesco a capire il perchè  

                                  A questo punto,non potendo inserire il codice  non posso partecipare alla sfida  

                                   

                                  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 )
                                  #14025 Score: 0 | Risposta

                                  Luca73

                                    Ciao a tutti appena accedo al mio computer vi invio anche le mi proposte. 

                                     

                                    #14028 Score: 0 | Risposta

                                    Luca73
                                    Partecipante
                                      54 pts

                                      Ciao innanzitutto io ho considerato i numeri da 2 a 10000 pertanto l'1 l'ho escluso 

                                      Prima soluzione la più compatta senza function.

                                      Sub NumPrimiGemelliRidDir()
                                      Dim NumPrimo(2 To 10000) As Boolean
                                      Dim Indice01
                                      Dim Indice02
                                      
                                      NumPrimo(2) = True
                                      
                                      For Indice01 = 3 To 10000 Step 2
                                          NumPrimo(Indice01) = True
                                      Next Indice01
                                      For Indice01 = 3 To (10000 - 1) Step 2
                                          If NumPrimo(Indice01) Then
                                              For Indice02 = Indice01 + 2 To 10000 Step 2
                                                  If ((Indice02 Mod Indice01) = 0) Then
                                                      NumPrimo(Indice02) = False
                                                  End If
                                              Next Indice02
                                          End If
                                      Next
                                      For Indice01 = 5 To 10000 Step 2
                                          If NumPrimo(Indice01) And NumPrimo(Indice01 - 2) Then
                                              With Range("O" & Rows.Count).End(xlUp)
                                                  .Offset(1, 0) = Indice01 - 2
                                                  .Offset(1, 1) = Indice01
                                              End With
                                          End If
                                      Next
                                      MsgBox "Finito"
                                      End Sub
                                      

                                      Quella sotto riportata invece è più compatta ma con una function.

                                      Function NumPrimo2(Numero As Long) As Boolean
                                      Dim index
                                      NumPrimo2 = True
                                      For index = 2 To Int(Sqr(Numero) + 1)
                                          If ((Numero / index) = (Numero \ index)) Then
                                              NumPrimo2 = False
                                              Exit For
                                          End If
                                      Next index
                                      End Function
                                      
                                      Sub NumeriPrimiTwin2()
                                      Dim Indice As Long
                                      Dim PrimiGemelli()
                                      ReDim PrimiGemelli(2, 0 To 0)
                                      For Indice = 4 To 10000
                                          If NumPrimo2(Indice) Then
                                              If NumPrimo2(Indice - 2) Then
                                                  ReDim Preserve PrimiGemelli(2, 0 To UBound(PrimiGemelli, 2) + 1)
                                                  PrimiGemelli(1, UBound(PrimiGemelli, 2)) = Indice - 2
                                                  PrimiGemelli(2, UBound(PrimiGemelli, 2)) = Indice
                                              End If
                                          End If
                                      Next
                                      For Indice = 1 To UBound(PrimiGemelli, 2)
                                          Range("G1").Offset(Indice - 1, 0) = PrimiGemelli(1, Indice)
                                          Range("G1").Offset(Indice - 1, 1) = PrimiGemelli(2, Indice)
                                      Next
                                      
                                      End Sub

                                      La function sopra utilizzata può essere sostituita da:

                                      Function NumPrimo(Numero As Long) As Boolean
                                      Dim index
                                      NumPrimo = True
                                      For index = 2 To Int(Sqr(Numero) + 1)
                                          If Numero Mod index = 0 Then
                                              NumPrimo = False
                                              Exit For
                                          End If
                                      Next index
                                      End Function

                                      Ciao

                                      Luca

                                      #14035 Score: 0 | Risposta

                                      vecchio frac
                                      Senior Moderator
                                        238 pts

                                        albatros54 ha scritto:

                                        non posso partecipare alla sfida

                                        Bè hai allegato il file no? certo che puoi partecipare 🙂

                                        #14036 Score: 0 | Risposta

                                        vecchio frac
                                        Senior Moderator
                                          238 pts

                                          ha scritto:

                                          vi invio anche le mi proposte.

                                          Ciao Luca e grazie!!

                                          #14037 Score: 0 | Risposta

                                          vecchio frac
                                          Senior Moderator
                                            238 pts

                                            Comunico che la chiusura della sfida avverrà domani sera, lunedì 18 marzo, alle ore 20.

                                            Poi apriremo il televoto 🙂

                                            #14038 Score: 0 | Risposta

                                            albatros54
                                            Moderatore
                                              81 pts

                                              vecchio frac ha scritto:

                                              Bè hai allegato il file no? certo che puoi partecipare

                                               

                                              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 )
                                              #14047 Score: 0 | Risposta

                                              Luca73
                                              Partecipante
                                                54 pts

                                                Ciao

                                                HO ottimizzato la mia prima soluzione.

                                                Eccola:

                                                Sub NumPrimiGemelliRidDir_Ott()
                                                Dim NumPrimo(2 To 10000) As Boolean
                                                Dim Indice01
                                                Dim Indice02
                                                NumPrimo(2) = True
                                                For Indice01 = 3 To 10000 Step 2
                                                    NumPrimo(Indice01) = True
                                                Next Indice01
                                                For Indice01 = 3 To Sqr((10000 - 1) + 1) Step 2
                                                    If NumPrimo(Indice01) Then
                                                        For Indice02 = Indice01 + 2 To 10000 Step 2
                                                            If ((Indice02 Mod Indice01) = 0) Then
                                                                NumPrimo(Indice02) = False
                                                            End If
                                                        Next Indice02
                                                    End If
                                                Next
                                                For Indice01 = 5 To 10000 Step 2
                                                    If NumPrimo(Indice01) And NumPrimo(Indice01 - 2) Then
                                                        With Range("O" & Rows.Count).End(xlUp)
                                                            .Offset(1, 0) = Indice01 - 2
                                                            .Offset(1, 1) = Indice01
                                                        End With
                                                    End If
                                                Next
                                                MsgBox "Finito"
                                                End Sub
                                                #14048 Score: 0 | Risposta

                                                vecchio frac
                                                Senior Moderator
                                                  238 pts

                                                  Ok!   

                                                  Luca73 ha scritto:

                                                  For Indice01 = 3 To Sqr((10000 - 1) + 1) Step 2

                                                  #14049 Score: 0 | Risposta

                                                  Luca73
                                                  Partecipante
                                                    54 pts

                                                    In effetti.....bizzarro...

                                                    Avevo fatto una modifica "al volo"

                                                    Così mi piace di più

                                                     

                                                    Sub NumPrimiGemelliRidDir_Ott()
                                                    Dim NumPrimo(2 To 10000) As Boolean
                                                    Dim Indice01
                                                    Dim Indice02
                                                    NumPrimo(2) = True
                                                    For Indice01 = 3 To 10000 Step 2
                                                        NumPrimo(Indice01) = True
                                                    Next Indice01
                                                    For Indice01 = 3 To (Sqr(10000) + 1) Step 2
                                                        If NumPrimo(Indice01) Then
                                                            For Indice02 = Indice01 + 2 To 10000 Step 2
                                                                If ((Indice02 Mod Indice01) = 0) Then
                                                                    NumPrimo(Indice02) = False
                                                                End If
                                                            Next Indice02
                                                        End If
                                                    Next
                                                    For Indice01 = 5 To 10000 Step 2
                                                        If NumPrimo(Indice01) And NumPrimo(Indice01 - 2) Then
                                                            With Range("O" & Rows.Count).End(xlUp)
                                                                .Offset(1, 0) = Indice01 - 2
                                                                .Offset(1, 1) = Indice01
                                                            End With
                                                        End If
                                                    Next
                                                    MsgBox "Finito"
                                                    End Sub
                                                    #14056 Score: 0 | Risposta

                                                    Marius44
                                                    Moderatore
                                                      51 pts

                                                      Salve a tutti

                                                      Vorrei proporre una variante al sistema di votazione. 

                                                      E' previsto un solo voto. A mio avviso è insufficiente e non "premia" le diverse sfaccettature della sfida.

                                                      Mi piacerebbe poter votare il codice più veloce ma anche quello più geniale ovvero quello che ha centrato in pieno il problema. Mi viene alquanto difficile poter esprimere UN voto ad una persona, che - fra l'altro - può aver presentato più lavori.

                                                      Per quanto sopra, il mio plauso è esteso a tutti i partecipanti.

                                                       

                                                      Ciao,

                                                      Mario

                                                    Login Registrati
                                                    Stai vedendo 25 articoli - dal 1 a 25 (di 53 totali)
                                                    Rispondi a: Sfida numero 3: numeri primi gemelli
                                                    Gli allegati sono permessi solo ad utenti REGISTRATI
                                                    Le tue informazioni: