Algorithmen Teil VII: Das andere Müllspiel!

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

  • Alter Fehler aus GWBASIC-Zeiten: Bitte ersetzt die Zeile:
    : Print h_neu!,n&,,v_neu!,a_gravi!,rho!,F_Luft!,a_gesamt!
    durch
    : Print h_neu!,n&;".",v_neu!,a_gravi!,rho!,F_Luft!,a_gesamt!
    dann klappts auch mit dem Nachbarn ...äh...Compiler.
    Gruss
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3
  • Abt. Anstiegsfunktion von Ellipsen in beliebiger Lage
    =================================
    Weil wir hier schon lange nichts über Ellipsen hatten, aber ein Kollege unbedingt zwischen Satellitenorbits navigieren will, wurden dazu die nachstehenden ersten Vorarbeiten geleistet. Man beachte den großen Geschwindigkeitsunterschied zwischen der Darstellung in Karthesischen Koordinaten und in Polarkoordinaten (was leider auch die Verwendbarkeit als Bildschirmschoner torpediert).
    Gruss

    P.S.: Fernziel ist die Bestimmung energiearmer Homan-Übergangsbahnen zwischen Orbits, z.B. von Erde zu Mars. Wer also mit Privatrakete auf den Roten Planeten auswandern will, muß noch etwas Geduld haben ;-)

    Quellcode

    1. WindowTitle "ELLI" '(CL)CopyLeft 2014-02 by P.Specht
    2. WindowStyle 24:Window 0,0-%maxx,%maxy-39:Var xh&=width(%hwnd)\2:Var yh&=height(%hwnd)\2
    3. Font 2:Randomize:var f!=-1*pi()/180:var ff!=180/pi()
    4. declare x!,y!,xx!,yy!,u&,v!,a!,b!,w!,xm!,ym!,step&
    5. usepen 0,1,0:Line 0,yh&-2*xh&,yh&:Line xh&,0-xh&,2*yh&
    6. proc Ellips :parameters xm!,ym!,a!,b!,w!,d&,c&
    7. 'Zeichne Ellipse in allg. Lage (xm,ym,a,b,w°) in Polarkoordinaten P(x,y)
    8. usepen 0,d&,c&
    9. whileloop 0,360,6
    10. v!= -0.017453292519943296*&Loop
    11. x!=a!*cos(v!):y!=b!*sin(v!)
    12. xx!= x!*cos(w!)+y!*sin(w!)
    13. yy!= -x!*sin(w!)+y!*cos(w!)
    14. if v!=0:moveto xh&+xm!+xx!,yh&-ym!-yy!
    15. else :lineto xh&+xm!+xx!,yh&-ym!-yy!
    16. endif
    17. endwhile
    18. endproc
    19. proc Ellip :parameters xm!,ym!,a!,b!,w!,d&,c&
    20. 'Zeichne Ellipse in allg. karthes. Lage (verwendet Elli_y(x))
    21. '-xh&,xh&
    22. declare y1!,y2!
    23. whileloop xm!-a!,xm!+a!:x!=&Loop
    24. y1!=Elli(xm!,ym!,a!,b!,w!,x!,0)
    25. y2!=Elli(xm!,ym!,a!,b!,w!,x!,1)
    26. usepen 0,d&,c&:Line xh&+x!,(yh&-y1!) - xh&+x!+1,yh&-y1!
    27. usepen 0,d&,c&:Line xh&+x!,(yh&-y2!) - xh&+x!+1,yh&-y2!
    28. endwhile
    29. endproc
    30. proc Elli :parameters xm!,ym!,a!,b!,w!,x!,ob&
    31. w!=-w! 'Karthes. Ellipsenpunkte y(x) in allg. Lage
    32. var aa!=sqr(a!):var bb!=sqr(b!)
    33. var sw!=sin(w!):var cw!=cos(w!)
    34. var ssw!=sqr(sw!):var ccw!=sqr(cw!)
    35. var nenn!=bb!*ssw!+aa!*ccw!
    36. var f1!=sqr(ssw!+ccw!)
    37. var wurz!=nenn!-f1!*sqr(xm!-x!)
    38. if (nenn!<>0) and (wurz!>0)
    39. var f2!=(bb!-aa!)*cw!*sw!
    40. var f3!=a!*b!*sqrt(wurz!)
    41. var f4!=f2!*(xm!-x!)
    42. if ob&
    43. return ym!+(f4!-f3!)/nenn! 'Obere Hälfte
    44. else
    45. return ym!+(f4!+f3!)/nenn! 'Untere Hälfte
    46. endif
    47. else
    48. y1!=yh&+2:y2!=y1!
    49. endif
    50. endproc
    51. proc EllipsSlope :parameters xm!,ym!,a!,b!,w!,d&,c&
    52. 'Zeichne Ellipsentangenten in allg. karthes. Lage (verwendet Ellislope_y(x))
    53. '-xh&,xh&
    54. declare y1!,y2!
    55. whileloop xm!-a!,xm!+a!:x!=&Loop
    56. y1!=b!/5*ElliSlope(xm!,ym!,a!,b!,w!,x!,0)
    57. y2!=b!/5*ElliSlope(xm!,ym!,a!,b!,w!,x!,1)
    58. usepen 0,d&,c&:Line xh&+x!,(yh&-y1!) - xh&+x!+1,yh&-y1!
    59. usepen 0,d&,255+0*c&:Line xh&+x!,(yh&-y2!) - xh&+x!+1,yh&-y2!
    60. endwhile
    61. endproc
    62. proc ElliSlope :parameters xm!,ym!,a!,b!,w!,x!,ob&
    63. var aa!=sqr(a!):var bb!=sqr(b!)
    64. var sw!=sin(w!):var cw!=cos(w!)
    65. var ssw!=sqr(sw!):var ccw!=sqr(cw!)
    66. var f1!= sqr(ssw!+ccw!)
    67. var nenn!=bb!*ssw!+aa!*ccw!
    68. var wurz!= nenn!-f1!*sqr(xm!-x!)
    69. var f2!=(bb!-aa!)*cw!*sw!
    70. if (nenn!<>0) and (wurz!>0)
    71. if ob&
    72. return (-1*(a!*b!*2*f1!*(xm!-x!))/(2*sqrt(wurz!))-f2!)/nenn!
    73. else
    74. return ( (a!*b!*2*f1!*(xm!-x!))/(2*sqrt(wurz!))-f2!)/nenn!
    75. endif
    76. else
    77. return yh&+2
    78. endif
    79. endproc
    80. 'xm!= 0:ym!= 0:a!=375:b!= 25:w!=10*f!:Ellips(xm!,ym!,a!,b!,w!,3,rgb(255,0,0)):waitinput 1000
    81. 'xm!= 0:ym!= 0:a!=375:b!= 25:w!=10*f!: Ellip(xm!,ym!,a!,b!,w!,1,rgb(0,0,0))
    82. 'xm!=100:ym!= 100:a!=275:b!=140:w!=60*f!:Ellips(xm!,ym!,a!,b!,w!,2,rgb(0,200,0))
    83. 'xm!=100:ym!= 100:a!=275:b!=140:w!=60*f!: Ellip(xm!,ym!,a!,b!,w!,1,rgb(0,0,0))
    84. xm!=100:ym!= 100:a!=275:b!=140:w!=60*f!
    85. ''Karthes. Ellipse drehen
    86. 'whileloop 0,1790,180:w!=&Loop*f!*0.1
    87. ' Ellip(xm!,ym!,a!,b!,w!,1,rgb(255,0,0))
    88. 'Endwhile
    89. step&=30
    90. ' EllipsenTangente drehen
    91. whileloop 0,1799,step&:w!=&Loop*f!*0.1
    92. 'EllipsSlope(-xm!,ym!,a!,b!,w!,1,rgb(0,0,0))
    93. casenot (&Loop/step&+0) mod 7:EllipsSlope(-xm!,ym!,a!,b!,w!,1,rgb(0,0,255))
    94. casenot (&Loop/step&+1) mod 7:EllipsSlope(-xm!,ym!,a!,b!,w!,1,rgb(0,200,0))
    95. casenot (&Loop/step&+2) mod 7:EllipsSlope(-xm!,ym!,a!,b!,w!,1,rgb(255,0,0))
    96. casenot (&Loop/step&+3) mod 7:EllipsSlope(-xm!,ym!,a!,b!,w!,1,rgb(200,200,0))
    97. casenot (&Loop/step&+4) mod 7:EllipsSlope(-xm!,ym!,a!,b!,w!,1,rgb(200,0,200))
    98. casenot (&Loop/step&+5) mod 7:EllipsSlope(-xm!,ym!,a!,b!,w!,1,rgb(0,200,200))
    99. casenot (&Loop/step&+6) mod 7:EllipsSlope(-xm!,ym!,a!,b!,w!,1,rgb(0,0,0))
    100. Endwhile
    101. Print "Anstiegsfunktion einer rotierenden Ellipse"
    102. Print "Tastendruck zeigt zugehörige Ellipse"
    103. waitinput
    104. 'end
    105. step&=30
    106. 'Polarkoordinaten-Ellipse
    107. whileloop 0,1799,step&:w!=&Loop*f!*0.1
    108. casenot (&Loop/step&+0) mod 7:Ellips(-xm!,ym!,a!,b!,w!,1,rgb(170,170,255))
    109. casenot (&Loop/step&+1) mod 7:Ellips(-xm!,ym!,a!,b!,w!,1,rgb(170,200,170))
    110. casenot (&Loop/step&+2) mod 7:Ellips(-xm!,ym!,a!,b!,w!,1,rgb(255,170,170))
    111. casenot (&Loop/step&+3) mod 7:Ellips(-xm!,ym!,a!,b!,w!,1,rgb(200,200,170))
    112. casenot (&Loop/step&+4) mod 7:Ellips(-xm!,ym!,a!,b!,w!,1,rgb(200,170,200))
    113. casenot (&Loop/step&+5) mod 7:Ellips(-xm!,ym!,a!,b!,w!,1,rgb(170,200,200))
    114. casenot (&Loop/step&+6) mod 7:Ellips(-xm!,ym!,a!,b!,w!,1,rgb(170,170,170))
    115. Endwhile
    116. usepen 0,1,0:Line 0,yh&-2*xh&,yh&:Line xh&,0-xh&,2*yh&
    117. waitinput
    118. end
    Alles anzeigen
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3
  • Abt. IE-Sicherheit durch interne Nabelbeschau
    =============================
    Wer glaubt, sich wie in Win98 (1 IE Cache) oder WinXP (4 oder 8 IE-Caches) einfach mal die diversen Datencaches des jeweils aktuellen Internet Explorers ansehen zu können, der wird bei Vista von neuen, versteckten Speicherorten überrascht, die aber mittels REGEDIT und dem Schlüssel HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Cache noch relativ leicht zu finden sind. (Die unsaubere Trennung zwischen Explorer und Internet Explorer war Gegenstand einer Strafe der EU für M$ in Höhe von ausgerechnet 561 Millionen Euro, zufällig beim damaligen Kurs genau 750 Mio $, die sich in den Produktpreisen merkwürdigerweise nicht zeigte. Zugehörige Verschwörungstheorie: Offenbar wurde M$ da einiges aus US-Budgets ersetzt, was die Vermutung nährt, dass M$ hier lediglich Vehikel einer Zahlung Nordamerikas an die EU war - etwa für Flugpassagierdaten?)

    Win7 überrascht dann mit der Tatsache, daß Microsoft dem IE-Cache einen Wachhund namens "WinInetCacheServer" verpasst hat, der u.a. offenbar Phishing verhindern soll, aber auch im Verstecken von Dateien und dem Unlöschbarmachen gewisser Cookies sehr gut zu sein scheint. Die zu diesem Server gehörigen Clients "Wininet Cache task object" mit verlinkendem Eintrag AppID REG_SZ {3eb3c...} scheinen sogar die Möglichkeit zu eröffnen, im Cache AKTIVE TASKS zu starten, die der von MS zugesagten Umgebungsvirtualisierung relativ leicht entkommen können. Die Phantasie von Experten, die um die nationale Sicherheit der USA besorgt sind, die damit aber auch den Interessen anderer, nicht wohlgesonnener Kräfte (( - wie wichtig doch Beistriche sind :roll: )) Scheunentor-große Eintrittspforten eröffnen scheint tatsächlich grenzenlos zu sein...

    Mein Eindruck ist folgender: Solange der IE etwas Längeres ladet, hat man Zeit zur Ermittlung der aktuellen versteckten Cache-Verzeichnisnamen (die sich aber mit jedem IE-Start leeren oder sogar ändern (- gilt zumindest für IE11 mit Update 1 unter Win7-64): Mit der Umgebungsvariablen %LOCALAPPDATA%=%USERPROFILE%\AppData\Local gilt folgendes nach Start von CMD.exe als Admin: Man gelangt mit folgenden Kommandozeileneingabe an einen Ort, der einem normalerweise auch im Modus "Zeige Systemdateien an" nicht angezeigt wird:
    >CD %LOCALAPPDATA%\Microsoft\Windows\Temporary Internet Files\Low\Content.IE5
    Die Anzeige der versteckten Verzeichnisnamen klappt dann (meist) mit
    >dir *. /s /w /AH
    ... und schon kann man sogar Unterverzeichnisse namens ACTIVE_TASKS und dergleichen finden.
    Auch die aus Vorversionen gültigen "Geheimpfade" existieren noch aus Kompatibilitätsgründen, manche scheinen aber tatsächlich leer zu sein. Also: Viel Spaß noch beim Surfen im Unterbewusstsein eures Computers.
    Gruss

    P.S.: Wenn ich bedenke, was da noch alles an doppelt-versteckten Verzeichnissen existieren könnte, deren Pfade wir alle NICHT kennen :whistling:.
    PPS: Wer glaubt, Chrome oder Firefox seien sicherer: Gott erhalte ihm seinen Glauben!
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3

    Dieser Beitrag wurde bereits 11 mal editiert, zuletzt von p. specht ()

  • Versuche zur Datumsarithmetik (Abt. Sackgassenprojekte)
    ====================================
    Wenn man mal den Grundaufbau eines Programms versaut hat (z.B. weil man die Zeit vor der Kalenderreform von 1582 auch noch reinquetschen wollte), helfen auch keine Klimmzüge zur Reparatur mehr. Nur ein kompletter Neubau mit einer logisch durchdachteren Modul-Struktur würde da noch helfen. Hier das verbockte Machwerk als abschreckendes Beispiel.
    Sorry!
    P.S.: In gewissen Grenzen funktioniert das Zeug, die Procs sind aber leider völlig überfrachtet.

    Brainfuck-Quellcode

    1. Windowtitle "Wochentag eines Datums, Tag im Jahr, Unix-DayNbr, Tage zwischen Datumsangaben"
    2. 'Early Alpha mit garantiert vielen Bugs. Keine wie auch immer geartete Gewähr!
    3. windowstyle 24:window 0,0-%maxx,%maxy-40 :var xx&=width(%hwnd):font 2
    4. var yy&=height(%hwnd):declare yr&,mt&,dy&,ly&,doy&,uxdy&,dt1$,dt2$
    5. '{ Diverse datumsbezogene Procs
    6. proc dt2yrmtdy :parameters dt$
    7. case dt$<="15821004":Print " Tagesname julianisch! "
    8. 'Setzt Jahres-, Monats- und Tageszahl
    9. 'Zerlege Datumsstring im Datenbankformat JJJJMMTT in die einzelnen Zahlen yr,mt,dy
    10. yr&=val(mid$(dt$,1,4)):mt&=val(mid$(dt$,5,2)):dy&=val(mid$(dt$,7,2))
    11. case (yr&=1582) and (mt&=10) and (dy&>4) and (dy&<15):Print "\n *** Achtung: Von Papst Gregor gestrichenes Datum! *** ";
    12. endproc
    13. proc isLeapYear :parameters yr&
    14. ' Stellt fest ob Schaltjahr (1) oder nicht (0)
    15. casenot yr& mod 400:return 1:casenot yr& mod 100:return 0:
    16. casenot yr& mod 4:return 1:return 0
    17. endproc
    18. proc doy :parameters yr&,mt&,dy&
    19. ' Welche Tagesnummer im Jahr hat der dy.te Tag im mt.Monat des Jahres yr&
    20. ' im zuückliegend erweiterten Gregorianischen Kalender
    21. if (mt&<1) or (mt&>12):Print " Month-Error ":return int(-1):endif
    22. if (dy&<1) or (dy&>31):Print " Day-Error ":return int(-1):endif
    23. var ly&=isleapyear(yr&)
    24. if (mt&=2) and (dy&>(28+ly&)):Print " Leap-Error ":return int(-1):endif
    25. var base&=dy&:case mt&>=3:base&=base&+ly&
    26. case (yr&=1582) and (mt&=10) and (dy&>14):Print " ***Wg.Kalenderreform doy 10 zuviel!***"
    27. select mt&:caseof 12:return int(334+base&):caseof 11:return int(304+base&)
    28. caseof 10:return int(273+base&):caseof 9:return int(243+base&)
    29. caseof 8:return int(212+base&):caseof 7:return int(181+base&)
    30. caseof 6:return int(151+base&):caseof 5:return int(120+base&)
    31. caseof 4:return int(90+base&):caseof 3:return int(59+base&)
    32. caseof 2:return int(31+base&):caseof 1:return base&
    33. endselect
    34. print " Undefined doy Error ":return int(-1)
    35. endproc
    36. proc yrdoy2mt :parameters yr&,doy&
    37. ' In welchem Monat liegt der doy.te Tag des Jahres yr&
    38. ' (yr 4stellig nötig wg. Schaltjahresfesstellung)
    39. Select doy&
    40. caseof >(365+ly&):return int(-1)
    41. caseof >(334+ly&):return int(12):caseof >(304+ly&):return int(11)
    42. caseof >(273+ly&):return int(10):caseof >(243+ly&):return int(9)
    43. caseof >(212+ly&):return int(8):caseof >(181+ly&):return int(7)
    44. caseof >(151+ly&):return int(6):caseof >(120+ly&):return int(5)
    45. caseof >(90+ly&):return int(4):caseof >(59+ly&):return int(3)
    46. caseof >31:return int(2):caseof >0:return int(1)
    47. endselect
    48. return int(-1)
    49. endproc
    50. proc yrdoy2dy :parameters yr&,doy&
    51. Select doy&
    52. caseof >(365+ly&):return int(-1)
    53. caseof >(334+ly&):return int(doy&-334-ly&)
    54. caseof >(304+ly&):return int(doy&-304-ly&)
    55. caseof >(273+ly&):return int(doy&-273-ly&)
    56. caseof >(243+ly&):return int(doy&-243-ly&)
    57. caseof >(212+ly&):return int(doy&-212-ly&)
    58. caseof >(181+ly&):return int(doy&-181-ly&)
    59. caseof >(151+ly&):return int(doy&-151-ly&)
    60. caseof >(120+ly&):return int(doy&-120-ly&)
    61. caseof >(90+ly&):return int(doy&-90-ly&)
    62. caseof >(59+ly&):return int(doy&-59-ly&)
    63. caseof >31:return int(doy&-31)
    64. caseof >0:return int(doy&)
    65. endselect
    66. return int(-1)
    67. endproc
    68. proc maxdom :parameters yr&,mt&,dy&
    69. case (mt&<1) or (mt&>12):return int(-1):case (dy&<1) or (dy&>31):return int(-1)
    70. var ly&=isleapyear(yr&):case (mt&=2) and (dy&>(28+ly&)):return int(-1)
    71. select mt&
    72. caseof 12:return int(31):caseof 11:return int(30):caseof 10:return int(31)
    73. caseof 9:return int(30):caseof 8:return int(31):caseof 7:return int(31)
    74. caseof 6:return int(30):caseof 5:return int(31):caseof 4:return int(30)
    75. caseof 3:return int(31):caseof 2:return int(28+ly&):caseof 1:return int(31)
    76. endselect :return int(-1)
    77. endproc
    78. proc yr2dybase :parameters yr&
    79. return int((yr&-1970)*365+int((yr&-1968)*0.2425))
    80. endproc
    81. proc uxdy :parameters yr&,mt&,dy&
    82. return int(yr2dybase(yr&)+doy(yr&,mt&,dy&)-1)
    83. endproc
    84. proc dtsapart :parameters dt1$,dt2$
    85. dt2yrmtdy(dt2$)
    86. var ux2&=uxdy(yr&,mt&,dy&)
    87. dt2yrmtdy(dt1$)
    88. var ux1&=uxdy(yr&,mt&,dy&)
    89. return int(ux2&-ux1&)
    90. endproc
    91. proc dynam$ :parameters uxdy&
    92. var ux&=uxdy&
    93. case ux&<0:ux&=ux&+2147483645
    94. select (ux&+if(uxdy&>-141427,4,0)) mod 7
    95. caseof 0:return "Sonntag":caseof 1:return "Montag":caseof 2:return "Dienstag"
    96. caseof 3:return "Mittwoch":caseof 4:return "Donnerstag":caseof 5:return "Freitag"
    97. caseof 6:return "Samstag":otherwise :return "LongDayname Error"
    98. endselect
    99. endproc
    100. proc Monam$ :parameters mt&
    101. select mt& :caseof 1:return "Jänner":caseof 2:return "Februar":caseof 3:return "März"
    102. caseof 4:return "April":caseof 5:return "Mai":caseof 6:return "Juni"
    103. caseof 7:return "Juli":caseof 8:return "August":caseof 9:return "September"
    104. caseof 10:return "Oktober":caseof 11:return "November":caseof 12:return "Dezember"
    105. otherwise :return "MonNam Error"
    106. endselect
    107. endproc
    108. '}
    109. var dt$=date$(3)
    110. ' dt$="19700301" 'Testdatum (immer 8 Zeichen bzw. auskommentieren für "heute")
    111. ' dt$="15821004" 'Do, ucdy& >= -141437
    112. ' dt$="15821015" 'Fr, ucdy& <= -141426 Kalenderreform: 10 ausgesparte Tage
    113. dt$="15821016"
    114. dt2yrmtdy(dt$):locate 3,1:uxdy&=uxdy(yr&,mt&,dy&):print " "+dynam$(uxdy&);",";
    115. print " ";format$("00",dy&);".";format$("00",mt&);".";yr&,if(isleapyear(yr&),"*","")
    116. doy&=doy(yr&,mt&,dy&):if doy&=-1:waitinput :end :else :print " ";doy&;". Tag im Jahr, ":endif
    117. print " UnixDayNbr:",uxdy&;". abgelaufener Tag bzgl. 19700101"
    118. 'print " Vorjahres-Schalttage seit 19700101 gab es:",int((yr&-1968)*0.2425)
    119. print "\n Rückrechnung aus Unix-Tagesnummer:"
    120. mt&=yrdoy2mt(yr&,doy&):dy&=yrdoy2dy(yr&,doy&)
    121. print " ";dynam$(uxdy&);", ";dy&;".",Monam$(mt&),yr&,if(isleapyear(yr&),"*"," ")
    122. print "\n----------------------------------------------"
    123. waitinput 10000:case %key=27:end
    124. Print " Tage zwischen Anfangs- und Enddatum " : nochmal:
    125. print "----------------------------------------------"
    126. print " Anfangsdatum [JJJJMMTT oder * für heute]: ";:input dt1$
    127. case (dt1$="*") or (dt1$="heute") or (dt1$="today"):dt1$=date$(3)
    128. print " End-Datum [JJJJMMTT oder * für heute]: ";:input dt2$
    129. case (dt2$="*") or (dt2$="heute") or (dt2$="today"):dt2$=date$(3)
    130. print "\n Wochentage von ";dt1$;" bis einschließlich ";dt2$;" : ";int(dtsapart(dt1$,dt2$)+1);" Tage "
    131. waitinput 18000:case %key=27:end
    132. goto "nochmal"
    Alles anzeigen
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3
  • Abt. Im Weltraum gehen die Uhren anders
    ===========================
    ... nämlich gleichmäßiger - z.B. weil es dort keine auf die Erde rückwirkenden Ebbe-und-Flut-Bewegungen gibt, und fast kein Gravitationsfeld. Die Bewegung der Himmelskörper folgt dieser Raumzeit, der Mond z.B. richtet sich nicht nach irdischen Schaltsekunden. Aus diesem Grund kommt es bereits über 50 Jahre zu erheblichem Korrekturbedarf gegenüber Erdzeit. Genau deshalb gibt es die sog. Zeitkorrektur Delta-T, die aus mittelalterlichen Aufzeichnungen bis hin zu hypergenauen modernen Messungen derzeit zwischen 2000 v.Chr. (= Astronomisches Jahr -1999) bis 3000 n.Chr. bekannt ist. Währen man dazu früher Tabellenbücher wälzen mußte, geht das heutzutage flotter.
    Gruss an alle Sterngucker!

    P.S.: Wenn in der Zeitung die Minute des Mond- und Sonnenauf- und -untergangs steht, muss das ja jemand berechnen. Das Progi räumt nur die erste kleine Schwierigkeit dazu aus dem Weg...

    Brainfuck-Quellcode

    1. Windowtitle "Korrektur Raumzeit - Erdzeit auf +/-4 sek genau zwischen -1999 v.Chr. und +3000 n.Chr"
    2. '(D) Demoware (XProfan 11.2a) 2014-02 by P. Specht, Wien. Mit Sorgfalt, aber ohne jede Gewähr!
    3. ' Ausgangspunkt siehe http://de.wikipedia.org/wiki/Delta_T
    4. Declare Jahr$,y!,c$
    5. var sw&=1 'Korrektur c wegen der vor 1955 nicht so genau bekannten Tidenhubverzögerung des Mondes
    6. Cls:font 2:set("decimals",5):Jahr$=date$(3)
    7. print "------------------------------------------------------------------------"
    8. rept:
    9. Print " Astronom.Jahr (Gregor./vor 1583: Julian: 1=1 n.Chr.,0=-1 v.Chr): ";
    10. input c$:case c$>"":jahr$=c$:y!=val(Jahr$)
    11. Print " Monatsnummer in diesem Jahr (1..12): ";:input c$
    12. y!=y!+(val(c$)-0.5)/12 ' Zehnteljahre, kalibriert auf Monatsmitte
    13. print " Gestirn erscheint ( -:später, +:früher) um ";
    14. print format$("+########0.##;-########0.##; 0 ",Delta_T(y!));" sec"
    15. print "-------------------------------------------------------------------------"
    16. waitinput :case %key=27:end
    17. goto "rept"
    18. proc Delta_T :parameters y!,sw&
    19. declare T!,u!
    20. if y! >3000:print "\n *** Out-Of-Range Overflow Error *** ":beep:return 0
    21. elseif y!<-1999:Print "\n *** Out-Of-Range Underflow Error ***":beep:return 0
    22. elseif (y!>=-1999) and (y!<-500): u! = (y!-1820)/100: T! = -20+32*sqr(u!):return T!
    23. elseif (y!>=-500) and (y!<500): u!=y!/100
    24. T! = 10583.6 - 1014.41 * u! + 33.78311 * sqr(u!) - 5.952053 * sqr(u!)*u! - 0.1798452 \
    25. * sqr(sqr(u!)) + 0.022174192 * sqr(sqr(u!))*u! + 0.0090316521 * sqr(sqr(u!))*sqr(u!)
    26. return T! - 0.000012932*sqr(y!-1955)*sw&
    27. elseif (y!>=500) and (y!<1600): u! = (y!-1000)/100
    28. T! = 1574.2 - 556.01 * u! + 71.23472 * sqr(u!) + 0.319781 * sqr(u!)*u! - 0.8503463 \
    29. * sqr(sqr(u!)) - 0.005050998 * sqr(sqr(u!))*u! + 0.0083572073 * sqr(sqr(u!))*sqr(u!)
    30. return T! - 0.000012932*sqr(y!-1955)*sw&
    31. elseif (y!>=1600) and (y!<1700): u! = y! - 1600
    32. T! = 120 - 0.9808 * u! - 0.01532 * sqr(u!) + sqr(u!)*u! / 7129
    33. return T!- 0.000012932*sqr(y!-1955)*sw&
    34. elseif (y!>=1700) and (y!<1800): u! = y! - 1700
    35. T! = 8.83 + 0.1603 * u! - 0.0059285 * sqr(u!) + 0.00013336 * sqr(u!)*u! - sqr(sqr(u!))/1174000
    36. return T! - 0.000012932*sqr(y!-1955)*sw&
    37. elseif (y!>=1800) and (y!<1860): u! = y! - 1800
    38. T! = 13.72 - 0.332447 * u! + 0.0068612 * sqr(u!) + 0.0041116 * sqr(u!)*u! - \
    39. 0.00037436 * sqr(sqr(u!)) + 0.0000121272 * sqr(sqr(u!))*u! - 0.0000001699 * \
    40. sqr(sqr(u!))*sqr(u!) + 0.000000000875 * sqr(sqr(u!))*sqr(u!)*u!
    41. return T! - 0.000012932*sqr(y!-1955)*sw&
    42. elseif (y!>=1860) and (y!<1900): u! = y! - 1860
    43. T! = 7.62 + 0.5737 * u! - 0.251754 * sqr(u!) + 0.01680668 * sqr(u!)*u! - \
    44. 0.0004473624 * sqr(sqr(u!)) + sqr(sqr(u!))*u! / 233174
    45. return T! - 0.000012932*sqr(y!-1955)*sw&
    46. elseif (y!>=1900) and (y!<1920): u! = y! - 1900
    47. T! = -2.79 + 1.494119 * u! - 0.0598939 * sqr(u!) + 0.0061966 * \
    48. sqr(u!)*u! - 0.000197 * sqr(sqr(u!))
    49. return T! - 0.000012932*sqr(y!-1955)*sw&
    50. elseif (y!>=1920) and (y!<1941): u! = y! - 1920
    51. T! = 21.20 + 0.84493*u! - 0.076100 * sqr(u!) + 0.0020936 * sqr(u!)*u!
    52. return T! - 0.000012932*sqr(y!-1955)*sw&
    53. elseif (y!>=1941) and (y!<1961): u! = y! - 1950
    54. T! = 29.07 + 0.407*u! - sqr(u!)/233 + sqr(u!)*u! / 2547
    55. return T! - 0.000012932*sqr(y!-1955)*(y!<1955)*sw&
    56. elseif (y!>=1961) and (y!<1986): u! = y! - 1975
    57. T! = 45.45 + 1.067*u! - sqr(u!)/260 - sqr(u!)*u! / 718 : return T!
    58. elseif (y!>=1986) and (y!<2005): u! = y! - 2000
    59. T! = 63.86 + 0.3345 * u! - 0.060374 * sqr(u!) + 0.0017275 * sqr(u!)*u! + \
    60. 0.000651814 * sqr(sqr(u!)) + 0.00002373599 * sqr(sqr(u!))*u! : return T!
    61. elseif (y!>=2005) and (y!<2050): u!=y!-2000:T!=62.92+0.32217*u!+0.005589*sqr(u!):return T!
    62. ' This expression is derived from estimated values of T in the years 2010 and 2050.
    63. ' The value for 2010 (66.9 seconds) is based on a linearly extrapolation from 2005
    64. ' using 0.39 seconds/year (average from 1995 to 2005). The value for 2050 (93 seconds)
    65. ' is linearly extrapolated from 2010 using 0.66 seconds/year (average rate from 1901 to 2000).
    66. elseif (y!>=2050) and (y!< 2150)
    67. T! = -20 + 32 * sqr((y!-1820)/100) - 0.5628 * (2150 - y!):return T!
    68. ' The last term is introduced to eliminate the discontinuity at 2050.
    69. elseif (y!>=2150) and (y!<=3000):u! = (y!-1820)/100:T! = -20 + 32 * sqr(u!):return T!
    70. else :print "\n *** Unexpected Error *** " :beep:return 0
    71. endif
    72. endproc
    73. '{ Kurzbeschreibung
    74. ' Als Delta T (dT) wird in der Astronomie die Differenz der Terrestrischen Dynamischen Zeit (TDT,
    75. ' auch TT genannt) und der Universal Time (UT, formals GMT -Greenwich Mean Time) bezeichnet,
    76. ' also die Differenz zu einer Zeitskala, die die Bewegung und Gravitationsfelder im Sonnensystem
    77. ' kompensiert und jener, die durch die tatsächliche Erdrotation bestimmt ist.
    78. '
    79. ' Additive Korrektur 'Delta' T = TDT - UT = ErdrotatationsPhasenversatz - GMT,
    80. ' betrug Anfang 2007 eine Minute und 5.15 Sekunden = 65.15 s
    81. ' Definitionsgleichung: T = 32.184 s + (TAI - UTC) - (UT1 - UTC)
    82. '
    83. ' Die 32,1840 Sekunden sind die konstante Differenz zwischen TDT und der Internat. Atomzeit (TAI).
    84. ' Die Differenz zwischen TAI und der Koordinierten Weltzeit (UTC) entspricht der Anzahl der bisher
    85. ' bei UTC eingefügten Schaltsekunden (seit dem 1. Juli 2012 und bis zur nächsten Schaltsekunde: 35).
    86. ' Der Beitrag des letzten Teilterms beträgt weniger als eine Sekunde, es handelt sich um die
    87. ' Differenz zwischen der Polschwankungen berücksichtigenden Variante der Universal Time (UT1)
    88. ' und UTC, die auch dUT1 genannt wird (Verantwortlich: IERS)
    89. '
    90. ' Der aktuelle Wert für dT kann aus den vom International Earth Rotation and Reference
    91. ' Systems Service (IERS) bereitgestellten Daten ermittelt werden. Zu Beginn des 21. Jahrhunderts
    92. ' betrug dT ungefähr 64 Sekunden, am Ende dieses Jahrhunderts wird der Zeitunterschied
    93. ' auf etwa 204 Sekunden angewachsen sein.... Historische Werte für dT lassen sich
    94. ' ungefähr bestimmen, indem überlieferte Beobachtungen mit heutigen Berechnungsergebnissen
    95. ' verglichen werden. Weiterhin gibt es verschiedene aus diesen Daten abgeleitete Polynome
    96. ' zur näherungsweisen Berechnung. Solche Polynome gibt es auch zur Prognose zukünftiger Werte.
    97. ' ...
    98. ' Auf folgender NASA-"Eclipse" Seite fand ich diese Polynome:
    99. ' Q: http://eclipse.gsfc.nasa.gov/SEcat5/deltatpoly.html (Zugriff 03.02.2014)
    100. ' Eclipse Web Site by Fred Espenak, GSFC Planetary Systems Laboratory der NASA
    101. ' Polynomial Expressions for Delta T; abgeleitet aus: 'Five Millennium Canon of Solar
    102. ' Eclipses [Espenak and Meeus]' sowie: 'Morrison, L. and Stephenson, F.R.,
    103. ' 'Historical Values of the Earth's Clock Error T and the Calculation of Eclipses',
    104. ' J. Hist. Astron., Vol.35 Part 3, Aug. 2004, No.120, pp 327-336 (2004)
    105. '
    106. ' All values of T based on Morrison and Stephenson [2004] assume a value for the
    107. ' Moon's secular acceleration of -26 arcsec / cy^2. [Ursache ist die Verzögerung des Mondes
    108. ' durch den nacheilenden Tidenhub des Meeres und in geringerem Maße der Landmassen. Es existieren
    109. ' da aber bereits genauere Daten, was per Korrektursummand c führt:]However,the ELP-2000/82 lunar
    110. ' ephemeris employed in the Canon (=Tabelle) uses a slightly different value of -25.858 arcsec/cy^2.
    111. ' Thus, a small correction "c" must be added to the values derived from the polynomial
    112. ' expressions for T before they can be used in the Canon:
    113. '
    114. ' c = -0.000012932 * sqr(y-1955) '*** Korrektur wird mit sw&=1 zugeschaltet, siehe unten! ***
    115. ' Since the values of T! for the interval 1955 to 2005 were derived independent of any
    116. ' lunar ephemeris, no correction is needed for this period.
    117. '}
    Alles anzeigen
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von p. specht ()

  • Abt. GrabFromURL
    ============
    Vor Jahren gab es mal ein nützliches kleines DOS-Tool namens GrabURL.exe :zorro:, das aber in der 64-bit-Welt von heute nicht mehr funktioniert :cry:. Anbei ein funktionell ähnliches Teil zum rohen Downloaden einzelner Files von Internetseiten :oops: auf den eigenen Desktop.
    Gruss
    P.S.: DRINGENDER HINWEIS: So geladene Dateien anschließend IMMER :idea: SOFORT auf Viren / Malware prüfen :!:

    Quellcode

    1. Windowtitle "GrabFromURL":declare stat&,u$,url$,path$,fnam$
    2. 'NO WARRANTIES WHATSOEVER! IT'S YOUR OWN RISK!
    3. Windowstyle 24:cls:font 2:url$="http://www.yepi.us/swf/Pee-Man---The-Game.swf"
    4. path$=getenv$("USERPROFILE")+"//desktop//":fnam$=path$+"PeeMan.swf.txt"
    5. print "FROM URL incl.'http' part: ";:input u$:case u$>"":url$=u$
    6. print "TO Filename on Desktop: ";:input u$:case u$>"":fnam$=path$+u$
    7. ifnot dirExists(path$):print "\nERROR: Directory not found!":waitinput 60000:end:endif
    8. if fileexists(fnam$):print "\nERROR: File already exists!":beep:waitinput 60000:end:endif
    9. stat&=@DownLoadFile(url$,fnam$)
    10. if stat&>0:CLS:else :print "Sorry, no DL possible!":beep:waitinput 60000:end :endif
    11. while %loading:locate 1,1:stat&=&BytesRead:print stat&;" bytes read...";:waitinput 250:endwhile
    12. stat&=&BytesRead:if stat&=-1:locate 1,1:print "Error after trying DL!"
    13. else :cls:locate 1,1:print stat&;" byte downloaded in total.\n":endif
    14. print "File ";fnam$;" ready.\n\nAlways check for viruses!!!":beep:waitinput 10000:end
    Alles anzeigen
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von p. specht ()

  • Abt. Fliehkraftberechnung ohne Massendynamik
    ==============================
    Zum Unterschied von Energie- bzw. Drehimpuls-Simulationen führt die bloße Darstellung des jeweils schon eingependelten Endzustandes von Fliehkraftreglern (wie er in Physiklehrbüchern als Winkel aus Gravitation und nach aussen wirkender Fliehkraft dargelegt wird) nicht zu realistisch wirkenden Resultaten, wie der nachfolgende Müllcode beweist... Das mit den Pendeln müssen wir also noch besser hinkriegen!
    Gruss

    Quellcode

    1. WindowTitle "Fliehkraft"
    2. '(CL) CopyLeft 2014-02 by P. Specht; Keine wie auch immer geartete Haftung!
    3. WindowStyle 24:Randomize:Font 2:Window 0,0-%maxx,%maxy-40
    4. cls rgb(200+rnd(56),200+rnd(56),200+rnd(56))
    5. var xx&=width(%hwnd):var yy&=height(%hwnd)
    6. line 0,yy&\2 - xx&,yy&\2:usepen 0,3,rgb(0,0,0):line xx&\2,0 - xx&\2,yy&
    7. declare masse!,F_flieh!,F_grav!,alpha!,omega!,r!,x!,y!,freq!,scale!
    8. scale!=5000
    9. r!= 0.1'm Radius
    10. masse!= 0.1'kg
    11. freq!= 0 'U/s Drehzahl
    12. whileloop 700,10000-700,100:if &Loop<5000:freq!=&Loop/2000:else : freq!=(10000-&Loop)/2000:endif
    13. omega!=2*pi()*freq!
    14. F_flieh!=masse!*r!*sqr(omega!)
    15. F_grav! =masse!*9.80665 'kg.m/s² = N
    16. if abs(F_flieh!)<10^-10:alpha!=pi()/2
    17. else :alpha!=arctan(F_grav!/F_flieh!)
    18. endif
    19. locate 1,1:print freq!;" U/s "
    20. usepen 0,3,255:line xx&\2,7 - xx&\2+scale!*r!*cos(pi()-alpha!), scale!*r!*sin(pi()-alpha!)
    21. usepen 0,3,0:usebrush 1,rgb(rnd(256),255,255)
    22. ellipse (xx&\2+25-scale!*r!*cos(pi()-alpha!)),(scale!*r!*sin(pi()-alpha!)-25) - \
    23. (xx&\2-25-scale!*r!*cos(pi()-alpha!)),(scale!*r!*sin(pi()-alpha!)+25)
    24. usepen 0,3,255:line xx&\2,7 - xx&\2-scale!*r!*cos(pi()-alpha!), scale!*r!*sin(pi()-alpha!)
    25. usepen 0,3,0:usebrush 1,rgb(255,rnd(256),255)
    26. ellipse (xx&\2+25+scale!*r!*cos(pi()-alpha!)),(scale!*r!*sin(pi()-alpha!)-25) - \
    27. (xx&\2-25+scale!*r!*cos(pi()-alpha!)),(scale!*r!*sin(pi()-alpha!)+25)
    28. waitinput 100
    29. endwhile
    30. waitinput
    Alles anzeigen
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von p. specht ()

  • Abt. Rechenpräzision von XProfan
    =====================
    Oft reicht die Double-precision-Arithmetik von XProfan für heikle iterative Simulationen (Wirksamkeit von Pharmaka etc.) nur dann, wenn der verwendete Algorithmus sehr geschickt programmiert ist und der Programmierer auch eine günstige Rechen-Reihenfolge wählt. Am Beispiel "Schwerpunkt" (z.B. eines Makromoleküls) kann das demonstriert werden, etwa beim Nachvollziehen der Vorgänge beim thermischen Cracken langkettiger Fette und Öle, wo es auf die präzise Berechnung der Teil-Schwerpunkte ((zur späteren Ermittlung der "Bruchspannungen" = Überwindung der Van der Waals-Kräfte)) ankommt. Nachstehend ein sehr einfach gehaltenes, "zu Fuß" programmiertes Testbeispiel dazu. In der Praxis wäre natürlich eine Automatisierung solcher Prüffolgen erforderlich!
    Gruss

    Brainfuck-Quellcode

    1. WindowTitle "Gesamtschwerpunkt-Ermittlung durch schrittweise Aggregatbildung"
    2. ' (CL) Copyleft 2014-03 by P.Specht, Wien. KEINE WIE AUCH IMMER GEARTETE GEWÄHR!
    3. WindowStyle 24:randomize:Window 0,0-%maxx,%maxy-40
    4. Cls rgb(200+rnd(56),200+rnd(56),200+rnd(56)):Font 2:set("decimals",18)
    5. declare m1!,x1!,y1!,z1!,m2!,x2!,y2!,z2!,m3!,x3!,y3!,z3!,m4!,x4!,y4!,z4!
    6. declare m12!,x12!,y12!,z12!,m123!,x123!,y123!,z123!
    7. declare m1234!,x1234!,y1234!,z1234!
    8. print "\n Schwerpunkt eines Systems aus 4 gegeneinander fixierten Massen wird berechnet."
    9. print "\n Aufgabe 'Schwerpunkt-Formel überprüfen': Gibt es Unterschiede im Ergebnis \n"
    10. print " (bzgl. Präzision etc.) bei unterschiedlicher Zusammenfassungsreihenfolge? \n\n\n"
    11. '--- Masse, x-, y-, z-Koordinate -------------------------------------------------------
    12. m1!=val("11") :x1!=val("-10.5") : y1!=val(" 5") :z1!=val("1")
    13. m2!=val("1 ") :x2!=val(" 10.5") : y2!=val("-5") :z2!=val("3")
    14. m3!=val("-9") :x3!=val(" 1.5") : y3!=val(" 5") :z3!=val("7")
    15. m4!=val("14") :x4!=val(" -1.5") : y4!=val("-2") :z4!=val("11")
    16. '----------------------------------------------------------------------------------------
    17. ' Precision Tests:
    18. '----------------------------------------------------------------------------------------
    19. print:print tab(30);" Masse ";tab(52);" X ";tab(74);" Y ";tab(100);" Z ":print
    20. m12!=m1!+m2!
    21. x12!=(m1!*x1!+m2!*x2!)/(m1!+m2!)
    22. y12!=(m1!*y1!+m2!*y2!)/(m1!+m2!)
    23. z12!=(m1!*z1!+m2!*z2!)/(m1!+m2!)
    24. m123!=m1!+m2!+m3!
    25. x123!=(m12!*x12!+m3!*x3!)/(m12!+m3!)
    26. y123!=(m12!*y12!+m3!*y3!)/(m12!+m3!)
    27. z123!=(m12!*z12!+m3!*z3!)/(m12!+m3!)
    28. m1234!=m1!+m2!+m3!+m4!
    29. x1234!=(m123!*x123!+m4!*x4!)/(m123!+m4!)
    30. y1234!=(m123!*y123!+m4!*y4!)/(m123!+m4!)
    31. z1234!=(m123!*z123!+m4!*z4!)/(m123!+m4!)
    32. print " Weg ((1+2)+3)+4: ",m1234!;" , ";x1234!;" , ";y1234!;" , ";z1234!:print
    33. m12!=m4!+m2!
    34. x12!=(m4!*x4!+m2!*x2!)/(m4!+m2!)
    35. y12!=(m4!*y4!+m2!*y2!)/(m4!+m2!)
    36. z12!=(m4!*z4!+m2!*z2!)/(m4!+m2!)
    37. m123!=m4!+m2!+m3!
    38. x123!=(m12!*x12!+m3!*x3!)/(m12!+m3!)
    39. y123!=(m12!*y12!+m3!*y3!)/(m12!+m3!)
    40. z123!=(m12!*z12!+m3!*z3!)/(m12!+m3!)
    41. m1234!=m1!+m2!+m3!+m4!
    42. x1234!=(m123!*x123!+m1!*x1!)/(m123!+m1!)
    43. y1234!=(m123!*y123!+m1!*y1!)/(m123!+m1!)
    44. z1234!=(m123!*z123!+m1!*z1!)/(m123!+m1!)
    45. print " Weg ((4+2)+3)+1: ",m1234!;" , ";x1234!;" , ";y1234!;" , ";z1234!:print
    46. m12!=m1!+m3!
    47. x12!=(m1!*x1!+m3!*x3!)/(m1!+m3!)
    48. y12!=(m1!*y1!+m3!*y3!)/(m1!+m3!)
    49. z12!=(m1!*z1!+m3!*z3!)/(m1!+m3!)
    50. m123!=m1!+m2!+m3!
    51. x123!=(m12!*x12!+m2!*x2!)/(m12!+m2!)
    52. y123!=(m12!*y12!+m2!*y2!)/(m12!+m2!)
    53. z123!=(m12!*z12!+m2!*z2!)/(m12!+m2!)
    54. m1234!=m1!+m2!+m3!+m4!
    55. x1234!=(m123!*x123!+m4!*x4!)/(m123!+m4!)
    56. y1234!=(m123!*y123!+m4!*y4!)/(m123!+m4!)
    57. z1234!=(m123!*z123!+m4!*z4!)/(m123!+m4!)
    58. print " Weg ((1+3)+2)+4: ",m1234!;" , ";x1234!;" , ";y1234!;" , ";z1234!:print
    59. m12!=m4!+m3!
    60. x12!=(m4!*x4!+m3!*x3!)/(m4!+m3!)
    61. y12!=(m4!*y4!+m3!*y3!)/(m4!+m3!)
    62. z12!=(m4!*z4!+m3!*z3!)/(m4!+m3!)
    63. m123!=m4!+m3!+m2!
    64. x123!=(m12!*x12!+m2!*x2!)/(m12!+m2!)
    65. y123!=(m12!*y12!+m2!*y2!)/(m12!+m2!)
    66. z123!=(m12!*z12!+m2!*z2!)/(m12!+m2!)
    67. m1234!=m4!+m3!+m2!+m1!
    68. x1234!=(m123!*x123!+m1!*x1!)/(m123!+m1!)
    69. y1234!=(m123!*y123!+m1!*y1!)/(m123!+m1!)
    70. z1234!=(m123!*z123!+m1!*z1!)/(m123!+m1!)
    71. print " Weg ((4+3)+2)+1: ",m1234!;" , ";x1234!;" , ";y1234!;" , ";z1234!:print
    72. print "\n\n Bitte weitere Tests durch Einprogrammieren stark abweichender Massen und Positionen durchführen! "
    73. waitinput
    Alles anzeigen
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von p. specht ()

  • Quellcode

    1. x1! = val("-10.5")


    Hm, ich dachte das man so etwas nur bei

    Quellcode

    1. x1! = val("-10.5e-3")


    benötigt.

    Für einfache Floatwerte mit Minuszeichen ist sowas nicht erforderlich. Ins Schleudern kommt XProfan nur bei dem negativen Exponenten.

    Die Lösung Deines Problemes wäre aber nicht so einfach. Wenn man intern mit höherer Genauigkeit rechnet, dann bleibt es bei der Zuweisung hängen. Da wird dann wieder auf einfache (doppelte) Genauigkeit zurückgerechnet.

    Um z.B. die Agner Fog Mathe-Routinen richtig ausreizen zu können braucht man dann auch die 80 oder 128-Byte Zielvariablen.

    Aber da sieht man mal das man nicht erst in den Weltraum ausweichen muss um an die Grenzen der in fast allen Programmiersprachen verwendeten Mathe-Routinen zu stoßen.

    Gruß
    Michael Wodrich
    Programmieren, das spannendste Detektivspiel der Welt.
  • @Michael: Da dachtest du natürlich richtig! :oops: Ich hätte auch dazuschreiben sollen, daß ich mit der guten alten Version 11.2a programmiere, die den Wertebereich 10^-323 (Underflow, rechnet aber weiter) bzw. eigentlich 10^-306 bis 10^306 hat :top: , - im Gegensatz zu einigen neueren Versionen mit Zahlenbereich 10^-53 bis 10^53 :8o: .

    Der VAL()-Befehl ist nur dann erforderlich, wenn man die Grenzen der Präzision voll austesten will, z.B. bei zwei Werten in der Größenordnung 10^-15 die in der Formel multipliziert werden, um dann durch das Ergebnis zu dividieren. Da kommt es rasch zu starken Genauigkeitseinbussen, die bei hundert- bis tausendfacher Iteration fatal werden können.
    Gruss

    P.S.: Danke auch für den Hinweis auf das Math Pack von Prof. Agner Fog, werde ich mir gleich näher ansehen!

    PPS: Klarstellung: Mit dem Schwerpunktsbeispiel oben galt es damals, Molekülbruchstellen zu finden - nur deshalb wurden auch 2-er und 3-er-Teilschwerpunkte ermittelt! Geht es lediglich um die 3D-Koordinaten des Gesamtschwerpunktes von N zueinander fest angeordneten Massenteilchen, dann gilt selbstverständlich die aus Film und Fernsehen bekannte Formel X_Schwerpkt = SUM(m[i]*X[i]) / SUM(m[i]) ... für i=1 bis N; gleiches dann jeweils auch für die Y- und Z-Koordinate. War aber eh klar, oder?
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3

    Dieser Beitrag wurde bereits 7 mal editiert, zuletzt von p. specht ()

  • Abt. Bytefelder aus Dateien als hexadezimale XProfan-$Longvariablen ins Clipboard bringen
    =========================================================
    ... aus gegebenem Anlaß. Gruss!

    Quellcode

    1. WindowTitle "File2Long into Clipboard"
    2. '(CL)CopyLeft 2014-03 by P.Specht, Wien. KEINE WIE AUCH IMMER GEARTETE GEWÄHR!
    3. var DrivePathFilename$="TESTSELF.PRF"
    4. declare i&,z$:Window 0,0-%maxx,%maxy-40
    5. ifnot FileExists(DrivePathFilename$):print " *** File not found *** "
    6. else :Assign #1,DrivePathFilename$:OpenRW #1:ClearClip
    7. z$="var v$="+chr$(34)+chr$(34):print z$:putclip z$+"\n"
    8. Repeat :print "v$=v$+"+chr$(34);:putclip "v$=v$+"+chr$(34)
    9. whilenot eof(#1):inc i&:z$="$"+right$("00000000"+hex$(GetLong(#1)),8)
    10. print z$;:putclip z$
    11. if (i& MOD 8) and not(eof(#1)) :print ",";:putclip ","
    12. else :print chr$(34):putclip chr$(34)+"\n":break
    13. endif :endwhile
    14. until eof(#1):Close #1:font 2:print "\n\n CLIPBOARD READY."
    15. endif :WaitInput 60000:End
    Alles anzeigen
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3
  • Hm, da wird aber ein Rest verschluckt...

    Sorry - stimmt nicht. Da landet bissl Müll am Ende. Ich hatte übersehen, das die Bytes ja anders herum gespeichert werden. Ist hiermit gut zu sehen...

    Quellcode

    1. ' ##### VORSICHT: nur zum Ausloten benutzen... #############
    2. WindowTitle "File2Long into Clipboard"
    3. '(CL)CopyLeft 2014-03 by P.Specht, Wien. KEINE WIE AUCH IMMER GEARTETE GEWÄHR!
    4. var DrivePathFilename$ = "TESTSELF.PRF"
    5. declare i&,z$ ,y$,L&
    6. Window 0,0 - %maxx,%maxy-40
    7. proc ch:parameters a%:return " "+if((a%>=32)and(a%<127),chr$(a%),"."):endproc
    8. ifnot FileExists(DrivePathFilename$)
    9. print " *** File not found *** "
    10. else
    11. Assign #1,DrivePathFilename$
    12. OpenRW #1
    13. ClearClip
    14. z$ = "var v$=" + chr$(34) + chr$(34)
    15. y$ = "var t$=" + chr$(34) + chr$(34)
    16. print z$
    17. putclip z$ + "\n"
    18. putclip y$ + "\n"
    19. Repeat
    20. print "v$=v$+" + chr$(34);
    21. putclip "v$=v$+" + chr$(34)
    22. y$ = "t$=t$+" + chr$(34)
    23. whilenot eof(#1)
    24. inc i&
    25. L& = GetLong(#1)
    26. z$ = "$" + right$("00000000" + hex$(L&),8)
    27. y$ = y$ + " " + ch(L& & $FF): L& = L& >> 8
    28. y$ = y$ + ch(L& & $FF): L& = L& >> 8
    29. y$ = y$ + ch(L& & $FF): L& = L& >> 8
    30. y$ = y$ + ch(L& & $FF)
    31. print z$;
    32. putclip z$
    33. if (i& MOD 8) and not(eof(#1))
    34. print ",";
    35. putclip ","
    36. y$ = y$ + " "
    37. else
    38. print chr$(34)
    39. putclip chr$(34) + "\n"
    40. putclip y$ + chr$(34) + "\n"
    41. break
    42. endif
    43. endwhile
    44. until eof(#1)
    45. Close #1
    46. font 2
    47. print "\n\n CLIPBOARD READY."
    48. endif
    49. WaitInput 60000
    50. End
    51. '****
    Alles anzeigen


    Genial einfach Dein Code und durch die Zwischenablage kann das Ergebnis gleich an die richtige Stelle gesetzt werden. :top:

    Gruß
    Michael Wodrich

    P.S.: Seit wann funktioniert eigentlich die Zahl hinter WaitInput. Ist nicht in der Hilfe erwähnt... 8O
    Programmieren, das spannendste Detektivspiel der Welt.

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von Michael Wodrich ()

  • Tja, das klappt sogar mit undeklarierten Variablen hinter Waitinput :s2:

    Quellcode

    1. CLS:randomize:repeat :gosub "":Waitinput @&(0)
    2. cls rgb(200+rnd(56),200+rnd(56),200+rnd(56)):continue
    3. :
    4. return 200+rnd(1250)
    5. until .
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3
  • Abt. Nebenläufige Parallel-Threads in XProfan-Versionen vor X2 bzw. Freeprofan32/XProfan64(beta)
    ==============================================================
    lassen sich u.a. per xpse-Präcompiler realisieren. Die Beispiele in dessen Syntaxbeschreibung sind allerdings etwas dürftig. Deshalb hier ein etwas komplexeres Beispiel. Ab X2 gibt es dazu den Befehl pExec, mit dem sich z.B. ebenfalls multiple Timerschleifen realisieren lassen.

    Quellcode

    1. {$cleq}
    2. cls:var n&=0:Print " Theads der Reihe nach beenden mit ESC-Taste!"
    3. var thread&=thread.start(procaddr(meinThread),0,"")
    4. var thread2&=thread.start(procaddr(meinZweiterThread),0,"")
    5. main:
    6. repeat
    7. locate 10,10:print n&:inc n&;
    8. waitinput 5:until %key=27
    9. print "\n Habe Hauptschleife verlassen.":waitinput
    10. thread.stop(thread&):while thread.is(thread&):endwhile:thread.close(thread&)
    11. print " Habe Thread Nr. 1 beendet.":waitinput
    12. thread.stop(thread2&):while thread.is(thread2&):endwhile:thread.close(thread2&)
    13. print " Habe Thread Nr. 2 beendet."
    14. print " Isch 'abe feddisch...":waitinput 3000
    15. end
    16. nproc meinThread :parameters thread&,dataLong&,dataString$
    17. whilenot thread.message(thread&)==wm_close
    18. settext(%hWnd,"Mein FensterTitel - ["+time$(0)+"."+substr$(time$(1),1,".")+"]")
    19. sleep(1000):endwhile:return 0
    20. endproc
    21. nproc meinZweiterThread :parameters thread&,dataLong&,dataString$
    22. whilenot thread.message(thread&)==wm_close
    23. settext(%hWnd,"MEIN FENSTERTI - ("+time$(0)+"."+substr$(time$(1),1,".")+")")
    24. sleep(900):endwhile:return 0
    25. endproc
    Alles anzeigen
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von p. specht ()

  • pExec erzeugt keine Threads, sondern erzeugt einen weiteren Process! Das sind 2 sehr verschiedene Dinge.
    Mehrere Threads eines Processes benutzen denselben Speicher, deshalb sind dort auch Maßnahmen wie
    Ciritical Sections, Mutex und Semaphoren erforderlich, um undefinierte Zustände des Speichers entgegenzu-
    wirken. Der von XPSE erzeugte Code ist nur sehr eingeschränkt Threadsafe.

    Bei durch pExec erzeugten Processen gibt es keine solche Probleme, aber der Datenaustausch zwischen den
    Processen ist natürlich stark beschränkt, dafür läuft das ganze aber wesentlich stabiler.
    Gruß Thomas

    Wenn ich lügend sage, dass ich lüge, lüge ich oder sage ich Wahres?
    ComputerInfo für PPF
  • Danke für die Klarstellung, TSSoft! Genau das mit dem Speicher hatte ich bisher nie verstanden!
    Gruss

    P.S.: Meine Methode "Lernen durch Blödsinn schreiben und von kompetenter Stelle korrigiert werden" hat sich wieder einmal bewährt ;-)
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3