 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
psygate
Anmeldungsdatum: 05.04.2005
Beiträge: 304
Wohnort: Wien und der Computer
|
 Verfasst am: 05.02.2008, 00:49 Titel: Rekursiver Aufruf (Frakaler Baum) |
 |
|
Hallo!
War schon lange nicht mehr da, aber jetzt steh ich wiedermal voll an.
Ich möchte gerne einen fraktalen Baum programmieren. Aber ich schaffs irgendwie nicht dass die Funktion sich selbst so aufruft, dass sie einen "Baum" erschafft. Ich möchte als endergebnis s einen Baum haben der sich als erstes in zwei Äste aufteilt und diese sollten sich dann wieder in zwei Äste aufteilen, aber ich schaff des einfach ned... Kann mir jemand helfen?
Achja... Ich würde das ganze ganz gern rekursiv machen, also die Funktion ruft sich selbst nochmal auf usw 
_________________
Danke an Volta für seine großartige MMX_fade function. *verneig*
Personal-DNA:
<script src="http://personaldna.com/h/?k=qtrCFboSuCOpFrX-OI-AADBA-f78d&t=Free-Wheeling+Leader">
</script>
| Zitat: | | Das Forum für den zum QBASIC kompatieblen open soure FreeBasic Kompiler. |
by DJ. Peters |
|
| Nach oben |
|
 |
ThePuppetMaster
Anmeldungsdatum: 18.02.2007
Beiträge: 1839
Wohnort: [JN58JR]
|
| Verfasst am: 05.02.2008, 08:33 Titel: |
|
|
Dazu musst du der Funktion eine Laufnummer übergeben, welche du in der funktion auswertest, und anhand dieser bestimmst, wie viele durchläufe in der funktion ausgeführt werden, bevor sie verlassen wird.
MfG
TPM
_________________
[ WebFBC ][ OPS ][ ToOFlo ][ Wiemann.TV ] |
|
| Nach oben |
|
|
Stormy
Anmeldungsdatum: 10.09.2004
Beiträge: 567
Wohnort: Sachsen - wo die schönen Frauen wachsen ;)
|
| Verfasst am: 05.02.2008, 10:44 Titel: |
|
|
So könnte es im Endeffekt aussehen:
| Code: | type Tree
as tree ptr left, right ' linker und rechter Ast
as integer depth ' Baumtiefe
end type
function CreateTree (depth as integer) As Tree Ptr
Dim as tree ptr myTree = callocate(sizeof(Tree)) ' Speicher für Baum allokieren
If depth > 0 then
myTree->left = CreateTree (depth-1)
myTree->right = CreateTree (depth-1)
End If
myTree->depth = depth
Return myTree
end function
Dim Baum As Tree Ptr = CreateTree (3) ' Erstellt einen Baum der Tiefe 3
|
Erklärung:
Jeder Baum hält zwei weitere Baum-Pointer, nämlich für seinen linken und seinen rechten Ast. Die Tiefe (depth) sollte selbsterklärend sein. Joa, ansonsten gibt es ja nicht viel zu erklären. Außer vielleicht wie du den Baum rekursiv durchsuchen kannst:
| Code: | sub VisitTree (myTree as Tree Ptr, depth as Integer)
' <- Hier beispielsweise Baum-Inhalt ausgeben
if myTree->depth > 0 then
VisitTree (myTree->left, depth-1)
VisitTree (myTree->right, depth-1)
end if
end sub |
Dies ist allerdings nur eine Variante, wie man einen Baum entwerfen kann. Ich zum Beispiel habe einen Quadtree für Kollisionerkennung (2D) in Entwicklung.
Viel Spaß damit!
_________________
+++ QB-City +++ Die virtuelle Stadt für jeden Freelancer - Join the community!
Projekte: QB-City,MysticWorld (RPG), 2D-OpenGL-Tutorial |
|
| Nach oben |
|
|
dreael
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 2529
Wohnort: Hofen SH (Schweiz)
|
| Verfasst am: 05.02.2008, 23:02 Titel: |
|
|
Von mir sonst ein sehr einfach gehaltenes Beispiel:
http://beilagen.dreael.ch/QB/FRAKTAL.BAS
Der Grundzweig ist in diesem Beispiel beabsichtigt konstruiert, wobei die "Nadeln" aufgrund des rekursiven Aufrufs selber wiederum Zweige darstellen und so schlussendlich ein fraktaltypisches, selbstähnliches Gebilde entsteht.
Codebeispiel dürfte evtl. sogar 1:1 in FreeBasic lauffähig sein, ansonsten kann ein FB-Profi das Beispiel noch anpassen.
_________________
Teste die PC-Sicherheit mit www.sec-check.net |
|
| Nach oben |
|
|
psygate
Anmeldungsdatum: 05.04.2005
Beiträge: 304
Wohnort: Wien und der Computer
|
| Verfasst am: 05.02.2008, 23:47 Titel: |
|
|
Also eig. wollte ich des ganzte einen graphischen Baum zeichnen lassen und dann auch möglichst ohne Pointer, da ich das ganze auch auf einem handy in Python implementieren wollte... Ich kenn ja die Forums regeln, dass ich erstmal was liefern sollte, aber ich hab grad nix in der Hand weil ich aus verzweiflung alles weggeworfen hab... Das wo ich wirklich hänge ist, dass die Funktion wissen muss in welcher Tiefe sie liegt...
Ah! Ich hab was ausgegraben:
| Code: |
const pi=3.141592
randomize timer
function branch(x,y,depth,child,r,maxdepth,n)
'x=Anfangspunkt x
'y=-"- y
'depth=Tiefe der Verzweigung (wie vielter Recall der Funktion)
'child=Anzahl der 'Kinder', also wie viele neue Funktionen aufgerufen werden sollen.
'r=Länge des Astes
'maxdepth=Maximale Tiefe der Iteration (Iterationsanzahl)
depth+=1
r*=0.5
a=pi*2*rnd
x1=x+cos(a)*r
y1=y+sin(a)*r
line (x,y)-(x1,y1),&hffffff
if depth<=maxdepth then
branch(x1,y1,depth,child,r,maxdepth)
endif
end function
|
Kann man damit wenigstens irgendwas anfangen?
_________________
Danke an Volta für seine großartige MMX_fade function. *verneig*
Personal-DNA:
<script src="http://personaldna.com/h/?k=qtrCFboSuCOpFrX-OI-AADBA-f78d&t=Free-Wheeling+Leader">
</script>
| Zitat: | | Das Forum für den zum QBASIC kompatieblen open soure FreeBasic Kompiler. |
by DJ. Peters |
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4704
Wohnort: ~/
|
| Verfasst am: 06.02.2008, 01:53 Titel: |
|
|
Du wirst statt des Aufrufs
| Code: | | branch(x1,y1,depth,child,r,maxdepth) |
vermutlich etwas in dieser Art brauchen:
| Code: | for i as integer = 1 to child
branch(x1,y1,depth,child,r,maxdepth)
next |
(übrigens END IF statt ENDIF  )
Das wird den Baum aber nicht von oben nach unten zeichnen, sondern Ast für Ast.
Warum nimmst du überhaupt eine Funktion? Hat doch keinen Rückgabewert, würde ich lieber eine Sub nehmen.
Nachtrag: das ganze sieht meines Erachtens ein wenig besser aus, wenn du
nimmst - dann geht der Baum zumindest immer nach unten und überlappt sich nicht gar so übel. 
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
psygate
Anmeldungsdatum: 05.04.2005
Beiträge: 304
Wohnort: Wien und der Computer
|
| Verfasst am: 06.02.2008, 02:26 Titel: |
|
|
Ok, ist klar, aber selbst wenn ich die deiden zusätze benutze zeichnet der nicht von oben nach unten alle äste, sondern einen und bricht dann ab...
_________________
Danke an Volta für seine großartige MMX_fade function. *verneig*
Personal-DNA:
<script src="http://personaldna.com/h/?k=qtrCFboSuCOpFrX-OI-AADBA-f78d&t=Free-Wheeling+Leader">
</script>
| Zitat: | | Das Forum für den zum QBASIC kompatieblen open soure FreeBasic Kompiler. |
by DJ. Peters |
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4704
Wohnort: ~/
|
| Verfasst am: 06.02.2008, 12:10 Titel: |
|
|
Also, bei mir zeichnet er alle Äste ...
| Code: | const pi=3.141592
randomize timer
screen 18
sub branch(x as integer, y as integer, depth as ubyte, child as ubyte, r as ubyte, maxdepth as ubyte)
'x=Anfangspunkt x
'y=-"- y
'depth=Tiefe der Verzweigung (wie vielter Recall der Funktion)
'child=Anzahl der 'Kinder', also wie viele neue Funktionen aufgerufen werden sollen.
'r=Länge des Astes
'maxdepth=Maximale Tiefe der Iteration (Iterationsanzahl)
depth+=1
r*=0.5
dim as single a=pi*2*rnd
dim as integer x1=x+cos(a)*r, y1=y+sin(a)*r
line (x,y)-(x1,y1), 15
if depth<=maxdepth then
for i as integer = 1 to child
branch(x1,y1,depth,child,r,maxdepth)
next
end if
end sub
' Hier mal ein Test
dim taste as string
do
cls
branch 200, 200, 0, 7, 500, 5
taste = input(1)
loop until taste = chr(27)
|
Habe sonst nur ein paar Änderungen wegen des DIM und der Farbwahl vorgenommen.
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
psygate
Anmeldungsdatum: 05.04.2005
Beiträge: 304
Wohnort: Wien und der Computer
|
| Verfasst am: 06.02.2008, 16:39 Titel: |
|
|
omfg... es funktioniert?!
Bei mir hat des nie geklappt...
Nagut Vielen vielen vielen dank! Das ist ein echter durchbruch für mich!  
_________________
Danke an Volta für seine großartige MMX_fade function. *verneig*
Personal-DNA:
<script src="http://personaldna.com/h/?k=qtrCFboSuCOpFrX-OI-AADBA-f78d&t=Free-Wheeling+Leader">
</script>
| Zitat: | | Das Forum für den zum QBASIC kompatieblen open soure FreeBasic Kompiler. |
by DJ. Peters |
|
| Nach oben |
|
|
psygate
Anmeldungsdatum: 05.04.2005
Beiträge: 304
Wohnort: Wien und der Computer
|
| Verfasst am: 07.02.2008, 01:05 Titel: |
|
|
So, ich hab das ganze jetzt mal so weit wie ichs eig. wollte. Vielleicht könnte sich jemand nochmal das ganze anschauen und mir bugs suchen, die ich bis jetzt noch nicht lösen konnte... danke
| Code: |
'Woods of Chaotic Decay
'by psygate
'Use as you like, but give credits.
'Thanks to nemored for help, and drael for his fractal code.
CONST pi=3.141592
randomize TIMER
'SCREEN 18
screenres 640,480,24,,
SUB branch(x AS INTEGER, y AS INTEGER, depth AS UBYTE, child AS UBYTE, r AS UBYTE, maxdepth AS UBYTE)
dim as ubyte r1,g1,b1,d
'x=Anfangspunkt x
'y=-"- y
'depth=Tiefe der Verzweigung (wie vielter Recall der Funktion)
'child=Anzahl der 'Kinder', also wie viele neue Funktionen aufgerufen werden sollen.
'r=Länge des Astes
'maxdepth=Maximale Tiefe der Iteration (Iterationsanzahl)
depth+=1
r*=0.5
DIM AS SINGLE a
DIM AS INTEGER x1,y1
if depth=1 then 'if first line, stam (sry, my english is a bit rusty ) should be upwards, not sidewards.
a=3*pi/8+pi+pi/8*2*rnd
elseif depth>1 then
a=-pi*RND 'Branches can go everywhere but down.
end if
x1=x+COS(a)*r
y1=y+SIN(a)*r
g1=int(rnd*255) 'Setting colours for the leafes, GREEN
r1=int(rnd*(g1-10)) 'Smaller than green, or the leaf isn't green anymore...
b1=r1
if depth=1 then 'If first line, stam should be brown (must work on that).
r1=128+int(rnd*128)
g1=r1/2+int(rnd*(r1/4))
b1=g1
endif
if r1<g1 then r1=0:b1=0 'I forgot what that line now really does... sry
'Routine für Brauntöne fehlt noch...
' if depth<maxdepth/2 then
' d=int(rnd*3)
' if d=0 then
' r1=int(rnd*255)
' g1=r1
' b1=int(rnd*(r1-10))
' elseif d=1 then
' r1=int(rnd*255)
' g1=r1-128
' b1=int(rnd*g1)
' elseif d=2 then
' r1=int(rnd*255)
' g1=int(rnd*(g1-128))
' b1=int(rnd*(b1-128))
' end if
' end if
LINE (x,y)-(x1,y1), rgb(r1,g1,b1)
IF depth<=maxdepth THEN
FOR i AS INTEGER = 1 TO child
branch(x1,y1,depth,child,r,maxdepth)
NEXT
END IF
END SUB
' Hier mal ein Test
DIM taste AS STRING
DO
'CLS
branch int(rnd*640), 479, 0, 2+int(rnd*3), 10+int(rnd*190), 4+int(rnd*6)
taste = inkey$'INPUT(1)
sleep 100
LOOP UNTIL taste = CHR(27)
|
_________________
Danke an Volta für seine großartige MMX_fade function. *verneig*
Personal-DNA:
<script src="http://personaldna.com/h/?k=qtrCFboSuCOpFrX-OI-AADBA-f78d&t=Free-Wheeling+Leader">
</script>
| Zitat: | | Das Forum für den zum QBASIC kompatieblen open soure FreeBasic Kompiler. |
by DJ. Peters |
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4704
Wohnort: ~/
|
| Verfasst am: 07.02.2008, 01:58 Titel: |
|
|
Sieht doch schön aus 
Bis auf ein weiteres ENDIF habe ich fast nichts zu meckern - na ja, ein bisschen was ist mir aufgefallen:
| Code: | | 'Thanks to nemored for help, and drael for his fractal code. |
nicht drael, sondern dreael.
| Code: | | if r1<g1 then r1=0:b1=0 'I forgot what that line now really does... sry |
Wenn alles richtig laufen würde, hättest du damit immer einen reinen Grünton (außer für den Stamm), weil r1 ja immer kleiner als g1 sein sollte. Dass dies nicht so ist, liegt hieran:
| Code: | | r1=INT(RND*(g1-10)) 'Smaller than green, OR the leaf isn't green anymore... |
Wenn g1 < 10 ist, dann kommen für r1 negative Werte heraus, die als UBYTE wieder positiv interpretiert werden und dann größer als g1 sind.
| Code: | | if depth=1 then 'if first line, stam (sry, my english is a bit rusty ) should be upwards, not sidewards. |
Meinst du den Baumstamm? Ich denke aber branch wäre ein passendes Wort.
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
psygate
Anmeldungsdatum: 05.04.2005
Beiträge: 304
Wohnort: Wien und der Computer
|
| Verfasst am: 07.02.2008, 16:06 Titel: |
|
|
<okok, um 2 in der nacht nach latein und fanzösisch hüs keine englisch ausflüge mehr
_________________
Danke an Volta für seine großartige MMX_fade function. *verneig*
Personal-DNA:
<script src="http://personaldna.com/h/?k=qtrCFboSuCOpFrX-OI-AADBA-f78d&t=Free-Wheeling+Leader">
</script>
| Zitat: | | Das Forum für den zum QBASIC kompatieblen open soure FreeBasic Kompiler. |
by DJ. Peters |
|
| Nach oben |
|
|
Cherry
Anmeldungsdatum: 20.06.2007
Beiträge: 249
|
| Verfasst am: 07.02.2008, 18:49 Titel: |
|
|
| @nemored: Was spricht gegen "EndIf"? |
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
