Lexikographisch aufsteigende Permutation eingegebener Worte

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.

  • COHEN/SUTHERLAND-LINECLIPPING
    ==========================
    So, hier wieder ein Gustostückchen, was einem alles passieren kann: Ich hatte das C++ Beispiel aus einem Wikipedia-Artikel über Cohen/Sutherland Clipping - Quatsch, natürlich dieses hier, unter Verwendung von Longinteger-Variablen in XProfan11 übersetzt. Das sah (nach erstem Debugging) schon recht gut aus - blieb aber nach durchschnittlich 11 Sekunden unerklärlicherweise stecken. Und langsam wurden bei der Fehlersuche die Haare grau.

    Hinweise auf die Ursache ergaben sich dann aus der folgenden Beobachtung: Die Endpunkte der Linien werden im Hauptteil jeweils via Zufallsgenerator definiert. Liegen diese Punkte aber genau über- oder nebeneinander (oder lediglich 1 pixel Unterschied), wurde in der Innenschleife die Abbruchbedingung ("Geclippte Linie liegt nun komplett im innern des Sichtfenster-Rechtecks") nie mehr erreicht.

    Nun zur endgültigen Klärung: C++ liefert bei der Division von zwei Integervariablen automatisch einen Integer-Wert zurück. XProfan versucht bei Verwendung der herkömmlichen Division aber, genau zu sein und liefert einen Floatwert - die Ursache für das merkwürdige Verhalten. Nach Ersatz des / Operators durch die Funktion @div&(a&,b&) bzw. künftig durch das \ Integerdivisionszeichen funktioniert nun alles. Interessant wäre die Beschleunigung mittels Inline-Assemblercode. Freiwillige?

    Gruss

    Quellcode

    1. ' Cohen-Sutherland Clipping Demo
    2. ' Keine Haftung, Verwendung auf eigene Gefahr!
    3. ' P. Specht 2011-01 für Paule´s PC Forum
    4. ' Anmerkung: Es gibt inzwischen bereits viel schnellere Algorithmen!
    5. Def %CLIPLEFT 1 ' Binär 0001
    6. Def %CLIPRIGHT 2 ' 0010
    7. Def %CLIPLOWER 4 ' 0100
    8. Def %CLIPUPPER 8 ' 1000
    9. Def %TRUE 1
    10. Def %FALSE 0
    11. Proc ClipLine
    12. var K1%=0
    13. var K2%=0
    14. declare dx&,dy&
    15. dx&=x2&-x1&
    16. dy&=y2&-y1&
    17. y1test
    18. y2test
    19. ' Schleife nach Cohen/Sutherland, die maximal 2 mal durchlaufen wird
    20. while K1% OR K2%
    21. rtn% = %TRUE
    22. if K1% & K2% : rtn% = %FALSE : BREAK : endif
    23. if K1%
    24. if K1% & %CLIPLEFT
    25. y1& = y1& + (XMin&-x1&)*dy&\dx&
    26. x1& = XMin&
    27. elseif K1% & %CLIPRIGHT
    28. y1& = y1& + (XMax&-x1&)*dy&\dx&
    29. x1& = XMax&
    30. endif
    31. if K1% & %CLIPLOWER
    32. x1& = x1& + (YMin&-y1&)*dx&\dy&
    33. y1& = YMin&
    34. elseif K1% & %CLIPUPPER
    35. x1& = x1& + (YMax&-y1&)*dx&\dy&
    36. y1& = YMax&
    37. endif
    38. K1% = 0
    39. y1test
    40. endif
    41. if K1% & K2% : rtn% = %FALSE : BREAK : endif
    42. if K2%
    43. if K2% & %CLIPLEFT
    44. y2& = y2& + (XMin&-x2&)*dy&\dx&
    45. x2& = XMin&
    46. elseif K2% & %CLIPRIGHT
    47. y2& = y2& + (XMax&-x2&)*dy&\dx&
    48. x2& = XMax&
    49. endif
    50. if K2% & %CLIPLOWER
    51. x2& = x2& + (YMin&-y2&)*dx&\dy&
    52. y2& = YMin&
    53. elseif K2% & %CLIPUPPER
    54. x2& = x2& + (YMax&-y2&)*dx&\dy&
    55. y2& = YMax&
    56. endif
    57. K2% = 0
    58. y2test
    59. endif
    60. EndWhile
    61. return rtn%
    62. EndProc
    63. proc y1test
    64. if y1&<YMin&
    65. K1% = %CLIPLOWER
    66. elseif y1& > YMax&
    67. K1% = %CLIPUPPER
    68. endif
    69. if x1& < XMin&
    70. K1% = K1% | %CLIPLEFT
    71. elseif x1&>XMax&
    72. K1% = K1% | %CLIPRIGHT
    73. endif
    74. endproc
    75. proc y2test
    76. if y2&<YMin&
    77. K2% = %CLIPLOWER
    78. elseif y2&>YMax&
    79. K2% = %CLIPUPPER
    80. endif
    81. if x2&<XMin&
    82. K2% = K2% | %CLIPLEFT
    83. elseif (x2&>XMax&)
    84. K2% = K2% | %CLIPRIGHT
    85. endif
    86. endproc
    87. 'INIT
    88. Declare XMax&,YMax&,XMin&,YMin&,rtn%
    89. Declare x1&,y1&,x2&,y2&,colo&
    90. RANDOMIZE
    91. WindowTitle "Cohen/Sutherland Clipping Demo"
    92. WindowStyle 4 | 8 | 16
    93. 'MAIN
    94. WHILE 1
    95. XMin& = Rnd(300)
    96. YMin& = Rnd(200)
    97. XMax& = XMin& + Rnd(500)
    98. YMax& = YMin& + Rnd(250)
    99. CLS
    100. colo&=rgb(rnd(256),rnd(256),rnd(256))
    101. UsePen 0,3,colo&
    102. rectangle XMin&,YMin& - XMax&,YMax&
    103. 'print XMin&,YMin&,XMax&,YMax&
    104. WhileLoop 1000
    105. x1& = rnd(Width( %HWnd))
    106. y1& = rnd(Height(%Hwnd))
    107. x2& = rnd(Width( %HWnd))
    108. y2& = rnd(Height(%Hwnd))
    109. colo&=rgb(rnd(256),rnd(256),rnd(256))
    110. UsePen 3,1,colo&
    111. Line x1&,y1& - x2&,y2&
    112. if ClipLine()
    113. UsePen 0,3,colo&
    114. Line x1&,y1& - x2&,y2&
    115. endif
    116. EndWhile
    117. ENDWHILE
    118. END
    Alles anzeigen
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3
  • Permutationen
    ===========
    Manchal fragt wer nach sowas. Schnell ist es nicht, aber dafür auch nicht rekursiv wie die meisten dieser Machwerke. Also könnte man es abspecken und in Assembler viel viel flotter realisieren - als Basis für Brute force Optimierungsprogramme beispielsweise. Naja, vielleicht kanns jemand brauchen...
    Gruss

    Brainfuck-Quellcode

    1. WindowTitle "Lexikographisch aufsteigende Permutation eingegebener Worte"
    2. ' (F) P. Specht 2011 für Paule´s PC-Forum, V1.02beta, keine Gewähr,
    3. ' Jedwede Nutzung erfolgt samt und sonders auf Gefahr des Anwenders!
    4. Declare t$,t$[],n&,k&,j&,u&,v&,e%,z&,q$
    5. WHILE 1:CLS:e%=1:z&=0:q$=" "
    6. print " Hinweis: ALLE Permutationen werden hier nur dann geliefert, "
    7. print " wenn die Elemente in aufsteigender Folge angegeben werden! "
    8. print " Beispiel: 1|3|3|4|4.. oder Alphons Charly Emil Franz Gustav"
    9. print " Eingabe der Elemente bitte mit Leerzeichen oder | als Trenner:\n"
    10. input t$:print:t$=trim$(t$):t$=translate$(t$," "," "):case instr("|",t$):q$="|"
    11. t$=translate$(t$," ","|"):t$[]=explode(t$,"|"):n&=SizeOf(t$[])
    12. print "--- Start ab der angegebenen Lexikal-Permutation ---"
    13. While e%:inc z&:casenot q$="|":print " ";
    14. WhileLoop n&:print t$[&Loop-1];:case &Loop=n&:continue :print q$;:EndWhile:print
    15. if n&<2:e%=0:break:endif
    16. k&=n&-2:While t$[k&]>=t$[k&+1]:Dec k&:case k&<0:break:EndWhile
    17. if k&<0:e%=0:break:endif
    18. j&=n&-1:While t$[j&]<=t$[k&]:dec j&:EndWhile
    19. t$=t$[k&]:t$[k&]=t$[j&]:t$[j&]=t$:u&=k&+1:v&=n&-1
    20. While u&<v&:t$=t$[u&]:t$[u&]=t$[v&]:t$[v&]=t$:inc u&:dec v&:EndWhile
    21. EndWhile : print "-------------- Ausgegebene Zeilen:",z&,"-----------------"
    22. WAITINPUT:ENDWHILE:END
    Alles anzeigen

    P.S.: Ein richtiges Problem hat keine Lösung!
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3