/// <summary> /// Classe permettant de charger et de gérer le dictionnaire /// </summary> public class Dico { private List<string> dico; private IEnumerable<string> dicoAppure; public Dico(string path) { Ouvrir(path); } /// <summary> /// Charge le fichier en paramètre, passe tous les mots en majuscules sans accent, exclu les mots composés /// </summary> /// <param name="path"></param> /// <returns></returns> public List<string> Ouvrir(string path) { char[] separateurs = { ' ','/','\t', '\\', Convert.ToChar(10) }; string[] tab = File.ReadAllText(path,Encoding.ASCII).Split(separateurs); Regex maRegex = new Regex("^[A-Z]{3,}$"); dico = (from mot in tab let m = RemoveDiacritics(mot.Trim()).ToUpperInvariant() where m.Length > 2 && maRegex.IsMatch(m) select m ).ToList<string>(); return dico; } /// <summary> /// Methode qui supprime les accents, source http://www.developpez.net/forums/d286030/dotnet/langages/csharp/supprimer-accents-lettre/ /// </summary> /// <param name="stIn"></param> /// <returns></returns> private string RemoveDiacritics(string stIn) { string stFormD = stIn.Normalize(NormalizationForm.FormD); StringBuilder sb = new StringBuilder(); for (int ich = 0; ich < stFormD.Length; ich++) { UnicodeCategory uc = CharUnicodeInfo.GetUnicodeCategory(stFormD[ich]); if (uc != UnicodeCategory.NonSpacingMark) { sb.Append(stFormD[ich]); } } return (sb.ToString().Normalize(NormalizationForm.FormC)); } /// <summary> /// Liste de mots qui constitue ce dictionnaire /// </summary> public List<string> Liste { get { return dico; } } }
public class De { private string faces; /// <summary> /// Construit un dé à partir d'un string listant chaque face /// </summary> /// <param name="Faces"></param> public De(string Faces) { faces = Faces; } /// <summary> /// Abscise du dé dans le tableau /// </summary> public int X { get; set; } /// <summary> /// Ordonnée du dé dans le tableau /// </summary> public int Y { get; set; } /// <summary> /// Face visible après le tirage /// </summary> public string FaceVisible { get; set; } /// <summary> /// Index du dé dans la liste /// </summary> public int Index { get; set; } /// <summary> /// Méthode choisant aléatoirement la face visible, les coordonnées du dé dans le plateau sont transférés par cette méthode /// </summary> /// <param name="X"></param> /// <param name="Y"></param> public void Tirage(int X, int Y) { Random rdm = new Random(); FaceVisible = faces[rdm.Next(faces.Length-1)].ToString(); this.X = X; this.Y = Y; Index = 4 * X + Y; } /// <summary> /// Retourne les dés adjacents à l'instance en cours, en sortant les dés contenus dans la liste exception /// </summary> /// <param name="Tirage">Tableau de dés correspond au tirage</param> /// <param name="excepetions">Liste de dés à exclure du resultat</param> /// <returns></returns> public List<De> Adjacents(List<De> Tirage, List<De> excepetions) { return (from De d in Tirage where (d != this && Math.Abs(d.X - X) < 2 && Math.Abs(d.Y - Y) < 2) select d ).Except(excepetions).ToList<De>(); } public override string ToString() { return FaceVisible; } }
public class Tirage { List<De> tires; /// <summary> /// Assure le tirage des disponibles 16 dés et la recherche de solutions /// </summary> /// <returns></returns> public Tirage(Dico MonDico) { this.MonDico = MonDico; Solutions = new List<string>(); NouveauTirage(); } public void NouveauTirage() { //dés disponilbes List<De> disponibles = new List<De>(); disponibles.Add(new De("ETUKNO")); disponibles.Add(new De("EVGTIN")); disponibles.Add(new De("IELRUW")); disponibles.Add(new De("DECAMP")); disponibles.Add(new De("EHIFSE")); disponibles.Add(new De("RECALS")); disponibles.Add(new De("ENTDOS")); disponibles.Add(new De("OFXRIA")); disponibles.Add(new De("NAVEDZ")); disponibles.Add(new De("EIOATA")); disponibles.Add(new De("GLENYU")); disponibles.Add(new De("BMAQJO")); disponibles.Add(new De("TLIBRA")); disponibles.Add(new De("SPULTE")); disponibles.Add(new De("AIMSOR")); disponibles.Add(new De("ENHRIS")); //dés tirés tires = new List<De>(); //effectue le tirage de la grille for (int x = 0; x < 4; x++) for (int y = 0; y < 4; y++) UnDe(disponibles, tires, x, y); //List<Chemin> chemins1 = CalculChemins(); List<Chemin> chemins2 = CalculCheminsRecursif(); } /// <summary> /// Lance un dé de la liste des dés disponibles, et le place dans la liste des dés tirés /// </summary> /// <param name="disponibles"></param> /// <param name="tires"></param> /// <param name="X"></param> /// <param name="Y"></param> private void UnDe(List<De> disponibles, List<De> tires, int X, int Y) { Random rnd = new Random(); De monDe = disponibles[rnd.Next(disponibles.Count)]; monDe.Tirage(X, Y); tires.Add(monDe); disponibles.Remove(monDe); } /// <summary> /// retourne les dés tirés /// </summary> public List<De> Des { get { return tires; } set { tires = value; } } /// <summary> /// Calcul tous les chemins de 3 dés possibles par récursivité /// </summary> private List<Chemin> CalculCheminsRecursif() { List<Chemin> chemins = new List<Chemin>(); foreach (De d in tires) { Chemin monChemin = new Chemin(); monChemin.Des.Add(d); RechercheRecursive(monChemin, chemins, MonDico.Liste.FindAll(m => m.StartsWith(monChemin.Texte))); } Solutions = (from c in chemins select c.Texte).ToList<string>(); return chemins; } /// <summary> /// Recherche par progression successive dans la grille, on teste s'il existe encore des mots commencant par le chemin /// en cours avant d'enclencher une instance supplémentaire. /// </summary> /// <param name="chemin">Chemin en cours</param> /// <param name="chemins">Liste des chemins valide</param> /// <param name="dico">dictionnaire appuré à chaque instance</param> private void RechercheRecursive(Chemin chemin, List<Chemin> chemins, List<string> dico) { List<De> adjacents =chemin.DernierDe.Adjacents(tires, chemin.Des); if (adjacents.Count == 0) return; foreach (De d in adjacents) { Chemin monChemin = chemin.Clone(); monChemin.Des.Add(d); int i; if (monChemin.Texte == "LUNE") i = monChemin.Des.Count; if (monChemin.Texte.Length > 2 && !chemins.Exists(m => m.Texte == monChemin.Texte) && dico.Exists(m => m == monChemin.Texte))//si le mot n'est pas déjà listé, et s'il existe on stocke le chemin chemins.Add(monChemin); List<string> dicoReduit = dico.FindAll(m => m.StartsWith(monChemin.Texte)); if (dicoReduit.Count > 0) RechercheRecursive(monChemin, chemins, dicoReduit);//s'il existe des mots commencant par cette sequence on continue else continue;//sinon on passe au dé adjacent suivant } } public Dico MonDico { get; set; } public List<string> Solutions { get; set; } }
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionSub Tirage() Dim Cubes As Variant, Cel As Range, cpt As Byte, carac As Integer cpt = 0 Sheets("feuil1").Range("grille").ClearContents Cubes = Array("ETUKNO", "EVGTIN", "IELRUW", "DECAMP", "EHIFSE", "RECALS", "ENTDOS", "OFXRIA", "NAVEDZ", "EIOATA", "GLENYU", "BMAQJO", "TLIBRA", "SPULTE", "AIMSOR", "ENHRIS") Randomize For Each Cel In Range("grille") Do carac = CInt((6 * Rnd()) + 1) If carac < 6 And carac > 1 Then Cel.Value = Mid(Cubes(cpt), carac, 1) Loop While Cel.Value = "" cpt = cpt + 1 Next Cel End Sub
Sub Tirage() Dim Cubes As Variant, cpt As Byte, carac As Integer, AleaLig As Integer, AleaCol As Integer 'la grille choisie : Range("D2:G5") Sheets("feuil1").Range("grille").ClearContents Cubes = Array("ETUKNO", "EVGTIN", "IELRUW", "DECAMP", "EHIFSE", "RECALS", "ENTDOS", "OFXRIA", "NAVEDZ", "EIOATA", "GLENYU", "BMAQJO", "TLIBRA", "SPULTE", "AIMSOR", "ENHRIS") Randomize Do While WorksheetFunction.CountA(Sheets("feuil1").Range("grille")) < 16 cpt = WorksheetFunction.CountA(Sheets("feuil1").Range("grille")) Do AleaLig = (5 - 2) * Rnd() + 2 ' 5 = dernière ligne de la grille, 2 = première ligne AleaCol = (7 - 4) * Rnd() + 4 ' 7 = dernière colonne de la grille, 4 = 1ère colonne Loop While Sheets("feuil1").Cells(AleaLig, AleaCol) <> "" Do carac = CInt((6 * Rnd()) + 1) Loop While carac > 6 Or carac < 1 Sheets("feuil1").Cells(AleaLig, AleaCol).Value = Mid(Cubes(cpt), carac, 1) Loop End Sub
cubes = Array("ETUKNO", "EVGTIN", "IELRUW", "DECAMP", "EHIFSE", "RECALS", "ENTDOS", "OFXRIA", "NAVEDZ", "EIOATA", "GLENYU", "BMAQJO", "TLIBRA", "SPULTE", "AIMSOR", "ENHRIS")avec cette procédure :
touille_cubes cubes '================> voir cette proc plus bas
Randomize
For Each Cel In grille
Do
carac = CInt((6 * Rnd()) + 1)
If carac < 6 And carac > 1 Then Cel.Value = Mid(cubes(cpt), carac, 1)
Loop While Cel.Value = ""
cpt = cpt + 1
Next Cel
Private Sub touille_cubes(ByRef cubes)
Dim i As Integer, nb As Integer, ou As Integer, temp As String
nb = UBound(cubes)
For i = 0 To nb / 2
ou = Int(((15 - i) * Rnd))
temp = cubes(ou)
cubes(ou) = cubes(nb - i)
cubes(nb - i) = temp
Next
End Sub
CInt((6 * Rnd()) + 1), on obtient des chiffres entre 1 et 7... N'y a t'il pas une autre méthode pour n'obtenir que des chiffres compris entre 1 et 6??
If carac < 6 And carac > 1. Il convient de remplacer les supérieur et inférieur stricts par supérieur ou égal et inférieu ou égal :
If carac <= 6 And carac >= 1
cubes = Array("ETUKNO", "EVGTIN", "IELRUW", "DECAMP", "EHIFSE", "RECALS", "ENTDOS", "OFXRIA", "NAVEDZ", "EIOATA", "GLENYU", "BMAQJO", "TLIBRA", "SPULTE", "AIMSOR", "ENHRIS")puisque la verif "If carac < 6 And carac > 1 Then " est alors inutile
touille_cubes cubes
Randomize
For Each Cel In grille
Do
carac = CInt((5 * Rnd()) + 1)
Cel.Value = Mid(cubes(cpt), carac, 1)
Loop While Cel.Value = ""
cpt = cpt + 1
Next Cel
Sub RetirerMotsLettresManquantes() Dim lettresutilisees(), lettresmanquantes() Dim ListeMotsTemp() As String, Lettr$, mot$ Dim i&, j&, k&, test As Boolean Dim MonDico1 As Object, MonDico2 As Object, c lettresutilisees = Range("grille") '-----> Menu Insertion/Noms/Définir Set MonDico1 = CreateObject("Scripting.Dictionary") For Each c In lettresutilisees MonDico1(c) = "" Next c Set MonDico2 = CreateObject("Scripting.Dictionary") For Each c In Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z") If Not MonDico1.exists(c) Then MonDico2(c) = "" Next c lettresmanquantes = Application.Transpose(MonDico2.keys) ListeMotsTemp = ListeMots Erase ListeMots For i = 0 To UBound(ListeMotsTemp) mot = ListeMotsTemp(i) For j = 1 To UBound(lettresmanquantes) Lettr = lettresmanquantes(j, 1) If InStr(mot, Lettr) = 0 Then test = True Exit For End If Next j If test = False Then ReDim Preserve ListeMots(k) ListeMots(k) = ListeMotsTemp(i) k = k + 1 End If Next i End Sub
Sub Dictionnaire() Dim Tb() As String, Chemin As String, num As Long, i As Long Chemin = ThisWorkbook.Path num = FreeFile Open Chemin & "\DicoFirefoxFrancais.txt" For Input As #num i = -1 While Not EOF(1) i = i + 1 ReDim Preserve Tb(i) Line Input #1, Tb(i) Wend Close #num End Sub
UBound(Tb) = 0...
Option Explicit Dim ListeMots Sub Dictionnaire() Dim Tb() As String, Chemin As String, num As Long, i As Long, PremierJet() As String Dim Start As Single Start = Timer Chemin = ThisWorkbook.Path num = FreeFile Open Chemin & "\DicoFirefoxFrancais.txt" For Input As #num i = -1 While Not EOF(1) i = i + 1 ReDim Preserve Tb(i) Line Input #1, Tb(i) Wend Close #num PremierJet = Split(Tb(0), "/") For i = LBound(PremierJet) To UBound(PremierJet) PremierJet(i) = Split(PremierJet(i), Chr(9))(1) PremierJet(i) = Split(PremierJet(i), Chr(10))(1) PremierJet(i) = RemplaceCarSpec(PremierJet(i)) Next i ListeMots = Affine(PremierJet) MsgBox "Enregistrement en mémoire de : " & UBound(ListeMots) & " mots, en : " & Timer - Start & " secondes." End Sub
Function RemplaceCarSpec(monMot As String) Dim motTemp As String motTemp = Replace(monMot, "é", "e") motTemp = Replace(motTemp, "ï", "i") motTemp = Replace(motTemp, "è", "e") motTemp = Replace(motTemp, "-", "") motTemp = Replace(motTemp, "ç", "c") motTemp = Replace(motTemp, "ë", "e") motTemp = Replace(motTemp, "ê", "e") motTemp = Replace(motTemp, "ü", "u") motTemp = Replace(motTemp, "â", "a") motTemp = Replace(motTemp, "ä", "ae") motTemp = Replace(motTemp, "ô", "o") motTemp = Replace(motTemp, "ÿ", "y") motTemp = Replace(motTemp, "î", "i") motTemp = Replace(motTemp, "Å""", "oe") motTemp = Replace(motTemp, "û", "u") motTemp = Replace(motTemp, "æ", "ae") motTemp = Replace(motTemp, "Ã¥", "a") motTemp = Replace(motTemp, "ö", "o") motTemp = Replace(motTemp, "Ã", "a") motTemp = Replace(motTemp, "É", "e") motTemp = Replace(motTemp, "È", "e") motTemp = Replace(motTemp, "Ã...", "a") motTemp = Replace(motTemp, "Å'", "oe") RemplaceCarSpec = UCase(motTemp) End Function
Function Affine(Tbl) Dim TbTemp(), i As Long, CptTbNum As Long, CptTemp As Long For i = LBound(Tbl) To UBound(Tbl) If Len(Tbl(i)) > 2 And Len(Tbl(i)) < 17 Then If Not IsNumeric(Right(Tbl(i), 1)) And Not IsNumeric(Left(Tbl(i), 1)) Then ReDim Preserve TbTemp(CptTemp) TbTemp(CptTemp) = Tbl(i) CptTemp = CptTemp + 1 End If End If Next i Affine = TbTemp End Function
Il importe également de ne pas perdre de vue que cette appli est sous VBA/.Excel et que cette particularité pourrait conduire à certaines méthodes que ne permettraient ni VB6 ni VB.Net (qui imposeraient entre autres le traitement d'un tableau dynamique, sans autre possibilité).
A P V XOn y voit très clairement que ce mot y est trouvé plusieurs fois.
Y A P I
I K I X
O X W Z
int i;
if (monChemin.Texte == "LUNE")
i = monChemin.Des.Count;
/// <summary> /// Calcul tous les chemins de dés possibles par récursivité /// </summary> private List<Chemin> CalculCheminsRecursif() { List<Chemin> chemins = new List<Chemin>(); foreach (De d in tires)//ici chaque dé { Chemin monChemin = new Chemin(); monChemin.Des.Add(d); RechercheRecursive(monChemin, chemins, MonDico.Liste.FindAll(m => m.StartsWith(monChemin.Texte)));//lance la recherche récursive sur la liste de mots commençant par la lettre en cours } Solutions = (from c in chemins select c.Texte).ToList<string>(); return chemins; }
/// <summary> /// Recherche par progression successive dans la grille, on teste s'il existe encore des mots commencant par le chemin /// en cours avant d'enclencher une instance supplémentaire. /// </summary> /// <param name="chemin">Chemin en cours</param> /// <param name="chemins">Liste des chemins valide</param> /// <param name="dico">dictionnaire appuré à chaque instance</param> private void RechercheRecursive(Chemin chemin, List<Chemin> chemins, List<string> dico) { List<De> adjacents =chemin.DernierDe.Adjacents(tires, chemin.Des);//recherche des adjacents if (adjacents.Count == 0) return;//s'il n'y en a plus on remote d'un niveau foreach (De d in adjacents) { Chemin monChemin = chemin.Clone();//je clone le chemin car à chaque instance récursive il m'en faut un dédié monChemin.Des.Add(d);// j'ajoute le dé en cours if (monChemin.Texte.Length > 2 && !chemins.Exists(m => m.Texte == monChemin.Texte) && dico.Exists(m => m == monChemin.Texte))//si le mot n'est pas déjà listé, et s'il existe on stocke le chemin chemins.Add(monChemin); List<string> dicoReduit = dico.FindAll(m => m.StartsWith(monChemin.Texte)); if (dicoReduit.Count > 0) RechercheRecursive(monChemin, chemins, dicoReduit);//s'il existe des mots commencant par cette sequence on continue else continue;//sinon on passe au dé adjacent suivant } }
tu trouves MAIN, réinitialise le chemin, et tu peux trouver MAINS. Ces deux mots sont comptabilisés
PS ; je m'en suis aperçu en comptabilisant (une fois pour toutes et en utilisant asc(65) ) le nombre de chaque lettre de chaque mot.Ton classeur n'est pas trop "lourd"? 3-4 Mo? plus?
En précisant que j'importe le dico dans excel, ainsi que cette comptabilisation. Cette moulinette prend plusieurs minutes, mais n'est faite qu'une seule fois, puisque le classeur est ensuite enregistré et garde donc une fois pour toutes ces données.
Modifié par ucfoutu le 4/03/2014 à 18:41
Directement sur me fichier téléchargé ou après (relis mon message précédent) l'avoir sauvegardé dans un autre dossier, fermé, puis ouvert à nouveau ?
Modifié par f894009 le 4/03/2014 à 19:12
copier fichier dans un repertoire et ouvert/fermer plusieurs fois. Aux premiers essais, voyant que c'etait plutot long, j'ai cru qu'excel etait plante. J'ai trouve des temps en remontant le fil du sujet, donc j'ai recommence en attendent que cela se fasse.
4 mars 2014 à 18:54
Merci beaucoup de votre retour.
Pouvez-vous essayer d'ouvrir le fichier et l'enregistrer toujours au format xls mais sous un autre nom avant de relancer le test. Merci d'avance
4 mars 2014 à 19:19
172.71 s pour la destruction, reste dans la plage 173-179
4 mars 2014 à 19:31
Encore merci pour ces résultats. Il y a vraiment donc un problème lors de la destruction, la mémoire met trop de temps à se libérer chez quatre testeurs différents.
Bonne soirée.