un télescope sensoriel en VBA

[invitedc72a11a]

Bonjour,

Ce projet est née ici

Le concept de télescope est arrivé quand j'ai pris conscience que la fréquence d'un mot à droite d'un autre mots et bien une fréquence comme celle de la lumière que capte nos télescope quand il scrute l'univers matériel.
Mais l'univers nous le sentons seulement sans pouvoir démontrer sa réalité matérielle.
Alors s'ouvre l'univers sensuel , et on peut y accéder car il est inscrit dans notre langage et son utilisation au cours de notre évolution.

Ensuite je me suis aperçu que si on prend les basse fréquence comme le fait WMAP dans l'univers réel on a une autre réponse.

puis qu'on pouvait étendre la résolution en prenant la fréquence sur plusieurs mots à droite d'un mots
Mais la programmation devient complexe et le nombre de relation risque d'exploser
J'ai commencé à l'implémenter mais ce n'est pas terminé.
Ce que j'espère c'est extraire des images de l'inconscient collectifs

Exemple de réponse en partant d'un mot au hasard avec fréquence maxi sur une base de 22485 mots et 100530 relations en résolution 1 mots à droite

berçant l’éclair : « je ne me le plus de la vie , et donnait à un peu mieux que cela c’est passé ; Mais Il est indispensable d’avoir été bien qui, comme s’il vous envoie jusqu’aux derniers temps a fait appel dans sa vie. On va peut-être être obligé d’endormir

paraissez prendre , et de la vie moderne, ou parce que je ne me le plus bien qui, comme un peu mieux encore, une autre chose telle est indispensable d’avoir été jetée, Elle alla pas oublier, simplement pour chevaux. j’ai trop intenses. L’énergie dans sa vie. Il y a fait appel à défaut d’amour qui avait appelé fameux Gaspard

JPL est la vie , et de faire un peu mieux que je ne me le plus bien qui, comme s’il vous envoie jusqu’aux derniers temps a fait appel à défaut d’amour qui avait été jetée, Elle alla pas oublier, simplement parce qu’elles pourront enfanter

avec fréquence mini

JPL est indispensable d’avoir connues au propriétaire. Mais musicalement et pourtant, je l’étais moi-même inconnu. Or, Ce cri strident du vétérinaire. J’entendais les écuries d’un immense centre d’équitation, devant l’humble bête, celui-là, avec certains d’entre eux, des émotions fortes passions vulgaires, Telles suppositions non analysée, l’art défini,

paraissaient pas oublier, simplement parce que… — Hé bien qui, à défaut d’amour (ce n’est que, la chance de trembler. le lundi 13 mars 2006. Ce cri strident du vétérinaire. J’entendais les écuries d’un immense centre d’équitation, devant l’humble bête, celui-là, avec certains d’entre eux, des émotions fortes passions vulgaires, Telles suppositions non analysée, l’art défini,

berçant l’éclair : chaos de trembler. le lundi 13 mars 2006. Ce cri strident du vétérinaire. J’entendais les écuries d’un immense centre d’équitation, devant l’humble bête, celui-là, avec certains d’entre eux, des émotions fortes passions vulgaires, Telles suppositions non analysée, l’art défini,

Voilà la dernière version
Pièce jointe 178571

Si vous avez meilleure une idée pour étendre la résolution je suis preneur
voilà le code

Function parler(N)
    Set t = CurrentDb.OpenRecordset("select Mot from Mots where N=" & N)
    Me!parle = t!mot
    n1 = N
    Do
        If Me!Mode = 1 Then
             cond = "Max(Nbre)"
        Else
             cond = "Min(Nbre)"
        End If
        Set t = CurrentDb.OpenRecordset("select " & cond & " as mn from Droite where IdMot=" & N)
        If t.EOF Or IsNull(t!mn) Then
            Exit Do
        End If
        nbr = t!mn
        Set ta = CurrentDb.OpenRecordset("select IdDroite from Droite where IdMot=" & N & " and Nbre=" & nbr)
        ng = N
        N = ta!IdDroite
        Set t = CurrentDb.OpenRecordset("select Mot from Mots where N=" & N)
        While InStr(Me!parle, " " & t!mot & " ") ' pour éviter que ça boucle
            ta.MoveNext
            If ta.EOF Then
                If Me!Mode = 1 Then
                    cond = " and Nbre<" & nbr
                Else
                    cond = " and Nbre>" & nbr
                End If
                Set ta = CurrentDb.OpenRecordset("select IdDroite from Droite where IdMot=" & ng & cond)
                If ta.EOF Then
                    Exit Do
                End If
                If Me!Mode = 1 Then
                    nbr = nbr - 1
                Else
                    nbr = nbr + 1
                End If
            End If
            N = ta!IdDroite
            Set t = CurrentDb.OpenRecordset("select Mot from Mots where N=" & N)
        Wend
        Me!parle = Me!parle & " " & t!mot
    Loop
End Function
Private Sub Commande0_Click()
    Nom = GetNomFich("Fichier texte", CurrentDb.Name)
    Open Nom For Input As 2 ' Ouvre le fichier texte.
    Me!parle = ""
    Set t = CurrentDb.OpenRecordset("select max(N) as mn from Mots")
    If Not IsNull(t!mn) Then
        nmot = t!mn + 1
    Else
        nmot = 1
    End If
    g = 0
    Dim tg
    For I = 1 To Me!Resolution
        tg(I) = 0
    End If
    Do Until EOF(2)
        Line Input #2, Te
        Te = Replace(Te, """", "")
        Te = Replace(Te, ".", " .")
        Te = Replace(Te, ",", " ,")
        Te = Replace(Te, ";", " ;")
        Te = Replace(Te, ":", " :")
        b = Split(Te, " ")
        N = UBound(b)
        For I = 0 To N
            C = b(I)
            If C <> "" Then
                req = "select N from Mots where Mot=""" & C & """"
                On Error Resume Next
                Set t = CurrentDb.OpenRecordset(req)
                If t.EOF Then
                    Set t = CurrentDb.OpenRecordset("Mots")
                    t.AddNew
                    t!mot = C
                    t!N = nmot
                    gn = nmot
                    nmot = nmot + 1
                    t.Update
                Else
                    gn = t!N
                End If
                If g > 0 Then
                    For I = Me!Resolution - 1 To 1
                       tg(I + 1) = tg(I)
                    End If
                    For I = Me!Resolution - 1 To 1
                       tg(I + 1) = tg(I)
                    End If
                    tg(1) = gn
                    tg(2) = g
                    Set ta = CurrentDb.OpenRecordset("select Nbre from Droite Where IdMot=" & g & " and IdDroite=" & gn)
                    If ta.EOF Then
                        Set ta = CurrentDb.OpenRecordset("Droite")
                        ta.AddNew
                        ta!IdMot = g
                        ta!IdDroite = gn
                        ta!Nbre = 1
                        ta.Update
                    Else
                        ta.Edit
                        ta!Nbre = ta!Nbre + 1
                        ta.Update
                        If Me!Resolution > 1 And tg(3) > 0 Then
                         ' la faut inséré un lien dans la table droite mais avec une boucle sur la résolution
                        End If
                    End If
                End If
                g = gn
            End If
        Next I
    Loop
    Close #2
    Me!Modifiable5.Requery
    BtParle_Click
End Sub

-----

[yoda1234]

Ce que j'espère c'est extraire des images de l'inconscient collectifs

Je ne ferais aucun commentaire, je me contente de fermer. Si quelqu'un d'autre que l'auteur voit un intérêt quelconque à ce fil ou y voit de la logique, qu'il me contacte en MP.