Auteur : Flype
Auteur : Comtois
| | Version : 20/02/2008 | | |
| |
Pour cela on utilise un arbre binaire. L'arbre contient un noeud pour chaque mot, et chaque noeud contient une variable pour stocker :
- Le mot
- Le nombre d'apparitions du mot
- Un pointeur vers le noeud suivant à gauche
- Un pointeur vers le noeud suivant à droite
A partir de n'importe quel noeud , le sous arbre de gauche ne contient que des mots de valeurs inférieures au mot contenu dans le noeud, et le sous arbre de droite ne contient que des mots de valeurs supérieures.
Structure Noeud
mot.s
compteur.l
*Gauche.Noeud
*Droit.Noeud
EndStructure
Procedure.s Affiche(*Noeud.Noeud, minimum.l)
Protected resultat.s
If *Noeud
resultat + Affiche(*Noeud\Gauche, minimum)
If *Noeud\compteur >= minimum
resultat + RSet(Str(*Noeud\compteur), 4, "0") + " : " + *Noeud\mot + #CRLF$
EndIf
resultat + Affiche(*Noeud\Droit, minimum)
EndIf
ProcedureReturn resultat
EndProcedure
Procedure.l Arbre(*Noeud.Noeud, mot.s)
If *Noeud
If mot = *Noeud\mot
*Noeud\compteur + 1
ElseIf mot < *Noeud\mot
*Noeud\Gauche = Arbre(*Noeud\Gauche, mot)
Else
*Noeud\Droit = Arbre(*Noeud\Droit, mot)
EndIf
Else
*Noeud = AllocateMemory(SizeOf(Noeud))
If *Noeud
*Noeud\mot = mot
*Noeud\compteur = 1
EndIf
EndIf
ProcedureReturn *Noeud
EndProcedure
Procedure.l Analyse(texte.s, minimum.l)
Protected *arbre, mot.s, nbcar.l, *txt.Character = @texte
While *txt\c
Select *txt\c
Case ' ', '.', ',', '
If nbcar >= minimum
*arbre = Arbre(*arbre, mot)
EndIf
mot = ""
nbcar = 0
Default
mot + Chr(*txt\c)
nbcar + 1
EndSelect
*txt + SizeOf(Character)
Wend
ProcedureReturn *arbre
EndProcedure
Procedure.s Texte(fichier.s)
Protected texte.s
If ReadFile(0, fichier)
texte = Space(Lof(0))
ReadData(0, @texte, Lof(0))
CloseFile(0)
EndIf
ProcedureReturn texte
EndProcedure
MessageRequester("Résultat", Affiche(Analyse(Texte(#PB_Compiler_Home+"Compilers/APIFunctionListing.txt"), 4), 20))
|
|
Auteur : Comtois
| | Version : 20/02/2008 | | |
| | 
Structure s_Objet
x.l
y.l
Rayon.l
EndStructure
Structure s_Boite
Xmini.l
Ymini.l
Xmaxi.l
Ymaxi.l
EndStructure
Structure s_QuadTree
Depth.l
Boite.s_Boite
NbObjets.l
*Liste.s_Objet
*Fils.s_QuadTree[4]
EndStructure
Declare ConstructionQuadTree(*Noeud.s_QuadTree, *Boite.s_Boite, *Liste.s_Objet, NbObjets)
Declare RenderQuadtree(*this.s_QuadTree)
#NbObjets = 50
#QuadSize = 599
#QuadDepth = 5
#QuadObjet = 1
#Rayon = 3
Dim ListeInitiale.s_Objet(#NbObjets-1)
Define.s_QuadTree NoeudInitial
Define.s_Boite BoiteInitiale
Procedure InitBoite(*this.s_Boite, Xmini, Xmaxi, Ymini, Ymaxi)
With *this
\Xmini = Xmini
\Xmaxi = Xmaxi
\Ymini = Ymini
\Ymaxi = Ymaxi
EndWith
EndProcedure
Procedure CreationListe(this.s_Objet(1))
For i=0 To #NbObjets-1
this(i)\x = Random(#QuadSize-#Rayon)
this(i)\y = Random(#QuadSize-#Rayon)
this(i)\Rayon = #Rayon
Next i
EndProcedure
Procedure ConstructionQuadTree(*Noeud.s_QuadTree, *Boite.s_Boite, *Liste.s_Objet, NbObjets)
Define.s_Boite BoiteFils
Define.s_Objet *ListeFils, *Ptr
Define.s_QuadTree *PtrF
Define.l x, y, z, i, t, NbObjetsFils
NewList Liste.s_Objet()
*Noeud\Boite\Xmini = *Boite\Xmini
*Noeud\Boite\Xmaxi = *Boite\Xmaxi
*Noeud\Boite\Ymini = *Boite\Ymini
*Noeud\Boite\Ymaxi = *Boite\Ymaxi
If NbObjets > #QuadObjet And *Noeud\Depth < #QuadDepth
For y = 0 To 1
For x = 0 To 1
i = (y << 1) | x
BoiteFils\Xmini = (1.0 - x / 2.0) * *Boite\Xmini + x / 2.0 * *Boite\Xmaxi
BoiteFils\Xmaxi = BoiteFils\Xmini + (*Boite\Xmaxi - *Boite\Xmini) / 2.0
BoiteFils\Ymini = (1.0 - y / 2.0) * *Boite\Ymini + y / 2.0 * *Boite\Ymaxi
BoiteFils\Ymaxi = BoiteFils\Ymini + (*Boite\Ymaxi - *Boite\Ymini) / 2.0
*Ptr = *Liste
ClearList(Liste())
For t = 1 To NbObjets
If *Ptr\x > BoiteFils\Xmini And *Ptr\x < BoiteFils\Xmaxi And *Ptr\y > BoiteFils\Ymini And *Ptr\y < BoiteFils\Ymaxi
AddElement(Liste())
CopyMemory(*Ptr, Liste(), SizeOf(s_Objet))
EndIf
*Ptr + SizeOf(s_Objet)
Next t
NbObjetsFils = CountList(Liste())
*ListeFils = #Null
If NbObjetsFils
*ListeFils = AllocateMemory(SizeOf(s_Objet) * NbObjetsFils)
*Ptr = *ListeFils
ForEach Liste()
CopyMemory(Liste(), *Ptr, SizeOf(s_Objet))
*Ptr + SizeOf(s_Objet)
Next
EndIf
*Noeud\Fils[i]=AllocateMemory(SizeOf(s_QuadTree))
*PtrF = *Noeud\Fils[i]
*PtrF\Depth = *Noeud\Depth + 1
ConstructionQuadTree(*Noeud\Fils[i], @BoiteFils, *ListeFils, NbObjetsFils)
Next x
Next y
Else
*Noeud\Liste = *Liste
*Noeud\NbObjets = NbObjets
EndIf
EndProcedure
Procedure RenderQuadtree(*this.s_QuadTree)
DrawingMode(#PB_2DDrawing_Outlined)
Box(*this\Boite\xmini,*this\Boite\ymini,*this\Boite\xmaxi-*this\boite\xmini,*this\Boite\ymaxi-*this\Boite\ymini,#White)
If *this\Liste
*Ptr.s_Objet = *this\Liste
For i = 0 To *this\NbObjets-1
Circle(*Ptr\x,*Ptr\y, *Ptr\Rayon,#Red)
*Ptr + SizeOf(s_Objet)
Next i
EndIf
For y = 0 To 1
For x = 0 To 1
i = (y << 1) | x
If *this\Fils[i]
RenderQuadtree(*this\Fils[i])
EndIf
Next x
Next y
EndProcedure
If InitSprite()=0 Or InitMouse()=0 Or InitKeyboard()=0
End
EndIf
OpenScreen(800,600,32,"Quadtree Demo")
InitBoite(@BoiteInitiale, 0, #QuadSize, 0, #QuadSize)
CreationListe(ListeInitiale())
ConstructionQuadTree(@NoeudInitial, @BoiteInitiale, ListeInitiale(), #NbObjets)
Repeat
ClearScreen(#Black)
ExamineKeyboard()
StartDrawing(ScreenOutput())
RenderQuadtree(@NoeudInitial)
StopDrawing()
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
|
|
Consultez les autres pages sources
Les sources présentés sur cette pages sont libre de droits,
et vous pouvez les utiliser à votre convenance. Par contre cette page de présentation de ces sources constitue une oeuvre intellectuelle protégée par les droits d'auteurs.
Copyright ©2008
Developpez LLC. Tout droits réservés Developpez LLC.
Aucune reproduction, même partielle, ne peut être faite de ce site et de
l'ensemble de son contenu : textes, documents et images sans l'autorisation
expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à 3 ans
de prison et jusqu'à 300 000 E de dommages et intérets.
Cette page est déposée à la SACD.
|
