ALGORITHMEN - Teil XIV: Jetzt noch irrer!

    Information: Wir verlosen 3 x "Das Buch für Ideensucher"! Spiel mit!

    • Abt. Aus einem Mathe-Wettbewerb
      ===========================
      stammt folgende Frage: Wie hoch ist die Wahrscheinlichkeit, daß ein zufällig gewähltes Dreieck, dessen Ecken auf dem Einheitskreis mit Radius 1 liegen, den Keismittelpunkt enthält?

      Also ich wußte mir nicht anders zu helfen, als diese Situatioin zu simulieren. Hellere Köpfe (wie z.B. der Ersteller dieses Videos) lösen das durch geometrische Anschauung im Kopf - sogar für den dreidimensionalen Fall. Seufz ...
      Gruss

      Quellcode

      1. WindowTitle "Problem aus einem Mathe-Wettbewerb"
      2. 'Q: https://www.youtube.com/watch?v=OkmNXy7er84
      3. 'Gewählt: MonteCarlo-Methode (Stichproben ziehen)
      4. WindowStyle 24:CLS:font 2:randomize:set("Decimals",17):set("Numwidth",23)
      5. print "\n Wie hoch ist die Wahrscheinnlichkeit, daß ein Zufällig gewähltes Dreieck,"
      6. print "\n dessen Ecken am Einheitskreis liegen, den Keismittelpunkt enthält?\n"
      7. declare N&,Z&,w2!,w3!,x2!,y2!,x3!,y3!,pi2!,fbc!
      8. pi2!=2*pi()
      9. Whileloop 1000000
      10. inc N&
      11. w2!=pi2!*rnd():x2!=cos(w2!):y2!=sin(w2!)
      12. w3!=pi2!*rnd():x3!=cos(w3!):y3!=sin(w3!)
      13. fBC!=y2!*(x2!-x3!)+x2!*(y3!-y2!)
      14. if ((y2!*fBC!)>0) & ((fBC!*(-y3!))>0)
      15. inc Z&
      16. if rnd()<0.0002
      17. locate 7,1
      18. print Z&/N&,
      19. endif
      20. endif
      21. ENDWHILE
      22. cls:print "\n Ergebnis nach 1.000.000 Versuchen: ";Z&/N&,
      23. print "\n Genaues Ergebnis aus geometrischen Überlegungen: ";0.25
      24. beep
      25. Waitinput
      26. End
      Alles anzeigen

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

    • Abt. Etwas für Schuldirektoren :lol:
      ==========================
      Das Nicht-Abschreibenlasser-Problem
      Wie hoch ist die Wahrscheinlichkeit, daß bei im Kreis sitzenden Schülern, die gleichwahrscheinlich alle entweder vom rechten oder linken Nachbarn abschreiben, ausgerechnet VON einem Schüler NICHT abgeschrieben wird?
      Gruss

      P.S.: Mit nackter Simulation, diesmal von Klassen, gelöst ...

      Quellcode

      1. WindowTitle "Das Nicht-Abschreibenlasser-Problem"
      2. 'Q: https://www.youtube.com/watch?v=OkmNXy7er84
      3. 'Gewählt: MonteCarlo-Methode (Stichproben as Klassensamples ziehen)
      4. CLS:font 2:randomize:set("Decimals",17):set("Numwidth",23):declare N&,Z&,S&,A&[]
      5. print "\n Wie hoch ist die Wahrscheinlichkeit, daß bei im Kreis sitzenden Schülern,"
      6. print "\n die gleichwahrscheinlich alle entweder vom rechten oder linken Nachbarn"
      7. print "\n abschreiben, ausgerechnet VON einem Schüler NICHT abgeschrieben wird?\n"
      8. S&=28 'Klassengröße
      9. Whileloop 50000:N&=&Loop 'N. Versuch
      10. clear A&[]:setsize A&[],s&+2
      11. A&[]=1-2*(rnd()<0.5)
      12. A&[0]=A&[s&]
      13. A&[s&+1]=A&[1]
      14. whileloop s&
      15. if (A&[&Loop-1]<0) AND (A&[&Loop+1]>0)
      16. inc Z&
      17. if rnd()<0.0002
      18. locate 9,10
      19. print Z&/N&/s&,
      20. endif
      21. endif
      22. endwhile
      23. ENDWHILE
      24. cls:print "\n Ergebnis nach 50.000 beobachteten Klassen: ";Z&/N&/s&,
      25. print "\n Genaues Ergebnis aus logischen Überlegungen: ";0.25
      26. beep
      27. Waitinput
      28. End
      Alles anzeigen
    • Neu

      Abt. Fibonacci-Zahlen schneller
      =======================
      Die Fibonacci-Zahlen ergeben sich aus der Addition des letzten und des vorletzten Wertes der Folge; Startwerte sind Null und Eins: [ 0 1 1 2 3 5 8 13 21 34 55 89 144 ... ]. Wenn man aber z.B. nach der 1474. Fibonnacci-Zahl fragt, wird die Sache etwas mühsam. Da tauchen Zahlen mit über 300 Stellen auf.

      XProfan kann das zwar Größenordnungsmäßig noch, dennoch verginge ziemlich Zeit, wenn man die Berechnung jedesmal von Null weg starten würde. Da gibt es aber die berühmte Formel von Binet, die nachstehend verwendet wurde. ;-)
      Gruss

      Quellcode

      1. WindowTitle "Die N.te Fibonnacci-Zahl berechnen"
      2. WindowStyle 24:CLS:font 2:declare w!
      3. whileloop -2,1476
      4. w!=N_FIB(&Loop)
      5. print " ";int(&Loop),tab(20);
      6. if w!<0:Print "*** OVERFLOW ERROR! ***"
      7. else: print format$("%g",N_FIB(&Loop))
      8. endif
      9. if %csrlin>33:waitinput 3000*(&Loop<100):cls:endif
      10. endwhile
      11. beep
      12. waitinput
      13. end
      14. proc N_FIB :parameters n&
      15. case n&<1:return 0:case n&=1:return 1:case n&>1474:return -1
      16. var phi!=1.6180339887498949
      17. var wd!=0.44721359549995793
      18. if n& mod 2:return -1*floor((phi!^n&)*-1*wd!)
      19. else :return floor((phi!^n&)*wd!)
      20. endif
      21. endproc
      22. proc floor :parameters x!
      23. ' Gaussklammer-Funktion
      24. case abs(x!)<(10^-35):return 0
      25. case x!>0:return intf(x!)
      26. return (abs(x!-intf(x!)) < 10^-35)-intf(abs(x!-1))
      27. endproc
      28. proc frac :parameters x!
      29. var s!=(x!>0)-(x!<0):x!=abs(x!)
      30. x!=x!-round(x!,0):case x!<0:x!=1+x!
      31. return s!*x!
      32. endproc
      33. proc intf :parameters x!
      34. var s!=(x!>0)-(x!<0)
      35. x!=abs(x!)
      36. x!=x!-frac(x!)
      37. return s!*x!
      38. endproc
      Alles anzeigen
    • Neu

      Abt. Imaginäre Potenz
      =================
      Nein, nichts mit virtuellem Sex. Es geht (mit %i als "Imaginäre Einheit" bei komplexen Zahlen) lediglich um die Frage, wieviel eigentlich %i hoch %i ist. Das erstaunliche Ergebnis: Es handelt sich um eine ganz konkrete, reelle Zahl:
      0.20787957635076193.... - also weit und breit nichts Imaginäres. Wovon man sich auch in diesem Youtube-Beitrag überzeugen kann. Sachen gibt´s ...
      Gruss

      Quellcode

      1. WindowTitle "Imaginäre Einheit %i hoch sich selbst?"
      2. 'Q:https://www.youtube.com/watch?v=9tlHQOKMHGA
      3. WindowStyle 24:CLS:set("decimals",17):font 2
      4. locate 3,3:print "%i^%i = exp(-Pi()/2) = ";exp(-Pi()/2)
      5. clearclip:putclip str$(exp(-Pi()/2))
      6. locate 5,3:print " %i^-%i = 1/exp(-Pi()/2) = ";1/exp(-Pi()/2)
      7. waitinput:End
      8. '%i^%i = exp(ln(%i^%i%)) = exp(%i*ln(%i)).
      9. 'Bekanntlich: exp(phi*%i)=cos(phi)+%i*sin(phi)
      10. 'aber auch: exp(%i*Pi())+1=0 >>>> exp(%i*Pi())=-1
      11. 'Zusammen:
      12. '%e^(%i*%Pi)+1 = 0 >>>> %e^(%i*%Pi)= -1 >>>> %i*%Pi = ln(-1)
      13. '(((Nebenergebnis: %Pi = ln(-1) - %i )))
      14. 'Es ist:
      15. '%i^-2 = -1, %i^-1 = -%i, %i^0 = 1, %i^1 = +%i, %i^2 = -1,
      16. '%i^3 = -%im %i^4 = +1, %i^5 = +%i
      17. 'exp(0) = 1, exp(%i*%Pi*1/2) = %i, exp(%i*%Pi*2/2) = -1, exp(%i*%Pi*3/2) = -%i,
      18. 'exp(%i*%Pi*4/2) = 1, wobei 2*Pi() ident mit 0: exp(%i*%Pi*0/2)=exp(0) = 1
      19. '
      20. 'Somit gilt: exp(%i*%Pi/2) = %i >>>> %i*%Pi/2 = ln(%i)
      21. 'Eingesetzt in unsere Erweiterung: %i^%i = exp(%i*ln(%i))
      22. 'gibt das: %i^%i = exp(%i*%i*%Pi/2) = exp(-1*%Pi/2)
      23. '%i^%i = exp(-1*%Pi/2) = 0.20787957635076193
      Alles anzeigen
    • Neu

      Abt. Neue Rätselecke NR 37: Aus einer Norwegischen Mathe-Olympiade
      ====================================================
      a, b und c seien positive ganze Zahlen größer Null.
      Ein Apfel kostet a $, eine Banane b $, eine Kirsche c $

      Auf einer handschriflichen Rechnung finden wir folgendes:
      b Äpfel + b Bananen + (a + b) Kirschen = 77 $

      Frage: Was kosten 1 Apfel + 2 Bananen + 1 Kirschen
      Gruss :evil3:
    • Neu

      Für Neugierige: Mein brute-Force Lösungsprogramm zu NR 37 (Nicht die offizielle Lösung!)
      Spoiler anzeigen

      Brainfuck-Quellcode

      1. WindowTitle "Neue Rätselecke NR 38"
      2. 'https://www.youtube.com/watch?v=yBW-saaH-PQ
      3. 'Abt. Neue Rätselecke NR 37: Aus der Norwegischen Mathe-Olympiade
      4. '================================================================
      5. 'a, b und c seien positive ganze Zahlen größer Null.
      6. 'Ein Apfel kostet a $, eine Banane b $, eine Kirsche c $
      7. 'Auf einer handschriflichen Rechnung finden wir folgendes:
      8. 'b Äpfel + b Bananen + (a + b) Kirschen = 77 $
      9. 'Frage: Was kosten 1 Apfel + 2 Bananen + 1 Kirsche?
      10. '----------------------------------------------------------
      11. 'Lösungsansatz:
      12. 'b*a + b*b + (a+b)*c = 77
      13. 'b*b + b*a + a*c + b*c = 77
      14. 'b*b + a*(b+c) + b*c = 77
      15. 'b*b + b*c - 77 = -1*a*(b+c)
      16. '(b*(b+c)-77)/(b+c) = -1*a
      17. '-1*(b*(b+c)-77)/(b+c) = a: ganzzahlig?
      18. 'Weiteres Vorgehen: probieren!
      19. CLS:font 1:set("numwidth",4)
      20. appendmenubar 100,"Apfelpreis Bananenpreis Kirschpreis Antwort"
      21. declare a!,b&,c&
      22. whileloop 77:b&=&Loop
      23. whileloop 77:c&=&Loop
      24. a!=-1*(b&*(b&+c&)-77)/(b&+c&)
      25. if (a!>0)
      26. if (a!=int(a!))
      27. print "\n ";int(a!),"$, ",b&,"$, ",c&,"$ Antwort:",int(a!+2*b&+c&),
      28. print "$, Probe: Check Nebenbed.: ";format$("%g", b&*a! + b&*b& + (a!+b&)*c& )
      29. waitinput 1000
      30. endif
      31. endif
      32. endwhile
      33. endwhile
      34. print "\n---\n"
      35. beep
      36. Print " Die Antwort selbst scheint eindeutig!"
      37. waitinput
      38. end
      Alles anzeigen


    • Neu

      Abt. Formelüberprüfung im Einheitsquadrat
      ================================
      Ohne Worte, ausser:
      Gruss

      Quellcode

      1. Windowtitle upper$(\
      2. "Mittlere Distanz zweier gleichverteilter Zufallspunkte im Einheitsquadrat")
      3. WindowStyle 24:CLS:font 2:randomize:set("decimals",17)
      4. declare avg!,x1!,y1!,x2!,y2!,d!,n&,s!
      5. n&=100000
      6. $IFDEF COMPILER:n&=n&*10
      7. $ENDIF
      8. whileloop n&:x1!=rnd():y1!=rnd():x2!=rnd():y2!=rnd()
      9. d!=sqrt(sqr(x2!-x1!)+sqr(y2!-y1!)):s!=s!+d!
      10. if rnd()<0.002:locate 3,1:print " Zwischenergebnis: ";s!/&Loop;" ":endif
      11. endwhile
      12. avg!=s!/n&:locate 2,1:print "\n Ergebnis aus Versuch: ";avg!
      13. Print "\n Ergebnis gem. Formel: ";(2+sqrt(2)+5*ln(1+sqrt(2)))/15
      14. beep:waitinput
      15. end
      Alles anzeigen
    • Neu

      Abt. "Unfaire" Statistik-Formelüberprüfung
      ===============================
      Was ist der Erwartungswert für Gewinne [Euro] bei einem unfairen Münzwurf?
      Die Story: Mein Nachbar wollte mich neulich reinlegen: Er feilte den Rand einer Münze rundherum schräg an und bot mir dann eine "Kopf-oder-Zahl"-Wette an. Die Regel lautete: Es darf so lange weitergeworfen werden, als Kopf kommt. Für Kopf wird dabei jedesmal 1 Euro an den Sieger ausgezahlt. Ich erkannte den Trick leider erst daran, daß ich oft verlor, wenn ich auf die Zahlseite tippte: Kopf kam viel öfter!
      Frage a) Auf welcher Seite wurde abgefeilt?
      Frage b) Falls die Wahrscheinlichkeit für "Zahl" < 50% ist, aber bekannt wäre, z.B. p = 40 %: Welchen Auszahlungs-Erwartungswert hat eine Spielrunde für die Seite, die 'Zahl' wählt?
      Aufgabe c) Überprüfe die Formel: E = x * p/(1-p) = Auszahlung * p(Zahl)/p(Kopf)
      Gruss

      P.S.: Anbei ein Testprogramm zu Aufgabe c)

      Quellcode

      1. WindowTitle "Statistik-Formelüberprüfung"
      2. '========================================
      3. WindowStyle 24:set("decimals",17):randomize
      4. Declare p!,n&,s&,Sum!,w&:Nochma:
      5. CLS
      6. print "\n Wahrscheinlichkeit für Zahl in [%]: ";
      7. input p!:p!=p!/100:case p!=0:p!=0.1:case p!<=0:goto "Nochma"
      8. print "\n Wieviele Spiele auswerten?: N [mind.20] = ";
      9. input n&:case n&=0:n&=100000
      10. case n&<20:goto "Nochma"
      11. Cls
      12. Sum!=0
      13. WhileLoop n&
      14. Repeat
      15. w&=(rnd()<=p!)
      16. inc s&,w&
      17. until w&=0
      18. Sum!=Sum!+s&
      19. s&=0
      20. if rnd()<0.002:locate 2,10:print Sum!/&Loop;" ";:endif
      21. endWhile
      22. Font 2:Cls:print "\n Versuch: ";Sum!/n&;" Eur"
      23. print "\n Formel: ";p!/(1-p!);" Eur":Font 0
      24. beep:waitinput
      25. goto "Nochma"
      Alles anzeigen
      PPS: Welche maximale Manipulation kann durch Anschrägen erzielt werden: Wenig. Mit dicken Münzen müsste es am besten klappen: p = (1- Dicke/Durchmesser)/2 für die Loser-Seite (Ohne Gewähr, ich hab´s nicht ausprobiert :oops: )

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

    • Neu

      Abt. MOUSEOGRAPH - THE LAST SCREENSAVER
      ===================================
      Wenn ich nur aufhören könnte, interessante Algorithmen abzukupfern...
      Gruss

      Quellcode

      1. WindowStyle 24:Window 0,0-%maxx,%maxy:showmax:randomize
      2. 'Q:http://blog.kenperlin.com/?p=5641 <== DEMO ONLY! RECHTE DRITTER!
      3. cls 0:declare x!,y!,w!,p!,q!,xh&,yh& , w1!,w2!,pl!,ql!
      4. xh&=Width(%hwnd)\2:yh&=Height(%hwnd)\2:lauf:
      5. WindowTitle mkstr$(" ",rnd(200))+"MOUSEOGRAPH - KLICKEN SIE WOHIN!"
      6. WaitInput 5000:pl!=p!:ql!=q!:p!=%MouseX/xh&:q!=%MouseY/yh&
      7. if (pl!=p!) and (ql!=q!):p!=rnd(2*xh&)/xh&:q!=rnd(2*yh&)/yh&:endif
      8. cls 0:clear x!,y!,w!:moveto xh&,yh&
      9. usepen 0,2,rgb(128+rnd(128),128+rnd(128),128+rnd(128))
      10. Whileloop 3000+rnd(5000)
      11. x!=x!+cos(w!)/10:y!=y!+sin(w!)/10:lineto xh&+x!*100,yh&-y!*120
      12. w1!=(sqr(x!)*q!)^p!:w2!=(sqr(y!)/q!):case w2!=0:w2!=0.0001
      13. w!=w!+(w1!+w2!^p!)/20
      14. Endwhile:goto "lauf"
      Alles anzeigen
    • Neu

      Abt. Populationsdynamik dynamisch betrachtet
      =============================
      Biologen nutzen manchmal Differenzengleichungen, etwa zur Prognose von Wildtierbeständen und Jäger-Beute-Systemen. Hier eine auf das absolute Minimum abgespeckte Version, die aber bereits alle Effekte zeigt, wie sie auch in großen, realistischen DGL-Systemen vorkommen: Aussterben, sich stabilisieren, abklingende Resonanzen, beständige Oszillationen mit und ohne Einschwingen, multistabile Zustände sowie absolut chaotisches Verhalten: Siehe Progi anbei!
      Gruss

      Quellcode

      1. WindowTitle " POPULATIONSDYNAMIK"
      2. WindowStyle 24:Window 0,0-%maxx,%maxy
      3. declare yh&,xh&,x!,x_next!,f!,Feigenbaum_delta!
      4. yh&=height(%hwnd)*(1-15/100):xh&=width(%hwnd)
      5. repeat:whileloop -400,400:f!=abs(&Loop)/101:x!=0.7
      6. MCLS %maxx,%maxy,$FFFFFF : StartPaint -1
      7. usepen 0,4,&Loop:moveto xh&,yh&:lineto 0,yh&
      8. Whileloop 1,%maxx\25
      9. lineto 25*&Loop,yh&-x!*500:x!=f!*x!*(1-X!)
      10. endwhile
      11. EndPaint : MCopyBMP 0,0 - %maxx,%maxy > 0,0;0
      12. waitinput 12:case %key:end
      13. endwhile
      14. until 0
      Alles anzeigen
    • Neu

      Abt. Statistische Ermittlung von Pi
      ==========================
      Nach Euler beträgt die Wahrscheinlickeit P, daß zwei natürliche Zufallszahlen a, b einen Größten gemeinsamen Teiler > 1 haben, genau P = 6 / Pi^2. Das liefert im Umkehrschluß eine Möglichkeit (wenn auch eine ziemlich mühsame), Diei Kreiszahl Pi zu ermitteln. So geschehen im untenstehenden Programm.
      Gruss

      Quellcode

      1. WindowTitle "Statistische Ermittlung von Pi als Sqrt(6 / P[Coprime(N1,N2)] )"
      2. 'Q: https://www.youtube.com/watch?v=RZBhSi_PwHU
      3. WindowStyle 24:set("decimals",17):CLS:font 0:declare s&,a&,b&,p!
      4. Proc GGTm :parameters a&,b&:Declare h&
      5. :While b&:h&=a& mod b&:a&=b&:b&=h&:EndWhile:return a&
      6. EndProc
      7. whileloop 1000000
      8. a&=rnd(1000000):b&=rnd(1000000)
      9. if ggTm(a&,b&)=1:inc s&
      10. if rnd()<0.002:p!=s&/&Loop
      11. locate 2,2:print format$("#0.### %",p!*100),
      12. case p!>0:print tab(20);sqrt(6/p!);
      13. endif
      14. endif
      15. endwhile
      16. font 2:locate 2,2:print p!,sqrt(6/p!)," "
      17. beep:waitinput:end
      Alles anzeigen
    • Neu

      Abt. Die Kreiszahl Pi aus Primzahlen herleiten
      =================================
      ... will selbst mit den Primzahlen bis 10.000 nicht so recht gelingen: Die zugrundeliegende Reihe konvergiert schlecht, springt oft hin und her und lässt sich auch mit Annealing-Methoden nicht glätten. Letzteres hat vor allem damit zu tun, dass auch die Lücken zwischen den Primzahlen nicht gut vorhersagbar sind ... Mit den ersten paar Millionen Primzahlen mag es besser gelingen, aber da werden wir vor Weihnachten nicht fertig! :nikolaus1:
      Gruss

      Quellcode

      1. WindowTitle "Versuch, Pi aus Primzahlen zu erzeugen"
      2. 'Q: https://www.youtube.com/watch?v=HrRMnzANHHs
      3. 'Ohne Gewähr, schlechte Konvergenz!
      4. var P$="2,3,5,7,11,13,17,19,23,29,31,37,41,43,"+\
      5. "47,53,59,61,67,71,73,79,83,89,97,101,103,107,"+\
      6. "109,113,127,131,137,139,149,151,157,163,167,173,179,181,"+\
      7. "191,193,197,199,211,223,227,229,233,239,241,251,257,263,"+\
      8. "269,271,277,281,283,293,307,311,313,317,331,337,347,349,"+\
      9. "353,359,367,373,379,383,389,397,401,409,419,421,431,433,"+\
      10. "439,443,449,457,461,463,467,479,487,491,499,503,509,521,"+\
      11. "523,541,547,557,563,569,571,577,587,593,599,601,607,613,"+\
      12. "617,619,631,641,643,647,653,659,661,673,677,683,691,701,"+\
      13. "709,719,727,733,739,743,751,757,761,769,773,787,797,809,"+\
      14. "811,821,823,827,829,839,853,857,859,863,877,881,883,887,"+\
      15. "907,911,919,929,937,941,947,953,967,971,977,983,991,997,"+\
      16. "1009,1013,1019,1021,1031,1033,1039,1049,1051,1061,1063,1069,1087,1091,"+\
      17. "1093,1097,1103,1109,1117,1123,1129,1151,1153,1163,1171,1181,1187,1193,"+\
      18. "1201,1213,1217,1223,1229,1231,1237,1249,1259,1277,1279,1283,1289,1291,"+\
      19. "1297,1301,1303,1307,1319,1321,1327,1361,1367,1373,1381,1399,1409,1423,"+\
      20. "1427,1429,1433,1439,1447,1451,1453,1459,1471,1481,1483,1487,1489,1493,"+\
      21. "1499,1511,1523,1531,1543,1549,1553,1559,1567,1571,1579,1583,1597,1601,"+\
      22. "1607,1609,1613,1619,1621,1627,1637,1657,1663,1667,1669,1693,1697,1699,"+\
      23. "1709,1721,1723,1733,1741,1747,1753,1759,1777,1783,1787,1789,1801,1811,"+\
      24. "1823,1831,1847,1861,1867,1871,1873,1877,1879,1889,1901,1907,1913,1931,"+\
      25. "1933,1949,1951,1973,1979,1987,1993,1997,1999,2003,2011,2017,2027,2029,"+\
      26. "2039,2053,2063,2069,2081,2083,2087,2089,2099,2111,2113,2129,2131,2137,"+\
      27. "2141,2143,2153,2161,2179,2203,2207,2213,2221,2237,2239,2243,2251,2267,"+\
      28. "2269,2273,2281,2287,2293,2297,2309,2311,2333,2339,2341,2347,2351,2357,"+\
      29. "2371,2377,2381,2383,2389,2393,2399,2411,2417,2423,2437,2441,2447,2459,"+\
      30. "2467,2473,2477,2503,2521,2531,2539,2543,2549,2551,2557,2579,2591,2593,"+\
      31. "2609,2617,2621,2633,2647,2657,2659,2663,2671,2677,2683,2687,2689,2693,"+\
      32. "2699,2707,2711,2713,2719,2729,2731,2741,2749,2753,2767,2777,2789,2791,"+\
      33. "2797,2801,2803,2819,2833,2837,2843,2851,2857,2861,2879,2887,2897,2903,"+\
      34. "2909,2917,2927,2939,2953,2957,2963,2969,2971,2999,3001,3011,3019,3023,"+\
      35. "3037,3041,3049,3061,3067,3079,3083,3089,3109,3119,3121,3137,3163,3167,"+\
      36. "3169,3181,3187,3191,3203,3209,3217,3221,3229,3251,3253,3257,3259,3271,"+\
      37. "3299,3301,3307,3313,3319,3323,3329,3331,3343,3347,3359,3361,3371,3373,"+\
      38. "3389,3391,3407,3413,3433,3449,3457,3461,3463,3467,3469,3491,3499,3511,"+\
      39. "3517,3527,3529,3533,3539,3541,3547,3557,3559,3571,3581,3583,3593,3607,"+\
      40. "3613,3617,3623,3631,3637,3643,3659,3671,3673,3677,3691,3697,3701,3709,"+\
      41. "3719,3727,3733,3739,3761,3767,3769,3779,3793,3797,3803,3821,3823,3833,"+\
      42. "3847,3851,3853,3863,3877,3881,3889,3907,3911,3917,3919,3923,3929,3931,"+\
      43. "3943,3947,3967,3989,4001,4003,4007,4013,4019,4021,4027,4049,4051,4057,"+\
      44. "4073,4079,4091,4093,4099,4111,4127,4129,4133,4139,4153,4157,4159,4177,"+\
      45. "4201,4211,4217,4219,4229,4231,4241,4243,4253,4259,4261,4271,4273,4283,"+\
      46. "4289,4297,4327,4337,4339,4349,4357,4363,4373,4391,4397,4409,4421,4423,"+\
      47. "4441,4447,4451,4457,4463,4481,4483,4493,4507,4513,4517,4519,4523,4547,"+\
      48. "4549,4561,4567,4583,4591,4597,4603,4621,4637,4639,4643,4649,4651,4657,"+\
      49. "4663,4673,4679,4691,4703,4721,4723,4729,4733,4751,4759,4783,4787,4789,"+\
      50. "4793,4799,4801,4813,4817,4831,4861,4871,4877,4889,4903,4909,4919,4931,"+\
      51. "4933,4937,4943,4951,4957,4967,4969,4973,4987,4993,4999,5003,5009,5011,"+\
      52. "5021,5023,5039,5051,5059,5077,5081,5087,5099,5101,5107,5113,5119,5147,"+\
      53. "5153,5167,5171,5179,5189,5197,5209,5227,5231,5233,5237,5261,5273,5279,"+\
      54. "5281,5297,5303,5309,5323,5333,5347,5351,5381,5387,5393,5399,5407,5413,"+\
      55. "5417,5419,5431,5437,5441,5443,5449,5471,5477,5479,5483,5501,5503,5507,"+\
      56. "5519,5521,5527,5531,5557,5563,5569,5573,5581,5591,5623,5639,5641,5647,"+\
      57. "5651,5653,5657,5659,5669,5683,5689,5693,5701,5711,5717,5737,5741,5743,"+\
      58. "5749,5779,5783,5791,5801,5807,5813,5821,5827,5839,5843,5849,5851,5857,"+\
      59. "5861,5867,5869,5879,5881,5897,5903,5923,5927,5939,5953,5981,5987,6007,"+\
      60. "6011,6029,6037,6043,6047,6053,6067,6073,6079,6089,6091,6101,6113,6121,"+\
      61. "6131,6133,6143,6151,6163,6173,6197,6199,6203,6211,6217,6221,6229,6247,"+\
      62. "6257,6263,6269,6271,6277,6287,6299,6301,6311,6317,6323,6329,6337,6343,"+\
      63. "6353,6359,6361,6367,6373,6379,6389,6397,6421,6427,6449,6451,6469,6473,"+\
      64. "6481,6491,6521,6529,6547,6551,6553,6563,6569,6571,6577,6581,6599,6607,"+\
      65. "6619,6637,6653,6659,6661,6673,6679,6689,6691,6701,6703,6709,6719,6733,"+\
      66. "6737,6761,6763,6779,6781,6791,6793,6803,6823,6827,6829,6833,6841,6857,"+\
      67. "6863,6869,6871,6883,6899,6907,6911,6917,6947,6949,6959,6961,6967,6971,"+\
      68. "6977,6983,6991,6997,7001,7013,7019,7027,7039,7043,7057,7069,7079,7103,"+\
      69. "7109,7121,7127,7129,7151,7159,7177,7187,7193,7207,7211,7213,7219,7229,"+\
      70. "7237,7243,7247,7253,7283,7297,7307,7309,7321,7331,7333,7349,7351,7369,"+\
      71. "7393,7411,7417,7433,7451,7457,7459,7477,7481,7487,7489,7499,7507,7517,"+\
      72. "7523,7529,7537,7541,7547,7549,7559,7561,7573,7577,7583,7589,7591,7603,"+\
      73. "7607,7621,7639,7643,7649,7669,7673,7681,7687,7691,7699,7703,7717,7723,"+\
      74. "7727,7741,7753,7757,7759,7789,7793,7817,7823,7829,7841,7853,7867,7873,"+\
      75. "7877,7879,7883,7901,7907,7919,7927,7933,7937,7949,7951,7963,7993,8009,"+\
      76. "8011,8017,8039,8053,8059,8069,8081,8087,8089,8093,8101,8111,8117,8123,"+\
      77. "8147,8161,8167,8171,8179,8191,8209,8219,8221,8231,8233,8237,8243,8263,"+\
      78. "8269,8273,8287,8291,8293,8297,8311,8317,8329,8353,8363,8369,8377,8387,"+\
      79. "8389,8419,8423,8429,8431,8443,8447,8461,8467,8501,8513,8521,8527,8537,"+\
      80. "8539,8543,8563,8573,8581,8597,8599,8609,8623,8627,8629,8641,8647,8663,"+\
      81. "8669,8677,8681,8689,8693,8699,8707,8713,8719,8731,8737,8741,8747,8753,"+\
      82. "8761,8779,8783,8803,8807,8819,8821,8831,8837,8839,8849,8861,8863,8867,"+\
      83. "8887,8893,8923,8929,8933,8941,8951,8963,8969,8971,8999,9001,9007,9011,"+\
      84. "9013,9029,9041,9043,9049,9059,9067,9091,9103,9109,9127,9133,9137,9151,"+\
      85. "9157,9161,9173,9181,9187,9199,9203,9209,9221,9227,9239,9241,9257,9277,"+\
      86. "9281,9283,9293,9311,9319,9323,9337,9341,9343,9349,9371,9377,9391,9397,"+\
      87. "9403,9413,9419,9421,9431,9433,9437,9439,9461,9463,9467,9473,9479,9491,"+\
      88. "9497,9511,9521,9533,9539,9547,9551,9587,9601,9613,9619,9623,9629,9631,"+\
      89. "9643,9649,9661,9677,9679,9689,9697,9719,9721,9733,9739,9743,9749,9767,"+\
      90. "9769,9781,9787,9791,9803,9811,9817,9829,9833,9839,9851,9857,9859,9871,"+\
      91. "9883,9887,9901,9907,9923,9929,9931,9941,9949,9967,9973" ',...,...
      92. WindowStyle 24:CLS:set("decimals",17):font 2
      93. ' Pi =2/[(1+1/3)*(1+1/5)*(1-1/7)*(1-1/11)*(1+1/13)*...
      94. ' ...*(1+If((Pj-1)mod 4,+1,-1)*1/Pj) * *(1+1/Inf)])
      95. declare p0!,p1!,p2!
      96. var Prod!=1:var w&=0
      97. whileloop 2,1229:w&=val(Substr$(P$,&Loop,","))
      98. Prod!=Prod!*(1+if((w&-1) mod 4,-1,1)/w&)
      99. p0!=p1!:p1!=p2!:p2!=2/Prod!
      100. locate 5,10:print p2!
      101. locate 7,9:print "(";Pi();")"
      102. locate 9,9:print "~";format$("%g",Strebwert(p0!,p1!,p2!));" ";
      103. waitinput 1000
      104. endwhile
      105. beep
      106. waitinput
      107. End
      108. Proc Strebwert :parameters c0!,c1!,c2!
      109. declare ce!,cen!,cez!
      110. if (c0!=c1!) and (c1!=c2!):return c2!
      111. else :cen!=2*c1!-c0!-c2!
      112. if cen!<>0:cez!=(c1!*c1!-c0!*c2!):ce!=cez!/cen!:return ce!
      113. else :print "Ohne Grenze!":return -999999
      114. endif
      115. endif
      116. Endproc
      Alles anzeigen
    • Neu

      Abt. Eigenartige Zahlen
      ==================
      Die "Münchhausen-Zahl" 3435 kann sich selbst aus dem Sumpf "hoch"-ziehen:
      3435 = 3^3 + 4^4 + 3^3 + 5^5, in Basis 10 die einzige Zahl mit genau dieser Eigenschaft!

      Mit Differenz 100 (da 0^0 gegen 1 konvergiert und nicht gegen 0) gibt es noch:
      438579088 = 4^4+3^3+8^8+5^5+7^7+9^9+0^0+8^8+8^8 - 100

      Mit umgedrehter Hochzahlordnung gibt es dagegen mehrere, z.B.:
      48625 = 4 ^5+8 ^2 +6 ^6 +2 ^8+5 ^4
      397612 = 3 ^2+9 ^1 +7 ^6 +6 ^7+1 ^9+2 ^3

      In gänzlich verdrehter Hochzahlordnung existieren viele Beispiele:
      4155 = 4 ^5+1^4+5 ^1+5 ^5

      Vollkommene Zahlen
      ==================
      Eine natürliche Zahl n wird vollkommene Zahl (auch perfekte Zahl) genannt, wenn sie
      gleich der Summe aller ihrer (positiven) Teiler außer sich selbst ist.
      Beispiel: Die positiven Teiler von 28 sind 1, 2, 4, 7, 14, und 28 selbst,
      und es gilt: 1 + 2 + 4 + 7 + 14 = 28.
      Alle bekannten vollkommenen Zahlen sind gerade und von Mersenne-Primzahlen abgeleitet.
      Es ist unbekannt, ob es auch ungerade vollkommene Zahlen gibt. Schon in der griechischen
      Antike waren vollkommene Zahlen bekannt, ihre wichtigsten Eigenschaften wurden in den
      "Elementen" des Euklid behandelt. Alle geraden vollkommenen Zahlen enden auf 6 oder 8.
      6
      28
      496
      756
      33550336
      ...

      Die James_Davis-Zahl: 13532385396179
      =====================================
      =13 53 2 3853 96179 enthält ihre eigene Primfaktorzerlegung:
      =13+53^2+3853*96179
      Das aber widerlegte eine Vermutung von J.H.Conway, was mit 1000 $ belohnt wurde!
      Gruss

      P.S. Q: Diverse Internetforen und Wikis

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

    • Neu

      Abt. Neue Collatz-Rekorde
      ================
      Die Collatz-Spielregel lautet: Wenn Zahl ungerade, dann z=3*z+1, wenn gerade: z=z/2.
      Die Collatz-Vermutung lautet: Nach einigen Durchgängen landen ALLE Zahlen im 1-4-2-1-Zykuls.
      Ein Beweis steht aus, aber gerade wurden wieder neue Durchgangs-Rekorde aufgestellt: Die Zahl 279731455495736617 braucht 2258 Durchgänge, bis sie bei 1 landet. Alle Zahlen darunter landen jedenfalls auch bei 1.

      Mit XProfan allein kommt man solchen Zahlen-Ungetümen nicht bei, da ist bei 1119569 Schluss. Aber immerhin stimmen die Ergebnisse.

      Gruss


      Quellcode

      1. WindowTitle "Collatz Rundenrekord-Zahlen"
      2. WindowStyle 24:cls:clearclip
      3. Declare x!,n&,w!,z&
      4. whileloop 1117065,1119569
      5. n&=0
      6. while x!>1
      7. inc n&
      8. if x!=2*int(x!/2):x!=x!/2
      9. else :x!=3*x!+1
      10. endif
      11. endwhile
      12. if n&>z&:z&=n&:w!=&Loop:print " Die Zahl ";&Loop,"brauchte ";z&;" Runden"
      13. putclip str$(&Loop)+" "+str$(z&)+"," '=N Delay,
      14. endif
      15. endwhile
      16. '"2 1,3 7,6 8,7 16,9 19,18 20,25 23,27 111,54 112,73 115,97 118,129 121,171 124,231 127,"
      17. '"313 130,327 143,649 144,703 170,871 178,1161 181,2223 182,2463 208,"
      18. '"2919 216,3711 237,6171 261,10971 267,13255 275,17647 278,23529 281,26623 307,"
      19. '"34239 310,35655 323,..."
      20. beep:print "\n\n"
      21. var ColRec$=\'https://oeis.org/A006877/list
      22. "2,1,3,7,6,8,7,16,9,19,18,20,25,23,27,111,54,112,73,115,97,118,129,121,"+\
      23. "171,124,231,127,313,130,327,143,649,144,703,170,871,178,1161,181,2223,182,2463,208,"+\
      24. "2919,216,3711,237,6171,261,10971,267,13255,275,17647,278,23529,281,26623,307,"+\
      25. "34239,310,35655,323,52527,339,77031,350,106239,353,142587,374,156159,382,216367,385,"+\
      26. "230631,442,410011,448,511935,469,626331,508,837799,524,1117065,527,1501353,530,"+\
      27. "1723519,556,2298025,559,3064033,562,3542887,583,3732423,596,5649499,612,6649279,664,"+\
      28. "8400511,685,11200681,688,14934241,691,15733191,704,31466382,705,36791535,744,"+\
      29. "63728127,949,127456254,950,169941673,953,226588897,956,268549803,964,537099606,965,"+\
      30. "670617279,986,1341234558,987,1412987847,1000,1674652263,1008,2610744987,1050,"+\
      31. "4578853915,1087,4890328815,1131,978065763,1132,12212032815,1153,12235060455,1184,"+\
      32. "13371194527,1210,17828259369,1213,31694683323,1219,63389366646,1220,75128138247,1228,"+\
      33. "133561134663,1234,158294678119,1242,166763117679,1255,202485402111,1307,404970804222,1308,"+\
      34. "426635908975,1321,568847878633,1324,674190078379,1332,881715740415,1335,989345275647,1348,"+\
      35. "1122382791663,1356,1444338092271,1408,1899148184679,1411,2081751768559,1437,2775669024745,1440,"+\
      36. "3700892032993,1443,3743559068799,1549,7487118137598,1550,7887663552367,1563,10516884736489,1566,"+\
      37. "14022512981985,1569,19536224150271,1585,26262557464201,1588,27667550250351,1601,"+\
      38. "38903934249727,1617,48575069253735,1638,51173735510107,1651,60650353197163,1659,"+\
      39. "80867137596217,1662,100759293214567,1820,134345724286089,1823,223656998090055,1847,"+\
      40. "397612441048987,1853,530149921398649,1856,706866561864865,1859,942488749153153,1862,"+\
      41. "1256651665537537,1865,1675535554050049,1868,2234047405400065,1871,2978729873866753,1874,"+\
      42. "3586720916237671,1895,4320515538764287,1903,4861718551722727,1916,6482291402296969,1919,"+\
      43. "7579309213675935,1958,12769884180266527,2039,17026512240355369,2042,22702016320473825,2045,"+\
      44. "45404032640947650,2046,46785696846401151,2090,93571393692802302,2091,104899295810901231,2254,"+\
      45. "209798591621802462,2255,279731455495736617,2258"
      46. font 2:Declare ColR$[135],ColZ$[135]
      47. Whileloop 133
      48. ColR$[&Loop]=substr$(ColRec$,2*&Loop-1,",")
      49. ColZ$[&Loop]=substr$(ColRec$,2*&Loop,",")
      50. print " ";&Loop,tab(6);ColR$[&Loop],tab(30),ColZ$[&Loop]
      51. if %csrlin>29:waitinput:cls:endif
      52. endwhile
      53. waitmouse
      Alles anzeigen