DNA-Bakterien
Übersicht

![]() |
FetzeBetreff: DNA-Bakterien |
![]() Antworten mit Zitat ![]() |
---|---|---|
Um nicht länger die Schwarmsimulation vollspammen zu müssen, mache ich mal ein eigenes Topic auf für meine DNA-Bakterien.
Für die, die es noch nicht wissen: Hier werden Bakterien simuliert, deren Eigenschaften auf ihrer DNA basieren. Diese DNA besteht nur aus einsen und Nullen, was in etwa den zwei Möglichkeiten unserer Basenpaar entspricht. Sie wird richtig interpretiert, ohne dass feste Reihenfolgen oder dergleichen existieren. EIne bestimmte Kombination teilt der Bakterie mit, dass dort ein bestimmter Wert auszulesen gilt. Die Bakterien sterben nicht nach gewisser Zeit, sondern sobald ihr Genom zu stark zerstört ist oder sie getötet werden. Probiert es einfach mal aus. Mehrere Anläufe werden nötig sein ^^ In dieser Version habe ich mal als Startvorraussetzung neben einem FotosyntheseBakterium noch eine Fresszelle platziert (Schwarz am Anfang). Diese bezieht ihre Energie, die sie zum Teilen benötigt, daraus, andere Bakterien (an) zu fressen. Mit der Leertaste kann man 4 der vorhandenen Genome zufällig auswählen lassen und in ein neues Testgebiet setzen. Quasi mit 4 aus dem alten Test in nem neuen Test weitermachen. Das ist allerdings eher zur CPU-Auslastung. Hier ist der aktuelle Code: 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 MaxBakterien=30 Const AutoClear=0 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 0 00001011 00001100 1100100 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 If CountBakterien()>MaxBakterien And AutoClear=1 Then ClearArea() If KeyHit(57) Then ClearArea() ;Text 100,100,GetSuccessGenom$() 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#)-b\xspeed#;/200 b\yspeed#=(temp\y#-b\y#)-b\yspeed#;/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 ;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 ;Bewegung b\xold#=b\x# b\yold#=b\y# 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 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 Function ClearArea() ; tmp$=GetSuccessGenom$() ; KillAll() ; CreateBakterium(300,200,100,tmp$) tmp1$=GetRandomGenom$() tmp2$=GetRandomGenom$() tmp3$=GetRandomGenom$() tmp4$=GetRandomGenom$() KillAll() CreateBakterium(150,100,100,tmp1$) CreateBakterium(450,100,100,tmp2$) CreateBakterium(150,300,100,tmp3$) CreateBakterium(450,300,100,tmp4$) End Function Function KillAll() For b.bakterium=Each bakterium KillBakterium(Handle(b)) Next End Function Function GetRandomGenom$() Local gtemp$[10000] For b.bakterium=Each bakterium gnum=gnum+1 gtemp[gnum]=b\genom_orig$ Next Return gtemp[Rand(1,gnum)] End Function Function GetSuccessGenom$() Local gtemp$[10000] Local gsuccess[10000] gnum=0 For b.bakterium=Each bakterium If gnum>0 Then For gloop=1 To gnum If b\genom_orig$=gtemp[gloop] Then gsuccess[gloop]=gsuccess[gloop]+1 : gfound=1 Next End If If gfound=0 Then gnum=gnum+1 gtemp[gnum]=b\genom_orig$ gsuccess[gnum]=1 End If Next For gloop=1 To gnum If gsuccess[gnum]>bestsuccess Then bsnum=gloop bestsuccess=gsuccess[gnum] End If Next Return gtemp[bsnum] End Function Function CountBakterien() For b.bakterium=Each bakterium num=num+1 Next Return num End Function ;################## |
||
![]() |
hamZtaAdministrator |
![]() Antworten mit Zitat ![]() |
---|---|---|
ui, fängt stark zum ruckeln, wenige sekunden nach start (ohne debugmodus), nach ein paar seks kommts dann ganz zum stillstand :/
p4 2.66 laptop 512 ddram radeon9000 mobil. |
||
Blog. |
![]() |
Fetze |
![]() Antworten mit Zitat ![]() |
---|---|---|
Natürlich ruckelt das, is doch klar.
1. wegen dem Line-Befehl 2. wegen Kollisionsabfrage der Bakterien 3. wegen Anzahl der Bakterien 4. wegen dem DNA-Parser, der bei der Teilung aufgerufen wird. Das Programm ist nicht dazu da, schnell zu laufen. Das Programm ist dazu da, Evolution zu simulieren. Naja, jedenfalls, wenn man das so nennen kann, die die Möglichkeiten ja etwas beschränkt sind. Obwohl... teilweise hatte ich schon wirklich überraschende Bakterienkulturen... *g* |
||
cavebird |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
Irgendwie macht das Spaß! Aber mach das mal bunter. Ich habe meistens nur weiße und schwarze... | ||
MegaUpload.de -- Uploade bis zu 2MB pro Bild !!DEIN PARTNER IN SACHEN UPLOAD --bitte weiterempfehlen, nur so können wir bekannt werden... |
![]() |
Fetze |
![]() Antworten mit Zitat ![]() |
---|---|---|
Wie soll ich die bitteschön bunter machen? Ihre Farbe hängt von ihrer DNA ab ^^
Hatte bei meiner letzten Simulation übrigens ein sehr interessantes Ergebnis: Eine Fünfeckige, Grüne Bakterienart, die per Fotosynthese Energie gewinnt. Sie hatte jedoch eine relativ hohe Mutationsrate, was normalerweise den Tod einer Art bedeutet. Jedoch nicht bei den Grünen Fünfecken: Die hatten zwar häufig mutationen, diese wurden aber sofort von allen gemeinsam gefressen. Und da eine Zelle auch ihre Energie teilt, die Mutationszelle also die Hälfte der Energie der Mutterzelle hat, aber alle Zellen zusammen die mutierte Tochterzelle fressen, hatte das den Effekt, dass die Bakterien alle die in etwa gleiche Energie hatten, da sie ständig gleichmäßig aufgeteilt wurde. Wenn dieser Art, die sich aufgrund dieses Verhaltens immer im Schwarm aufgehalten hat, eine andere Bakterienart zu nahe kam, wurde sie gefressen und somit vernichtet. Hätte meine Art gerne ein paar Experimenten unterzogen, aber leider hatte ich aufgrund fehlender Funktionen keine Möglichkeit, an ihre DNA zu kommen ![]() Hier mal meine aktuelle Version: 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=15 Const MaxFotoSynth#=2 Const MaxHealth=100 Const MaxBakterien=30 Const AutoClear=0 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 0 00001011 00001100 1100100 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 If CountBakterien()>MaxBakterien And AutoClear=1 Then ClearArea() If KeyHit(57) Then ClearArea() ;Text 100,100,GetSuccessGenom$() 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#)-b\xspeed#;/200 b\yspeed#=(temp\y#-b\y#)-b\yspeed#;/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 ;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 ;Bewegung b\xold#=b\x# b\yold#=b\y# 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 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 Function ClearArea() ; tmp$=GetSuccessGenom$() ; KillAll() ; CreateBakterium(300,200,100,tmp$) tmp1$=GetRandomGenom$() tmp2$=GetRandomGenom$() tmp3$=GetRandomGenom$() tmp4$=GetRandomGenom$() KillAll() CreateBakterium(150,100,100,tmp1$) CreateBakterium(450,100,100,tmp2$) CreateBakterium(150,300,100,tmp3$) CreateBakterium(450,300,100,tmp4$) End Function Function KillAll() For b.bakterium=Each bakterium KillBakterium(Handle(b)) Next End Function Function GetRandomGenom$() Local gtemp$[10000] For b.bakterium=Each bakterium gnum=gnum+1 gtemp[gnum]=b\genom_orig$ Next Return gtemp[Rand(1,gnum)] End Function Function GetSuccessGenom$() Local gtemp$[10000] Local gsuccess[10000] gnum=0 For b.bakterium=Each bakterium If gnum>0 Then For gloop=1 To gnum If b\genom_orig$=gtemp[gloop] Then gsuccess[gloop]=gsuccess[gloop]+1 : gfound=1 Next End If If gfound=0 Then gnum=gnum+1 gtemp[gnum]=b\genom_orig$ gsuccess[gnum]=1 End If Next For gloop=1 To gnum If gsuccess[gnum]>bestsuccess Then bsnum=gloop bestsuccess=gsuccess[gnum] End If Next Return gtemp[bsnum] End Function Function CountBakterien() For b.bakterium=Each bakterium num=num+1 Next Return num End Function ;################## |
||
![]() |
VirtualDreams |
![]() Antworten mit Zitat ![]() |
---|---|---|
Je mehr Bakterien es werden desto ruckliger wird. Sagen wir mal es waren ca 100 auf dem screen da war das alles schon ne diashow... | ||
Zitat: "Ich habe ein Programm geschrieben und das funst nich. Warum nich ![]() ![]() |
![]() |
Fetze |
![]() Antworten mit Zitat ![]() |
---|---|---|
Is doch klar. Und je komplexer ihre Formen, desto ruckeliger wird es ebenfalls, denn die Kollisionsabfrage mit LineIntersect braucht auch schon ihre Zeit ![]() |
||
![]() |
Ctuchik |
![]() Antworten mit Zitat ![]() |
---|---|---|
Woran siehst du eigentlich was deine Endbakterien so können:
Zitat: Eine Fünfeckige, Grüne Bakterienart, die per Fotosynthese Energie gewinnt. Sie hatte jedoch eine relativ hohe Mutationsrate
Wird doch nirgends angezeigt! Das müsstest du mal einbauen! Ansonsten: Hut ab, sowas wollte ich auch schon lange mal machen, bin aber irgendwie nie dazu gekommen! ![]() |
||
Zu den Nebenwirkungen gehören trockener Mund, Übelkeit, Erbrechen, Harnstau, schmerzhafter rektaler Juckreiz, Halluzinationen, Demenz, Psychose, Koma, Tod und Mundgeruch!
Magie eignet sich nicht für alle! Fraget euren Arzt oder Apotheker! |
- Zuletzt bearbeitet von Ctuchik am Di, Jan 11, 2005 15:48, insgesamt einmal bearbeitet
![]() |
Firstdeathmaker |
![]() Antworten mit Zitat ![]() |
---|---|---|
Das würde ich auch gerne wissen. Kannst du mir diese Bakterien entschlüsseln?:
|
||
www.illusion-games.de
Space War 3 | Space Race | Galaxy on Fire | Razoon Gewinner des BCC #57 User posted image |
![]() |
Lord_Vader |
![]() Antworten mit Zitat ![]() |
---|---|---|
Find ich ne klasse idee ![]() Selbst wenns ruckelt also es macht spaß ![]() Das wollte ich eigentlich so ähnlich auch mal machen, mit robotern aber keine evolution in der art. Klasse idee speicher ich mir mal schnell ![]() Und LOL: Wenn ich ne .exe draus mach dann erm vermehren sie sich net und schwirren irgendwann ab O_o Edit: Ok ne war zufall xD |
||
![]() |
Mr.Keks |
![]() Antworten mit Zitat ![]() |
---|---|---|
ich habe das ganze mal eben optimiert, indem ich die kollision auf eine entfernungsmessung beschränkte und die bakterien in images zwischenspeicherte und nur selten aktuallisierte. jetzt läufts bei normalen zahlen noch flüssig genug. | ||
MrKeks.net |
![]() |
Lord_Vader |
![]() Antworten mit Zitat ![]() |
---|---|---|
Kannste mal den Code pasten? Oder is der hier irgentwo ich seh nix. Wenns dann noch realistisch genug is reicht das ja völlig ![]() |
||
![]() |
MoochBetreff: ... |
![]() Antworten mit Zitat ![]() |
---|---|---|
@Fetze: Kannst du nich mal ne Funktion einbauen, die sämtliche Auftretenden DNA's in einer Datei speichert? | ||
Pentium IV 3.0Ghz; nVidia Geforce 6800;
Microsoft Windows XP Home SP2; BlitzBasic 3D .:: Sites ::. .:: http://www.fl4sh-clan.de/ ::. |
![]() |
Fetze |
![]() Antworten mit Zitat ![]() |
---|---|---|
Ja, ich sollte allgemein mal Diagnose- und Experimentier-Tools einbauen. Aber rechnet mal nicht mit Updates, mein Hauptprojekt geht vor und das hier mache ich nur, wenn ich grad wirklich zu viel Zeit hab *g*
@Ctuchik habe sie nicht entschlüsselt. Das sieht man doch: Es gibt derzeit nur 2 Arten der Energiegewinnung: Fressen und Fotosynthese. Und wenn sie sich auch vermehren, wenn nix zum fressen da is, dann ist es wohl Fotosynthese. @Firstdeathmaker Würde ich gerne, aber wenn ichs überhaupt kann, dann nur, wenn ich die leutz in Bewegung sehe. Wie hast du so eine Artenvielfalt bekommen? Bei mir gibts meistens nur so 1-2 dominante Rassen, die die anderen verdrängen. Und dann wirds langweilig, weil die meistens eine extrem geringe Mutationsrate haben. @Inarie Gibste mir bitte mal deine Optimierung? ^^ |
||
![]() |
Mr.Keks |
![]() Antworten mit Zitat ![]() |
---|---|---|
Code: [AUSKLAPPEN] ;### GRAFIKMODUS U. ZUFALLSGENERATOR ###
Const RES_X=1024,RES_Y=768 Graphics RES_X,RES_Y,16,2 SeedRnd MilliSecs() SetBuffer BackBuffer() ;ClsColor 30,30,30 AutoMidHandle 1 ;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=1 Const MaxEatRange=35 Const MaxFotoSynth#=4 Const MaxHealth=150 Const MaxBakterien=30 Const AutoClear=0 Const Shape_MaxEdges=16 Const Shape_MaxEdgeEntf=10 Const Genom_MaxChanges=40 ;################## Dim Resources#(res_x/32,res_y/32,1); "Resourcen", die die Zellen benötigen. ; 0 : O2 ; 1 : CO2 ; 2 : ;### 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 img ; Vorberechnetes Bild zum Line-Sparen. 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 ### RndEnviron() CreateBakterium(200,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(400,500,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(200,140,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 0 00001011 00001100 1100100 00001101 00001110 111111111111111111111111 00001111") ;###################### ;### HAUPTSCHLEIFE ### Repeat Cls DrawEnviron() UpdateBakterien() ;Bakterien berechnen count = CountBakterien() If count>MaxBakterien And AutoClear=1 Then ClearArea() If KeyHit(57) Then ClearArea() Text 100,100,count ;WaitTimer(zeittakt) Flip 0 Until KeyHit(1) ;##################### End ;### FUNKTIONEN ### Function CreateBakterium(x,y,health#,genom$) ;Bakterium erstellen b.bakterium=New bakterium 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 b\x = 10 b\y = 10 b\img = CreateImage(60,60) SetBuffer ImageBuffer(b\img) DrawBakterium(Handle(b)) SetBuffer BackBuffer() b\x#=x ;Position b\y#=y Return Handle(b) ;Handle zurückgeben End Function Function DeleteBakterium(hndl) b.bakterium=Object.bakterium(hndl) FreeImage b\img Delete b.bakterium End Function Function KillBakterium(hndl) DeleteBakterium(hndl) End Function Function UpdateBakterien() ;Bakterien berechnen For b.bakterium=Each bakterium ;Bakterien durchgehen If Rand(25) = 10 SetBuffer ImageBuffer(b\img) Cls DrawBakterium(Handle(b)) SetBuffer BackBuffer() End If ;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#)-b\xspeed#;/200 b\yspeed#=(temp\y#-b\y#)-b\yspeed#;/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 ;Kollisionsüberprüfung If Rand(3)=2 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 EndIf ;Bewegung b\xold#=b\x# b\yold#=b\y# b\x#=b\x#+b\xspeed# b\y#=b\y#+b\yspeed# If resources(b\x/32,b\y/32,0) > 1 resources(b\x/32,b\y/32,0) = resources(b\x/32,b\y/32,0) - 1 resources(b\x/32,b\y/32,1) = resources(b\x/32,b\y/32,1) + 1 If Not (b\health_fotosynth>10 And resources(b\x/32,b\y/32,1) < 10) b\health = b\health + .3 EndIf Else b\health = b\health - .5 EndIf ;Fotosynthese If b\health_fotosynth>5 Then If b\health_fotosynth/100<=MaxFotoSynth# Then If resources(b\x/32,b\y/32,1) > 1 b\health#=b\health#+Float(Float(b\health_fotosynth)/Float(120)) resources(b\x/32,b\y/32,0) = resources(b\x/32,b\y/32,0)+Float(Float(b\health_fotosynth)/20.00) resources(b\x/32,b\y/32,1) = resources(b\x/32,b\y/32,1)-Float(Float(b\health_fotosynth)/20.00) EndIf End If ; Color 0,255,0 ; Rect b\x#,b\y#,2,2,1 End If ;Fressen If b\health_eat>5 And Rand(10)=4 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(30)) b\health#=b\health#+Float(Float(b\health_eat)/Float(30)) 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>70 Then CreateBakterium(b\x#,b\y#,b\health#/2,B\genom$) b\health#=b\health#/1.5 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\reproductionrate > 200 Then KillBakterium(Handle(b)) : killed=1 ;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 DrawImage b\img,b\x,b\y;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 temp<>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 30+b\shape_edgeX[dloop]*b\health#/100,30+b\shape_edgeY[dloop]*b\health#/100,30+b\shape_edgeX[Shape_NormalizeEdgeNum(Handle(b),dloop+1)]*b\health#/100,30+b\shape_edgeY[Shape_NormalizeEdgeNum(Handle(b),dloop+1)]*b\health#/100 Next Color 255,255,255 ;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) If ((b1\x-b2\x)^2+(b1\y-b2\y)^2) < 50 Then Return 1 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 Function ClearArea() ; tmp$=GetSuccessGenom$() ; KillAll() ; CreateBakterium(300,200,100,tmp$) tmp1$=GetRandomGenom$() tmp2$=GetRandomGenom$() tmp3$=GetRandomGenom$() tmp4$=GetRandomGenom$() KillAll() CreateBakterium(150,100,100,tmp1$) CreateBakterium(450,100,100,tmp2$) CreateBakterium(150,300,100,tmp3$) CreateBakterium(450,300,100,tmp4$) End Function Function KillAll() For b.bakterium=Each bakterium KillBakterium(Handle(b)) Next End Function Function GetRandomGenom$() Local gtemp$[10000] For b.bakterium=Each bakterium gnum=gnum+1 gtemp[gnum]=b\genom_orig$ Next Return gtemp[Rand(1,gnum)] End Function Function GetSuccessGenom$() Local gtemp$[10000] Local gsuccess[10000] gnum=0 For b.bakterium=Each bakterium If gnum>0 Then For gloop=1 To gnum If b\genom_orig$=gtemp[gloop] Then gsuccess[gloop]=gsuccess[gloop]+1 : gfound=1 Next End If If gfound=0 Then gnum=gnum+1 gtemp[gnum]=b\genom_orig$ gsuccess[gnum]=1 End If Next For gloop=1 To gnum If gsuccess[gnum]>bestsuccess Then bsnum=gloop bestsuccess=gsuccess[gnum] End If Next Return gtemp[bsnum] End Function Function CountBakterien() For b.bakterium=Each bakterium num=num+1 Next Return num End Function ;################## Function RndEnviron() For x = 0 To res_x/32 For y = 0 To res_y/32 Resources(x,y,0) = Rnd(100,200) Resources(x,y,1) = Rnd(100,200) Next Next End Function Function DrawEnviron() For x = 1 To res_x/32 For y = 1 To res_y/32 g = resources(x,y,0) r = resources(x,y,1) If g > 255 Then g = 255 If g < 0 Then g = 0 If r > 255 Then r = 255 If r < 0 Then r = 0 Color r/2,g/2,0 Rect x*32-32,y*32-32,32,32 Next Next End Function |
||
MrKeks.net |
![]() |
Lord_Vader |
![]() Antworten mit Zitat ![]() |
---|---|---|
Eindeutig ein kleines meisterwerk. Klasse gemacht Inarie! | ||
Edlothiol |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
Ja, wirklich gut. Ich hatte grade eine riesige Kolonie kleiner weißer Dreiecke, die Fotosynthese betrieben. Dann kamen von oben blaue Striche, die sich durch die Dreiecksansammlungen gefressen haben ![]() |
||
Scorp.ius |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
also ich hatte gerade eine art, die wohl irgendwie sehr erfolgreich war, ich musste das programm schließlich abbrechen, da ich bereits über 1500 von denen auf dem schrim hatte und es zwischen zwei bildern ca. 5 sekunden dauerte ![]() schickes Program ich hatte sowas auch mal vor (damals noch auf dem Amiga mit AMOS-Basic), leider habe ich es nicht so richtig hinbekommen, vielleicht probiere ich es ja mal wieder ![]() |
||
ke^kx |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
Ich glaub ich hatte so ähnliche, die haben mit jedem Schleifendurchlauf so um 100 zugenommen ![]() cooles Proggramm, Jiriki |
||
http://i3u8.blogspot.com
Asus Striker II Intel Core2Quad Q9300 @ 2,5 GHz (aber nur zwei Kerne aktiv aufgrund der Instabilität -.-) Geforce 9800 GTX 2GB RAM |
![]() |
Ebola33 |
![]() Antworten mit Zitat ![]() |
---|---|---|
Mein lieber Schwarm,
![]() Am Anfang waren die weissen dominant und haben sich vermehrt wie die Fliegen. Bis die roten kamen die zum Schluss alles vertilgt haben*gg* Geiles Programm. |
||
ansteckend... ![]() verstaubtes Projekt : http://www.mitglied.lycos.de/ebola33/ |
Übersicht


Powered by phpBB © 2001 - 2006, phpBB Group