ALGORITHMEN - Teil XX: Zwischen Fersuch und Irrdumm

    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.

    • Lösung zu EaR 14: STRG+D
      --------------------------
      Die Tabelle im Spoiler enthält Tastenkombinationen für die Arbeit mit WordPad.
      Spoiler anzeigen

      WordPad Tastaturkürzel
      ======================
      Strg+N ... Ein neues Dokument erstellen
      Strg+O ... Öffnen eines vorhandenen Dokuments
      Strg+S ... Änderungen an einem Dokument speichern
      F12 ...... Speichern Sie das Dokument als neue Datei.
      Strg+P ... Ein Dokument drucken
      Alt+F4 ... WordPad schließen
      Strg+Z ... Eine Änderung rückgängig machen
      Strg+Y ... Eine Änderung wiederholen
      Strg+A ... Das gesamte Dokument auswählen
      Strg+X ... Eine Auswahl ausschneiden
      Strg+C ... Kopieren einer Auswahl in die Zwischenablage
      Strg+V ... Eine Auswahl aus der Zwischenablage einfügen
      Strg+B ... Markierten Text fett setzen
      Strg+I ... Ausgewählten Text kursiv darstellen
      Strg+U ... Markierten Text unterstreichen
      Strg+=== . Markierten Text tiefgestellt machen
      Strg+Umschalt+== Markierten Text hochstellen
      Strg+L ... Text links ausrichten
      Strg+E ... Textmitte ausrichten
      Strg+R ... Text rechtsbündig ausrichten
      Strg+J ... Text ausrichten
      Strg+1 ... Einzelzeilenabstand einstellen
      Strg+2 ... Doppelten Zeilenabstand einstellen
      Strg+5 ... Zeilenabstand auf 1,5 einstellen
      Strg+Umschalt+> .Schriftgröße vergrößern
      Strg+Umschalt+< .Verkleinern der Schriftgröße
      Strg+Shift+A ... Ändernt die Zeichen alle Großbuchstaben.
      Strg+Shift+L ... Ändern des Aufzählungszeichens
      Strg+D ... Einfügen einer Microsoft Paint Zeichnung
      Strg+F ... Text in einem Dokument suchen
      F3 ....... Suchen Sie die nächste Instanz des Textes im Dialogfenster Suchen.
      Strg+H ... Text in einem Dokument ersetzen
      Strg+Linkspfeil ....... Bewegen Sie den Cursor ein Wort nach links.
      Strg+Rechtspfeil ...... Bewegen Sie den Cursor ein Wort nach rechts.
      Strg+Pfeil_nach_oben .. Bewegen Sie den Cursor auf die Zeile über der Zeile.
      Strg+Pfeil_nach_unten . Bewegen Sie den Cursor auf die folgende Zeile
      Strg+Home ... An den Anfang des Dokuments springen
      Strg+Ende ... An das Ende des Dokuments springen
      Strg+Seite_nach_oben ... Eine Seite nach oben blättern
      Strg+Seite_nach_unten .. Eine Seite nach unten blättern
      Strg+Löschen ... Das nächste Wort löschen
      F10 ............ Keytips anzeigen
      Umschalt+F10 ... Zeigt das aktuelle Kontextmenü an.
      F1 .............. WordPad-Hilfe öffnen
    • Abt. Verlegenheitslösung
      ==================
      Nachdem die PTB Braunschweig die Atomzeitserver offenbar etwas umgestellt hat, funktionieren einige Programme nicht mehr. Da es aber Branchenservices und Fachgeschäfte mit Atomzeitangaben gibt, ist die folgende Verlegenheitslösung entstanden - Achtung, in nachstehender Form vor allem für Österreich gültig! Aber auf Google kann man sicher Dienste finden, die auf das jeweilige Land Bezug nehmen.
      Gruss

      Quellcode

      1. WindowTitle "Uhrzeit und Datum":WindowStyle 24:Window 100,100 - 200,100
      2. cls:font 2:declare c$,url$,OnString$,ldl&,lon&,zeit$,datm$,in&,Tag$
      3. url$="https://www.zeitzonen.de/oesterreich.html":print "\n zeitzonen.de ..."
      4. @downloadfile(url$):while %Loading:waitinput 333:endwhile:ldl&=&Bytesread
      5. CLS':print "\n ";ldl&;" Byte\n":OnString$="time clock":lon&=len(OnString$)
      6. in&=instr(OnString$,$Download):if in&<=0:print " Zeit nicht gefunden!"
      7. else :zeit$=mid$($Download,in&+lon&+2,8):endif
      8. OnString$="<span class="+chr$(34)+"weekday"+chr$(34)+">"
      9. lon&=len(OnString$):in&=instr(OnString$,$Download)
      10. if in&<=0:print " Tag nicht gefunden!":else :Tag$=mid$($Download,in&+lon&,2)
      11. endif:in&=instr(chr$(34)+"date"+chr$(34),$Download)
      12. if in&<=0:print "Datum nicht gefunden!"
      13. else :Datm$=mid$($Download,in&+7,10):endif
      14. print "\n ";Tag$;" ";Datm$;" ";Zeit$:waitinput 6000:End
      Alles anzeigen
    • Abt. Parametrierte Figuren
      ====================
      Die sog. Superformel (Youtube, engl.) erzeugt bei geeigneter Wahl der Parameter recht interessante Figuren. Für Bildschirmschoner ist das aber zuwenig - da will man Bewegung. Doch auch diese wird irgendwann langweilig, wie das nachstehende Machwerk als abschreckendes Beispiel zeigt.
      Gruss

      P.S. Ich trauere immer noch dem alten DOS-Bildschirmschoner Dazzle nach. Nun habe ich ihn wenigstens als Youtube-Video wiedergefunden: Nostalgie pur!

      Quellcode

      1. WindowTitle "Figuren mittels Superformel erzeugen"
      2. WindowStyle 24:Cls rgb(0,0,0):ShowMax
      3. var xh&=width(%hwnd)\2:var yh&=height(%hwnd)\2:randomize:font 2
      4. Proc Superformel 'liefert Radius(phi!,...)
      5. parameters phi!,Symmetrie!,Form1!,Form2!,Form3!,xHalbachse!,yHalbachse!
      6. casenot xHalbachse!*yHalbachse!:return 0
      7. var Winkel!=Symmetrie!*phi!*0.25
      8. 'r! = (abs(cos(Winkel!)/xHalbachse!)^Form2!+abs(sin(Winkel!)/yHalbachse!)^Form3!)^(-1/Form1!)
      9. var co!=cos(Winkel!):var si!=sin(Winkel!)
      10. var r!=0:case co!<>0:r!=abs(co!/xHalbachse!)^Form2!
      11. case si!<>0:r!=r!+abs(sin(Winkel!)/yHalbachse!)^Form3!
      12. :if r!>0:r! = r!^(-1/Form1!):else r!=0:endif
      13. return r!
      14. EndProc
      15. :Proc To_xy :parameters r!,phi!:x!=r!*cos(phi!):y!=r!*sin(phi!):endproc
      16. :Proc rPhi :parameters x!,y!:r!=sqrt(sqr(x!)+sqr(y!)):phi!=ArcTan4(x!,y!):endproc
      17. Proc ArcTan4 :parameters x!,y!:var pi!=3.1415926535897932:var w!=0
      18. if x!=0:if y!>0:w!=pi!*0.5:elseif y!<0:w!=pi!*1.5:else :w!=0:endif :return w!:elseif x!>0
      19. if y!=0:w!=0:return w!:elseif y!>0:if x!>y!:w!=arctan(y!/x!):else :w!=pi!/2-arctan(x!/y!):endif
      20. return w!:else :if x!<-y!:w!=pi!*1.5+arctan(x!/-y!):else :w!=2*pi!-arctan(-y!/x!):endif :return w!
      21. endif :else :if y!>0:if x!>-y!:w!=pi!/2+arctan(-x!/y!):return w!:else :w!=pi!-arctan(y!/-x!)
      22. return w!:endif :elseif y!<0:if x!<y!:w!=pi!+arctan(-y!/-x!):else :w!=pi!*1.5-arctan(-x!/-y!)
      23. endif :return w!:else :w!=pi!:return w!:endif :endif :Print " ArcTan4 ERROR":waitinput 1e5
      24. endproc
      25. MAIN:
      26. var s!=100 ' Size
      27. var f!=pi()/180
      28. Declare x!,y!,r!,phi!,w!,n&,\
      29. \
      30. Symmetrie!,Form1!,Form2!,Form3!,xHalbachse!,yHalbachse! :var Data$=\
      31. "3 5 18 18 1 1 "+"6 20 7 18 1 1 "+"4 2 4 13 1 1 "+"7 2 4 17 1 1 " +\
      32. "7 3 6 6 1 1 "+"3 3 14 2 1 1 "+"19 9 14 11 1 1 "+"12 15 20 3 1 1 "+\
      33. "8 1 1 8 1 1 "+"8 1 5 8 1 1 "+"8 3 4 3 1 1 "+"8 7 8 2 1 1 "+\
      34. "5 2 6 6 1 1 "+"6 1 1 6 1 1 "+"6 1 7 8 1 1 "+"7 2 8 4 1 1 "+\
      35. "3 2 8 3 1 1 "+"3 6 6 6 1 1 "+"4 1 7 8 1 1 "+"4 4 7 7 1 1 "+\
      36. "2 2 2 2 1 1 "+"2 1 1 1 1 1 "+"2 1 4 8 1 1 "+"3 2 5 7 1 1"
      37. Declare LSymmetrie!,LForm1!,LForm2!,LForm3!,LxHalbachse!,LyHalbachse!
      38. Declare p!,q!, p1!,p2!,p3!,p4!,p5!,p6!
      39. Nochmal:
      40. Whileloop 0,23:n&=&Loop
      41. Symmetrie!=val(substr$(Data$,6*n&+1," "))
      42. Form1!=val(substr$(Data$,6*n&+2," "))
      43. Form2!=val(substr$(Data$,6*n&+3," "))
      44. Form3!=val(substr$(Data$,6*n&+4," "))
      45. xHalbachse!=val(substr$(Data$,6*n&+5," "))
      46. yHalbachse!=val(substr$(Data$,6*n&+6," "))
      47. Whileloop 200,0,-2
      48. p!=&Loop/200:q!=1-p!
      49. p1!=LSymmetrie!*p!+Symmetrie!*q!
      50. p2!=LForm1!*p!+Form1!*q!
      51. p3!=LForm2!*p!+Form2!*q!
      52. p4!=LForm3!*p!+Form3!*q!
      53. p5!=LxHalbachse!*p!+xHalbachse!*q!
      54. p6!=LyHalbachse!*p!+yHalbachse!*q!
      55. phi!=0
      56. r!=Superformel(phi!,p1!,p2!,p3!,p4!,p5!,p6!)
      57. To_xy(r!,phi!)
      58. 'cls 0:locate 1,1:print " ";n&;" - ";&Loop;" "
      59. MCLS %maxx, %maxy, 0'$FFFFFF
      60. StartPaint -1
      61. Usepen 0,12,rgb(0,255,0)
      62. moveto xh&+s!*x!,yh&-s!*y!
      63. whileloop 0,360,3 :phi!=f!*&Loop
      64. r!=Superformel(phi!,p1!,p2!,p3!,p4!,p5!,p6!)
      65. To_xy(r!,phi!):Lineto xh&+s!*x!,yh&-s!*y!
      66. endwhile
      67. EndPaint
      68. MCopyBMP 0, 0 - %maxx,%maxy > 0, 0; 0
      69. ' waitinput 42
      70. Endwhile
      71. LSymmetrie!=Symmetrie!
      72. LForm1!=Form1!
      73. LForm2!=Form2!
      74. LForm3!=Form3!
      75. LxHalbachse!=xHalbachse!
      76. LyHalbachse!=yHalbachse!
      77. waitinput 1000
      78. 'cls 0
      79. Endwhile
      80. beep
      81. n&=0
      82. goto "Nochmal"
      Alles anzeigen
    • Abt. Zeitbedarf für Message-abholendes Waitinput stark reduzieren
      ================================================
      Jens-Arne Reumschüssel fand dazu kürzlich eine Lösung, die ohne API-Fummelei auskommt und eine deutliche Beschleunigung sowohl im Interpreter als auch Compiler bringt. Dazu im Anhang ein kleiner Benchmark.
      Gruss

      Quellcode

      1. WindowTitle "Messageabholendes Waitinput beschleunigt:"+\
      2. " Lösung von Jens-Arne Reumschüssel testen"
      3. '(CL) CopyLEFT 2019-01 by P.Specht, Vienna/AT/EU
      4. CLS:Randomize:font 2
      5. declare n&,tm&,i&,x&,y&,txt$,ungueltig&
      6. $IFNDEF COMPILER
      7. txt$="INTERPRETER"
      8. n&=2500
      9. $ELSE
      10. txt$="COMPILER"
      11. n&=4000
      12. $ENDIF
      13. AppendMenuBar 100," "+txt$+" zählt bis "+str$(n&)+\
      14. ". ESC-Taste soll erkannt werden und zerstört den laufenden Test!"
      15. print "\n OHNE Beschleunigung:",:x&=%pos:y&=%csrlin
      16. waitinput 3:sound 200,20:ungueltig&=0
      17. tm&=&GetTickCount
      18. Whileloop n&:locate 20,20:print &Loop;" ";
      19. i&=&Loop
      20. waitinput 3
      21. :if %Key="27":ungueltig&=1:break:endif
      22. Endwhile
      23. tm&=&GetTickCount-tm&
      24. locate y&,x&
      25. ifnot ungueltig&: print tm&,"ms"
      26. else :print "<abgebrochen>":clear ungueltig&
      27. Endif
      28. print "\n NUR Fastmode:",:x&=%pos:y&=%csrlin
      29. waitinput 3:sound 200,20:ungueltig&=0
      30. tm&=&GetTickCount
      31. set("Fastmode",1)
      32. Whileloop n&:locate 20,20:print &Loop;" ";
      33. waitinput 3
      34. :if %Key="27":ungueltig&=1:break:endif
      35. Endwhile
      36. set("Fastmode",0)
      37. tm&=&GetTickCount-tm&
      38. locate y&,x&
      39. ifnot ungueltig&: print tm&,"ms"
      40. else :print "<abgebrochen>":clear ungueltig&
      41. Endif
      42. print "\n NUR MIT rnd()-Chance:",:x&=%pos:y&=%csrlin
      43. waitinput 3::sound 200,20:ungueltig&=0
      44. tm&=&GetTickCount
      45. Whileloop n&:locate 20,20:print &Loop;" ";
      46. if rnd()>0.95
      47. waitinput 3
      48. :if %Key="27":ungueltig&=1:break:endif
      49. endif
      50. Endwhile
      51. tm&=&GetTickCount-tm&
      52. locate y&,x&
      53. ifnot ungueltig&: print tm&,"ms"
      54. else :print "<abgebrochen>":clear ungueltig&
      55. Endif
      56. print "\n LÖSUNG von Jens-Arne R.: Fastmode mit %PeekMessage:",:x&=%pos:y&=%csrlin
      57. waitinput 3:sound 200,20:ungueltig&=0
      58. tm&=&GetTickCount
      59. set("Fastmode",1)
      60. Whileloop n&:locate 20,20:print &Loop;" ";
      61. if %PeekMessage
      62. waitinput 3
      63. :if %Key="27":ungueltig&=1:break:endif
      64. Endif
      65. Endwhile
      66. set("Fastmode",0)
      67. tm&=&GetTickCount-tm&
      68. locate y&,x&
      69. ifnot ungueltig&: print tm&,"ms"
      70. else :print "<abgebrochen>":clear ungueltig&
      71. Endif
      72. print "\n OHNE JEDE ABFRAGE:",:x&=%pos:y&=%csrlin
      73. waitinput 3:sound 200,20:ungueltig&=0
      74. tm&=&GetTickCount
      75. Whileloop n&:locate 20,20:print &Loop;" ";
      76. :
      77. Endwhile
      78. tm&=&GetTickCount-tm&
      79. locate y&,x&
      80. ifnot ungueltig&: print tm&,"ms"
      81. else :print "<abgebrochen>":clear ungueltig&
      82. Endif
      83. hold:
      84. sound 2000,60
      85. Waitinput 7000:casenot %wmTimer:goto "hold"
      86. END
      Alles anzeigen

      Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von p. specht () aus folgendem Grund: Tastenpreller

    • Abt. Wie schnell bewegen sich Programmierer?
      ==================================
      Die tägliche Erddrehung verleiht einem Punkt am Äquator eine Geschwindigkeit von etwa 464 m/s = 1670 km/h,
      einem sitzenden Münchner auf 48.1351° Nördl. Breite immer noch 1115 km/h.

      Bezogen auf die jährliche Umkreisung der Sonne hat die Erde eine Geschwindigkeit von fast 30 Kilometern pro Sekunde,
      das sind rund 107.600 km/h. Das Sonnenesysstem selbst ist etwa 25.000 Lichtjahre vom Zentrum der Milchstraße entfernt und braucht für einen Umlauf grob 240 Millionen Jahre. Daraus folgt, daß sich das Sonnensystem mit rund 220 Kilometern pro Sekunde, das sind 782.000 km/h, in der Galaxie um das Zentrum bewegt.

      Die aus Messungen gegenüber der Hintergrundstrahlung des Universums abgeleitete Summe der verschiedenen Geschwindigkeitskomponenten unseres Sonnensystems beträgt etwa 370 Kilometer pro Sekunde bzw. 1.332.000 km/h.
      Die Milchstraße und ihre benachbarten Galaxien bilden nämlich die so genannte Lokale Gruppe, die sich auf das Sternbild Jungfrau (den Virgo-Haufen) zubewegt. Die Geschwindigkeit dieses Galaxienhaufens wurde zu etwa 630 Kilometer pro Sekunde = 2.268.000 km/h errechnet.

      Frage: Sind das nicht bereits relativistische Geschwindigkeiten?

      Kontrollrechnung :
      Lichgeschwindigkeit 299792,458 km/s = 17.987.547,48 km/min = 1.079.252.849 km/h

      2.268.000 km/h / 1.079.252.848,8 km/h = 0.002101454
      Antwort: Programmierer bewegen sich mit 0.21 % der Lichtgeschwindigkeit.

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

    • Fortsetzung: ... und das gilt auch für die ggw. 28.504 angemeldeten Mitglieder von Paules PC-Forum, + 1 Info-Bot, minus einige Doubletten, Karteileichen und tatsächlich Verstorbene. Mit anderen Worten: Hier bewegen sich rund 28.400 Mitglieder mit 0.21 % der Lichtgeschwindigkeit weiter! :P
    • Abt. Paralellogramm-Gleichung
      ====================
      Die Paralellogramm-Gleichung macht eine Aussage über die Quadrate der beiden Parallelogrammseiten im Verhältnis zu den Quadraten über der beiden Diagonalen dieses Parallelogramms (In der Schule war mir das offenbar vollkommen entgangen, deshalb hat es mich heute so erstaunt!).

      In Vektorform lautet diese Gleichung: ||a+b||^2 + ||a-b||^2 = 2*(||a||^2 + ||b||^2),
      wobei ||..|| ´Länge von x´ bzw. Abstand bedeutet (Mathematiker nennen das ´Norm´).

      In Komponentenschreibweise - für Computer ohne Vektor-Mathematikpaket - kann man das so schreiben:
      (ax+bx)^2+(ay+by)^2 + (ax-bx)^2+(ay-by)^2 = 2 * (ax^2+ay^2 + bx^2+by^2)

      bzw. in XProfan:
      sqr(ax+bx)+sqr(ay+by) + sqr(ax-bx)+sqr(ay-by) = 2 * (sqr(ax)+sqr(ay) + sqr(bx)+sqr(by))

      Probieren wir doch mal mit verschiedenen Werten, ob das stimmt:

      Quellcode

      1. WindowTitle "Parallelogrammgleichung überprüfen"
      2. CLS:font 2:randomize
      3. AppendMenuBar 100," Zufallswert 1 "+\
      4. "Zufallswert 2 Abs. u. Relativer Fehler"
      5. Declare ax!,ay!,bx!,by! 'Zufallwerte in weitem Bereich
      6. Declare z1!,z2! 'Linke und rechte Gleichungsseite
      7. Declare z3! 'Relativer Fehler, Alarm falls > 10^-15
      8. Nochmal:
      9. ax!=(1-2*rnd(2))*rnd()*10^(rnd(200)-100)
      10. ay!=(1-2*rnd(2))*rnd()*10^(rnd(200)-100)
      11. bx!=(1-2*rnd(2))*rnd()*10^(rnd(200)-100)
      12. by!=(1-2*rnd(2))*rnd()*10^(rnd(200)-100)
      13. z1!= sqr(ax!+bx!)+sqr(ay!+by!) + sqr(ax!-bx!)+sqr(ay!-by!)
      14. z2!= 2*(sqr(ax!)+sqr(ay!) + sqr(bx!)+sqr(by!))
      15. print tab(2);format$("%g",z1!);tab(26);format$("%g",z2!),
      16. print tab(50);format$("%g",z1!-z2!)
      17. if (z1!-z2!)<>0
      18. z3!=abs((z1!-z2!)/z1!)
      19. print tab(39);"Rel.Error: ";format$("%g",z3!)
      20. waitinput 1200
      21. if z3!>val("1e-15")
      22. sound 2000,200
      23. Print "\n F E H L E R A L A R M bei folgenden Komponenten:"
      24. print ax!
      25. print ay!
      26. print bx!
      27. print by!
      28. waitinput
      29. waitinput
      30. endif
      31. endif
      32. 'waitinput 10'000
      33. goto "Nochmal"
      Alles anzeigen
      Bei mir sieht es so aus als ob es stimmt - Beweis ist das im strengen Sinne natürlich keiner.
      Gruss

      P.S.: Wer die einleuchtende geometrische Deutung dieser Sache wissen will, kann sich in diesem informativen Youtube-Video von Prof. Weitz schlau machen.

      PPS.: Den echten Beweis gibt´s nachstehend im Spoiler!
      Spoiler anzeigen

      Die Parallelogrammgleichung:

      (ax+bx)^2+(ay+by)^2 + (ax-bx)^2+(ay-by)^2 = 2 * (ax^2+ay^2 + bx^2+by^2)

      ergibt mit ausgerechneten Quadraten:

      (ax^2+bx^2+2*ax*bx) +(ay^2+by^2+2*ay*by) + (ax^2+bx^2-2*ax*bx)+(ay^2+by^2-2*ay*by) =
      = 2 * (ax^2+ay^2 + bx^2+by^2)

      bzw. ohne die unnötigen Klammern:

      ax^2+bx^2+2*ax*bx + ay^2+by^2+2*ay*by + ax^2+bx^2-2*ax*bx + ay^2+by^2-2*ay*by =
      = 2 * ax^2+2 * ay^2 + 2 * bx^2+2 * by^2

      und etwas georndeter:

      ax^2+ ax^2 + ay^2+ ay^2 + bx^2+bx^2 + by^2+by^2 + 2*ax*bx +2*ay*by -2*ax*bx -2*ay*by =
      = 2 * ax^2+2 * ay^2 + 2 * bx^2+2 * by^2 ,

      somit:

      2*ax^2+2*ay^2+2*bx^2+2*by^2 + 2*ax*bx +2*ay*by -2*ax*bx -2*ay*by =
      2*ax^2+2*ay^2+2*bx^2+2*by^2 ,

      was soviel bedeutet wie

      2*ax*bx-2*ax*bx + 2*ay*by -2*ay*by = 0,

      daher 0 = 0, und das stimmt ja wohl auch!

      q.e.d.
      ------

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

    • Abt. Speicherverwaltung dreidimensionaler Matrizen
      =====================================
      XProfan (V. 11.2a) funktioniert mit der "Am-Stück"-Speicherverwaltung nur für statisch deklarierte Listen und für Matrizen mit von vorneherein definierter Größe. Dann aber lässt sich sicher zugreifen, wenn man die Indexverwaltung (und den Speicherbedarf für ein Einzelelement) richtig einsetzt. Dazu die nachstehende kleine Studie.
      Gruss

      Quellcode

      1. WindowTitle "Studie: Speicher- und Zugriffsorganisation"+\
      2. "auf dreidimensionale Matrizen (a.k.a. Tensoren)"
      3. Cls:randomize
      4. 'Speicherbedarf eines Einzelwertes (XProfan):
      5. var SB&=8 'Double precision Floatingpoint: 8 Byte
      6. 'Stellenzahlen
      7. var xm&=2
      8. var ym&=2
      9. var zm&=2
      10. declare x&,y&,z&, M![xm&-1,ym&-1,zm&-1]
      11. M![]=&index 'rnd()
      12. print
      13. print "Händisch für M[x,y,z]:"
      14. print M![0,0,0],M![0,0,1]," ",M![0,1,0],M![0,1,1]
      15. print M![1,0,0],M![1,0,1]," ",M![1,1,0],M![1,1,1]
      16. print
      17. print "Vereinfacher x-Komponentenaufruf:"
      18. print M![0]
      19. print M![1]
      20. print
      21. print "Linear programmierter Aufruf:"
      22. Whileloop 0,zm&-1:z&=&Loop
      23. Whileloop 0,ym&-1:y&=&Loop
      24. whileloop 0,xm&-1:x&=&Loop
      25. print float( addr(M![0]),SB&*(x& * ym&*zm& + y& *zm& + z&)),
      26. EndWhile:print " ";
      27. Endwhile:print
      28. Endwhile:print
      29. waitinput
      Alles anzeigen
    • Abt. Ältere Profan-Sourcecodes
      ====================
      benötigen die Include-Datei ProfAlt.Inc und können dann klaglos auch mit neueren XProfan-Versionen ausgeführt werden. Voraussetzung ist eine vorangestellte gültige Einbindung mittels $I ProfAlt.inc , wobei es sich u.U. empfiehlt die Datei in das Arbeitsverzeichnis mitzukopieren, um sie in Projekt-Zips stets mit dabei zu haben.

      Für eigene Zwecke habe ich mal die Häufigkeit der alten Befehle in meiner Sammlung älterer Programmsourcen analysiert, und die ProfAlt.inc so getuned, daß die häufigsten Befehle am raschesten gefunden werden. Je nach Programm ist eine gewissen Beschleunigung festzustellen - oder auch nicht. Schaden tut das Verfahren jedenfalls nicht. Anbei die ´tiefergelegte´ Version, ProfAlt_v2.Inc
      Gruss

      Quellcode

      1. :PROC ADD :PARAMETERS A!,B!:RETURN A!+B!:ENDPROC
      2. :PROC MUL :PARAMETERS A!,B!:RETURN A!*B!:ENDPROC
      3. :PROC SUB :PARAMETERS A!,B!:RETURN A!-B!:ENDPROC
      4. :PROC EQU :PARAMETERS A!,B!:RETURN A!=B!:ENDPROC
      5. :PROC NEQ :PARAMETERS A!,B!:RETURN A!<>B!:ENDPROC
      6. :PROC LT :PARAMETERS A!,B!:RETURN A!<B!:ENDPROC
      7. :PROC GT :PARAMETERS A!,B!:RETURN A!>B!:ENDPROC
      8. :PROC DIV :PARAMETERS A!,B!:RETURN A!/B!:ENDPROC
      9. :PROC POW :PARAMETERS A!,B!:RETURN A!^B!:ENDPROC
      10. :PROC MOD :PARAMETERS A!,B!:RETURN A! MOD B!:ENDPROC
      11. :PROC DIV& :PARAMETERS A!,B!:RETURN A!\B!:ENDPROC
      12. :PROC ADD$ :PARAMETERS A$,B$:RETURN A$+B$:ENDPROC
      13. :PROC EQU$ :PARAMETERS A$,B$:RETURN A$=B$:ENDPROC
      14. :PROC NEQ$ :PARAMETERS A$,B$:RETURN A$<>B$:ENDPROC
      15. :PROC LT$ :PARAMETERS A$,B$:RETURN A$<B$:ENDPROC
      16. :PROC GT$ :PARAMETERS A$,B$:RETURN A$>B$:ENDPROC
      17. '= Include-Datei für Quellcodes früher Profan-Versionen, die
      18. ' noch keine Operatoren nutzen. Einbinden mit $I ProfAlt_v2.inc
      Alles anzeigen
    • Abt. Torte teilen für Fortgeschrittene
      =======================
      Bei einem Mathe-Quiz, das eine Nummer zu groß für mich war, tauchte die Frage auf, in wieviele Teilstücke ein Kreis maximal zerfällt, wenn man N Randpunkte beliebig irgendwo am Kreisumfang platziert und von jedem Randpunkt zu jedem anderen Randpunkt gerade Schnitte macht. Anm.: Im Gegensatz zu einem bekannten Rätsel, bei dem die Anzahl der Schnitte vorgegeben ist - und das wir in dieser Reihe schon behandelt haben - geht es hier um vorgegebene Eckpunkte, also ggf. auch um eine ungerade Anzahl von Eckpunkten!

      Klar ist, daß der Kreis dann N*(N-1)/2 Schnitte enthält, die alle so geführt werden müssen, daß dabei immer nur jeweils 2 Schnitte einander in einem Kreuzungspunkt treffen dürfen - die Kreuzungen also alle nicht mehr als 4 Äste haben. In meiner naiven Art habe ich also Kreise und Eckpunkte zu zeichnen begonnen und die Flächen abgezählt. Das Verfahren empfiehlt sich allerdings nur für geringe Ecken-Anzahlen. Schon ab 7 oder 8 Ecken ergibt sich, daß Punkte versetzt werden müssen, weil sich rasch mehr als 2 Schnitte in einem Kreuzungspunkt treffen - d.h.: Alles nochmals zeichnen...

      Während ich also bastelte, gab der Sieger folgende Formel an: Der Kreis zerfällt bei geeigneter Wahl von N Punkten am Kreisumfang in 1/24*(N^4 - 6*N^3 + 23*N^2 - 18*N + 24) Flächenstücke.

      Was soll ich sagen: Scheint zu stimmen!
      Gruss

      P.S.: Meine amateurhaften Versuche führten zu dem nachfolgenden, letztlich vollkommen sinnlosen Programm. Sollt auch was davon haben, geteiltes Leid ist ja halbes Leid ...

      Quellcode

      1. WindowTitle "MISSGLÜCKTES Stern-Netz möglichst mit 4-Ast-Kreuzungen"
      2. randomize:var N&= 4+rnd(14)
      3. WindowStyle 24:Window 0,0 - %maxx,%maxy
      4. declare xh&,yh&:xh&=width(%hwnd)\2:yh&=height(%hwnd)\2
      5. declare x!,y!,w!,r!,f!,d&,i&,j&
      6. declare px![n&-1],py![n&-1]
      7. f!=pi()/180:d&=3
      8. r!=300
      9. usepen 0,3,rgb(255,0,0)
      10. whileloop 0,n&-1
      11. w!=&Loop*f!*360/n&
      12. px![&Loop]=(1+(n&>5)*rnd()/Sqrt(n&))*r!*cos(w!)
      13. py![&Loop]=(1+(n&>5)*rnd()/Sqrt(n&))*r!*sin(w!)
      14. ellipse xh&+px![&Loop]-d&,(yh&-py![&Loop]-d&)\
      15. - xh&+px![&Loop]+d&, yh&-py![&Loop]+d&
      16. endwhile
      17. locate 4,40:print "N = ";n&
      18. usepen 0,1,rgb(0,0,0)
      19. whileloop 0,n&-1:i&=&Loop
      20. whileloop i&+1,n&-1:j&=&Loop
      21. case abs(i&-j&)=1:continue
      22. case (i&=0) and (j&=N&-1):continue
      23. Line xh&+px![i&],(yh&-py![i&]) - xh&+px![j&],yh&-py![j&]
      24. endwhile
      25. endwhile
      26. waitinput
      27. waitinput 'Shift+Druck für Screencopy
      Alles anzeigen
    • Abt. X-Y-ungelöst: Weitere Quizfrage (Fortsetzung von oben)
      =======================
      Noch nicht frustriert genug, habe ich auch bei der nächsten Quizfrage versucht, mitzukommen: Die Frage lauutete nun, wieviele KREUZUNGSPUNKTE im Szenario des vorigen Beitrags auftreten. Also habe ich zuerst wieder mit Aufzeichnen (bzw. ausdrucken) und zählen begonnen. Dabei wurde klar, daß die Randverbindungen und Direktverbindungen zwischen benachbarten Randpunkten keine Kreuzungen enthalten können. Wir betrachten also hier nur die N * (N-3)/2 inneren verbindenden Schnitte.

      Weitere Überlegungen zeigten, daß man Doppelzählungen vermeiden und parallel führende Schnitte durch einfache Größer-Kleiner-Vergleiche erkennen kann. Das ganze floss dann in nachstehendes Progrämmchen, das statt mir das Durchzählen übernimmt. So ab 80 Eckpunkten wird die Sache allerdings sehr zeitaufwaendig.

      Ich bin überzeugt, daß es auch dafür eine Formel gibt - nur bin ich zu doof um sie zu finden, und warte daher wieder auf einen SiegerInnen-Typ unter der geneigten Leserschaft.
      Gruss

      Quellcode

      1. WindowTitle "Vier-Ast-Kreuzungen eines vollständigen N-Sterngraphen"
      2. '(CL) CopyLeft 2019-01 by P.Specht, Vienna/EU
      3. Windowstyle 24:CLS:randomize
      4. declare N&,i&,j&,u&,v&,x&,y&,tm&,z&
      5. declare Mi&[],Mj&[],Mu&[],Mv&[],count&
      6. LUP:
      7. clear N&,i&,j&,u&,v&,Mi&[],Mj&[],Mu&[],Mv&[],count&
      8. font 0
      9. Print "\n\n Gewünschte Zahl der Eckpunkte des Sterngraphen = ";
      10. input N&
      11. tm&=&gettickcount 'Start des Aufsetzens:
      12. whileloop 0,N&-3:i&=&Loop
      13. whileloop i&+2,N&-1-(i&=0):j&=&Loop
      14. ' print " ";i&,j&," ",
      15. Mi&[sizeof(Mi&[])]=i&
      16. Mj&[sizeof(Mj&[])]=j&
      17. if i&>0
      18. Mu&[sizeof(Mu&[])]=i&
      19. Mv&[sizeof(Mv&[])]=j&
      20. ' print i&,j&,
      21. endif
      22. ' print
      23. endwhile
      24. Endwhile
      25. print "\n Prüfung der",int(n&*(n&-1)/2),"Direktverbindungen läuft: ";
      26. whileloop 0,sizeof(Mi&[])-2:x&=&Loop:case rnd()<(n&/200):print "~";
      27. whileloop 0,sizeof(Mu&[])-1:y&=&Loop
      28. if Mi&[x&]<Mu&[y&]
      29. if Mu&[y&]<Mj&[x&]
      30. if Mj&[x&]<Mv&[y&]
      31. inc count&
      32. endif
      33. endif
      34. endif
      35. endwhile
      36. endwhile
      37. tm&=&gettickcount-tm&
      38. font 2
      39. print "\n Ein vollständiger Sterngraph mit",N&,"Ecken hat",
      40. print count&,"Kreuzungen."
      41. Sound 50,100:font 0:print "\n Rechendauer",
      42. if tm&<1000:print tm&,"ms.":elseif tm&<60000:print tm&/1000,"s"
      43. else:print tm&/60000,"min":endif
      44. if %csrlin>31:waitinput:cls:endif
      45. goto "LUP"
      Alles anzeigen
    • P.S. Ein Beispiel zu oben:
      -----------------------------
      Ein vollständiger Sterngraph mit N = 100 Ecken hat 4.950 Direktverbindungen bzw. 4850 Innenverbindungen, die K = 3.921.225 vierÄstige Kreuzungen aufweisen. Das obige Programm brauchte zu dieser Durchzählung 14.66 min.
    • Nachtrag zu oben:
      Abt. Anzahl der Flächenstücke einer N-Eckpunkte-Kreisteilung
      ==============================================

      Quellcode

      1. cls:set("decimals",17):declare n&
      2. whileloop 20:n&=&Loop
      3. print n&, 1/24*(n&^4-6*n&^3+23*n&^2-18*n&+24)
      4. waitinput
      5. endwhile
      6. beep:Waitinput
      7. end
    • Abt. Frustrationsformeln
      ==================
      1) Die in Beitrag #73 angegebene Formel für Flächenstücke, die bei Kreisteilung zwischen N Randpunkten entstehen, verschafft Mathematikern Frustrationserlebnisse - geht die Reihe doch: 1, 2, 4, 8, 16, ... Jedem Normalo fällt sofort eine Fortsetzung ein: 32. Die Formel liefert aber korrekterweise 31. Ätsch!

      2) Der Größe gemeinsamte Teiler GgT von n^17+9 und (n+1)^17+9) ist stets 1 für alle n. So dachte man lange, bis ein findiger Zeitgenosse die Zahl n = 8424432925592889329288197322308900672459420460792433 fand. Ab da kommen dann alle möglichen GgT-Ergebnisse vor. Ätsch!

      3) Die Formel f(n)=n^2+n+41, so dachten viele Mathematiker vor Leonhard Euler, erzeugt lauter Primzahlen.
      Euler bewies dann: Nö, doch nicht, nur bis 39:
      Zwar gilt für f(1)=43 prim!, f(2)=47 prim!, ..., f(30)=971 alle prim! aaaaaaaber:
      n=40 liefert f(40)=1681 = 41*41 daher nicht prim, f(41)=1763 = 41*43 <> prim! ... Ätsch!

      4) Zahlreiche mathematische Vermutungen lassen sich mit Computerhilfe für jede einzelne Zahl bis in den Milliardenbereich nachrechnen - bisher fand man nicht eine einzige Abweichung. Dennoch gilt so etwas nicht als mathematischer Beweis - aus Gründen, die Beispiel 2 besonders deutlich zeigt. Erstaunlich, daß es doch immer wieder neue, hieb- und stichfeste mathematische Schlußfolgerungen und Axiome gibt - mit viel Grips halt. Im Kopf addieren können reicht da nicht aus...

      Gruss
    • Abt. EaR 15 ´Die Superzahl´
      =====================
      Gesucht ist eine ganze Zahl, die aus den Ziffern 1 bis 9 besteht und ...
      deren 1. Stelle durch 1 ohne Rest teilbar ist (trivial),
      deren durch die ersten beiden Stellen (von links gerechnet) gebildete Zahl durch 2 ohne Rest teilbar ist,
      deren durch die ersten 3 Stellen (von links gerechnet) gebildete Zahl durch 3 ohne Rest teilbar ist,
      ... usw., bis:
      deren durch alle 9 Stellen gebildete Zahl durch 9 ohne Rest teilbar ist.

      Programmierte Lösungen sind zulässig, es geht aber auch anders.
      Viel Spaß!

      Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von p. specht () aus folgendem Grund: Verwirrender Ausdruck, sorry

    • Lösung zu EAR 15
      -----------------
      Entweder mit Computer-Power:

      Quellcode

      1. Windowtitle "Superzahl 1-9 bzw. 1-9 & 0 ermittlen"
      2. WindowStyle 24:CLS:font 2
      3. declare x0&,x1&,x2&,x3&,x4&,x5&,x6&,x7&,x8&,x9&,z!
      4. Whileloop 1,9:x0&=&Loop
      5. Whileloop 0,9:x1&=&Loop
      6. case x1&=x0&:continue
      7. z!=10*x0&+x1&
      8. casenot z!=2*int(z!/2):continue
      9. Whileloop 1,9:x2&=&Loop
      10. case x2&=x1&:continue
      11. case x2&=x0&:continue
      12. z!=100*x0&+10*x1&+x2&
      13. casenot z!=3*int(z!/3):continue
      14. Whileloop 0,9:x3&=&Loop
      15. case x3&=x2&:continue
      16. case x3&=x1&:continue
      17. case x3&=x0&:continue
      18. z!=1000*x0&+100*x1&+10*x2&+x3&
      19. casenot z!=4*int(z!/4):continue
      20. Whileloop 1,9:x4&=&Loop
      21. case x4&=x3&:continue
      22. case x4&=x2&:continue
      23. case x4&=x1&:continue
      24. case x4&=x0&:continue
      25. casenot (x4&=0) or (x4&=5):continue
      26. Whileloop 0,9:x5&=&Loop
      27. case x5&=x4&:continue
      28. case x5&=x3&:continue
      29. case x5&=x2&:continue
      30. case x5&=x1&:continue
      31. case x5&=x0&:continue
      32. z!=100000*x0&+10000*x1&+1000*x2&+100*x3&+10*x4&+x5&
      33. casenot z!=6*int(z!/6):continue
      34. Whileloop 0,9:x6&=&Loop
      35. case x6&=x5&:continue
      36. case x6&=x4&:continue
      37. case x6&=x3&:continue
      38. case x6&=x2&:continue
      39. case x6&=x1&:continue
      40. case x6&=x0&:continue
      41. z!=1000000*x0&+100000*x1&+10000*x2&+\
      42. 1000*x3&+100*x4&+10*x5&+x6&
      43. casenot z!=7*int(z!/7):continue
      44. Whileloop 0,9:x7&=&Loop
      45. case x7&=x6&:continue
      46. case x7&=x5&:continue
      47. case x7&=x4&:continue
      48. case x7&=x3&:continue
      49. case x7&=x2&:continue
      50. case x7&=x1&:continue
      51. case x7&=x0&:continue
      52. z!=10000000*x0&+1000000*x1&+100000*x2&+\
      53. 10000*x3&+1000*x4&+100*x5&+10*x6&+x7&
      54. casenot z!=8*int(z!/8):continue
      55. Whileloop 1,9:x8&=&Loop
      56. case x8&=x7&:continue
      57. case x8&=x6&:continue
      58. case x8&=x5&:continue
      59. case x8&=x4&:continue
      60. case x8&=x3&:continue
      61. case x8&=x2&:continue
      62. case x8&=x1&:continue
      63. case x8&=x0&:continue
      64. z!=100000000*x0&+10000000*x1&+1000000*x2&+\
      65. 100000*x3&+10000*x4&+1000*x5&+100*x6&+10*x7&+x8&
      66. 'print z!,9*int(z!/9)
      67. casenot z!=9*int(z!/9):continue
      68. x9&=45-x0&-x1&-x2&-x3&-x4&-x5&-x6&-x7&-x8&
      69. casenot x9&=0:continue
      70. print "\n\n\n ";\
      71. x0&,x1&,x2&,x3&,x4&,x5&,x6&,x7&,x8&,"(";x9&;")"
      72. Endwhile
      73. Endwhile
      74. Endwhile
      75. Endwhile
      76. Endwhile
      77. Endwhile
      78. Endwhile
      79. Endwhile
      80. Endwhile
      81. print "\n\n\n OK"
      82. beep:waitinput
      83. End
      Alles anzeigen
      oder mit Grips :idee: : Youtube-Link (dt.)
    • Abt. Float-Gefahren
      ===============
      XProfans 64-bit lange "Double precision floating point"-Variablen, etwa x!, bergen bekanntlich Gefahren in sich, die man als Anwender kennen sollte. Folgende Operationen liefern nur Ergebnisse begrenzter Genauigkeit, und verlässt man dabei übliche Zahlenbereiche, kommt es nicht nur zu Rundungsfehlern wie sie jedermann/jederfrau auch beim normalen Dividieren und Subtrahieren passieren können, sondern es kommt noch die Tatsache hinzu, daß es Zahlen gibt, die im Dezimalsystem zwar exakt darstellenbar sind, binär aber nur näherungsweise.

      1 - 0.9 ist exakt 0.1, der Computer macht daraus 0.099999999999999998
      ... und schon gehen Vergleichsabfragen wie größer oder größer gleich schief.

      1 - dieser obige Wert sollte also 0.9 liefern: 1 - 0.099999999999999998 lierfert aber 0.9000000000000002

      1/3 liefert nicht 0.33333333333333333, sondern 0.33333333333333331

      2/3 liefert nicht 0.66666666666666667, sondern 0.66666666666666663

      1 - 1/3 sollte auch 2/3 ergeben, liefert aber 0.66666666666666674

      usw. usw.

      Krass wird die Sache, wenn man in die Randbereiche binärer Darstellungsmöglichkeiten gerät. Hier beginnt der Rechner die Zahlen immer gröber und gröber zu behandeln und phanatsiert schon mal Einer-, Zehner- und Hunderterstellen hinzu. Fachleute nennen das den "De-Normalisierungsbereich". Da leidet allerdings nur die Genauigkeit. Die absoluten Katastrophen aber treten ein, wenn man folgende Werte über- bzw. unterschreitet:

      Werte größer als
      +\- 8.98846567431158E307 = 2^1024, rückkonvertiert +/- 898846567431157954E+298
      Folge: Fataler Fehler mit Programmabbruch

      Werte kleiner als
      +\- 4.9406564584127E-324 = 2^-1074, rückkonvertiert +\- 494065645841246544E-341
      Unerklärliche Not-a-number-Nullwerte (NAN), die bei Folgeoperationen zu völlig unerklärlichem Verhalten führen können, bzw. bei Divisionen zu nicht abfangbaren Abstürzen.

      Gruss

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