Aktuelle Zeit: 22.06.2018 19:08

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 25 Beiträge ]  Gehe zu Seite Vorherige  1, 2, 3
Autor Nachricht
 Betreff des Beitrags: Re:
BeitragVerfasst: 13.02.2018 02:10 
Offline
Benutzeravatar

Registriert: 06.07.2017 12:24
Kiffi hat geschrieben:
Hier noch ein netter Tipp, der zeigt, wie sich verschiedenene Zugriffe auf ein
mehrdimensionales Array auf die Geschwindigkeit auswirken kann:

http://www.purebasic.fr/english/viewtopic.php?t=22909

Grüße ... Kiffi


Vielen Dank dafür! :o
Auf die Idee wäre ich nie gekommen!
Hab's getestet, und in der Tat kann man damit so einige Millisekunden rausquetschen, worüber sich insbesondere meine A*-Pfadsuche freut.
Oder auch beim Zeichnen von Tile-basierter Level-Data.

_________________
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Programmier Tipps und Tricks
BeitragVerfasst: 13.02.2018 23:34 
Offline

Registriert: 27.11.2016 18:13
Wohnort: Erzgebirge
Hallo Leute,

braucht hier jemand zufällig einen "Stern"?

Für Optimierungstipps bin ich offen.

Code:
; Mein kleiner A-Stern- und Delta-Move -Test

InitSprite() : InitKeyboard()

#Fullscreen = 0

Global t.d = 0, dt.d = 0

Global Stepping.d = 0, Quit = 0

Global Dim LevelMap.i(36,36)
Restore Level
#MapH = 18
#MapW = 18
For Y = 0 To #MapH
  For X = 0 To #MapW
    Read.i LevelMap(X, Y)
  Next X
Next Y
;Startkoordinaten
Global StartPointX = 10
Global StartPointY = 3
;Zielkoordinaten
Global EndPointX = 15
Global EndPointY = 16

Global WayString.s

Enumeration
  #FrontX=1
  #FrontY
  #Start
  #Stop
EndEnumeration

Enumeration
  #NoWay=0
  #Next
  #Last
  #Left
  #Right
  #Up
  #Down
EndEnumeration

Structure WayPoint
  X.d
  Y.d
EndStructure

Structure Way
  SaveWay.s
  LastPosition.WayPoint
EndStructure

If #Fullscreen
  OpenScreen(800,600,32,"A-Star")
Else
  OpenWindow(0,0,0,800,600,"A-Star",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)   
  OpenWindowedScreen(WindowID(0),0,0,800,600,0,0,0)
  ;SetFrameRate(200)
  ;SetFrameRate(100) ;Framerate-Switchen für DeltaT - Test
  SetFrameRate(60)
  ;SetFrameRate(30)
EndIf

Structure MoveSprite
  x.d
  y.d
EndStructure

actor.MoveSprite

actor\x = 0 : actor\y = 200

;Actor
If CreateSprite(0,32,32)
  If StartDrawing(SpriteOutput(0))
    Box(0,0,32,32,RGB(0,255,0))
    StopDrawing()
  EndIf
EndIf

;EndPoint
If CreateSprite(1,32,32)
  If StartDrawing(SpriteOutput(1))
    Box(0,0,64,64,RGB(255,0,0))
    StopDrawing()
  EndIf
EndIf

;Wall
If CreateSprite(2,32,32)
  If StartDrawing(SpriteOutput(2))
    Box(0,0,32,32,RGB(255,255,0))
    StopDrawing()
  EndIf
EndIf

Procedure.i NextStep(*WayString)
  Protected tempstr.s
  If Left(PeekS(*WayString),3) = "-+-"
    ProcedureReturn #NoWay
  ElseIf Left(PeekS(*WayString),3) = "+++"
    If Len(PeekS(*WayString))>4
      tempstr=Mid(PeekS(*WayString),4,1)
      PokeS(*WayString, "+++"+Right(PeekS(*WayString), (Len(PeekS(*WayString))-4 )))
      ProcedureReturn Val(tempstr)
    Else
      tempstr=Mid(PeekS(*WayString),4,1)
      PokeS(*WayString, "-+-")
      ProcedureReturn Val(tempstr)
    EndIf
  Else
    ProcedureReturn #NoWay
  EndIf
EndProcedure

Procedure.s FindWay( BeginX.i, BeginY.i, EndX.i, EndY.i, Field.i, NoField.i, Array AMap.i(2) )
  Protected.b WayFound=#False
  Protected.WayPoint AMap_Dim, StartPoint, EndPoint
  Protected.i PointerImage, CounterX, CounterY, ALayer
  Protected NewList Way1.Way()
  Protected NewList Way2.Way()
  Protected.s TempString
 
  Protected.i WayNext=#Next, WayBack=#Last, WayLeft=#Left, WayRight=#Right
 
  If BeginX<0 Or BeginX>ArraySize(AMap(),1) Or EndX<0 Or EndX>ArraySize(AMap(),1) Or BeginY<0 Or BeginY>ArraySize(AMap(),2) Or EndY<0 Or EndY>ArraySize(AMap(),2)
    ProcedureReturn "Start/Ziel ist ausserhalb der Karte."
  ElseIf AMap( BeginX, BeginY ) = NoField
    ProcedureReturn "Start ist nicht möglich."
  ElseIf AMap( EndX, EndY ) = NoField
    ProcedureReturn "Ziel ist nicht erreichbar."
  ElseIf BeginX = EndX And EndY = BeginY
    ProcedureReturn "Ziel wurde erreicht."
  EndIf
 
  StartPoint\X = BeginX
  StartPoint\Y = BeginY
  EndPoint\X = EndX
  EndPoint\Y = EndY
  If ArraySize(AMap(),1) >= ArraySize(AMap(),2)
    ALayer = #FrontX
    AMap_Dim\X = ArraySize(AMap(),1)
    AMap_Dim\Y = ArraySize(AMap(),2)
  Else
    ALayer=#FrontY
    AMap_Dim\X = ArraySize(AMap(),2)
    AMap_Dim\Y = ArraySize(AMap(),1)
    Swap StartPoint\X, StartPoint\Y
    Swap EndPoint\X, EndPoint\Y
    Swap WayNext, WayLeft
    Swap WayBack, WayRight
  EndIf
  AddElement(Way1())
  Way1()\LastPosition\X = StartPoint\X
  Way1()\LastPosition\Y = StartPoint\Y
  Way1()\SaveWay = "+++"
 
  PointerImage = CreateImage(#PB_Any,AMap_Dim\X+5,AMap_Dim\Y+5)
 
  If PointerImage = #False
    ProcedureReturn "Prüfinstanz nicht einrichtbar"
  ElseIf  #False = StartDrawing(ImageOutput(PointerImage))
    ProcedureReturn "Prüfdraw nicht verfügbar"
  EndIf
 
  For CounterX=0 To AMap_Dim\X
    For CounterY=0 To AMap_Dim\Y
      Select ALayer
        Case #FrontX
          Plot(CounterX, CounterY, AMap(CounterX, CounterY))
        Case #FrontY
          Plot(CounterX, CounterY, AMap(CounterY, CounterX))
        Default
          ProcedureReturn "Dimensionen sind falsch eingerichtet"
      EndSelect
    Next CounterY
  Next CounterX
 
  While WayFound = #False
    ResetList(Way1())
    ForEach Way1()
      If Way1()\LastPosition\Y > 0
        If Point( Way1()\LastPosition\X, Way1()\LastPosition\Y-1) = Field
          If Way1()\LastPosition\X = EndPoint\X And Way1()\LastPosition\Y-1 = EndPoint\Y
            TempString = Way1()\SaveWay + Str(WayNext)
            WayFound = #True
          Else
            AddElement(Way2())
            Way2()\SaveWay = Way1()\SaveWay + Str(WayNext)
            Way2()\LastPosition\X = Way1()\LastPosition\X
            Way2()\LastPosition\Y = Way1()\LastPosition\Y-1
            Plot(Way2()\LastPosition\X,Way2()\LastPosition\Y,NoField)
          EndIf
        EndIf
      EndIf
      If Way1()\LastPosition\Y < AMap_Dim\Y
        If Point( Way1()\LastPosition\X, Way1()\LastPosition\Y+1) = Field
          If Way1()\LastPosition\X = EndPoint\X And Way1()\LastPosition\Y+1 = EndPoint\Y
            TempString = Way1()\SaveWay + Str(WayBack)
            WayFound = #True
          Else
            AddElement(Way2())
            Way2()\SaveWay = Way1()\SaveWay + Str(WayBack)
            Way2()\LastPosition\X = Way1()\LastPosition\X
            Way2()\LastPosition\Y = Way1()\LastPosition\Y+1
            Plot(Way2()\LastPosition\X,Way2()\LastPosition\Y,NoField)
          EndIf
        EndIf
      EndIf
      If Way1()\LastPosition\X > 0
        If Point( Way1()\LastPosition\X-1, Way1()\LastPosition\Y ) = Field
          If Way1()\LastPosition\X-1 = EndPoint\X And Way1()\LastPosition\Y = EndPoint\Y
            TempString = Way1()\SaveWay + Str(WayLeft)
            WayFound = #True
          Else
            AddElement(Way2())
            Way2()\SaveWay = Way1()\SaveWay + Str(WayLeft)
            Way2()\LastPosition\X = Way1()\LastPosition\X-1
            Way2()\LastPosition\Y = Way1()\LastPosition\Y
            Plot(Way2()\LastPosition\X,Way2()\LastPosition\Y,NoField)
          EndIf
        EndIf
      EndIf
      If Way1()\LastPosition\X < AMap_Dim\X
        If Point( Way1()\LastPosition\X+1, Way1()\LastPosition\Y ) = Field
          If Way1()\LastPosition\X+1 = EndPoint\X And Way1()\LastPosition\Y = EndPoint\Y
            TempString = Way1()\SaveWay + Str(WayRight)
            WayFound = #True
          Else
            AddElement(Way2())
            Way2()\SaveWay = Way1()\SaveWay + Str(WayRight)
            Way2()\LastPosition\X = Way1()\LastPosition\X+1
            Way2()\LastPosition\Y = Way1()\LastPosition\Y
            Plot(Way2()\LastPosition\X,Way2()\LastPosition\Y,NoField)
          EndIf
        EndIf
      EndIf
    Next
   
    If WayFound = #False
      ClearList(Way1())
      ResetList(Way2())
     
      If 1 <= ListSize(Way2())
        ForEach Way2()
          AddElement(Way1())
          Way1()\SaveWay = Way2()\SaveWay
          Way1()\LastPosition\X = Way2()\LastPosition\X
          Way1()\LastPosition\Y = Way2()\LastPosition\Y
        Next
        ClearList(Way2())
        ResetList(Way1())
      Else
        WayFound = #True
        TempString = "Es gibt keinen Weg zum Ziel."
      EndIf
    EndIf
  Wend
 
  StopDrawing()
  FreeImage(PointerImage)
 
  ClearList(Way2())
  ClearList(Way1())
  ProcedureReturn TempString
EndProcedure

Procedure StarDraw()
  For Y=0 To #MapH
    For X=0 To #MapW
      If StartPointX = X And StartPointY = Y
        DisplaySprite(0,XX,YY)
      ElseIf EndPointX = X And EndPointY = Y
        DisplaySprite(1,XX,YY)
      Else
        Select LevelMap(X,Y)
          Case 0
            ;...
          Case 2
            DisplaySprite(2,XX,YY)
        EndSelect
      EndIf
      If XX <= 575
        XX + 32
      Else
        XX = 0
      EndIf
    Next X
    YY + 32
  Next Y
 
EndProcedure

Procedure StarMove()
  If Quit <> 3
    ;Auf gehts!
    Dir.i = NextStep(@WayString)
    Select Dir
      Case #Left
        StartPointX = StartPointX-1
      Case #Right
        StartPointX = StartPointX+1
      Case #Next
        StartPointY = StartPointY-1
      Case #Last
        StartPointY = StartPointY+1
      Case #NoWay
        Quit = 3
        MessageRequester("Ende", "Kein Weg möglich oder das Ziel wurde erreicht!"+Chr(13)+Chr(13)+"Das Ziel wurde in: "+Str(ElapsedMilliseconds() - run)+" ms erreicht.", 0)
    EndSelect
  EndIf
EndProcedure

run = ElapsedMilliseconds()

WayString = FindWay(StartPointX, StartPointY, EndPointX, EndPointY, 0, 2, LevelMap())

XX.d = 0 : YY.d = 0

Repeat
  If #Fullscreen = 0
    Repeat
      EventID = WindowEvent()
     
      Select EventID
        Case #PB_Event_CloseWindow
          End
      EndSelect
    Until EventID = 0
  EndIf
 
  t = ElapsedMilliseconds()
 
  ExamineKeyboard()
 
  ClearScreen(RGB(0,0,0))
 
  StarDraw()
 
  If Stepping >= 20
    StarMove()
  EndIf
 
  If Stepping >= 20
    Stepping = 0
  Else
    Stepping + (100 * dt)
  EndIf
 
  FlipBuffers():Delay(10)
  dt = (ElapsedMilliseconds() - t) / 1000
 
Until KeyboardPushed(#PB_Key_Escape) Or EventID = #PB_Event_CloseWindow

DataSection
  Level:
  Data.i 0,0,0,0,0,0,0,0,0,2,2,0,0,0,0,0,0,0,0
  Data.i 0,0,0,0,0,0,0,2,2,2,0,2,0,0,0,0,0,0,0
  Data.i 0,0,0,0,0,0,2,2,0,0,0,0,2,0,0,0,0,0,0
  Data.i 0,0,0,0,2,2,0,0,0,0,0,0,2,2,0,0,0,0,0
  Data.i 0,0,2,2,2,0,0,0,0,0,0,0,0,2,2,0,0,0,0
  Data.i 0,2,2,0,0,0,2,2,0,0,2,2,0,0,2,2,2,0,0
  Data.i 2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,2,0
  Data.i 2,0,0,0,0,0,0,0,2,0,0,0,0,0,0,0,0,2,2
  Data.i 2,2,2,2,0,0,0,0,2,0,0,0,0,0,0,0,0,0,2
  Data.i 0,0,0,2,2,2,0,0,0,0,0,0,0,0,2,2,2,2,2
  Data.i 0,0,0,0,0,2,2,0,0,0,0,0,0,0,2,0,0,0,0
  Data.i 0,0,0,0,2,2,0,0,0,2,2,0,0,0,2,0,0,0,0
  Data.i 0,0,0,0,2,0,0,0,2,2,2,0,0,0,2,0,0,0,0
  Data.i 0,0,0,2,0,0,0,2,2,0,2,2,0,0,2,2,0,0,0
  Data.i 0,0,2,2,0,0,2,2,0,0,0,2,2,0,0,2,2,0,0
  Data.i 0,0,2,0,0,0,2,0,0,0,0,0,2,2,0,0,2,0,0
  Data.i 0,2,2,0,0,2,2,0,0,0,0,0,0,2,2,0,2,2,0
  Data.i 2,2,0,0,2,2,0,0,0,0,0,0,0,0,2,0,0,2,2
  Data.i 2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,2,2,2,2
EndDataSection


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Programmier Tipps und Tricks
BeitragVerfasst: 16.02.2018 13:52 
Offline
Benutzeravatar

Registriert: 19.10.2006 12:51
Ein guter Anfang zur Optimierung wäre, den If aus der Renderschleife herauszuziehen, der bei jedem Durchlauf prüft, ob der Spielstein oder das Ziel auf dem jeweiligen Feld ist, Die könntest du einfach am Ende dort hinrendern, wo sie hingehören. Wenn der zusätzliche Rechenaufwand von ein paar Multiplikationen nicht ins Gewicht fallen, würde ich auf die zusätzlichen XX und YY verzichten, aber das ist eher Geschmackssache.:

Code:
Procedure StarDraw()
  SpriteSize = 32
  For Y=0 To #MapH
    For X=0 To #MapW
      Select LevelMap(X,Y)
        Case 2
          DisplaySprite(2, X*SpriteSize, Y*SpriteSize)
        Default
          ;----
      EndSelect
    Next X
  Next Y
  DisplaySprite(0, StartPointX*SpriteSize, StartPointY*SpriteSize)
  DisplaySprite(1, EndPointX*SpriteSize, EndPointY*SpriteSize)
EndProcedure


<)

Auch das mit dem Pathfinding würde ich nochmal überdenken, ob es nicht ohne Stringoperationen ginge.

Zudem fehlen viele If-Abfragen, ob InitX oder OpenX geklappt haben. Dein Programm stürzt einfach ab, wenn InitScreen() nicht erfolgreich ist.

Außerdem findet der Algorithmus den Weg nicht mehr, wenn er winkeliger wird.

_________________
return;


Zuletzt geändert von DarkSoul am 16.02.2018 14:09, insgesamt 1-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Programmier Tipps und Tricks
BeitragVerfasst: 16.02.2018 14:05 
Offline
Ein Admin
Benutzeravatar

Registriert: 29.08.2004 20:20
Wohnort: Saarbrücken
Nichts für ungut, ccode_new, aber ich finde den Code nicht sonderlich elegant, sodass er hier hin gehören würde. Du hättest da lieber einen eigenen Thread für aufmachen sollen. Dann kann man ihn dort optimieren und anschließend das Ergebnis oder einen Link zum Ergebnis hier nochmal posten. Davon abgesehen passt ein kompletter A*-Algorithmus kein nicht in die Rubrik "Programmier Tipps und Tricks". Sonst könnte man ja gleich alles hier rein stellen, was irgendwie ein Algorithmus ist. :wink:

_________________
Freakscorner.de - Der Bastelkeller | Neustes Video: Creality 3D CR-10 Review und erste Druckergebnisse
Ubuntu Gnome 16.04.3 LTS x64, PureBasic 5.60 x64 (außerdem 4.41, 4.50, 4.61, 5.00, 5.10, 5.11, 5.21, 5.22, 5.30, 5.31, 5.40, 5.50)
"Die deutsche Rechtschreibung ist Freeware, du darfst sie kostenlos nutzen – Aber sie ist nicht Open Source, d. h. du darfst sie nicht verändern oder in veränderter Form veröffentlichen."


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Programmier Tipps und Tricks
BeitragVerfasst: 16.02.2018 15:22 
Offline

Registriert: 27.11.2016 18:13
Wohnort: Erzgebirge
@NicTheQuick

Sorry!

Dann verschiebe es, lösche es, oder ignoriere es einfach.

Anbei: Hier einmal eine coole Seite um verschiedene Wegfindungs-Algorithmen zu vergleichen.

Pathfinding


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 25 Beiträge ]  Gehe zu Seite Vorherige  1, 2, 3

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 3 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye