Schwarm-Simulation
Übersicht
BlitzBasic CodearchivGehe zu Seite Zurück 1, 2, 3, 4, 5 Weiter
Eisrabe |
 Fr, Jan 30, 2004 17:45Antworten mit Zitat 
|
|
|---|---|---|
|
Inarie hat Folgendes geschrieben: MENSCH EISRABE! Du nervst! Update mal dein BB und hör auf andauernd zu posten, dass irgendwas nicht funzt! Lass die finger vom Postknopf, überprüfe ob es EVENTUELL auch mal an deiner BBVersion liegen könnte und wenn es nicht an ihr liegt, dann poste!
p.s. die befehle object und handle gibt es nicht in den uraltbbversionen... Inarie, finde dich ab, dass nicht jeder die neuest BB-version hat. ich denke nicht dass ich meine alte BB2D-version überhaupt updaten kann. ich könnte höchstens BBplus kaufen, was ich noch nicht tue. wenn du nicht helfen magst, dann lasse DU einfach das posten auf meine fragen. ps: da es verschiedene BB-versionen gibt, wäre es für die coder doch mal ratsam in der ersten programmzeile die erforderliche BB-version für das jeweilige listing zu schreiben, oder? |
||
|
ich habe einCode: [AUSKLAPPEN] GOTO und ich bin bereit es einzusetzen!
|
||
|
Mr.Keks |
Fr, Jan 30, 2004 17:51 Antworten mit Zitat
|
|---|---|---|
|
wie soll ich dir denn bitteschön helfen? der befehl geht nur mit neueren bbversionen und das ist dein zehntes posting aus soeinem grund innerhalb weniger tage und soetwas nervt mich einfach. du bist der erste, der probleme damit hat, zu erkennen, ob sein bb zu alt ist bzw. er die falsche version besitzt.
und es ist noch möglich, upzudaten. ich habe auf blitzbasic.com nachgeschaut und im accountbereich ist b2dv180 downloadbar... |
||
| MrKeks.net | ||
Eisrabe |
Fr, Jan 30, 2004 17:57 Antworten mit Zitat
|
|
|---|---|---|
| hehe, Inarie, DAS IST der IE6-patch. den hab ich längst. | ||
|
ich habe einCode: [AUSKLAPPEN] GOTO und ich bin bereit es einzusetzen!
|
||
|
|
Mr.Keks |
Fr, Jan 30, 2004 17:59 Antworten mit Zitat
|
|---|---|---|
dann wollen die mich wohl verarschen, indem die da "Blitz2DUpdate180.exe" raufschreiben? 
|
||
| MrKeks.net | ||
Eisrabe |
Fr, Jan 30, 2004 18:02 Antworten mit Zitat
|
|
|---|---|---|
|
Inarie hat Folgendes geschrieben: dann wollen die mich wohl verarschen, indem die da "Blitz2DUpdate180.exe" raufschreiben?
verarschen können sie dich nur, wenn sie schreben, was der patch macht, er es aber nicht macht. ich habe auf jeden fall DEN o.g. patch längst installiert. benutzt du BBplus? welche versionen gibts jetzt überhapt ? BB2d, BBplus und BB3D ? oder gibts noch verschiedene BB2D-versionen? |
||
|
ich habe einCode: [AUSKLAPPEN] GOTO und ich bin bereit es einzusetzen!
|
||
|
MoochBetreff: ... |
Fr, Jan 07, 2005 23:06 Antworten mit Zitat
|
|---|---|---|
| Oh! Die gleiche Idee hatte ich auch! http://hometown.aol.de/Tristan...lation.zip | ||
|
Pentium IV 3.0Ghz; nVidia Geforce 6800;
Microsoft Windows XP Home SP2; BlitzBasic 3D .:: Sites ::. .:: http://www.fl4sh-clan.de/ ::. |
||
xperience2003Betreff: ... |
Sa, Jan 08, 2005 3:08 Antworten mit Zitat
|
|
|---|---|---|
|
hehe, absolut genial
|
||
|
|
MoochBetreff: ... |
Sa, Jan 08, 2005 14:29 Antworten mit Zitat
|
|---|---|---|
War das jetzt ironisch gemeint? 
Ach ja, mit nem Rechtsklick kann man einen Fuchs oder eine Maus erstellen. (Die Simulation ist ja auch noch nicht fertig...) |
||
|
Pentium IV 3.0Ghz; nVidia Geforce 6800;
Microsoft Windows XP Home SP2; BlitzBasic 3D .:: Sites ::. .:: http://www.fl4sh-clan.de/ ::. |
||
|
Fetze |
So, Jan 09, 2005 4:38 Antworten mit Zitat
|
|---|---|---|
|
Hab mich mal rangesetzt und was zum Thema programmiert. Nochmal komplett neu angefangen. Es sieht zwar nicht halb so schön aus, wie euer Teil und ist auch nicht halb so fertig, aber dafür hat es ein interessantes Konzept:
Jedes Bakterium hat eine DNA, die aus einsen und nullen besteht. Diese DNA wird tatsächlich interpretiert und wirkt sich auf die Zelle aus. Praktisch alles wird davon beeinflusst: Form, Farbe, Vermehrungsrate, Mutationsrate, Lebensdauer, Art der Energiegewinnung(noch nicht 100% ausgereift), etc. Vielleicht habt ihr ja lust, das mal weiterzuproggen. Diese Version ist schon voll ansehbar, allerdings benötigt ihr wohl mehrere Versuche, bis sich zumindest eine der beiden Bakterienkolonien etabliert. Die Mutationsrate ist nämlich im moment sehr hoch, sodass sie sich zwar schnell entwickeln, jedoch ihr Genom auch schnell futsch ist, sodass sie sterben. Hier: Code: [AUSKLAPPEN] ;### GRAFIKMODUS U. ZUFALLSGENERATOR ### Const RES_X=640,RES_Y=480 Graphics RES_X,RES_Y,16,2 SeedRnd MilliSecs() SetBuffer BackBuffer() ClsColor 30,30,30 zeittakt=CreateTimer(60) ;####################################### ;### KONSTANTEN ### Const DNA_StartLength=8 Const DNA_Shape_Edge_Start$="00000000" Const DNA_Shape_Edge_End$="00000001" Const DNA_Genom_Repairtime_Start$="00000010" Const DNA_Genom_Repairtime_End$="00000011" Const DNA_Genom_Protection_Start$="00000100" Const DNA_Genom_Protection_End$="00000101" Const DNA_Genom_Repairchance_Start$="00000110" Const DNA_Genom_Repairchance_End$="00000111" Const DNA_Reproductionrate_Start$="00001000" Const DNA_Reproductionrate_End$="00001001" Const DNA_Health_Fotosynth_Start$="00001010" Const DNA_Health_Fotosynth_End$="00001011" Const DNA_Health_Eat_Start$="00001100" Const DNA_Health_Eat_End$="00001101" Const DNA_Shape_Color_Start$="00001110" Const DNA_Shape_Color_End$="00001111" Const NegativeStr$="0" Const PositiveStr$="1" Const ReproduceDelay=1000 Const KillHealth=20 Const MaxEatRange=25 Const MaxFotoSynth#=2 Const Shape_MaxEdges=16 Const Shape_MaxEdgeEntf=10 Const Genom_MaxChanges=10 ;################## ;### TYPE-FELDER DEFINIEREN ### Type bakterium ;Eine Bakterie ;### NICHT-STATISCHE VARIABLEN ### Field x#,y# ;Position Field xspeed#,yspeed# ;Geschwindigkeit Field health# ;Gesundheit des Bakteriums. Sinkt es auf KillHealth, stirbt das Bakterium. Field genom$ ;Ihr momentanes Genom Field genom_changes ;Die Veränderungen am Genom Field timer_genomrepair ;Der Reperatur-Timer. Zählt bis genom_repairtime*10 hoch ;################################# ;### STATISCHE VARIABLEN ### Field shape_edges ;Die Anzahl der Kanten der Form des Bakteriums Field shape_edgeX[Shape_MaxEdges] ;Die Position der Kanten der Form des Bakteriums Field shape_edgeY[Shape_MaxEdges] Field shape_color_r,shape_color_g,shape_color_b ;Die Farbe des Bakteriums Field genom_repairtime ;Die Zeitabstand / 10, in dem das Genom repariert wird Field genom_protection ;Der "Schutz" des Genoms. Je höher, desto seltener Mutiert es. Field genom_repairchance ;Die Chance zur Reperatur eines Gens. Je höher, desto höher die Erfolgschance. Field health_fotosynth ;Die Effizienz der Fotosynthese. In Health pro Zyklus / 100 Field health_eat ;Die Effizienz des Fressens. In Health pro Zyklus / 100 Field reproductionrate ;Die Vermehrungsrate. Je höher, desto schneller vermehrt sich das Bakterium Field genom_orig$ ;Das Genom bei geburt der Bakterie ;########################### End Type ;############################## ;### INITIALISIEREN ### ;CreateBakterium(300,100,100,"00000000 0100 0100 00000001 00000000 1100 0100 00000001 00000000 1100 1100 00000001 00000000 0100 1100 00000001 00000010 1100100 00000011 00000100 1010 00000101 00000110 0101 00000111 00001000 110010 00001001 00001010 1100100 00001011 00001110 000 00001111") CreateBakterium(300,200,100,"00000000 0100 0100 00000001 00000000 1100 0100 00000001 00000000 1100 1100 00000001 00000000 0100 1100 00000001 00000010 1100100 00000011 00000100 1010 00000101 00000110 0101 00000111 00001000 110010 00001001 00001010 1100100 00001011 00001100 0 00001101 00001110 000000000000000000000000 00001111") CreateBakterium(300,300,100,"00000000 0100 0100 00000001 00000000 1100 0100 00000001 00000000 1100 1100 00000001 00000000 0100 1100 00000001 00000010 1100100 00000011 00000100 1010 00000101 00000110 0101 00000111 00001000 110010 00001001 00001010 1100100 00001011 00001100 0 00001101 00001110 111111111111111111111111 00001111") ;CreateBakterium(300,400,100,"00000000 0100 0100 00000001 00000000 1100 0100 00000001 00000000 1100 1100 00000001 00000000 0100 1100 00000001 00000010 1100100 00000011 00000100 1010 00000101 00000110 0101 00000111 00001000 110010 00001001 00001010 1100100 00001011 00001110 000 00001111") ;###################### ;### HAUPTSCHLEIFE ### Repeat Cls UpdateBakterien() ;Bakterien berechnen WaitTimer(zeittakt) Flip Until KeyHit(1) ;##################### ;### FUNKTIONEN ### Function CreateBakterium(x,y,health#,genom$) ;Bakterium erstellen b.bakterium=New bakterium b\x#=x ;Position b\y#=y b\xspeed#=0 ;Geschwindigkeit b\yspeed#=0 b\health#=health# b\genom$=Replace(genom$," ","") ;Genom festlegen b\genom_orig$=b\genom$ ParseDNA(Handle(b)) ;Genom interpretieren Return Handle(b) ;Handle zurückgeben End Function Function DeleteBakterium(hndl) b.bakterium=Object.bakterium(hndl) Delete b.bakterium End Function Function KillBakterium(hndl) DeleteBakterium(hndl) End Function Function UpdateBakterien() ;Bakterien berechnen For b.bakterium=Each bakterium ;Bakterien durchgehen ;Temporär: Speedberechnung. Sollte noch ausgetauscht werden! If b\health_eat>10 Then tmphndl=GetPreyBakterium(Handle(b),200) If tmphndl<>-1 Then temp.bakterium=Object.bakterium(tmphndl) b\xspeed#=(temp\x#-b\x#);/200 b\yspeed#=(temp\y#-b\y#);/200 End If End If b\xspeed#=b\xspeed#+Rnd(-0.5,0.5) b\yspeed#=b\yspeed#+Rnd(-0.5,0.5) If b\xspeed#>1 Then b\xspeed#=1 If b\xspeed#<-1 Then b\xspeed#=-1 If b\yspeed#>1 Then b\yspeed#=1 If b\yspeed#<-1 Then b\yspeed#=-1 ;Bewegung b\x#=b\x#+b\xspeed# b\y#=b\y#+b\yspeed# ;Fotosynthese If b\health_fotosynth>10 Then b\health#=b\health#+Float(Float(b\health_fotosynth)/Float(100)) ; Color 0,255,0 ; Rect b\x#,b\y#,2,2,1 End If ;Fressen If b\health_eat>10 Then tmphndl=GetPreyBakterium(Handle(b),MaxEatRange) ;GetPreybakterium durch Genetisch bedingte Fressvorlieben ersetzen If tmphndl<>-1 Then temp.bakterium=Object.bakterium(tmphndl) temp\health#=temp\health#-Float(Float(b\health_eat)/Float(25)) b\health#=b\health#+Float(Float(b\health_eat)/Float(25)) End If ; Color 255,0,0 ; Rect b\x#,b\y#+2,2,2,1 End If ;Genombeschädigung durch "Umwelteinflüsse" und Stoffwechsel If Rand(0,b\genom_protection)=0 Then ;Zu beschädigende Position aussuchen: dpos=Rand(1,Len(b\genom$)) ;Genom$ aufteilen: gs1$=Left(b\genom$,dpos) gs2$=Right(b\genom$,Len(b\genom$)-dpos) ;Wert am Ende des ersten Genom-Teils löschen gs1$=Left(gs1$,Len(gs1$)-1) ;...und einen beliebigen anderen Wert eintragen d$=Str(Rand(0,3)) If d$="2" Then d$="" If d$="3" Then d$=Str(Bin(Rand(0,3))) gs1$=gs1$+d$ ;Und zu guter letzt die DNA wieder zusammenfügen: b\genom$=gs1$+gs2$ b\genom_changes=b\genom_changes+1 End If b\timer_genomrepair=b\timer_genomrepair+1 ;Genomreperatur If b\timer_genomrepair>=(b\genom_repairtime*10) Then ;b\genom$=b\genom_orig$ For rpos=1 To Len(b\genom_orig$) ;Genom durchgehen ;Genom aufteilen: gs1$=Left(b\genom$,rpos) gs2$=Right(b\genom$,Len(b\genom$)-rpos) If gs2$="" Then gs2$=" " If gs1$="" Then gs1$=" " ;Letzte Stelle abfragen: tpg$=Right(gs1$,1) tpog$=Mid(b\genom_orig$,rpos,1) ;Vergleichen und mit festgelegter Erfolgsquote reparieren If tpg$<>tpog$ Then If Rand(0,b\genom_repairchance)>0 Then b\genom_changes=b\genom_changes-1 gs1$=Left(gs1$,Len(gs1$)-1) gs1$=gs1$+tpog$ End If End If ;DNS wieder zusammensetzen b\genom$=gs1$+gs2$ Next b\timer_genomrepair=0 End If ; ParseDNA(Handle(b)) ;War mal zu testzwecken drin. Veranschaulichung der Mutation DrawBakterium(Handle(b)) ;Bakterium zeichnen If Rand(-ReproduceDelay,b\reproductionrate)>0 And b\health>50 Then CreateBakterium(b\x#,b\y#,b\health#/2,b\genom$) b\health#=b\health#/2 End If ;Bei unzulässigen Werten wird das Bakterium getötet If killed=0 Then If b\shape_edges<=2 Then KillBakterium(Handle(b)) : killed=1 ;Unvollständige Form ;und bei zu extremer DNA-Veränderung auch If killed=0 Then If b\genom_changes>Genom_MaxChanges Then KillBakterium(Handle(b)) : killed=1 ;und wenn es dem Bakterium nicht gut geht If killed=0 Then If b\health#<=KillHealth Then KillBakterium(Handle(b)) : killed=1 ;und auch, wenns aus dem Testfeld läuft If killed=0 Then If b\x#<0 Or b\x#>RES_X Or b\y#<0 Or b\y#>RES_Y Then KillBakterium(Handle(b)) : killed=1 Next Return 1 End Function Function GetPreyBakterium(hndl,rng) b.bakterium=Object.bakterium(hndl) For temp.bakterium=Each bakterium If Handle(temp)<>Handle(b) Then tmpabs=Sqr((b\x#-temp\x#)^2+(b\y#-temp\y#)^2) If tmpabs<rng And temp\genom_orig$<>b\genom_orig$ Then Return Handle(temp) End If End If Next Return -1 End Function Function DrawBakterium(hndl) ;Bakterium zeichnen b.bakterium=Object.bakterium(hndl) ;Bakterium anhand des Handles auswählen Color 255-b\shape_color_r,255-b\shape_color_g,255-b\shape_color_b For dloop=1 To b\shape_edges Line b\x#+b\shape_edgeX[dloop],b\y#+b\shape_edgeY[dloop],b\x#+b\shape_edgeX[Shape_NormalizeEdgeNum(Handle(b),dloop+1)],b\y#+b\shape_edgeY[Shape_NormalizeEdgeNum(Handle(b),dloop+1)] Next Return 1 End Function Function ParseDNA(hndl) ;Genom interpretieren b.bakterium=Object.bakterium(hndl) ;Bakterium anhand seines Handles auswählen ;Variablen nullen, falls nicht genullt b\shape_edges=0 b\genom_repairtime=0 For ploop=1 To Len(b\genom$) Step DNA_StartLength ;Genom durchgehen startsearch$=Mid(b\genom$,ploop,DNA_StartLength) ;...und dabei jedesmal DNA_StartLength Zeichen von der jetzigen Position aus einlesen Select startsearch$ ;Inhalt auf übereinstimmung mit Lesemarken prüfen. Case DNA_Shape_Edge_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Shape_Edge_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen xtempbin$=Mid(resultbinary$,1,(Len(resultbinary$)/2)) ;Koordinate in X und Y aufteilen ytempbin$=Mid(resultbinary$,(Len(resultbinary$)/2+1),-1) If xtempbin$="" Then xtempbin$="0" If ytempbin$="" Then ytempbin$="0" ;Aus der ersten Zahl as Vorzeichen auslesen: vorzeichen$=Left(xtempbin$,1) xtempbin$=RSet$(xtempbin$,Len(xtempbin$)-1) If vorzeichen$=NegativeStr$ Then xtemp=-BinToDezi(xtempbin$) If vorzeichen$=PositiveStr$ Then xtemp=BinToDezi(xtempbin$) vorzeichen$=Left(ytempbin$,1) ytempbin$=RSet$(ytempbin$,Len(ytempbin$)-1) If vorzeichen$=NegativeStr$ Then ytemp=-BinToDezi(ytempbin$) If vorzeichen$=PositiveStr$ Then ytemp=BinToDezi(ytempbin$) If xtemp<-Shape_MaxEdgeEntf Then xtemp=-Shape_MaxEdgeEntf If xtemp>Shape_MaxEdgeEntf Then xtemp=Shape_MaxEdgeEntf If ytemp<-Shape_MaxEdgeEntf Then ytemp=-Shape_MaxEdgeEntf If ytemp>Shape_MaxEdgeEntf Then ytemp=Shape_MaxEdgeEntf ;fertig interpretiertes Ergebnis eintragen b\shape_edges=b\shape_edges+1 If b\shape_edges>Shape_MaxEdges Then b\shape_edges=Shape_MaxEdges b\shape_edgeX[b\shape_edges]=xtemp b\shape_edgeY[b\shape_edges]=ytemp Case DNA_Genom_Repairtime_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Genom_Repairtime_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen resultdezi=BinToDezi(resultbinary$) ;fertig interpretiertes Ergebnis eintragen b\genom_repairtime=resultdezi Case DNA_Genom_Protection_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Genom_Protection_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen resultdezi=BinToDezi(resultbinary$) ;fertig interpretiertes Ergebnis eintragen b\genom_protection=resultdezi Case DNA_Genom_Repairchance_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Genom_Repairchance_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen resultdezi=BinToDezi(resultbinary$) ;fertig interpretiertes Ergebnis eintragen b\genom_repairchance=resultdezi Case DNA_Reproductionrate_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Reproductionrate_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen resultdezi=BinToDezi(resultbinary$) ;fertig interpretiertes Ergebnis eintragen b\reproductionrate=resultdezi Case DNA_Health_Fotosynth_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Health_Fotosynth_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen resultdezi=BinToDezi(resultbinary$) ;fertig interpretiertes Ergebnis eintragen b\health_fotosynth=resultdezi Case DNA_Health_Eat_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Health_Eat_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen resultdezi=BinToDezi(resultbinary$) ;fertig interpretiertes Ergebnis eintragen b\health_eat=resultdezi Case DNA_Shape_Color_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Shape_Color_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen Repeat resultbinary$=resultbinary$+"0" Until Len(resultbinary$)>=3 rtempbin$=Mid(resultbinary$,1,Ceil(Len(resultbinary$)/3)) ;Wert in R,G und B aufteilen gtempbin$=Mid(resultbinary$,Ceil(Len(resultbinary$)/3),Ceil(Len(resultbinary$)/3)) btempbin$=Mid(resultbinary$,Ceil(Len(resultbinary$)/3*2),-1) If rtempbin$="" Then rtempbin$=" " If gtempbin$="" Then gtempbin$=" " If btempbin$="" Then btempbin$=" " rtempdezi=BinToDezi(rtempbin$) gtempdezi=BinToDezi(gtempbin$) btempdezi=BinToDezi(btempbin$) If rtempdezi>255 Then rtempdezi=255 If gtempdezi>255 Then gtempdezi=255 If btempdezi>255 Then btempdezi=255 ;fertig interpretiertes Ergebnis eintragen b\shape_color_r=rtempdezi b\shape_color_g=gtempdezi b\shape_color_b=btempdezi End Select Next Return 1 End Function Function BinToDezi(binary$) For i=1 To Len(binary$) ;Binäres Ergebnis in Dezimale Zahl umformen If Mid$(binary$,i,1)="1" Then result=result+2^(Len(binary$)-i) Next Return result End Function Function Shape_NormalizeEdgeNum(hndl,num) b.bakterium=Object.bakterium(hndl) Repeat If num>b\shape_edges Then num=num-b\shape_edges If num<1 Then num=num+b\shape_edges Until num<=b\shape_edges And num>=1 Return num End Function ;################## |
||
|
|
Fetze |
So, Jan 09, 2005 13:05 Antworten mit Zitat
|
|---|---|---|
|
So, winziges Update:
Code: [AUSKLAPPEN] ;### GRAFIKMODUS U. ZUFALLSGENERATOR ### Const RES_X=640,RES_Y=480 Graphics RES_X,RES_Y,16,2 SeedRnd MilliSecs() SetBuffer BackBuffer() ClsColor 30,30,30 zeittakt=CreateTimer(60) ;####################################### ;### KONSTANTEN ### Const DNA_StartLength=8 Const DNA_Shape_Edge_Start$="00000000" Const DNA_Shape_Edge_End$="00000001" Const DNA_Genom_Repairtime_Start$="00000010" Const DNA_Genom_Repairtime_End$="00000011" Const DNA_Genom_Protection_Start$="00000100" Const DNA_Genom_Protection_End$="00000101" Const DNA_Genom_Repairchance_Start$="00000110" Const DNA_Genom_Repairchance_End$="00000111" Const DNA_Reproductionrate_Start$="00001000" Const DNA_Reproductionrate_End$="00001001" Const DNA_Health_Fotosynth_Start$="00001010" Const DNA_Health_Fotosynth_End$="00001011" Const DNA_Health_Eat_Start$="00001100" Const DNA_Health_Eat_End$="00001101" Const DNA_Shape_Color_Start$="00001110" Const DNA_Shape_Color_End$="00001111" Const NegativeStr$="0" Const PositiveStr$="1" Const ReproduceDelay=1000 Const KillHealth=20 Const MaxEatRange=25 Const MaxFotoSynth#=2 Const MaxHealth=100 Const Shape_MaxEdges=16 Const Shape_MaxEdgeEntf=10 Const Genom_MaxChanges=10 ;################## ;### TYPE-FELDER DEFINIEREN ### Type bakterium ;Eine Bakterie ;### NICHT-STATISCHE VARIABLEN ### Field x#,y# ;Position Field xspeed#,yspeed# ;Geschwindigkeit Field health# ;Gesundheit des Bakteriums. Sinkt es auf KillHealth, stirbt das Bakterium. Field genom$ ;Ihr momentanes Genom Field genom_changes ;Die Veränderungen am Genom Field timer_genomrepair ;Der Reperatur-Timer. Zählt bis genom_repairtime*10 hoch ;################################# ;### STATISCHE VARIABLEN ### Field shape_edges ;Die Anzahl der Kanten der Form des Bakteriums Field shape_edgeX[Shape_MaxEdges] ;Die Position der Kanten der Form des Bakteriums Field shape_edgeY[Shape_MaxEdges] Field shape_color_r,shape_color_g,shape_color_b ;Die Farbe des Bakteriums Field genom_repairtime ;Die Zeitabstand / 10, in dem das Genom repariert wird Field genom_protection ;Der "Schutz" des Genoms. Je höher, desto seltener Mutiert es. Field genom_repairchance ;Die Chance zur Reperatur eines Gens. Je höher, desto höher die Erfolgschance. Field health_fotosynth ;Die Effizienz der Fotosynthese. In Health pro Zyklus / 100 Field health_eat ;Die Effizienz des Fressens. In Health pro Zyklus / 25 Field reproductionrate ;Die Vermehrungsrate. Je höher, desto schneller vermehrt sich das Bakterium Field genom_orig$ ;Das Genom bei geburt der Bakterie ;########################### End Type ;############################## ;### INITIALISIEREN ### ;CreateBakterium(300,100,100,"00000000 0100 0100 00000001 00000000 1100 0100 00000001 00000000 1100 1100 00000001 00000000 0100 1100 00000001 00000010 1100100 00000011 00000100 1010 00000101 00000110 0101 00000111 00001000 110010 00001001 00001010 1100100 00001011 00001110 000 00001111") CreateBakterium(300,200,100,"00000000 0100 0100 00000001 00000000 1100 0100 00000001 00000000 1100 1100 00000001 00000000 0100 1100 00000001 00000010 1100100 00000011 00000100 1010 00000101 00000110 0101 00000111 00001000 110010 00001001 00001010 1100100 00001011 00001100 0 00001101 00001110 000000000000000000000000 00001111") CreateBakterium(300,300,100,"00000000 0100 0100 00000001 00000000 1100 0100 00000001 00000000 1100 1100 00000001 00000000 0100 1100 00000001 00000010 1100100 00000011 00000100 1010 00000101 00000110 0101 00000111 00001000 110010 00001001 00001010 1100100 00001011 00001100 0 00001101 00001110 111111111111111111111111 00001111") ;CreateBakterium(300,400,100,"00000000 0100 0100 00000001 00000000 1100 0100 00000001 00000000 1100 1100 00000001 00000000 0100 1100 00000001 00000010 1100100 00000011 00000100 1010 00000101 00000110 0101 00000111 00001000 110010 00001001 00001010 1100100 00001011 00001110 000 00001111") ;###################### ;### HAUPTSCHLEIFE ### Repeat Cls UpdateBakterien() ;Bakterien berechnen WaitTimer(zeittakt) Flip Until KeyHit(1) ;##################### ;### FUNKTIONEN ### Function CreateBakterium(x,y,health#,genom$) ;Bakterium erstellen b.bakterium=New bakterium b\x#=x ;Position b\y#=y b\xspeed#=0 ;Geschwindigkeit b\yspeed#=0 b\health#=health# b\genom$=Replace(genom$," ","") ;Genom festlegen b\genom_orig$=b\genom$ ParseDNA(Handle(b)) ;Genom interpretieren Return Handle(b) ;Handle zurückgeben End Function Function DeleteBakterium(hndl) b.bakterium=Object.bakterium(hndl) Delete b.bakterium End Function Function KillBakterium(hndl) DeleteBakterium(hndl) End Function Function UpdateBakterien() ;Bakterien berechnen For b.bakterium=Each bakterium ;Bakterien durchgehen ;Temporär: Speedberechnung. Sollte noch ausgetauscht werden! If b\health_eat>10 Then tmphndl=GetPreyBakterium(Handle(b),200) If tmphndl<>-1 Then temp.bakterium=Object.bakterium(tmphndl) b\xspeed#=(temp\x#-b\x#);/200 b\yspeed#=(temp\y#-b\y#);/200 End If End If b\xspeed#=b\xspeed#+Rnd(-0.5,0.5) b\yspeed#=b\yspeed#+Rnd(-0.5,0.5) If b\xspeed#>1 Then b\xspeed#=1 If b\xspeed#<-1 Then b\xspeed#=-1 If b\yspeed#>1 Then b\yspeed#=1 If b\yspeed#<-1 Then b\yspeed#=-1 ;Bewegung b\x#=b\x#+b\xspeed# b\y#=b\y#+b\yspeed# ;Fotosynthese If b\health_fotosynth>10 Then If b\health_fotosynth/100<=MaxFotoSynth# Then b\health#=b\health#+Float(Float(b\health_fotosynth)/Float(100)) End If ; Color 0,255,0 ; Rect b\x#,b\y#,2,2,1 End If ;Fressen If b\health_eat>10 Then tmphndl=GetPreyBakterium(Handle(b),MaxEatRange) ;GetPreybakterium durch Genetisch bedingte Fressvorlieben ersetzen If tmphndl<>-1 Then temp.bakterium=Object.bakterium(tmphndl) temp\health#=temp\health#-Float(Float(b\health_eat)/Float(25)) b\health#=b\health#+Float(Float(b\health_eat)/Float(25)) End If ; Color 255,0,0 ; Rect b\x#,b\y#+2,2,2,1 End If If b\health#>MaxHealth Then b\health#=MaxHealth ;Genombeschädigung durch "Umwelteinflüsse" und Stoffwechsel If Rand(0,b\genom_protection)=0 Then ;Zu beschädigende Position aussuchen: dpos=Rand(1,Len(b\genom$)) ;Genom$ aufteilen: gs1$=Left(b\genom$,dpos) gs2$=Right(b\genom$,Len(b\genom$)-dpos) ;Wert am Ende des ersten Genom-Teils löschen gs1$=Left(gs1$,Len(gs1$)-1) ;...und einen beliebigen anderen Wert eintragen d$=Str(Rand(0,3)) If d$="2" Then d$="" If d$="3" Then d$=Str(Bin(Rand(0,3))) gs1$=gs1$+d$ ;Und zu guter letzt die DNA wieder zusammenfügen: b\genom$=gs1$+gs2$ b\genom_changes=b\genom_changes+1 End If b\timer_genomrepair=b\timer_genomrepair+1 ;Genomreperatur If b\timer_genomrepair>=(b\genom_repairtime*10) Then ;b\genom$=b\genom_orig$ For rpos=1 To Len(b\genom_orig$) ;Genom durchgehen ;Genom aufteilen: gs1$=Left(b\genom$,rpos) gs2$=Right(b\genom$,Len(b\genom$)-rpos) If gs2$="" Then gs2$=" " If gs1$="" Then gs1$=" " ;Letzte Stelle abfragen: tpg$=Right(gs1$,1) tpog$=Mid(b\genom_orig$,rpos,1) ;Vergleichen und mit festgelegter Erfolgsquote reparieren If tpg$<>tpog$ Then If Rand(0,b\genom_repairchance)>0 Then b\genom_changes=b\genom_changes-1 gs1$=Left(gs1$,Len(gs1$)-1) gs1$=gs1$+tpog$ End If End If ;DNS wieder zusammensetzen b\genom$=gs1$+gs2$ Next b\timer_genomrepair=0 End If ; ParseDNA(Handle(b)) ;War mal zu testzwecken drin. Veranschaulichung der Mutation If b\health#<MaxHealth And b\health#>KillHealth Then DrawBakterium(Handle(b)) ;Bakterium zeichnen If Rand(-ReproduceDelay,b\reproductionrate)>0 And b\health>50 Then CreateBakterium(b\x#,b\y#,b\health#/2,b\genom$) b\health#=b\health#/2 End If ;Bei unzulässigen Werten wird das Bakterium getötet If killed=0 Then If b\shape_edges<=2 Then KillBakterium(Handle(b)) : killed=1 ;Unvollständige Form ;und bei zu extremer DNA-Veränderung auch If killed=0 Then If b\genom_changes>Genom_MaxChanges Then KillBakterium(Handle(b)) : killed=1 ;und wenn es dem Bakterium nicht gut geht If killed=0 Then If b\health#<=KillHealth Then KillBakterium(Handle(b)) : killed=1 ;und auch, wenns aus dem Testfeld läuft If killed=0 Then If b\x#<0 Or b\x#>RES_X Or b\y#<0 Or b\y#>RES_Y Then KillBakterium(Handle(b)) : killed=1 Next Return 1 End Function Function GetPreyBakterium(hndl,rng) b.bakterium=Object.bakterium(hndl) For temp.bakterium=Each bakterium If Handle(temp)<>Handle(b) Then tmpabs=Sqr((b\x#-temp\x#)^2+(b\y#-temp\y#)^2) If tmpabs<rng And temp\genom_orig$<>b\genom_orig$ Then Return Handle(temp) End If End If Next Return -1 End Function Function DrawBakterium(hndl) ;Bakterium zeichnen b.bakterium=Object.bakterium(hndl) ;Bakterium anhand des Handles auswählen Color 255-b\shape_color_r,255-b\shape_color_g,255-b\shape_color_b For dloop=1 To b\shape_edges Line b\x#+b\shape_edgeX[dloop]*b\health#/100,b\y#+b\shape_edgeY[dloop]*b\health#/100,b\x#+b\shape_edgeX[Shape_NormalizeEdgeNum(Handle(b),dloop+1)]*b\health#/100,b\y#+b\shape_edgeY[Shape_NormalizeEdgeNum(Handle(b),dloop+1)]*b\health#/100 Next ;Text b\x#,b\y#,b\health# Return 1 End Function Function ParseDNA(hndl) ;Genom interpretieren b.bakterium=Object.bakterium(hndl) ;Bakterium anhand seines Handles auswählen ;Variablen nullen, falls nicht genullt b\shape_edges=0 b\genom_repairtime=0 For ploop=1 To Len(b\genom$) Step DNA_StartLength ;Genom durchgehen startsearch$=Mid(b\genom$,ploop,DNA_StartLength) ;...und dabei jedesmal DNA_StartLength Zeichen von der jetzigen Position aus einlesen Select startsearch$ ;Inhalt auf übereinstimmung mit Lesemarken prüfen. Case DNA_Shape_Edge_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Shape_Edge_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen xtempbin$=Mid(resultbinary$,1,(Len(resultbinary$)/2)) ;Koordinate in X und Y aufteilen ytempbin$=Mid(resultbinary$,(Len(resultbinary$)/2+1),-1) If xtempbin$="" Then xtempbin$="0" If ytempbin$="" Then ytempbin$="0" ;Aus der ersten Zahl as Vorzeichen auslesen: vorzeichen$=Left(xtempbin$,1) xtempbin$=RSet$(xtempbin$,Len(xtempbin$)-1) If vorzeichen$=NegativeStr$ Then xtemp=-BinToDezi(xtempbin$) If vorzeichen$=PositiveStr$ Then xtemp=BinToDezi(xtempbin$) vorzeichen$=Left(ytempbin$,1) ytempbin$=RSet$(ytempbin$,Len(ytempbin$)-1) If vorzeichen$=NegativeStr$ Then ytemp=-BinToDezi(ytempbin$) If vorzeichen$=PositiveStr$ Then ytemp=BinToDezi(ytempbin$) If xtemp<-Shape_MaxEdgeEntf Then xtemp=-Shape_MaxEdgeEntf If xtemp>Shape_MaxEdgeEntf Then xtemp=Shape_MaxEdgeEntf If ytemp<-Shape_MaxEdgeEntf Then ytemp=-Shape_MaxEdgeEntf If ytemp>Shape_MaxEdgeEntf Then ytemp=Shape_MaxEdgeEntf ;fertig interpretiertes Ergebnis eintragen b\shape_edges=b\shape_edges+1 If b\shape_edges>Shape_MaxEdges Then b\shape_edges=Shape_MaxEdges b\shape_edgeX[b\shape_edges]=xtemp b\shape_edgeY[b\shape_edges]=ytemp Case DNA_Genom_Repairtime_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Genom_Repairtime_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen resultdezi=BinToDezi(resultbinary$) ;fertig interpretiertes Ergebnis eintragen b\genom_repairtime=resultdezi Case DNA_Genom_Protection_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Genom_Protection_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen resultdezi=BinToDezi(resultbinary$) ;fertig interpretiertes Ergebnis eintragen b\genom_protection=resultdezi Case DNA_Genom_Repairchance_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Genom_Repairchance_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen resultdezi=BinToDezi(resultbinary$) ;fertig interpretiertes Ergebnis eintragen b\genom_repairchance=resultdezi Case DNA_Reproductionrate_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Reproductionrate_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen resultdezi=BinToDezi(resultbinary$) ;fertig interpretiertes Ergebnis eintragen b\reproductionrate=resultdezi Case DNA_Health_Fotosynth_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Health_Fotosynth_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen resultdezi=BinToDezi(resultbinary$) ;fertig interpretiertes Ergebnis eintragen b\health_fotosynth=resultdezi Case DNA_Health_Eat_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Health_Eat_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen resultdezi=BinToDezi(resultbinary$) ;fertig interpretiertes Ergebnis eintragen b\health_eat=resultdezi Case DNA_Shape_Color_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Shape_Color_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen Repeat resultbinary$=resultbinary$+"0" Until Len(resultbinary$)>=3 rtempbin$=Mid(resultbinary$,1,Ceil(Len(resultbinary$)/3)) ;Wert in R,G und B aufteilen gtempbin$=Mid(resultbinary$,Ceil(Len(resultbinary$)/3),Ceil(Len(resultbinary$)/3)) btempbin$=Mid(resultbinary$,Ceil(Len(resultbinary$)/3*2),-1) If rtempbin$="" Then rtempbin$=" " If gtempbin$="" Then gtempbin$=" " If btempbin$="" Then btempbin$=" " rtempdezi=BinToDezi(rtempbin$) gtempdezi=BinToDezi(gtempbin$) btempdezi=BinToDezi(btempbin$) If rtempdezi>255 Then rtempdezi=255 If gtempdezi>255 Then gtempdezi=255 If btempdezi>255 Then btempdezi=255 ;fertig interpretiertes Ergebnis eintragen b\shape_color_r=rtempdezi b\shape_color_g=gtempdezi b\shape_color_b=btempdezi End Select Next Return 1 End Function Function BinToDezi(binary$) For i=1 To Len(binary$) ;Binäres Ergebnis in Dezimale Zahl umformen If Mid$(binary$,i,1)="1" Then result=result+2^(Len(binary$)-i) Next Return result End Function Function Shape_NormalizeEdgeNum(hndl,num) b.bakterium=Object.bakterium(hndl) Repeat If num>b\shape_edges Then num=num-b\shape_edges If num<1 Then num=num+b\shape_edges Until num<=b\shape_edges And num>=1 Return num End Function ;################## Ich finds allerdings blöd, dass die Evolution immer gleich endet: Hohes Fotosynthesevermögen bei geringer Mutationsrate und hoher Erfolgsquoute bei der DNA-Reperatur. Das liegt daran, dass das die bestmögliche "Lebensform" für mein "Testgebiet" ist, in dem es allgegenwärtig genug Licht gibt. Und vor allem auch daran, dass Form und Farbe beim Überleben gar keine Rolle spielen. Hat jemand eine Idee, wie man die einbringen könnte? |
||
Edlothiol |
So, Jan 09, 2005 13:51 Antworten mit Zitat
|
|
|---|---|---|
|
Man könnte einen mehrfarbigen Hintergrund machen und dann sowas wie "Tarnung" einbauen... Die FPS lassen sich übrigens sehr verbessern, wenn man bei GetPreyBakterium das Sqr() wegmacht:Code: [AUSKLAPPEN] Function GetPreyBakterium(hndl,rng)
b.bakterium=Object.bakterium(hndl) For temp.bakterium=Each bakterium If Handle(temp)<>Handle(b) Then tmpabs=((b\x#-temp\x#)^2+(b\y#-temp\y#)^2) If tmpabs<(rng^2) And temp\genom_orig$<>b\genom_orig$ Then Return Handle(temp) End If End If Next Return -1 End Function |
||
|
|
Fetze |
So, Jan 09, 2005 14:03 Antworten mit Zitat
|
|---|---|---|
| Tarnung bringt aber noch nix, solange die Bakterien, die "Jagen" schnell aussterben, da das ja gen nicht effektiv genug ist. Es gibt so gar keinen Grund zur Tarnung. Abgesehen davon: Selbst mit Tarnung werdne sie genausoschnell entdeckt, da die Funktion GetPreyBakterium einfach alle Bakterien durchgeht und sie auf ihr genom prüft. Das gesamte Fressverhalten und die Bewegungen sollten noch in die DNA einfließen. Und Eventuell sollte man das Licht auf bestimmte Punkte beschränken und Kollision einbauen - das würde einerseits die Population der Bakterien mit Fotosynthese verringern und andererseits erfordern, dass sie sich Bewegen und so eine neue Lichtquelle finden können. | ||
|
|
Mooch |
So, Jan 09, 2005 14:14 Antworten mit Zitat
|
|---|---|---|
|
http://hometown.aol.de/Tristan...lation.zip
Hab einiges erneuert! (Tipp: Nehmt die EXE! Sonst müsst ihr die ganzen Bilder nochmal mitcompilieren! |
||
|
Pentium IV 3.0Ghz; nVidia Geforce 6800;
Microsoft Windows XP Home SP2; BlitzBasic 3D .:: Sites ::. .:: http://www.fl4sh-clan.de/ ::. |
||
sven123 |
So, Jan 09, 2005 14:36 Antworten mit Zitat
|
|
|---|---|---|
| @Fetze baut doch aus den Simulationen einen Bildschirmschoner! | ||
|
Amd Athlon 2200+,Saphire Atlantis Radeon9800pro,1024 MB DDR RAm,40 Gb Festblatte.
'in shâ'a llâh=so Gott will Fertiges Projekt:Invasion der Heuschrecken |
||
|
|
Fetze |
So, Jan 09, 2005 14:59 Antworten mit Zitat
|
|---|---|---|
|
Sorry, wenn ich nochmal störe,
aber meine Bakterien kollidieren jetzt ^^ Code: [AUSKLAPPEN] ;### GRAFIKMODUS U. ZUFALLSGENERATOR ### Const RES_X=640,RES_Y=480 Graphics RES_X,RES_Y,16,2 SeedRnd MilliSecs() SetBuffer BackBuffer() ClsColor 30,30,30 zeittakt=CreateTimer(60) ;####################################### ;### GLOBALE FÜR LINES_INTERSECT ### Global Intersection_X# Global Intersection_Y# Global Intersection_AB# Global Intersection_CD# ;################################### ;### KONSTANTEN ### Const DNA_StartLength=8 Const DNA_Shape_Edge_Start$="00000000" Const DNA_Shape_Edge_End$="00000001" Const DNA_Genom_Repairtime_Start$="00000010" Const DNA_Genom_Repairtime_End$="00000011" Const DNA_Genom_Protection_Start$="00000100" Const DNA_Genom_Protection_End$="00000101" Const DNA_Genom_Repairchance_Start$="00000110" Const DNA_Genom_Repairchance_End$="00000111" Const DNA_Reproductionrate_Start$="00001000" Const DNA_Reproductionrate_End$="00001001" Const DNA_Health_Fotosynth_Start$="00001010" Const DNA_Health_Fotosynth_End$="00001011" Const DNA_Health_Eat_Start$="00001100" Const DNA_Health_Eat_End$="00001101" Const DNA_Shape_Color_Start$="00001110" Const DNA_Shape_Color_End$="00001111" Const NegativeStr$="0" Const PositiveStr$="1" Const ReproduceDelay=1000 Const KillHealth=20 Const MaxEatRange=25 Const MaxFotoSynth#=2 Const MaxHealth=100 Const Shape_MaxEdges=16 Const Shape_MaxEdgeEntf=10 Const Genom_MaxChanges=10 ;################## ;### TYPE-FELDER DEFINIEREN ### Type bakterium ;Eine Bakterie ;### NICHT-STATISCHE VARIABLEN ### Field x#,y# ;Position Field xold#,yold# ;Position von vor einem Frame. Field xspeed#,yspeed# ;Geschwindigkeit Field health# ;Gesundheit des Bakteriums. Sinkt es auf KillHealth, stirbt das Bakterium. Field genom$ ;Ihr momentanes Genom Field genom_changes ;Die Veränderungen am Genom Field timer_genomrepair ;Der Reperatur-Timer. Zählt bis genom_repairtime*10 hoch ;################################# ;### STATISCHE VARIABLEN ### Field shape_edges ;Die Anzahl der Kanten der Form des Bakteriums Field shape_edgeX[Shape_MaxEdges] ;Die Position der Kanten der Form des Bakteriums Field shape_edgeY[Shape_MaxEdges] Field shape_color_r,shape_color_g,shape_color_b ;Die Farbe des Bakteriums Field genom_repairtime ;Die Zeitabstand / 10, in dem das Genom repariert wird Field genom_protection ;Der "Schutz" des Genoms. Je höher, desto seltener Mutiert es. Field genom_repairchance ;Die Chance zur Reperatur eines Gens. Je höher, desto höher die Erfolgschance. Field health_fotosynth ;Die Effizienz der Fotosynthese. In Health pro Zyklus / 100 Field health_eat ;Die Effizienz des Fressens. In Health pro Zyklus / 25 Field reproductionrate ;Die Vermehrungsrate. Je höher, desto schneller vermehrt sich das Bakterium Field genom_orig$ ;Das Genom bei geburt der Bakterie ;########################### End Type ;############################## ;### INITIALISIEREN ### ;CreateBakterium(300,100,100,"00000000 0100 0100 00000001 00000000 1100 0100 00000001 00000000 1100 1100 00000001 00000000 0100 1100 00000001 00000010 1100100 00000011 00000100 1010 00000101 00000110 0101 00000111 00001000 110010 00001001 00001010 1100100 00001011 00001110 000 00001111") CreateBakterium(300,200,100,"00000000 0100 0100 00000001 00000000 1100 0100 00000001 00000000 1100 1100 00000001 00000000 0100 1100 00000001 00000010 1100100 00000011 00000100 1010 00000101 00000110 0101 00000111 00001000 110010 00001001 00001010 1100100 00001011 00001100 0 00001101 00001110 000000000000000000000000 00001111") CreateBakterium(300,300,100,"00000000 0100 0100 00000001 00000000 1100 0100 00000001 00000000 1100 1100 00000001 00000000 0100 1100 00000001 00000010 1100100 00000011 00000100 1010 00000101 00000110 0101 00000111 00001000 110010 00001001 00001010 1100100 00001011 00001100 0 00001101 00001110 111111111111111111111111 00001111") ;CreateBakterium(300,400,100,"00000000 0100 0100 00000001 00000000 1100 0100 00000001 00000000 1100 1100 00000001 00000000 0100 1100 00000001 00000010 1100100 00000011 00000100 1010 00000101 00000110 0101 00000111 00001000 110010 00001001 00001010 1100100 00001011 00001110 000 00001111") ;###################### ;### HAUPTSCHLEIFE ### Repeat Cls UpdateBakterien() ;Bakterien berechnen WaitTimer(zeittakt) Flip Until KeyHit(1) ;##################### ;### FUNKTIONEN ### Function CreateBakterium(x,y,health#,genom$) ;Bakterium erstellen b.bakterium=New bakterium b\x#=x ;Position b\y#=y b\xspeed#=0 ;Geschwindigkeit b\yspeed#=0 b\health#=health# b\genom$=Replace(genom$," ","") ;Genom festlegen b\genom_orig$=b\genom$ ParseDNA(Handle(b)) ;Genom interpretieren Return Handle(b) ;Handle zurückgeben End Function Function DeleteBakterium(hndl) b.bakterium=Object.bakterium(hndl) Delete b.bakterium End Function Function KillBakterium(hndl) DeleteBakterium(hndl) End Function Function UpdateBakterien() ;Bakterien berechnen For b.bakterium=Each bakterium ;Bakterien durchgehen ;Temporär: Speedberechnung. Sollte noch ausgetauscht werden! If b\health_eat>10 Then tmphndl=GetPreyBakterium(Handle(b),200) If tmphndl<>-1 Then temp.bakterium=Object.bakterium(tmphndl) b\xspeed#=(temp\x#-b\x#);/200 b\yspeed#=(temp\y#-b\y#);/200 End If End If b\xspeed#=b\xspeed#+Rnd(-0.5,0.5) b\yspeed#=b\yspeed#+Rnd(-0.5,0.5) If b\xspeed#>1 Then b\xspeed#=1 If b\xspeed#<-1 Then b\xspeed#=-1 If b\yspeed#>1 Then b\yspeed#=1 If b\yspeed#<-1 Then b\yspeed#=-1 ;Bewegung b\xold#=b\x# b\yold#=b\y# b\x#=b\x#+b\xspeed# b\y#=b\y#+b\yspeed# ;Kollisionsüberprüfung For bc.bakterium=Each bakterium If Handle(bc)<>Handle(b) Then If BakteriumsCollide(Handle(b),Handle(bc)) Then ; b\x#=b\xold# ; b\y#=b\yold# b\xspeed#=(b\x#-bc\x#);-b\xspeed# b\yspeed#=(b\y#-bc\y#);-b\yspeed# End If End If Next ;Fotosynthese If b\health_fotosynth>10 Then If b\health_fotosynth/100<=MaxFotoSynth# Then b\health#=b\health#+Float(Float(b\health_fotosynth)/Float(100)) End If ; Color 0,255,0 ; Rect b\x#,b\y#,2,2,1 End If ;Fressen If b\health_eat>10 Then tmphndl=GetPreyBakterium(Handle(b),MaxEatRange) ;GetPreybakterium durch Genetisch bedingte Fressvorlieben ersetzen If tmphndl<>-1 Then temp.bakterium=Object.bakterium(tmphndl) temp\health#=temp\health#-Float(Float(b\health_eat)/Float(25)) b\health#=b\health#+Float(Float(b\health_eat)/Float(25)) End If ; Color 255,0,0 ; Rect b\x#,b\y#+2,2,2,1 End If If b\health#>MaxHealth Then b\health#=MaxHealth ;Genombeschädigung durch "Umwelteinflüsse" und Stoffwechsel If Rand(0,b\genom_protection)=0 Then ;Zu beschädigende Position aussuchen: dpos=Rand(1,Len(b\genom$)) ;Genom$ aufteilen: gs1$=Left(b\genom$,dpos) gs2$=Right(b\genom$,Len(b\genom$)-dpos) ;Wert am Ende des ersten Genom-Teils löschen gs1$=Left(gs1$,Len(gs1$)-1) ;...und einen beliebigen anderen Wert eintragen d$=Str(Rand(0,3)) If d$="2" Then d$="" If d$="3" Then d$=Str(Bin(Rand(0,3))) gs1$=gs1$+d$ ;Und zu guter letzt die DNA wieder zusammenfügen: b\genom$=gs1$+gs2$ b\genom_changes=b\genom_changes+1 End If b\timer_genomrepair=b\timer_genomrepair+1 ;Genomreperatur If b\timer_genomrepair>=(b\genom_repairtime*10) Then ;b\genom$=b\genom_orig$ For rpos=1 To Len(b\genom_orig$) ;Genom durchgehen ;Genom aufteilen: gs1$=Left(b\genom$,rpos) gs2$=Right(b\genom$,Len(b\genom$)-rpos) If gs2$="" Then gs2$=" " If gs1$="" Then gs1$=" " ;Letzte Stelle abfragen: tpg$=Right(gs1$,1) tpog$=Mid(b\genom_orig$,rpos,1) ;Vergleichen und mit festgelegter Erfolgsquote reparieren If tpg$<>tpog$ Then If Rand(0,b\genom_repairchance)>0 Then b\genom_changes=b\genom_changes-1 gs1$=Left(gs1$,Len(gs1$)-1) gs1$=gs1$+tpog$ End If End If ;DNS wieder zusammensetzen b\genom$=gs1$+gs2$ Next b\timer_genomrepair=0 End If ; ParseDNA(Handle(b)) ;War mal zu testzwecken drin. Veranschaulichung der Mutation If Rand(-ReproduceDelay,b\reproductionrate)>0 And b\health>50 Then CreateBakterium(b\x#,b\y#,b\health#/2,b\genom$) b\health#=b\health#/2 End If killed=0 ;Bei unzulässigen Werten wird das Bakterium getötet If killed=0 Then If b\shape_edges<=2 Then KillBakterium(Handle(b)) : killed=1 ;Unvollständige Form ;und bei zu extremer DNA-Veränderung auch If killed=0 Then If b\genom_changes>Genom_MaxChanges Then KillBakterium(Handle(b)) : killed=1 ;und wenn es dem Bakterium nicht gut geht If killed=0 Then If b\health#<=KillHealth Then KillBakterium(Handle(b)) : killed=1 ;...oder zu gut. Dann muss es sich nämlich um irgendeine Art von DNA-Fehler handeln. Und Fehlerhafte DNA stirbt aus. If killed=0 Then If b\health#>MaxHealth Then KillBakterium(Handle(b)) : killed=1 ;und auch, wenns aus dem Testfeld läuft If killed=0 Then If b\x#<0 Or b\x#>RES_X Or b\y#<0 Or b\y#>RES_Y Then KillBakterium(Handle(b)) : killed=1 If killed=0 Then DrawBakterium(Handle(b)) ;Bakterium zeichnen Next Return 1 End Function Function GetPreyBakterium(hndl,rng) b.bakterium=Object.bakterium(hndl) For temp.bakterium=Each bakterium If Handle(temp)<>Handle(b) Then tmpabs=((b\x#-temp\x#)^2+(b\y#-temp\y#)^2) If tmpabs<(rng^2) And temp\genom_orig$<>b\genom_orig$ Then Return Handle(temp) End If End If Next Return -1 End Function Function DrawBakterium(hndl) ;Bakterium zeichnen b.bakterium=Object.bakterium(hndl) ;Bakterium anhand des Handles auswählen Color 255-b\shape_color_r,255-b\shape_color_g,255-b\shape_color_b For dloop=1 To b\shape_edges Line b\x#+b\shape_edgeX[dloop]*b\health#/100,b\y#+b\shape_edgeY[dloop]*b\health#/100,b\x#+b\shape_edgeX[Shape_NormalizeEdgeNum(Handle(b),dloop+1)]*b\health#/100,b\y#+b\shape_edgeY[Shape_NormalizeEdgeNum(Handle(b),dloop+1)]*b\health#/100 Next ;Text b\x#,b\y#,b\health# Return 1 End Function Function ParseDNA(hndl) ;Genom interpretieren b.bakterium=Object.bakterium(hndl) ;Bakterium anhand seines Handles auswählen ;Variablen nullen, falls nicht genullt b\shape_edges=0 b\genom_repairtime=0 For ploop=1 To Len(b\genom$) Step DNA_StartLength ;Genom durchgehen startsearch$=Mid(b\genom$,ploop,DNA_StartLength) ;...und dabei jedesmal DNA_StartLength Zeichen von der jetzigen Position aus einlesen Select startsearch$ ;Inhalt auf übereinstimmung mit Lesemarken prüfen. Case DNA_Shape_Edge_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Shape_Edge_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen xtempbin$=Mid(resultbinary$,1,(Len(resultbinary$)/2)) ;Koordinate in X und Y aufteilen ytempbin$=Mid(resultbinary$,(Len(resultbinary$)/2+1),-1) If xtempbin$="" Then xtempbin$="0" If ytempbin$="" Then ytempbin$="0" ;Aus der ersten Zahl as Vorzeichen auslesen: vorzeichen$=Left(xtempbin$,1) xtempbin$=RSet$(xtempbin$,Len(xtempbin$)-1) If vorzeichen$=NegativeStr$ Then xtemp=-BinToDezi(xtempbin$) If vorzeichen$=PositiveStr$ Then xtemp=BinToDezi(xtempbin$) vorzeichen$=Left(ytempbin$,1) ytempbin$=RSet$(ytempbin$,Len(ytempbin$)-1) If vorzeichen$=NegativeStr$ Then ytemp=-BinToDezi(ytempbin$) If vorzeichen$=PositiveStr$ Then ytemp=BinToDezi(ytempbin$) If xtemp<-Shape_MaxEdgeEntf Then xtemp=-Shape_MaxEdgeEntf If xtemp>Shape_MaxEdgeEntf Then xtemp=Shape_MaxEdgeEntf If ytemp<-Shape_MaxEdgeEntf Then ytemp=-Shape_MaxEdgeEntf If ytemp>Shape_MaxEdgeEntf Then ytemp=Shape_MaxEdgeEntf ;fertig interpretiertes Ergebnis eintragen b\shape_edges=b\shape_edges+1 If b\shape_edges>Shape_MaxEdges Then b\shape_edges=Shape_MaxEdges b\shape_edgeX[b\shape_edges]=xtemp b\shape_edgeY[b\shape_edges]=ytemp Case DNA_Genom_Repairtime_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Genom_Repairtime_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen resultdezi=BinToDezi(resultbinary$) ;fertig interpretiertes Ergebnis eintragen b\genom_repairtime=resultdezi Case DNA_Genom_Protection_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Genom_Protection_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen resultdezi=BinToDezi(resultbinary$) ;fertig interpretiertes Ergebnis eintragen b\genom_protection=resultdezi Case DNA_Genom_Repairchance_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Genom_Repairchance_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen resultdezi=BinToDezi(resultbinary$) ;fertig interpretiertes Ergebnis eintragen b\genom_repairchance=resultdezi Case DNA_Reproductionrate_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Reproductionrate_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen resultdezi=BinToDezi(resultbinary$) ;fertig interpretiertes Ergebnis eintragen b\reproductionrate=resultdezi Case DNA_Health_Fotosynth_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Health_Fotosynth_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen resultdezi=BinToDezi(resultbinary$) ;fertig interpretiertes Ergebnis eintragen b\health_fotosynth=resultdezi Case DNA_Health_Eat_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Health_Eat_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen resultdezi=BinToDezi(resultbinary$) ;fertig interpretiertes Ergebnis eintragen b\health_eat=resultdezi Case DNA_Shape_Color_Start$ ;Lesemarke DNS_Shape_Edge_Start$ tempnumstart=(ploop+DNA_StartLength) ;Startposition des Ergebnisses bestimmen For ploop2=tempnumstart To Len(b\genom$) ;Von der Startposition ausgehen und Zeichen für Zeichen die Lesemarke für die Endposition suchen temp$=Mid(b\genom$,ploop2,DNA_StartLength) ;DNA_TempLength Zeichen einlesen If temp$=DNA_Shape_Color_End$ Then ;und auf Übereinstimmung mit der Endposition prüfen tempnumend=ploop2 ;Endposition speichern ploop=tempnumend ;Lesezeiger auf die Endposition setzen, um doppelte, fehlerhafte Interpretationen zu vermeiden Exit End If Next resultbinary$=Mid(b\genom$,tempnumstart,(tempnumend-tempnumstart)) ;Binäres Ergebnis zwischen Start- und Endmarke auslesen Repeat resultbinary$=resultbinary$+"0" Until Len(resultbinary$)>=3 rtempbin$=Mid(resultbinary$,1,Ceil(Len(resultbinary$)/3)) ;Wert in R,G und B aufteilen gtempbin$=Mid(resultbinary$,Ceil(Len(resultbinary$)/3),Ceil(Len(resultbinary$)/3)) btempbin$=Mid(resultbinary$,Ceil(Len(resultbinary$)/3*2),-1) If rtempbin$="" Then rtempbin$=" " If gtempbin$="" Then gtempbin$=" " If btempbin$="" Then btempbin$=" " rtempdezi=BinToDezi(rtempbin$) gtempdezi=BinToDezi(gtempbin$) btempdezi=BinToDezi(btempbin$) If rtempdezi>255 Then rtempdezi=255 If gtempdezi>255 Then gtempdezi=255 If btempdezi>255 Then btempdezi=255 ;fertig interpretiertes Ergebnis eintragen b\shape_color_r=rtempdezi b\shape_color_g=gtempdezi b\shape_color_b=btempdezi End Select Next Return 1 End Function Function BinToDezi(binary$) For i=1 To Len(binary$) ;Binäres Ergebnis in Dezimale Zahl umformen If Mid$(binary$,i,1)="1" Then result=result+2^(Len(binary$)-i) Next Return result End Function Function Shape_NormalizeEdgeNum(hndl,num) b.bakterium=Object.bakterium(hndl) Repeat If num>b\shape_edges Then num=num-b\shape_edges If num<1 Then num=num+b\shape_edges Until num<=b\shape_edges And num>=1 Return num End Function Function BakteriumsCollide(hndl,hndl2) If hndl=hndl2 Then Return 0 b1.bakterium=Object.bakterium(hndl) b2.bakterium=Object.bakterium(hndl2) For eloop=1 To b1\shape_edges For floop= 1 To b2\shape_edges x1#=b1\x#+b1\shape_edgeX[eloop]*b1\health#/100 x2#=b1\x#+b1\shape_edgeX[Shape_NormalizeEdgeNum(Handle(b1),eloop+1)]*b1\health#/100 x3#=b2\x#+b2\shape_edgeX[floop]*b2\health#/100 x4#=b2\x#+b2\shape_edgeX[Shape_NormalizeEdgeNum(Handle(b2),floop+1)]*b2\health#/100 y1#=b1\y#+b1\shape_edgeY[eloop]*b1\health#/100 y2#=b1\y#+b1\shape_edgeY[Shape_NormalizeEdgeNum(Handle(b1),eloop+1)]*b1\health#/100 y3#=b2\y#+b2\shape_edgeY[floop]*b2\health#/100 y4#=b2\y#+b2\shape_edgeY[Shape_NormalizeEdgeNum(Handle(b2),floop+1)]*b2\health#/100 If Lines_Intersect(x1#,y1#,x2#,y2#,x3#,y3#,x4#,y4#) Then Return 1 End If Next Next Return 0 End Function Function Lines_Intersect(Ax#, Ay#, Bx#, By#, Cx#, Cy#, Dx#, Dy#) Rn# = (Ay#-Cy#)*(Dx#-Cx#) - (Ax#-Cx#)*(Dy#-Cy#) Rd# = (Bx#-Ax#)*(Dy#-Cy#) - (By#-Ay#)*(Dx#-Cx#) If Rd# = 0 ; Lines are parralel. ; If Rn# is also 0 then lines are coincident. All points intersect. ; Otherwise, there is no intersection point. Return False Else ; The lines intersect at some point. Calculate the intersection point. Sn# = (Ay#-Cy#)*(Bx#-Ax#) - (Ax#-Cx#)*(By#-Ay#) Intersection_AB# = Rn# / Rd# Intersection_CD# = Sn# / Rd# If Intersection_AB#<0 Or Intersection_AB#>1 Then Return False If Intersection_CD#<0 Or Intersection_CD#>1 Then Return False Intersection_X# = Ax# + Intersection_AB#*(Bx#-Ax#) Intersection_Y# = Ay# + Intersection_AB#*(By#-Ay#) Return True EndIf End Function ;################## |
||
|
Bms |
Mi, Jan 12, 2005 14:22 Antworten mit Zitat
|
|---|---|---|
|
ein paar bienchen:
Code: [AUSKLAPPEN] Const br=640,ho=480:Graphics br,ho,16,2:SetBuffer BackBuffer() ;Ausschlag: Const au=10 ;Geschwindigkeit: Const g#=1 ;Länge Const laenge=4 ;Bienen Const anz=50 Dim biene#(anz,2) ;Bienen verteilen For a=0 To anz biene#(a,0)=Rand(10,br-10) ;x biene#(a,1)=Rand(10,ho-10) ;y biene#(a,2)=Rand(360) ;richtung(winkel => sin+cos) Next ;Hintergrundfarbe ClsColor 0,100,0 Repeat Cls For a=0 To anz ;richtung ändern biene#(a,2)=biene#(a,2)+Rand(-au,au) If biene#(a,2)<0 Then biene#(a,2)=359 If biene#(a,2)>359 Then biene#(a,2)=0 ;bewegen biene#(a,0)=biene#(a,0)+Sin#(biene#(a,2))*g# biene#(a,1)=biene#(a,1)+Cos#(biene#(a,2))*g# ;Sieht man sie noch? wenn nein, dann resetten If (biene#(a,0)<10)Or(biene#(a,0)>(br-10))Or(biene#(a,1)>(ho-10))Then biene#(a,0)=Rand(br):biene#(a,1)=Rand(-140,0):biene#(a,2)=0 EndIf ;Biene malen For b=0 To laenge Color 255/laenge*b,255/laenge*b,0 Plot biene#(a,0)+Sin#(biene(a,2))*b,biene(a,1)+Cos#(biene(a,2))*b Next Next Flip Until KeyDown(1) End ist natürlich noch lange nicht optimiert.... |
||
flohrian |
Sa, Apr 22, 2006 17:07 Antworten mit Zitat
|
|
|---|---|---|
|
sven123 hat Folgendes geschrieben: @Fetze baut doch aus den Simulationen einen Bildschirmschoner!
die idee find ich gut
|
||
|
|
Mr.Keks |
Sa, Apr 22, 2006 17:12 Antworten mit Zitat
|
|---|---|---|
ok, bin mal gespannt, in wie vielen jahren der thread hier das nächste mal ausgegraben wird  D
|
||
| MrKeks.net | ||
Skulk |
Mo, Jul 03, 2006 13:36 Antworten mit Zitat
|
|
|---|---|---|
...und von wem, nämlich MIR 
Man verzeihe es mir dass ich Leichen ausbuddel, aber ich habe einige Ideen hierzu die noch mehr Pepp bringen könnten. Ich habe diese Thread verfolgt und muss sagen, ich finde diese Art der Lebens-analyse hochgradig interessant. Und ich bekomme lust damit zu experimentieren. Leider bin ich gerade in der Arbeit und kann mir dort nur den SourceCode ansehen und es noch nicht testen, aber mir sind dennoch einige Ideen gekommen die das ganze sicher interessanter gestalten könnten. Ich stelle jetzt erstmal meine Ideen vor, und weiter unten gebe ich die selben ideen als Stichpunktliste wieder (wegen der übersichtlichkeit) Die Idee mit dem Spiel ist zwar schon mal ganz gut, aber ich denke das sollte man noch bei seite lassen. Interessanter wäre eine Art Baukasten. Dass heisst, man hat die Möglichkeit, bestimmte dinge per mouse zu platzieren und zu beobachten wie sich die organismen verhalten. D.h. an einem der Bildschirmränder befindet sich eine Toolbox. Dort kann man dann wählen was man platzieren will. Also z.B.: - Organismus erstellen (und Startwerte selbst angeben) - Raubtier erstellen - Futterplatz erstellen - etc. Ausserdem wäre es praktisch, die Simulation pausieren zu können. Während die Pause aktiv ist, sollte man die organismen anklicken können und in einer Infobox detailierte informationen über den aktuellen Zustand dieses Organismusses erfahren können. Unter der Toolbox ist dann auch sicher noch genug platz für diverse statistiken. falls nicht, ein tastendruck und ein Statistikfenster blendet sich ein. Dazu sollte das spiel am besten pausieren bei dem Folgenden Punkt weiss ich leider nicht konkret wie weit er implementiert ist, da ich ja leider mir nur den source etwas angucken kann, die simulations aber noch nicht näher ansehen. Aber bei "Organismen" kam mir sofort die Idee des Gruppenführers. Es besteht eine gewisse, niedrige Wahrscheinlichkeit, dass ein Organismus Gruppenführereigenschaften entwickelt. D.h. der Organismus schart andere um sich und diese ziehen in gruppen herum. (es sollte immer mindestens einen geben) Natürlich gibt es ein paar wenige organismen, die sich weigern, auf eine person zu höhren. diese wuseln nach wie vor als freelancer durch die gegend. je stärker die Gruppenführereigenschaft ausgeprägt ist, desto eher folgen ihm andere. wenn nun ein starker führer an einem schwachen vorbeizieht, kann es durchaus passieren, dass sich diese organismen entscheiden, lieber dem stärkeren hinterher zu rennen. Desweiteren - was haltet ihr von der Fähigkeit sprinten zu können? Wenn ein Organismus bestimmte anreize erhält, kann es passieren dass er lust hat diese anreize schneller zu verfolgen als sonst. d.h. er sprintet auf sein ziel zu (oder von diesem weg) also wenn ein organismus z.B. ausgehungert ist und er entdeckt eine futterquelle, ist die wahrscheinlichkeit sehr hoch, dass er alles gibt um diese quelle zu erreichen. oder wenn er von einem raubtier verfolgt wird, würde er alles geben, diesem zu entkommen bei kleinkindern besteht eine höhere wahrscheinlichkeit, dass diese einfach so sprinten. ihr kennt doch kinder, die rennen gern
eine weitere variante ist erschöpfung einzubauen. d.h. ein organismus kann nicht unendlich oft und lange sprinten, sondern nur wenn er seinen erschöpfungswert nicht erreicht hat. erschöpfung regeneriert sich 3x langsamer als sie durch sprinten zu nimmt. je älter ein organismus ist, desto schneller ist er erschöpft und desto mehr nimmt seine sprintgeschwindigkeit ab. So. ihr denkt das wären schon viele ideen? Jetzt hab ich die ultimative! Diese idee macht (für mich) die thematik um den faktor 5 interessanter. Krankheiten und Seuchen. Organismen können krankheiten entwickeln und weiter geben (anstecken) kranke organismen sind langsamer und leichter erschöpft. eine krankheit heilt sich mit der zeit von selbst. das dauert jedoch und während dessen kann der kranke organismus andere anstecken (natürlich nie sofort bei kontakt, sondern nur bei einer gewissen wahrscheinlichkeit. später könnte man sogar genetische resistenzen einbauen) damit einem aber nicht sofort das rudel ausstirbt, sollte man zeitgleich auch heiler einsetzen. diese wandeln durch die gegend und steuern gezielt kranke organismen an, welche sie dann heilen. (heilen sollte jedoch sofort klappen, sonst kriegt man die seuche nicht unter kontrolle) neben heiler könnte man auch lazarette einbauen, die die organismen nach einiger zeit krankheit von selbst ansteuern...wenn sie vorher nicht sterben (an alters schwäche)
Stichpunkte Gruppenführer (attractors) je höher der Attractor-Wert, desto höher die wahrscheinlichkeit dass ihm welche folgen. (gruppenmitglieder eines schwachen führes können sich entscheiden zu einem starken zu wechseln) organismen können SprintenWenn anreiz vorhanden (Futter in sicht (und hunger groß), fliehen vor feind, bei kindern: spieltrieb) Nimmt im Alter ab. erschöpfung: maximale dauer, die ein organismus sprinten kann. anschliessend muss er erschöpfung * 3 zeiteinheiten regenerieren. krankheiten / seuchen: durch Krankheit reduziert sich beweglichkeit, fortpflanzungstrieb und es erhöht sich die erschöpfung (natürlich nur temporär) krankheit wird nach gewisser zeit auskuriert Heiler / Lazarette heilen die organismen, wenn sie mit ihnen in berührung kommen, steuern diese gezielt an Kranke Organismen steueren Lazarette gezielt an Möglichkeit, bestimmte Dinge per Mouse zu platzieren. Lazarette, Heiler einsetzen, Futter verteilen, Raubtiere verteilen, organismus mit bestimmten werten erschaffen, alle organismen tilgen, etc. darunter platz für statistiken Möglichkeit, das Spiel zu pausieren (zur genaueren Analyse) Während Pause, kann man einzelne organismen anklicken und erhält detailierte Informationen zum aktuellen zustand. |
||
|
War doesn't determine who's right,
war determines who's left... |
||
|
|
Fetze |
Mo, Jul 03, 2006 17:45 Antworten mit Zitat
|
|---|---|---|
|
ALso abgesehen mal davon, dass das ganze als Bakteriensimulation gedacht war, die Vorschläge klingen doch recht interessant. Ich verfolge - oder besser verfolgte, als ich das ganze Projekt vor einem Jahr auf der DUSmania neu anpackte - aber einen anderen Weg:
Die DNA nämlich nicht mehr als Ansammlung von Eigenschaften sondern eher als Verhaltens- sowie Wachstumsskript zu betrachten: Jedes Frame wird ein Befehl abgearbeitet, der Wachstum in eine bestimmte "Richtung", Synthese bestimmter Stoffe (Natürlich nur Möglich, wenn Ausgangsprodukte vorhanden) oder ein bestimmtes Verhalten hervorrufen kann. Unter die Befehle mischt sich DNA-Syntax wie beispielsweise "Goto" oder "Wenn X, dann folgenden Befehl ausführen. Wenn nicht, überspringen" sowie einen "Negator", der Wenn-Befehle und eventuell weitere Befehle, bei denen dies möglich ist, negiert. Also - im Beispiel des Wenn-Befehls - aus dem "Wenn" ein "Wenn nicht" macht. Da jedes Frame nur ein Befehl ausgeführt wird, ist das ganze nicht zu rechenaufwändig und die Evolution führt automatisch zu einer Optimierung der DNA auf das unbedingt notwendige - weil die Zelle so agiler ist und schneller reagiert. Zudem wäre durch ein solches System ein weitaus komplexeres Verhalten Möglich. Ein Beispiel: Eine blaue "Raubzelle" hat im Script irgendwo die entscheidende Stelle "Wenn Zelle in der weiteren Umgebung dann Wenn Zelle nicht blau dann flieg in Richtung der Zelle. Friss Zelle." Die Farbunterscheidung hat sie entwickelt, um keine Artgenossen aufzufressen. Jetzt kann eine andere Zellenart jedoch die Farbe imitieren und entzieht sich so dem gefressen-werden. Auf diese Art und Weise werden mit Sicherheit interessante Kulturen entstehen. Neben dem Zell-Script muss es natüürlich noch Programmroutinen geben, die allgemein gelten, damit eine Zelle nicht einfach zur Über-Zelle heranwachsen kann. Ideal wären "natürliche" Grenzen, die sich aus Regeln der Umwelt ergeben anstatt von hardcode-Grenzen. Zum Beispiel: Große Zellen sind träge, da sie eine größere Masse haben und ihr Antrieb mehr leisten muss, für die gleiche Geschwindigkeit und Strecke mehr Energie braucht. Große Zellen wären also Jägern schutzlos ausgeliefert. Oder: Je größer eine Zelle, desto instabiler ist sie, was sich zB. in permanentem Energieverlust äußern könnte. Man kann das ganze natürlich noch auf die Spitze treiben und chemische Stoffe samt Eigenschaften definieren, sodass eine Zelle, um eine bestimmte Farbe zu erhalten, zB. einen bestimmten Stoff synthetisieren muss, und um das zu tun benötigt sie Stoff X, Y und Z, die sie erst durch ihre Membran aus der Umgebung aufnehmen muss. Aber derlei wird wahrscheinlich zu rechenaufwändig. Hui, bin ich motiviert, mich da mal wieder ranzusetzen 
Naja. Wahrscheinlich werde ich aufgrund von *schleichwerbung* StarTrade keine freie Freizeit dafür finden, aber mal schauen. Vielleicht will sich ja auch jemand anderes der Sache annehmen? Ich würde BlitzMax empfehlen. NewfromScratch, da mein jahre altes Beispiel nicht wirklich ein glänzendes ist. ^^ |
||
Gehe zu Seite Zurück 1, 2, 3, 4, 5 Weiter
Übersicht
BlitzBasic Codearchiv
Powered by phpBB © 2001 - 2006, phpBB Group