Die Leibnitz-Reihe konvergiert gegen Pi/4

[p. specht]

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

' Cohen-Sutherland Clipping Demo
' Keine Haftung, Verwendung auf eigene Gefahr!
' P. Specht 2011-01 für Paule´s PC Forum
' Anmerkung: Es gibt inzwischen bereits viel schnellere Algorithmen!

Def %CLIPLEFT  1  '  Binär   0001
Def %CLIPRIGHT 2  '          0010
Def %CLIPLOWER 4  '          0100
Def %CLIPUPPER 8  '          1000
Def %TRUE 1
Def %FALSE 0

Proc ClipLine
var K1%=0
var K2%=0 
declare dx&,dy&
dx&=x2&-x1&
dy&=y2&-y1&

y1test
y2test

'  Schleife nach Cohen/Sutherland, die maximal 2 mal durchlaufen wird
 while K1% OR K2%
 
   rtn% = %TRUE
   if K1% & K2% : rtn% = %FALSE : BREAK : endif   
   
   if K1%
   
     if K1% & %CLIPLEFT
       y1& = y1& + (XMin&-x1&)*dy&\dx&
       x1& = XMin&
     elseif K1% & %CLIPRIGHT
       y1& = y1& + (XMax&-x1&)*dy&\dx&
       x1& = XMax&
     endif
     if K1% & %CLIPLOWER
       x1& = x1& + (YMin&-y1&)*dx&\dy&
       y1& = YMin&
     elseif K1% & %CLIPUPPER
       x1& = x1& + (YMax&-y1&)*dx&\dy&
       y1& = YMax&
     endif
     
     K1% = 0
     y1test
   endif

   if K1% & K2% : rtn% = %FALSE : BREAK : endif

   if K2%
     if K2% & %CLIPLEFT
       y2& = y2& + (XMin&-x2&)*dy&\dx&
       x2& = XMin&
     elseif K2% & %CLIPRIGHT
       y2& = y2& + (XMax&-x2&)*dy&\dx&
       x2& = XMax&
     endif
     if K2% & %CLIPLOWER
       x2& = x2& + (YMin&-y2&)*dx&\dy&
       y2& = YMin&
     elseif K2% & %CLIPUPPER
       x2& = x2& + (YMax&-y2&)*dx&\dy&
       y2& = YMax&
     endif
     K2% = 0
     y2test
    
   endif
   
 EndWhile
return rtn%
EndProc

proc y1test
if y1&<YMin&
    K1% = %CLIPLOWER
elseif y1& > YMax&
    K1% = %CLIPUPPER
endif
if x1& < XMin&
    K1% = K1% | %CLIPLEFT
elseif x1&>XMax&
    K1% = K1% | %CLIPRIGHT
endif
endproc


proc y2test
if y2&<YMin&
  K2% = %CLIPLOWER
elseif y2&>YMax&
  K2% = %CLIPUPPER
endif
if x2&<XMin&
  K2% = K2% | %CLIPLEFT
elseif (x2&>XMax&)
  K2% = K2% | %CLIPRIGHT
endif
endproc

'INIT
Declare XMax&,YMax&,XMin&,YMin&,rtn%
Declare x1&,y1&,x2&,y2&,colo&
RANDOMIZE
WindowTitle "Cohen/Sutherland Clipping Demo"
WindowStyle  4 | 8 | 16

'MAIN
WHILE 1
XMin& = Rnd(300)
YMin& = Rnd(200)
XMax& = XMin& + Rnd(500)
YMax& = YMin& + Rnd(250)
CLS
colo&=rgb(rnd(256),rnd(256),rnd(256))
UsePen 0,3,colo&
rectangle XMin&,YMin& - XMax&,YMax&

'print XMin&,YMin&,XMax&,YMax&
  WhileLoop 1000
  x1& = rnd(Width( %HWnd))
  y1& = rnd(Height(%Hwnd))
  x2& = rnd(Width( %HWnd))
  y2& = rnd(Height(%Hwnd))
  colo&=rgb(rnd(256),rnd(256),rnd(256))
    UsePen 3,1,colo&
    Line x1&,y1& - x2&,y2&
    if ClipLine()
      UsePen 0,3,colo&
      Line x1&,y1& - x2&,y2&
    endif
  EndWhile
ENDWHILE
END

[p. specht]

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

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

P.S.: Ein richtiges Problem hat keine Lösung!

[p. specht]

Manchmal fragt man sich, warum Dinge nicht so gut funktionieren wie ihre elegante Form im ersten Moment nahelegt. Hier haben wir so einen Fall:

WindowTitle "Die Leibnitz-Reihe konvergiert gegen Pi/4"
cls
declare pivi!,gl!,vz!,k&
print 
print " Die Leibnitz-Reihe ist definiert durch die Gleichung "
print " Summe[k= 0 bis +INF]{(-1^k)/(2*k+1)} =               "
print "    = 1 - 1/3 + 1/5 - 1/7 + 1/9 - ... = Pi/4          "
print " auf 4 Kommastellen genau erst ab soviel Gliedern:    "
print
print " (Berechung läuft...)"
vz!=1:k&=99999
whileloop 0,k&
'locate 10,5:print &Loop;
gl!=vz!/(2*&Loop+1)
vz!=-1*vz!
pivi!=pivi!+gl!
' print gl!,pivi!
Endwhile
locate 7,2 : Print int(k&+1);"                                  "
print
print " Der Näherungswert für Pi beträgt dann: ", pivi!*4
print " Der absolute Fehler beträgt: "; pivi!*4-pi()
print
print " Die Reihe ist für die Berechnung von Pi daher NICHT gut geeignet."
WaitInput
End

Naja, reisst heute auch niemanden vom Hocker...

P.S.: Wie man die Werte von Pi im Laufe der Jahrhunderte OHNE Rechenmaschinen - geschweige denn Computer - ermittelte, ist allerdings selbst ein faszinierendes Kapitel der Mathematik: LINK
Gruss