PureBoard
http://forums.purebasic.com/german/

Programmier Tipps und Tricks
http://forums.purebasic.com/german/viewtopic.php?f=8&t=4840
Seite 3 von 3

Autor:  diceman [ 13.02.2018 02:10 ]
Betreff des Beitrags:  Re:

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.

Autor:  ccode_new [ 13.02.2018 23:34 ]
Betreff des Beitrags:  Re: Programmier Tipps und Tricks

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

Autor:  DarkSoul [ 16.02.2018 13:52 ]
Betreff des Beitrags:  Re: Programmier Tipps und Tricks

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.

Autor:  NicTheQuick [ 16.02.2018 14:05 ]
Betreff des Beitrags:  Re: Programmier Tipps und Tricks

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:

Autor:  ccode_new [ 16.02.2018 15:22 ]
Betreff des Beitrags:  Re: Programmier Tipps und Tricks

@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

Seite 3 von 3 Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/