Suchalgorithmen (binär)

    Diese Seite verwendet Cookies. Durch die Nutzung unserer Seite erklären Sie sich damit einverstanden, dass wir Cookies setzen. Weitere Informationen

    Unsere Datenschutzerklärung wurde aktualisiert. Mit der Nutzung unseres Forums akzeptierst Du unsere Datenschutzerklärung. Du bestätigst zudem, dass Du mindestens 16 Jahre alt bist.

    • Suchalgorithmen (binär)

      Hätte ich doch beinahe die einfachsten vergessen...

      Binärsuche in sortierten Daten...

      Mal nicht getestet, aber dafür für ältere Versionen angepasst.

      Quellcode

      1. ' binäre Suche
      2. ' - bin_search_intArr
      3. ' - bin_search_strArr
      4. ' - bin_search_List
      5. ' aus den beiden folgenden ist's entstanden
      6. ' - Bin_Search_Rek
      7. ' - Bin_Search
      8. Proc bin_search_intArr
      9. ' Durchsucht ein übergebenes INT-Array nach einem Suchwert.
      10. ' Ist bis = 0, dann wird das ganze Array durchsucht.
      11. ' Ist der gleiche Suchwert mehrfach enthalten,
      12. ' dann wird das erste Vorkommen zurückgegeben. (Kann entarten.)
      13. Parameters Arr&[], Suchwert&, von&, bis&
      14. Declare maxi&, mitte&, vonOri&
      15. maxi& = SizeOf(Arr&[])
      16. ' Ist bis = 0, dann wird das ganze Array durchsucht.
      17. Case bis& = 0 : bis& = maxi& - 1
      18. If (von& < maxi&) and (bis& < maxi&)
      19. vonOri& = von&
      20. While von& <= bis&
      21. mitte& = von& + ((bis& - von&) / 2)
      22. If Arr&[mitte&] = Suchwert& ' hier ist ein Wert gefunden
      23. ' jetzt gehen wir bis zum ersten Duplikat zurück (falls vorhanden)
      24. While (mitte& > 0) and (mitte& > vonOri&)
      25. If Arr&[mitte& - 1] = Suchwert&
      26. ' Duplikat gefunden
      27. Dec mitte&
      28. Else
      29. BREAK
      30. EndIf
      31. EndWhile
      32. Return mitte&
      33. ElseIf Arr&[mitte&] > Suchwert&
      34. bis& = mitte& - 1 ' suche im vorderen Teil weiter
      35. Else 'Arr&[mitte&] < Suchwert&
      36. von& = mitte& + 1 ' suche im hinteren Teil weiter
      37. EndIf
      38. EndWhile
      39. EndIf
      40. Return -1 ' Suchwert nicht gefunden
      41. EndProc
      42. Proc bin_search_strArr
      43. ' Durchsucht ein übergebenes String-Array nach einem Suchwert.
      44. ' Ist bis = 0, dann wird das ganze Array durchsucht.
      45. ' Ist der gleiche Suchwert mehrfach enthalten,
      46. ' dann wird das erste Vorkommen zurückgegeben. (Kann entarten.)
      47. ' Groß-/Kleinschreibung egal, wenn ignoreCase% <> 0
      48. ' Beginnt mit Suchwert, wenn startedWith% <> 0
      49. Parameters Arr$[], Suchwert$, von&, bis&, ignoreCase%, startedWith%
      50. Declare maxi&, mitte&, vonOri&, suchLen&, vgl$
      51. maxi& = SizeOf(Arr$[])
      52. Case ignoreCase% : Suchwert$ = Lower$(Suchwert$)
      53. suchLen& = Len(Suchwert$)
      54. ' Ist bis = 0, dann wird das ganze Array durchsucht.
      55. Case bis& = 0 : bis& = maxi& - 1
      56. If (von& < maxi&) and (bis& < maxi&)
      57. vonOri& = von&
      58. While von& <= bis&
      59. mitte& = von& + ((bis& - von&) / 2)
      60. vgl$ = Arr$[mitte&]
      61. Case ignoreCase% : vgl$ = Lower$(vgl$)
      62. Case startedWith% : vgl$ = Left$(vgl$,suchLen&)
      63. If vgl$ = Suchwert$ ' hier ist ein Wert gefunden
      64. ' jetzt gehen wir bis zum ersten Vorkommen zurück (falls vorhanden)
      65. While (mitte& > 0) and (mitte& > vonOri&)
      66. vgl$ = Arr$[mitte& - 1]
      67. Case ignoreCase% : vgl$ = Lower$(vgl$)
      68. Case startedWith% : vgl$ = Left$(vgl$,suchLen&)
      69. If vgl$ = Suchwert$
      70. ' Vorgänger gefunden
      71. Dec mitte&
      72. Else
      73. BREAK
      74. EndIf
      75. EndWhile
      76. Return mitte&
      77. ElseIf vgl$ > Suchwert$
      78. bis& = mitte& - 1 ' suche im vorderen Teil weiter
      79. Else 'Arr$[mitte&] < Suchwert$
      80. von& = mitte& + 1 ' suche im hinteren Teil weiter
      81. EndIf
      82. EndWhile
      83. EndIf
      84. Return -1 ' Suchwert nicht gefunden
      85. EndProc
      86. Proc bin_search_List
      87. ' Durchsucht eine Liste nach einem Suchwert.
      88. ' Ist bis = 0, dann wird die ganze Liste durchsucht.
      89. ' Ist der gleiche Suchwert mehrfach enthalten,
      90. ' dann wird das erste Vorkommen zurückgegeben. (Kann entarten.)
      91. ' Groß-/Kleinschreibung egal, wenn ignoreCase% <> 0
      92. ' Beginnt mit Suchwert, wenn startedWith% <> 0
      93. Parameters hListe&, Suchwert$, von&, bis&, ignoreCase%, startedWith%
      94. Declare maxi&, mitte&, vonOri&, suchLen&, vgl$
      95. maxi& = GetCount(hListe&)
      96. Case ignoreCase% : Suchwert$ = Lower$(Suchwert$)
      97. suchLen& = Len(Suchwert$)
      98. ' Ist bis = 0, dann wird das ganze Array durchsucht.
      99. Case bis& = 0 : bis& = maxi& - 1
      100. If (von& < maxi&) and (bis& < maxi&)
      101. vonOri& = von&
      102. While von& <= bis&
      103. mitte& = von& + ((bis& - von&) / 2)
      104. vgl$ = GetString$(hListe&,mitte&)
      105. Case ignoreCase% : vgl$ = Lower$(vgl$)
      106. Case startedWith% : vgl$ = Left$(vgl$,suchLen&)
      107. If vgl$ = Suchwert$ ' hier ist ein Wert gefunden
      108. ' jetzt gehen wir bis zum ersten Vorkommen zurück (falls vorhanden)
      109. While (mitte& > 0) and (mitte& > vonOri&)
      110. vgl$ = GetString$(hListe&,mitte& - 1)
      111. Case ignoreCase% : vgl$ = Lower$(vgl$)
      112. Case startedWith% : vgl$ = Left$(vgl$,suchLen&)
      113. If vgl$ = Suchwert$
      114. ' Vorgänger gefunden
      115. Dec mitte&
      116. Else
      117. BREAK
      118. EndIf
      119. EndWhile
      120. Return mitte&
      121. ElseIf vgl$ > Suchwert$
      122. bis& = mitte& - 1 ' suche im vorderen Teil weiter
      123. Else 'Arr$[mitte&] < Suchwert$
      124. von& = mitte& + 1 ' suche im hinteren Teil weiter
      125. EndIf
      126. EndWhile
      127. EndIf
      128. Return -1 ' Suchwert nicht gefunden
      129. EndProc
      130. Proc Bin_Search_Rek
      131. Parameters WerteArr&[], Suchwert&, Start&, Ende&
      132. Declare Mitte&
      133. If Ende& >= Start&
      134. Mitte& = Start& + ((Ende& - Start&) / 2)
      135. If WerteArr&[Mitte&] = Suchwert&
      136. Return Mitte&
      137. ElseIf WerteArr&[Mitte&] > Suchwert&
      138. Return Bin_Search_Rek(WerteArr&[], Suchwert&, Start&, Mitte& - 1)
      139. Else
      140. Return Bin_Search_Rek(WerteArr&[], Suchwert&, Mitte& + 1, Ende&)
      141. EndIf
      142. EndIf
      143. Return -1
      144. EndProc
      145. Proc Bin_Search
      146. Parameters WerteArr&[], Suchwert&, Start&, Ende&
      147. Declare Mitte&, schluss&
      148. schluss& = SizeOf(WerteArr&[]) - 1 : Case schluss& < Ende& : Ende& = schluss&
      149. While Start& <= Ende&
      150. Mitte& = Start& + ((Ende& - Start&) / 2)
      151. If WerteArr&[Mitte&] = Suchwert&
      152. Return Mitte&
      153. ElseIf WerteArr&[Mitte&] > Suchwert&
      154. Ende& = Mitte& - 1
      155. Else
      156. Start& = Mitte& + 1
      157. EndIf
      158. EndWhile
      159. Return -1
      160. EndProc
      Alles anzeigen
      Programmieren, das spannendste Detektivspiel der Welt.
    • Ein Test dazu könnte z.B. so aussehen (wobei das zu testende Proc einzufügen bzw. der Aufruf anzupasser wäre):

      Brainfuck-Quellcode

      1. WindowTitle "Test für Suchalgorithmen in sortieren Stringdateien"
      2. ' Ohne Gewähr, da Quick&Dirty early Alpha Version!
      3. WindowStyle 24:Window 0,0-%maxx,%maxy-40:randomize:font 2
      4. var n&=40000 ' Zufallsstrings erzeugen und anschließend Quicksortieren, als Basis für Suchtest
      5. declare stra$[n&-1],tmp$,i&,j&,vec&,su$,tmp&
      6. print "\n Generiere ";n&;" alphabetische Zufalls-Strings der Länge [3..20]"
      7. whileloop 0,n&-1:tmp$="":whileloop 3+rnd(17):tmp$=tmp$+chr$(97+rnd(26))
      8. endwhile :stra$[&Loop]=tmp$:endwhile
      9. print "\n Sortiere Zufallsarray aufsteigend...":QuickSortUpStr( stra$[] )
      10. Print "\n-------------------< Testarray-Anfang >--------------------"
      11. whileloop 0,19:print stra$[&Loop]:endwhile
      12. Print "...\n-------------------< Testarray-Ende >----------------------"
      13. whileloop n&-21,n&-1:print stra$[&Loop]:endwhile
      14. print "-----------------< Array bereit für BinärSuch-Test >------------";
      15. sound 400,10:waitinput 5000
      16. '====================================================================================
      17. proc QuickSortUpStr :parameters a$[]:declare n&,p&,l&,r&,s&,sl&[],sr&[],w$
      18. declare x$,i&,j&:n&=sizeof(a$[]):s&=1:sl&[1]=0:sr&[1]=n&-1
      19. while s&>0:l&=sl&[s&]:r&=sr&[s&]:s&=s&-1:while l&<r&:i&=l&:j&=r&:p&=(l&+r&)\2
      20. if a$[l&]>a$[p&]:w$=a$[l&]:a$[l&]=a$[p&]:a$[p&]=w$:endif
      21. if a$[l&]>a$[r&]:w$=a$[l&]:a$[l&]=a$[r&]:a$[r&]=w$:endif
      22. if a$[p&]>a$[r&]:w$=a$[p&]:a$[p&]=a$[r&]:a$[r&]=w$:endif:x$=a$[p&]
      23. while i&<=j&:while a$[i&]<x$:inc i&:endwhile:while x$<a$[j&]:dec j&:endwhile
      24. if i&<=j&:w$=a$[i&]:a$[i&]=a$[j&]:a$[j&]=w$:i&=i&+1:j&=j&-1:endif:endwhile
      25. if (j&-l&)<(r&-i&):if i&<r&:s&=s&+1:sl&[s&]=i&:sr&[s&]=r&:endif:r&=j&:else
      26. if l&<j&:s&=s&+1:sl&[s&]=l&:sr&[s&]=j&:endif:l&=i&:endif:endwhile:endwhile
      27. endproc
      28. '====================================================================================
      29. such:
      30. CLS:Print "\n-----< Gesuchter Wortanfang (Gross/Kleinschreibung egal) >: ";:Input su$
      31. tmp&=&gettickcount
      32. vec&=-1
      33. whileloop 0,n&-1
      34. ' vec&=bin_search_strArr(stra$[],su$, 0, 0, 1, 1)
      35. vec&=binaersuch(stra$[],su$ )
      36. if vec&=-1
      37. print "------------------< Kein weiteres Ergebnis >----------------"
      38. waitinput
      39. break
      40. else
      41. print stra$[vec&],
      42. tmp&=&gettickcount-tmp&:print " ... in",tmp&,"[ms]"
      43. if %csrlin=40:waitinput 4000:cls:tmp&=&gettickcount:endif
      44. endif
      45. endwhile
      46. goto "such"
      47. '===============================================================
      48. ' Hier zu testende Stringsuche einfügen
      49. '===============================================================
      Alles anzeigen
      Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3