Forum Liberty Basic France

• Index
• Jeux » Anagrammes Et Cie
Roland
Le 23/01/2017 à 18h19

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2484
Voici un gri gri pour trouver des anagrammes
On entre par le textbox (Attention que plus de 7 caractères ou plus de 2000 cycles allonge de beaucoup le temps de traitement
On règle le nombre de cycles dans l'autre textbox qui est à 200 par défaut
Ce n'est pas un alogo combinatoire c'est un algo de mélange, et donc plus il y a de cycles par rapport au nombre de caractères et plus on s'approche de la combinatoire théorique
L'élimination des doublons est deux fois plus longue que la génération.
Code VB :
 
        NOMAINWIN
    WindowWidth = 650
    WindowHeight = 500
    UpperLeftX = (DisplayWidth-WindowWidth)-200
    UpperLeftY = 20 ' (DisplayHeight-WindowHeight)
   ' BUTTON #w.go, "Ok", [ok], UL, 10, 10, 50, 25
    TEXTBOX #w.entr, 20 , 50, 290, 25
    BUTTON #w.go, "Shuffle", [go], UL, 320, 50, 70, 25
    BUTTON #w.new, "New", [new], UL, 400, 50, 50, 25
    TEXTBOX #w.lot, 320, 115, 70, 25
    BUTTON #w.ded, "Suppress Doubles", [ded], UL, 320, 165, 200, 25
    TEXTBOX #w.nded, 320, 220, 60, 25
    TEXTBOX #w.nf, 320, 260, 300, 25
    TEXTEDITOR #w.sort, 20, 100, 290, 320
    GRAPHICBOX #w.m, 5, 5, 635, 440
    OPEN "Anagram" FOR window_nf AS #w
    #w, "TRAPCLOSE [closeH]"
    #w.m , "down"
    #w.m , "fill blue; color white; backcolor blue"
    f$="#w.entr #w.go #w.new #w.lot #w.ded #w.nded #w.nf"
    for x=1 to 7
    hand$=word$(f$,x)
       #hand$, "!font arial 12 bold"
    next x
    #w.lot, "200"
    #w.m, "place 20 30": #w.m, "\ ENTREE    Attention: Si plus de 7 caractères "+_
    "ou plus de 2000 cycles-->Temps de traitement"
    #w.m, "place 320 100": #w.m, "\ Nombre de Cycles"
    #w.m, "place 320 205": #w.m, "\ Tri doublons"
    '-------------
  [new]
    #w.sort, "!cls"
    dim prop$(50): dim stoa$(10000): dim stob$(10000)
    #w.entr, "AZERTY": n=1
  wait
  [go]
    sto=0
    #w.lot, "!contents? lot$": lot=val(lot$)
    #w.entr, "!contents? string$":tr$=string$: lon=len(tr$)
  [shuffle] '----mélange les lettres
  for n=1 to lot
          redim prop$(lon)
        for t=1 to lon
           prop$(t)=mid$(tr$,t,1)
           if prop$(t)=" " then prop$(t)="**"
        next t
        For i = lon to 1 Step -1
            x = Int(Rnd(1) * i) + 1
            temp$ = prop$(x)
            prop$(x) = prop$(i)
            prop$(i) = temp$
        Next i
        tran$=""
        for t=1 to lon 'reconstitution chaîne
        tran$=tran$+prop$(t)
        next t
    #w.sort, n;"   "; tran$: stoa$(n)=tran$:n=n+1: stob$(n)=tran$ 'affichage
    #w.sort, " "
    next n
  wait
  '------------------------suppression doublons
  [ded]
     dim a$(10000)
  for i = 1 to lot
     a$(i) = stoa$(i)
  next
  '************
  dim temp$(10000)
  for i = 0 to n
    for j = i + 1 to n-1
        if a$(i) = a$(j) then a$(j) = "" 'mark duplicate with non value
    next
    #w.nded, str$(i)
  next
  index = 0
  for i = 0 to n
    if a$(i) <> "" then temp$(index) = a$(i) : index = index + 1
  next
redim a$(index - 1)'optional resize a
  #w.nded, "Reste: ";str$(index - 1)
for i = 0 to index - 1
    a$(i) = temp$(i)
next
    '------
    #w.sort, "!cls"
    for s=1 to index - 1
       #w.sort, s; "   ";a$(s)
    next s
    '------------
    n= lon
   nff=factorial(n)
   #w.nf, "Sur:";str$(lon);"!-->  ";  str$(nff);"   Attendus"
   wait
function factorial(n)
    if n = 1 then
        factorial = n
    else
        factorial = n * factorial(n-1)
    end if
end function
  wait
  [closeH]
    CLOSE  #w
    END
 
 
____________________
Roro
   
Christophe
Le 02/02/2017 à 17h35

Modérateur

Groupe: Modérateur

Inscrit le: 09/02/2015
Messages: 741
Simple et fonctionnel. Il y aura une étape suivante, ou c'était juste pour le fun ?
____________________
Just BASIC v2.0 :
  • utilisation courante avec GNU/Linux Mageia7+ Wine (Pas trouvé d'incohérences ou de bug de compilation à ce jour)
  • utilisation occasionnelle ou vérification/débugage difficile avec Windows XP sur un petit eeepc
   
Roland
Le 02/02/2017 à 23h17

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2484
Citation:
Il y aura une étape suivante

Comme le mélange se fait de façon aléatoire, au bout d'un certain nombre de passes y a des doublons
J'essaie désespérément de supprimer les doublons
Et j'y arrive pô
On se fait fumer le cerveau avec ce qu'on peut, hein
Pour l'instant je fais avec trois tableaux
Peut-être qu'en en ajoutant cinq ou six, ça irait mieux ?
Y a un truc qui m'échappe scrogneugneu de saperlipopette
____________________
Roro
   
Christophe
Le 03/02/2017 à 14h16

Modérateur

Groupe: Modérateur

Inscrit le: 09/02/2015
Messages: 741
Ca veut dire que tu as la tête trop dans le guidon ;)

Met les anagrammes dans un tableau que tu dimensionne au nombre d'anagrammes attendues. A chaque nouvelle anagramme tu recherches dans le tableau si elle existe déjà, si oui tu laisses le tableau tel quel, si non tu la place à la fin du tableau et tu génères l'anagramme suivante... Et au final tu imprime le tableau.



Edité par Christophe Le 03/02/2017 à 14h16
____________________
Just BASIC v2.0 :
  • utilisation courante avec GNU/Linux Mageia7+ Wine (Pas trouvé d'incohérences ou de bug de compilation à ce jour)
  • utilisation occasionnelle ou vérification/débugage difficile avec Windows XP sur un petit eeepc
   
Roland
Le 03/02/2017 à 18h34

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2484
J'ai été chercher de l'aide chez les anglophones
A trois: "bplus", "tsh73"(drasvoditié tovaritch), et Rod ont tout défoncé
J'ai mis des"**" à la place des espaces pour pouvoir mettre plusieurs mots en entrée
Et voila le résultat, et ça maaaaaarche:
Code VB :
 
    NOMAINWIN
    WindowWidth = 450
    WindowHeight = 500
    UpperLeftX = (DisplayWidth-WindowWidth)-200
    UpperLeftY = 20 ' (DisplayHeight-WindowHeight)
   ' BUTTON #w.go, "Ok", [ok], UL, 10, 10, 50, 25
    TEXTBOX #w.entr, 20 , 50, 290, 25
    BUTTON #w.go, "Go !", [go], UL, 320, 50, 50, 25
    BUTTON #w.new, "New", [new], UL, 380, 50, 50, 25
    TEXTBOX #w.lot, 320, 115, 50, 25
    BUTTON #w.ded, "Suppress Doubles", [ded], UL, 320, 165, 110, 25
    TEXTBOX #w.nded, 320, 220, 50, 25
    TEXTEDITOR #w.sort, 20, 100, 290, 320
    GRAPHICBOX #w.m 5, 5, 435, 440
    OPEN "Anagram" FOR window_nf AS #w
    #w, "TRAPCLOSE [closeH]"
    #w.m , "down"
    #w.m , "fill blue; color yellow; backcolor blue"
    #w.sort, "!font arial 12 bold"
    #w.lot, "200"
    #w.m, "place 20 30": #w.m, "\ ENTREE"
    #w.m, "place 320 100": #w.m, "\ n Mélanges"
    #w.m, "place 320 205": #w.m, "\ n Sorties"
    '-------------
  [new]
    #w.sort, "!cls"
    dim prop$(50): dim stoa$(500): dim stob$(500)
    #w.entr, "AZERTYUIOP": n=1
  wait
  [go]
    sto=0
    #w.lot, "!contents? lot$": lot=val(lot$)
    #w.entr, "!contents? string$":tr$=string$: lon=len(tr$)
  [shuffle] '----mélange les lettres
  for n=1 to lot
          redim prop$(lon)
        for t=1 to lon
           prop$(t)=mid$(tr$,t,1)
           if prop$(t)=" " then prop$(t)="**"
        next t
        For i = lon to 1 Step -1
            x = Int(Rnd(1) * i) + 1
            temp$ = prop$(x)
            prop$(x) = prop$(i)
            prop$(i) = temp$
        Next i
        tran$=""
        for t=1 to lon 'reconstitution chaîne
        tran$=tran$+prop$(t)
        next t
    #w.sort, tran$: stoa$(n)=tran$:n=n+1: stob$(n)=tran$ 'affichage
    #w.sort, " "
    next n
  wait
  '------------------------suppression doublons
  [ded]
     dim a$(500)
  for i = 1 to lot
     a$(i) = stoa$(i)
  next
  '************
  dim temp$(500)
  for i = 0 to n-1
    for j = i + 1 to n
        if a$(i) = a$(j) then a$(j) = "" 'mark duplicate with non value
    next
  next
  index = 0
  for i = 0 to n
    if a$(i) <> "" then temp$(index) = a$(i) : index = index + 1
  next
redim a$(index - 1)'optional resize a
  #w.nded, str$(index - 1)
for i = 0 to index - 1
    a$(i) = temp$(i)
    print a$(i)
next
    '------
    #w.sort, "!cls"
    for s=1 to index - 1
       #w.sort, a$(s)
    next s
  wait
  [closeH]
    CLOSE  #w
    END
 
____________________
Roro
   
Christophe
Le 04/02/2017 à 01h16

Modérateur

Groupe: Modérateur

Inscrit le: 09/02/2015
Messages: 741
Pas mal. Il n'oublierait pas la première anagramme ?

Je me suis permis de modifier ton programme initial. Je voulais aussi ajouter un tri alphabétique pour que les doublons nous sautent à la figure si dès fois il en restait encore, mais c'est bien trop complexe pour moi et pour ce soir, il est déjà 1h15 et j'écoute Dire Straits au casque, il est temps d'aller dormir. Voici ton prog modifié (j'ai pas trop testé s'il fonctionnait comme ça) :

Code VB :
 
NOMAINWIN
    WindowWidth = 400
    WindowHeight = 500
    UpperLeftX = (DisplayWidth-WindowWidth)-200
    UpperLeftY = 20 ' (DisplayHeight-WindowHeight)
   ' BUTTON #w.go, "Ok", [ok], UL, 10, 10, 50, 25
    TEXTBOX #w.entr, 20 , 50, 290, 25
    BUTTON #w.go, "Go !", [go], UL, 320, 50, 50, 25
    TEXTBOX #w.lot, 320, 95, 50, 25
    BUTTON #w.new, "New", [new], UL, 320, 135, 50, 25
    TEXTEDITOR #w.sort, 20, 100, 290, 300
 
 
    GRAPHICBOX #w.m 5, 5, 385, 440
    OPEN "Anagram" FOR window_nf AS #w
    #w, "TRAPCLOSE [closeHelp]"
    #w.m , "down"
    #w.m , "fill blue; color yellow; backcolor blue"
    #w.sort, "!font arial 12 bold"
    #w.lot, "5"
 
 
 
    '-------------
  [new]
    #w.sort, "!cls"
    dim prop$(20): dim sto$(500)
    #w.entr, "AZERTYUIOP": n=1
  wait
  [go]
    sto=0
    #w.lot, "!contents? lot$": lot=val(lot$)
    dim anagram$(lot) 'ajouté par moi
    #w.entr, "!contents? string$":tr$=string$: lon=len(tr$)
 
  [shuffle] '----mélange les lettres
  for n=1 to lot
        redim prop$(lon)
 
        for t=1 to lon
           prop$(t)=mid$(tr$,t,1)
        next t
 
        For i = lon to 1 Step -1
            x = Int(Rnd(1) * i) + 1
            temp$ = prop$(x)
            prop$(x) = prop$(i)
            prop$(i) = temp$
        Next i
 
        tran$=""
        for t=1 to lon
        tran$=tran$+prop$(t)
        next t
        sto$(n)=tran$:n=n+1
    '#w.sort, tran$': sto$(n)=tran$:n=n+1
    '#w.sort, " "
'************
        explore=0:index=0:fin=0:valable=-1
        while fin=0
            if anagram$(index)="" then explore=1:valable=index
            if anagram$(index)=tran$ then explore=1:valable=-1
            if explore=1 then fin=1
            index=index+1
        wend
 
        if valable<>-1 then anagram$(valable)=tran$
 
    next n
 
    for pub=0 to valable
        #w.sort, anagram$(pub)
    next
'************
  wait
  [stop]
  sto=1
  wait
  [closeHelp]
    CLOSE  #w
    END
 


Bonne nuit ;)
____________________
Just BASIC v2.0 :
  • utilisation courante avec GNU/Linux Mageia7+ Wine (Pas trouvé d'incohérences ou de bug de compilation à ce jour)
  • utilisation occasionnelle ou vérification/débugage difficile avec Windows XP sur un petit eeepc
   
Roland
Le 04/02/2017 à 10h06

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2484
Ton truc a l'air de marcher
"bplus" ma proposé un système sans doublons auquel je ne comprends que dalle (transfert par fichiers, sub de la mort s'auto-appelant...ext)
Alors je lui demande un truc sans sub
Et il me sort du non récursif (code contraint à la longueur de la chaîne)
Et donc je demande du récursif sans sub ni fonction
Y va y avoir du neurone fumant de l'autre côté de la mer

Je mets les liens des threads de là bas pour ceux que ça intéresse:

http://justbasic.conforums.com/index.cgi?board=novice&num=1486074411&action=display&start=15

http://libertybasic.conforums.com/index.cgi?board=open&action=display&num=1354086588
____________________
Roro
   
Christophe
Le 11/02/2017 à 23h39

Modérateur

Groupe: Modérateur

Inscrit le: 09/02/2015
Messages: 741
T'inquiète pas, c'est des fadas ;)

Quelques nouvelles : les anagrammes sont maintenant triées alphabétiquement. J'ai mis le temps à sortir un truc potable, et il y a aussi le tourbillon de la vie et d'autres activités qui font qu'au total on n'a pas tant de temps que ça...

Je me suis obstiné à faire un tri au sein du même tableau, mais déterminer la place d'un mot et déplacer toute la liste en conséquence ça faisait beaucoup de mouvements, et je m'emmelais les pinceaux dans la conception du truc. Donc j'ai simplifié en utilisant un nouveau tableau dans lequel on place directement les anagrammes à leur bonne place.

C'est toujours basé sur ton programme initial :
Code VB :
 
 
NOMAINWIN
    WindowWidth = 400
    WindowHeight = 500
    UpperLeftX = (DisplayWidth-WindowWidth)-200
    UpperLeftY = 20 ' (DisplayHeight-WindowHeight)
   ' BUTTON #w.go, "Ok", [ok], UL, 10, 10, 50, 25
    TEXTBOX #w.entr, 20 , 50, 290, 25
    BUTTON #w.go, "Go !", [go], UL, 320, 50, 50, 25
    TEXTBOX #w.lot, 320, 95, 50, 25
    BUTTON #w.new, "New", [new], UL, 320, 135, 50, 25
    TEXTEDITOR #w.sort, 20, 100, 290, 300
 
 
    GRAPHICBOX #w.m 5, 5, 385, 440
    OPEN "Anagram" FOR window_nf AS #w
    #w, "TRAPCLOSE [closeHelp]"
    #w.m , "down"
    #w.m , "fill blue; color yellow; backcolor blue"
    #w.sort, "!font arial 12 bold"
    #w.lot, "5"
 
 
 
    '-------------
  [new]
    #w.sort, "!cls"
    dim prop$(20): dim sto$(500)
    #w.entr, "AZERTYUIOP": n=1
  wait
  [go]
    sto=0
    #w.lot, "!contents? lot$": lot=val(lot$)
    dim anagram$(lot) 'ajouté par moi
    #w.entr, "!contents? string$":tr$=string$: lon=len(tr$)
 
  [shuffle] '----mélange les lettres
  for n=1 to lot
        redim prop$(lon)
 
        for t=1 to lon
           prop$(t)=mid$(tr$,t,1)
        next t
 
        For i = lon to 1 Step -1
            x = Int(Rnd(1) * i) + 1
            temp$ = prop$(x)
            prop$(x) = prop$(i)
            prop$(i) = temp$
        Next i
 
        tran$=""
        for t=1 to lon
        tran$=tran$+prop$(t)
        next t
        sto$(n)=tran$:n=n+1
 
        explore=0:index=0:fin=0:valable=-1
        while fin=0
            if anagram$(index)="" then explore=1:valable=index
            if anagram$(index)=tran$ then explore=1:valable=-1
            if explore=1 then fin=1
            index=index+1
        wend
 
        if valable<>-1 then anagram$(valable)=tran$
 
    next n
 
    'afficher les anagrammes
    dim tri$(index):gosub [tri_alpha]   'tri de la liste d'anagrammes
    for pub=0 to valable
        #w.sort, tri$(pub)
    next
 
wait
 
 
[tri_alpha] 'tri alphabétique des anagrammes
    for ref=0 to index-1
        motRef$=anagram$(ref)
 
        for compare=0 to index-1
            if ref<>compare then
 
                'on compare lettre à lettre le mot référence et le mot comparé
                'jusqu'à ce que les lettres soient différentes
                motCompare$=anagram$(compare)
                lettre=1
                difference=0
                while difference=0
 
                    'codes ascii des lettres
                    a=asc(mid$(motRef$,lettre,1))
                    b=asc(mid$(motCompare$,lettre,1))
 
                    'on supprime la distinction majuscules-minuscules
                    if a>96 then a=a-32
                    if b>96 then b=b-32
 
                    'comparaison
                    if a=b then lettre=lettre+1 else difference=1
 
                wend
 
            '('apres' est la position du mot motRef$ dans la liste alphabétique)
            '('avant' permet d'inverser le tri)
            if a>b then apres=apres+1 else avant=avant+1
 
        end if
 
    next
 
    tri$(apres)=motRef$ 'tri dans l'ordre conventionnel
    'tri$(avant)=motRef$ 'tri dans l'ordre inverse
    avant=0:apres=0
 
next
 
Return
 
  [stop]
  sto=1
  wait
  [closeHelp]
    CLOSE  #w
    END
 


Vu de chez moi le tri fonctionne pour les cas courants, je n'ai pas cherché s'il y avait des cas-pièges à tester, comme un grand nombre d'anagramme ou un mot initial exagérément long. J'ai testé sur 200 anagrammes du même mot.

Comme je me suis basé sur ta première version, je n'ai pas essayé la présence d'espace, d'étoile ou de caractères différents des caractères alphabétiques.

A+



Edité par Christophe Le 11/02/2017 à 23h40
____________________
Just BASIC v2.0 :
  • utilisation courante avec GNU/Linux Mageia7+ Wine (Pas trouvé d'incohérences ou de bug de compilation à ce jour)
  • utilisation occasionnelle ou vérification/débugage difficile avec Windows XP sur un petit eeepc
   
Roland
Le 11/02/2017 à 23h52

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2484
Je n'avais pas pensé qu'on pouvait se servir des codes ASII
Du coup, je voyais le tri quasiment insurmontable
Heureusement que je ne l'ai pas tenté
C'était un coup à y péter une durite
____________________
Roro
   
atomose
Le 16/02/2017 à 00h09

Modérateur

Groupe: Modérateur

Inscrit le: 30/03/2011
Messages: 436
Salut tous le monde !

Je suis de retour après quelques semaines d'absences :P

Je rajoute ma sauce, rien de révolutionnaire mais un petit "plus" au programme de base ^^.

++ Je retourne au taf, je vais bientôt poster des Maj de mes jeux :D.

Code VB :
 
    NOMAINWIN
    secuGO = 1
    WindowWidth = 400 : WindowHeight = 500
    UpperLeftX = (DisplayWidth-WindowWidth)-200
    UpperLeftY = 20 ' (DisplayHeight-WindowHeight)
    TEXTBOX #w.entr, 20 , 50, 290, 25
    BUTTON #w.go, "START", [go2], UL, 320, 100, 50, 25
    BUTTON #w.go, "STOP", [go], UL, 320, 200, 50, 25
    TEXTBOX #w.lot, 320, 130, 50, 25
    BUTTON #w.new, "CLEAR", [new], UL, 320, 230, 50, 25
    TEXTEDITOR #w.sort, 20, 100, 290, 330
    GRAPHICBOX #w.m 5, 5, 385, 440
    OPEN "Anagram" FOR window_nf AS #w
    #w, "TRAPCLOSE [closeHelp]"
    #w.m , "down"
    #w.m , "fill darkgray; color BLACK; backcolor BLACK"
    #w.sort, "!font Times New Roman 10"
    #w.entr, "!font Times New Roman 10"
    #w.m, "font Times New Roman 10"
    #w, "font Times New Roman 10"
    #w.m, "backcolor darkgray ;place 17 37 ;\"; "Initial Word :"
    #w.lot, "1"
 
 
 
    '-------------
    [new]
    #w.sort, "!cls"
    dim prop$(20): dim sto$(500)
    #w.entr, "AZERTYUIOP": n=1
    wait
 
    [stopGO]
    timer 0
    secuGO = 1
    wait
 
   [go]
   if secuGO = 1 then
     secuGO = 0
   end if
   goto [stopGO]
 
   [go2]
   if secuGO = 1 then
     secuGO = 0
     goto [go2]
   end if
   sto=0
   #w.lot, "!contents? lot$": lot=val(lot$)
   dim anagram$(lot) 'ajouté par moi
   #w.entr, "!contents? string$":tr$=string$: lon=len(tr$)
 
   [shuffle] '----mélange les lettres
   for n=1 to lot
        redim prop$(lon)
 
        for t=1 to lon
           prop$(t)=mid$(tr$,t,1)
        next t
 
        For i = lon to 1 Step -1
            x = Int(Rnd(1) * i) + 1
            temp$ = prop$(x)
            prop$(x) = prop$(i)
            prop$(i) = temp$
        Next i
 
        tran$=""
        for t=1 to lon
        tran$=tran$+prop$(t)
        next t
        sto$(n)=tran$:n=n+1
 
        explore=0:index=0:fin=0:valable=-1
        while fin=0
            if anagram$(index)="" then explore=1:valable=index
            if anagram$(index)=tran$ then explore=1:valable=-1
            if explore=1 then fin=1
            index=index+1
        wend
 
        if valable<>-1 then anagram$(valable)=tran$
 
    next n
 
    'afficher les anagrammes
    dim tri$(index):gosub [tri_alpha]   'tri de la liste d'anagrammes
    for pub=0 to valable
        #w.sort, tri$(pub)
    next
 
    timer 50, [go2]
    wait
 
 
    [tri_alpha] 'tri alphabétique des anagrammes
    for ref=0 to index-1
        motRef$=anagram$(ref)
 
        for compare=0 to index-1
            if ref<>compare then
 
                'on compare lettre à lettre le mot référence et le mot comparé
                'jusqu'à ce que les lettres soient différentes
                motCompare$=anagram$(compare)
                lettre=1
                difference=0
                while difference=0
 
                    'codes ascii des lettres
                    a=asc(mid$(motRef$,lettre,1))
                    b=asc(mid$(motCompare$,lettre,1))
 
                    'on supprime la distinction majuscules-minuscules
                    if a>96 then a=a-32
                    if b>96 then b=b-32
 
                    'comparaison
                    if a=b then lettre=lettre+1 else difference=1
 
                wend
 
            '('apres' est la position du mot motRef$ dans la liste alphabétique)
            '('avant' permet d'inverser le tri)
            if a>b then apres=apres+1 else avant=avant+1
 
        end if
 
    next
 
    tri$(apres)=motRef$ 'tri dans l'ordre conventionnel
    'tri$(avant)=motRef$ 'tri dans l'ordre inverse
    avant=0:apres=0
 
    next
    Return
 
  [closeHelp]
  timer 0
  CLOSE  #w
  END
 




Edité par atomose Le 16/02/2017 à 00h11
____________________
Yo !
MSN Web    
Christophe
Le 17/02/2017 à 17h59

Modérateur

Groupe: Modérateur

Inscrit le: 09/02/2015
Messages: 741
Je suis surpris que ça fonctionne, les deux boutons s'appellent "go" :
Code VB :
 
    BUTTON #w.go, "START", [go2], UL, 320, 100, 50, 25
    BUTTON #w.go, "STOP", [go], UL, 320, 200, 50, 25
 


Mis mon grain de sel en rajoutant #w.sort, "" après impression de la liste d'anagrammes, et en mettant la valeur 15 dans #w.lot :

Code VB :
 
NOMAINWIN
    secuGO = 1
    WindowWidth = 400 : WindowHeight = 500
    UpperLeftX = (DisplayWidth-WindowWidth)-200
    UpperLeftY = 20 ' (DisplayHeight-WindowHeight)
    TEXTBOX #w.entr, 20 , 50, 290, 25
    BUTTON #w.go, "START", [go2], UL, 320, 100, 50, 25
    BUTTON #w.go, "STOP", [go], UL, 320, 200, 50, 25
    TEXTBOX #w.lot, 320, 130, 50, 25
    BUTTON #w.new, "CLEAR", [new], UL, 320, 230, 50, 25
    TEXTEDITOR #w.sort, 20, 100, 290, 330
    GRAPHICBOX #w.m 5, 5, 385, 440
    OPEN "Anagram" FOR window_nf AS #w
    #w, "TRAPCLOSE [closeHelp]"
    #w.m , "down"
    #w.m , "fill darkgray; color BLACK; backcolor BLACK"
    #w.sort, "!font Times New Roman 10"
    #w.entr, "!font Times New Roman 10"
    #w.m, "font Times New Roman 10"
    #w, "font Times New Roman 10"
    #w.m, "backcolor darkgray ;place 17 37 ;\"; "Initial Word :"
    #w.lot, "15"
 
 
 
    '-------------
    [new]
    #w.sort, "!cls"
    dim prop$(20): dim sto$(500)
    #w.entr, "AZERTYUIOP": n=1
    wait
 
    [stopGO]
    timer 0
    secuGO = 1
    wait
 
   [go]
   if secuGO = 1 then
     secuGO = 0
   end if
   goto [stopGO]
 
   [go2]
   if secuGO = 1 then
     secuGO = 0
     goto [go2]
   end if
   sto=0
   #w.lot, "!contents? lot$": lot=val(lot$)
   dim anagram$(lot) 'ajouté par moi
   #w.entr, "!contents? string$":tr$=string$: lon=len(tr$)
 
   [shuffle] '----mélange les lettres
   for n=1 to lot
        redim prop$(lon)
 
        for t=1 to lon
           prop$(t)=mid$(tr$,t,1)
        next t
 
        For i = lon to 1 Step -1
            x = Int(Rnd(1) * i) + 1
            temp$ = prop$(x)
            prop$(x) = prop$(i)
            prop$(i) = temp$
        Next i
 
        tran$=""
        for t=1 to lon
        tran$=tran$+prop$(t)
        next t
        sto$(n)=tran$:n=n+1
 
        explore=0:index=0:fin=0:valable=-1
        while fin=0
            if anagram$(index)="" then explore=1:valable=index
            if anagram$(index)=tran$ then explore=1:valable=-1
            if explore=1 then fin=1
            index=index+1
        wend
 
        if valable<>-1 then anagram$(valable)=tran$
 
    next n
 
    'afficher les anagrammes
    dim tri$(index):gosub [tri_alpha]   'tri de la liste d'anagrammes
    for pub=0 to valable
        #w.sort, tri$(pub)
    next
    #w.sort, ""
    timer 50, [go2]
    wait
 
 
    [tri_alpha] 'tri alphabétique des anagrammes
    for ref=0 to index-1
        motRef$=anagram$(ref)
 
        for compare=0 to index-1
            if ref<>compare then
 
                'on compare lettre à lettre le mot référence et le mot comparé
                'jusqu'à ce que les lettres soient différentes
                motCompare$=anagram$(compare)
                lettre=1
                difference=0
                while difference=0
 
                    'codes ascii des lettres
                    a=asc(mid$(motRef$,lettre,1))
                    b=asc(mid$(motCompare$,lettre,1))
 
                    'on supprime la distinction majuscules-minuscules
                    if a>96 then a=a-32
                    if b>96 then b=b-32
 
                    'comparaison
                    if a=b then lettre=lettre+1 else difference=1
 
                wend
 
            '('apres' est la position du mot motRef$ dans la liste alphabétique)
            '('avant' permet d'inverser le tri)
            if a>b then apres=apres+1 else avant=avant+1
 
        end if
 
    next
 
    tri$(apres)=motRef$ 'tri dans l'ordre conventionnel
    'tri$(avant)=motRef$ 'tri dans l'ordre inverse
    avant=0:apres=0
 
    next
    Return
 
  [closeHelp]
  timer 0
  CLOSE  #w
  END
 
 
____________________
Just BASIC v2.0 :
  • utilisation courante avec GNU/Linux Mageia7+ Wine (Pas trouvé d'incohérences ou de bug de compilation à ce jour)
  • utilisation occasionnelle ou vérification/débugage difficile avec Windows XP sur un petit eeepc
   
atomose
Le 18/02/2017 à 19h21

Modérateur

Groupe: Modérateur

Inscrit le: 30/03/2011
Messages: 436
Encore quelques petites améliorations :P
Oui, c'est étonnant mais vu que rien ne se rapporte au bouton ca ne créé pas de conflit ^^.

Code VB :
 
    NOMAINWIN
    secuGO = 1
    WindowWidth = 400 : WindowHeight = 500
    UpperLeftX = (DisplayWidth-WindowWidth)/2
    UpperLeftY = (DisplayHeight-WindowHeight)/2
    TEXTBOX #w.entr, 20 , 50, 290, 25
    BUTTON #w.main, "GO !", [go], UL, 320, 100, 50, 25
    TEXTBOX #w.lot, 320, 130, 50, 25
    BUTTON #w.new, "CLEAR", [new], UL, 320, 170, 50, 25
    TEXTEDITOR #w.sort, 20, 100, 290, 330
    GRAPHICBOX #w.m 5, 5, 385, 440
    OPEN "Anagram" FOR window_nf AS #w
    #w, "TRAPCLOSE [closeHelp]"
    #w.m , "down; fill darkgray; color BLACK; backcolor BLACK"
    #w.sort, "!font Times New Roman 10"
    #w.entr, "!font Times New Roman 10"
    #w.m, "font Times New Roman 10"
    #w, "font Times New Roman 10"
    #w.m, "backcolor darkgray ;place 17 37 ;\"; "Initial Word :"
    #w.m, "backcolor darkgray ;place 17 86 ;\"; "Combinaisons generated : "; Gen
    #w.lot, "1"
 
 
 
    '-------------
    [new]
    #w.sort, "!cls"
    Gen = 0
    #w.m, "backcolor darkgray ;place 17 86 ;\"; "Combinaisons generated : "; Gen ; "                "
    dim prop$(20): dim sto$(500)
    #w.entr, "AZERTYUIOP": n=1
    wait
 
   [go]
   if secuGO = 0 then
     timer 0
     secuGO = 1
     PRINT #w.main ,"GO !"
     wait
   end if
 
   [go2]
   if secuGO = 1 then
     secuGO = 0
     PRINT #w.main ,"STOP"
   end if
   sto=0
   #w.lot, "!contents? lot$": lot=val(lot$)
   dim anagram$(lot) 'ajouté par moi
   #w.entr, "!contents? string$":tr$=string$: lon=len(tr$)
 
   [shuffle] '----mélange les lettres
   for n=1 to lot
        redim prop$(lon)
        for t=1 to lon
           prop$(t)=mid$(tr$,t,1)
           if prop$(t)=" " then prop$(t)="  "
        next t
 
        For i = lon to 1 Step -1
            x = Int(Rnd(1) * i) + 1
            temp$ = prop$(x)
            prop$(x) = prop$(i)
            prop$(i) = temp$
        Next i
 
        tran$=""
        for t=1 to lon
        tran$=tran$+prop$(t)
        next t
 
        sto$(n)=tran$:n=n+1
 
        explore=0:index=0:fin=0:valable=-1
        while fin=0
            if anagram$(index)="" then explore=1:valable=index
            if anagram$(index)=tran$ then explore=1:valable=-1
            if explore=1 then fin=1
            index=index+1
        wend
 
        if valable<>-1 then anagram$(valable)=tran$
 
    next n
 
    'afficher les anagrammes
    dim tri$(index):gosub [tri_alpha]   'tri de la liste d'anagrammes
    for pub=0 to valable
        #w.sort, tri$(pub)
    next
 
    Gen = Gen + 1
    #w.m, "backcolor darkgray ;place 17 86 ;\"; "Combinaisons generated : "; Gen ; "                "
 
    timer 50, [go2]
    wait
 
 
    [tri_alpha] 'tri alphabétique des anagrammes
    for ref=0 to index-1
        motRef$=anagram$(ref)
 
        for compare=0 to index-1
            if ref<>compare then
 
                'on compare lettre à lettre le mot référence et le mot comparé
                'jusqu'à ce que les lettres soient différentes
                motCompare$=anagram$(compare)
                lettre=1
                difference=0
                while difference=0
 
                    'codes ascii des lettres
                    a=asc(mid$(motRef$,lettre,1))
                    b=asc(mid$(motCompare$,lettre,1))
 
                    'on supprime la distinction majuscules-minuscules
                    if a>96 then a=a-32
                    if b>96 then b=b-32
 
                    'comparaison
                    if a=b then lettre=lettre+1 else difference=1
 
                wend
 
            '('apres' est la position du mot motRef$ dans la liste alphabétique)
            '('avant' permet d'inverser le tri)
            if a>b then apres=apres+1 else avant=avant+1
 
        end if
 
    next
 
    tri$(apres)=motRef$ 'tri dans l'ordre conventionnel
    'tri$(avant)=motRef$ 'tri dans l'ordre inverse
    avant=0:apres=0
 
    next
    Return
 
  [closeHelp]
  timer 0
  CLOSE  #w
  END
 
____________________
Yo !
MSN Web    
Christophe
Le 24/02/2017 à 23h54

Modérateur

Groupe: Modérateur

Inscrit le: 09/02/2015
Messages: 741
Oki, start et stop sur le même bouton, c'est sympa. Surtout que c'est un peu inquiétant cette liste qui défile (probablement par vieux souvenir perso de chaines qui grandissaient sans cesse jusqu'à arriver à saturation)

Mais au fait, avec des listes d'une anagramme, le tri ne sert plus...
____________________
Just BASIC v2.0 :
  • utilisation courante avec GNU/Linux Mageia7+ Wine (Pas trouvé d'incohérences ou de bug de compilation à ce jour)
  • utilisation occasionnelle ou vérification/débugage difficile avec Windows XP sur un petit eeepc
   
Roland
Le 26/02/2017 à 18h49

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2484
Citation:
le tri ne sert plus

Le tri préalable sert pour éliminer les doublons (quand y en a)
____________________
Roro
   
Christophe
Le 05/03/2017 à 07h51

Modérateur

Groupe: Modérateur

Inscrit le: 09/02/2015
Messages: 741
Certes, mais sur une liste d'un mot le tri est vite fait, c'était un truc d'atomose pour nous faire réfléchir sur ce qu'il avait bien pu modifier^^
____________________
Just BASIC v2.0 :
  • utilisation courante avec GNU/Linux Mageia7+ Wine (Pas trouvé d'incohérences ou de bug de compilation à ce jour)
  • utilisation occasionnelle ou vérification/débugage difficile avec Windows XP sur un petit eeepc
   
• Jeux » Anagrammes Et Cie  
• Index

 |  |

1 Utilisateur en ligne : 0 Administrateur, 0 Modérateur, 0 Membre et 1 Visiteur
Utilisateur en ligne : Aucun membre connecté
Répondre
Vous n'êtes pas autorisé à écrire dans cette catégorie