ALGORITHMEN TEIL X: Das hat uns noch gefehlt!

    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.

    • Die Unixtime
      ============
      Die Unixtime beginnt als Sekundenzähler mit 0 am Donnerstag, dem 1. Januar 1970 um 00:00 Uhr UTC. Bitte zu beachten, daß wir UTC+1 im Winter und UTC+2 in der Sommerzeit haben. Die Ausgabe bei der Umwandlung wird daher entsprechend der Zeitzone und Periode anzupassen sein. Die Umwandlung wird ganz offiziell dadurch erleichtert, daß Schaltsekunden nicht mitgezählt werden (Diese sollen ja die Abweichung der Erdrotation von einer stetig durchlaufenden Zeit korrigieren).

      Das festgelegte Startdatum wird auch als Epoch bezeichnet, was bei 32bit-System wichtig werden wird, denn 2038 wird sich für Unix in etwa das wiederholen, was bei Windows schon als Jahr-2000-Problem bekannt wurde.

      Anbei mein jüngstes Machwerk dazu in XProfan 11.2 , Quelle: Wikipedia "Unixtime" (Java-Beispielcode). Ich benötigte das, um Diabetiker-Aufzeichnungen eines Bekannten auf der Zeitachse korrekt als Kurvenverlauf darstellen zu können. Deshalb ausnahmsweise mal wieder: Gruss

      Quellcode

      1. WindowTitle "Konverter Lesbare Zeitangabe zu Unixtime (Sekunde 0 = Do,1.1.1970 00:00 UTC (damals GMT)"
      2. 'Vgl:https://www.unixtimestamp.de , www.pagerenk.de/mehr-informationen/tools/timestampconverter.htm
      3. WindowStyle 24:Declare Jahr&,Monat&,Tag&,Stunde&,Minute&,Sekunde&,utcdif&,UXTM&:luup:
      4. CLS:print "\n UTC+1\+2h= ";:input utcdif&
      5. Print "\n JJJJ = ";:input Jahr&:Print " Monat = ";:input Monat&
      6. Print " Tag = ";:input Tag&:Print " Stunden = ";:input Stunde&
      7. Print " Minuten = ";:input Minute&:print " Sekunden = ";:input Sekunde&
      8. UXTM&=Readable2Unixtime(Jahr&,Monat&,Tag&,Stunde&,Minute&,Sekunde&,utcdif&)
      9. locate 12,12:font 2:if (UXTM&<>-1) and (UXTM&<>-2):print UXTM&
      10. clearclip:putclip str$(UXTM&):font 2:print:print "\n ... auch in Zwischenablage."
      11. else:beep:print "E R R O R ";UXTM&:Endif:font 0
      12. waitinput:waitinput:goto "luup"
      13. Proc Readable2Unixtime ' Konvertiert gegliederte UTC-Angaben nach Unix-Sekunden
      14. parameters Jahr&,Monat&,Tag&,Stunde&,Minute&,Sekunde&,utcdif& ' GETESTET, ABER OHNE JEDE GEWÄHR!
      15. case (jahr&<1970) or (jahr&>2038) or (monat&>12) or (monat&<1) or (tag&<1) or (tag&>31):return -1
      16. case (Stunde&>23) or (Minute&>59) or (Sekunde&>59) :return -2
      17. declare tage_seit_jahresanfang$[],istschaltjahr&,schaltjahre&,tage_seit_1970&
      18. 'Anzahl der Tage seit Jahresanfang ohne Tage des aktuellen Monats und ohne Schalttag:
      19. tage_seit_jahresanfang$[]=explode("0,31,59,90,120,151,181,212,243,273,304,334",",")
      20. ' Anzahl der Schaltjahre seit 1970 ohne ein evtl. gerade laufendes Schaltjahr
      21. schaltjahre& = ((jahr&-1)-1968)/4 - ((jahr&-1)-1900)/100 + ((jahr&-1)-1600)/400
      22. tage_seit_1970&=(jahr&-1970)*365+schaltjahre&+val(tage_seit_jahresanfang$[monat&-1])+tag&-1
      23. if (jahr& mod 4)=0: istschaltjahr&=1:if (jahr& mod 100)=0: istschaltjahr&=0
      24. case (jahr& mod 400)=0: istschaltjahr&=1
      25. endif:endif ' Schalttage+1, wenn angefragte Jahrs Schaltjahr und Termin nach Februar:
      26. case (monat&>2) and istschaltjahr&: inc tage_seit_1970&
      27. return int(sekunde&+60*(minute&+60*(stunde&+24*tage_seit_1970&))-utcdif&*3600)
      28. endproc
      Alles anzeigen
      P.S.: Ein deutlich flotteres, in XPIA+Assembler geschriebenes Unixtime-Programm von M. Wodrich gibt es hier. Auch Dieter Zornow hat sich mit dem Problem beschäftigt, siehe hier.

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

    • Kalenderwoche berechnen
      ================
      In EU-Europa beginnt die Zählung der Wochentage einer (Arbeits-)Woche mit Montag = 1.
      Die erste Kalenderwoche ist jene, bei der die überwiegende Zahl von Tagen bereits im laufenden Jahr liegen, wenn der Neujahrstag also ein Donnerstag oder später ist. Darum kommt im nachfolgenden Programm der Berechnung des Wochentagsnummer des Neujahrstages besondere Bedeutung zu.

      Eine Ausgabe KW=0 bedeutet dann, daß der gesuchte Tag noch zur 53. Woche des Vorjahres zählt. Der Algorithmus arbeitet ab dem 01.01.1583 und ist vom Unix-Jahr_2038-Fehler nicht betroffen.

      Alles wie immer ohne Gewähr!
      Gruss

      Quellcode

      1. WindowTitle upper$("Europäische Kalenderwochennummer eines bestimmten Datums")
      2. WindowStyle 24:declare jahr&,monat&,tag&:font 2 'BETA-VERSION OHNE JEDE GEWÄHR!
      3. looop:
      4. CLS:print "\n Jahr = ";:input jahr&:print " Monat = ";:input monat&
      5. print " Tag = ";:input tag&:print
      6. if WTNr(jahr&,monat&,tag&)<1:print " Eingabefehler! (Jahr<1583 o.ähnl.)":goto "resum":endif
      7. casenot SJ(jahr&):print " Kein";:print " Schaltjahr!"
      8. print " Dieser ";TN(jahr&,monat&,tag&);".Tag des Jahres";
      9. print " liegt in der ";KW(jahr&,monat&,tag&);".KW";
      10. case KW(jahr&,monat&,tag&)=0:print " bzw. die 53.KW des Vorjahres,";
      11. print "\n und ist der ";WTNr(jahr&,monat&,tag&);".Tag dieser Woche (Zählung beginnt mit Mo)."
      12. print " Es handelt sich um einen ";WTStr$(WTNr(jahr&,monat&,tag&));" (";WTsStr$(WTNr(jahr&,monat&,tag&));")"
      13. resum:
      14. print:waitinput:goto "Looop"
      15. END
      16. proc SJ :parameters jahr&:case jahr&<1583:return -1 'SCHALTJAHR
      17. var sj&=0:ifnot jahr& mod 4:sj&=1:ifnot jahr& mod 100:sj&=0
      18. casenot jahr& mod 400:sj&=1:endif:endif:return sj&
      19. endproc
      20. proc TN :parameters jahr&,monat&,tag& 'TAGNUMMER IM JAHR
      21. case (jahr&<1583) or (monat&<1) or (monat&>12):return -1
      22. var tn&=val(substr$("0 31 59 90 120 151 181 212 243 273 304 334 365",monat&," "))+tag&
      23. case monat&<3:return tn&:case SJ(jahr&):inc tn&:return tn&
      24. endproc
      25. proc WTNr :parameters jahr&,monat&,tag&
      26. case jahr&<1583:return -1 'WOCHENTAG-Nr
      27. var WTNrNJ&=WTNrNJ(jahr&)
      28. var TN&=TN(jahr&,monat&,tag&)
      29. var WTNr& = ( ((TN&-1) mod 7)+(WTNrNJ&-1)) mod 7 + 1
      30. return WTNr&
      31. endproc
      32. proc WTsStr$ :parameters WTNr& 'WOCHENTAG-shortString
      33. return substr$("Mo Di Mi Do Fr Sa So",WTNr&," ")
      34. endproc
      35. proc WTStr$ :parameters WTNr& :return substr$(\
      36. "Montag Dienstag Mittwoch Donnerstag Freitag Samstag Sonntag",WTNr&," ")
      37. endproc ' = WOCHENTAG-NAME
      38. proc WTNrNJ :parameters jahr& 'WOCHENTAG-Nr_des_Neujahrstages
      39. case jahr&<1583:return -1:var AJ&=jahr&-1201
      40. var WT&=1+AJ&+int(AJ&/4)-int(AJ&/100)+int(AJ&/400)
      41. WT&=WT& mod 7: case wt&=0:wt&=7:return WT& ' 1="Montag"
      42. endproc
      43. Proc KW :parameters jahr&,monat&,tag&
      44. var WT&=WTNrNJ(jahr&) 'KALENDERWOCHE
      45. var WN&=TN(jahr&,monat&,tag&)+WT&-2
      46. case WT&<5:WN&=WN&+7
      47. WN&=int(WN&/7):return WN&
      48. endproc
      Alles anzeigen
    • Ergänzung zu oben (aus Wikipedia "Woche"):
      ---------------------------------------------------

      " Jedes Jahr hat entweder 52 oder 53 Kalenderwochen.

      -------------------------------------------------------------------------------------------------------------
      Ein Jahr hat genau dann 53 Kalenderwochen, wenn es mit einem Donnerstag beginnt oder endet:
      ------------------------------------------------------------------------------------------------------------

      - Ein Gemeinjahr mit 53 Wochen beginnt an einem Donnerstag und endet an einem Donnerstag.
      - Ein Schaltjahr mit 53 Wochen beginnt entweder an einem Mittwoch und endet an einem Donnerstag oder es beginnt an einem Donnerstag und endet an einem Freitag.

      - - Der 29., 30. und 31. Dezember können schon zur Kalenderwoche 1 des Folgejahres gehören.
      - - Der 1., 2. und 3. Januar können noch zu der letzten Kalenderwoche des Vorjahres gehören.

      ...DIN 1355-1 führte zum 1. Januar 1976 eine entsprechende Zählweise mit Montag als ersten Wochentag im deutschen Sprachraum ein."
      Gruss

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

    • Wahnsinn: Integralcosinus Ci() missbraucht!
      ============================
      Da sucht man ganz unschuldig nach der Formel, die den durchschnittlichen Blutzucker-Verlauf nach Kohlehydrat-Zufuhr darstellt, und kommt darauf daß es im ganzen Internet bloß Bilder und Tabellen dazu gibt, aber keine Formel. Dann bastelt man vergeblich mit Exponentialfunktionen rum, liest Fachbücher mit Doppelintegralen und komplexen und hochtheoretischen physiologischen Modellen drin, und möchte schon den Hut draufhauen.

      Dann erinnert man sich, daß es da mal ein Buch mit Funktionsgraphen und zugehörigen Formeln gab, lädt sich Abramowitz, Stegun: Handbook of Mathematical Functions und findet schließlich (Tataaaa!): Den Integralcosinus in seinem ersten positiven Abschnitt. Das modelliert dann sogar automatisch die anfängliche Insulinverzögerung. Danke - hat (inklusive Funktion programmieren) nur 11 1/2 Stunden gedauert!
      Nachstehend die Funktion, wie immer ohne jede Gewähr!
      Gruss

      Quellcode

      1. WindowTitle "Integralcosinus Ci() aus Reihenentwicklung"
      2. Windowstyle 24:Window 0,0-%maxx,%maxy
      3. var xh&=width(%hwnd)\2:var yh&=height(%hwnd)\2
      4. Declare x!,y!,f!:f!=1/1000:set("decimals",17)
      5. Main:
      6. cls:line 0,yh& - 2*xh&,yh&: line 300,0 - 300,2*yh&:usepen 0,1,255
      7. whileloop 0,24300,50:x!=&loop*f!
      8. y!=Ci(x!)
      9. print format$("##0.#####",x!),tab(12);y!
      10. lineto 300+x!*20,yh&-y!*500
      11. case %csrlin>50:locate 1,1
      12. endwhile
      13. waitinput:cls:goto "Main"
      14. Proc Ci :parameters x!:case x!<=0:return -999999999
      15. case x!>24.3:print " **Err: x > 24.3** ";
      16. var EulerMascheroni!=0.57721566490153286:var lm2!=0
      17. var sum!=EulerMascheroni!+ln(x!)
      18. whileloop 30:lm2!=&Loop*2
      19. sum!=sum! + if(&loop mod 2,-1,1)*x!^Lm2!/(faku(Lm2!)*Lm2!)
      20. endwhile
      21. return sum!
      22. endproc
      23. proc faku :parameters x!:x!=abs(x!)
      24. if x!>169:print " ***Error in Faku: Overflow!***"
      25. waitinput:End:endif :var prod!=1
      26. whileloop int(x!):prod!=prod!*&loop
      27. endwhile:return prod!
      28. endproc
      Alles anzeigen
      P.S.: Die Reihenentwicklung sollte jedenfalls nicht überbeansprucht werden: Bei x=24 ist Schluss!
    • Funktionen, die es nicht gibt
      ===================
      - z.B. weil eine Formel dazu nicht bekannt ist: Liegen konkrete Meßergebnisse vor, kann man für diese manchmal durch Parabelanpassung, Fourieranalyse oder Reihenentwicklung eine Funktionsformel erzeugen. Doch manchmal eben auch nicht. Dann hilft nur mehr PROBIEREN und mit Parametern so lange herum EXPERIMENTIEREN, bis etwas halbwegs brauchbares herauskommt. Bzgl. Laufzeit ist eine Zusammensetzung der neuen Funktion aus Standardfunktionen, die in der Programmiersprache schon vorhanden sind, natürlich vorteilhaft.
      Gruss

      P.S.: Sollte auch die manuelle Erzeugung scheitern, hilft nurmehr Abschnittsweise (lineare oder nichtlineare) Interpolation zwischen den gewonnenen Messpunkten - etwa durch Spline-Anpassung. Dann wird es allerdings aufw/ä/e/ndig!!!

      Quellcode

      1. WindowTitle "ExpMan: Eine Funktionskurve aus bis zu 5 Glockenkurven manuell erzeugen"
      2. '(CL) CopyLeft 2016-05 by P.Specht, Vienna/Austria - Ohne jede Gewähr! No warranty whatsoever!
      3. WindowStyle 24:Window 0,0-%maxx,%maxy
      4. declare xh&,yh&,x!,y!,first&,n&,fnr&,anzf&,lastx!,lasty!,w$,co&
      5. declare f1pos!,f1streu!,f1amp!,f2pos!,f2streu!,f2amp!,f3pos!
      6. declare f3streu!,f3amp!,f4pos!,f4streu!,f4amp!,f5pos!,f5streu!,f5amp!
      7. xh&=width(%hwnd)\2:yh&=height(%hwnd)*7/8:font 2
      8. proc f :parameters x!,mu!,sigma!
      9. return exp(-1*sqr(x!-mu!)/sigma!)
      10. endproc
      11. Default:
      12. anzf&=5
      13. inc anzf& 'da plus Summenkurve
      14. f1pos!=-2:f1streu!=1:f1amp!=1
      15. f2pos!=-1:f2streu!=1:f2amp!=1
      16. f3pos!= 0:f3streu!=1:f3amp!=1
      17. f4pos!= 1:f4streu!=1:f4amp!=1
      18. f5pos!= 2:f5streu!=1:f5amp!=1
      19. beep
      20. SCHLEIFE:
      21. fnr&=anzf&+1
      22. REPEAT
      23. dec fnr& 'funktionsnummer
      24. first&=1
      25. whileloop -xh&,xh&,10
      26. x!=&Loop/100
      27. SELECT fnr&
      28. caseof 1 : y!=f(x!,f1pos!,f1streu!)*f1amp!:co&=rgb(255,0,0)
      29. caseof 2 : y!=f(x!,f2pos!,f2streu!)*f2amp!:co&=rgb(0,200,0)
      30. caseof 3 : y!=f(x!,f3pos!,f3streu!)*f3amp!:co&=rgb(0,0,255)
      31. caseof 4 : y!=f(x!,f4pos!,f4streu!)*f4amp!:co&=rgb(200,0,255)
      32. caseof 5 : y!=f(x!,f5pos!,f5streu!)*f5amp!:co&=rgb(100,100,0)
      33. caseof 6 : co&=0
      34. y! = f(x!,f1pos!,f1streu!)*f1amp!+f(x!,f2pos!,f2streu!)*f2amp!+ \
      35. f(x!,f3pos!,f3streu!)*f3amp!+f(x!,f4pos!,f4streu!)*f4amp!+f(x!,f5pos!,f5streu!)*f5amp!
      36. ENDSELECT
      37. if first&
      38. first&=0
      39. else
      40. usepen 0,2+4*(fnr&=anzf&),co&
      41. line xh&+lastx!*100,(yh&-lasty!*200) - xh&+x!*100,yh&-y!*200
      42. endif
      43. lastx!=x!:lasty!=y!
      44. endwhile
      45. UNTIL fnr&=0
      46. usepen 0,1,0:line 0,yh& - 2*xh&,yh&
      47. locate 1,1
      48. print "\n "
      49. color 12,15
      50. print " 1 F1-Position: ";format$("%g",f1pos!);" "
      51. print " 2 F1-Streuung: ";format$("%g",f1streu!);" "
      52. print " 3 F1-Amplitude ";format$("%g",f1amp!);" "
      53. print " "
      54. color 2,15
      55. print " 4 F2-Position: ";format$("%g",f2pos!);" "
      56. print " 5 F2-Streuung: ";format$("%g",f2streu!);" "
      57. print " 6 F2-Amplitude:";format$("%g",f2amp!);" "
      58. print " "
      59. color 9,15
      60. print " 7 F3-Position: ";format$("%g",f3pos!);" "
      61. print " 8 F3-Streuung: ";format$("%g",f3streu!);" "
      62. print " 9 F3-Amplitude ";format$("%g",f3amp!);" "
      63. print " "
      64. color 3,15
      65. print " 7 F4-Position: ";format$("%g",f4pos!);" "
      66. print " 8 F4-Streuung: ";format$("%g",f4streu!);" "
      67. print " 9 F4-Amplitude ";format$("%g",f4amp!);" "
      68. print " "
      69. color 6,15
      70. print " 7 F5-Position: ";format$("%g",f5pos!);" "
      71. print " 8 F5-Streuung: ";format$("%g",f5streu!);" "
      72. print " 9 F5-Amplitude ";format$("%g",f5amp!);" "
      73. color 0,15
      74. print "\n Neustart? [j/-] ";
      75. locate 3,17:input w$:if w$<>"":f1pos!=val(w$):goto "weitr":endif
      76. locate 4,17:input w$:if w$<>"":f1streu!=val(w$):case f1Streu!=0:f1Streu!=1:goto "weitr":endif
      77. locate 5,17:input w$:if w$<>"":f1amp!=val(w$):goto "weitr":endif
      78. locate 7,17:input w$:if w$<>"":f2pos!=val(w$):goto "weitr":endif
      79. locate 8,17:input w$:if w$<>"":f2streu!=val(w$):case f2Streu!=0:f2Streu!=1:goto "weitr":endif
      80. locate 9,17:input w$:if w$<>"":f2amp!=val(w$):goto "weitr":endif
      81. locate 11,17:input w$:if w$<>"":f3pos!=val(w$):goto "weitr":endif
      82. locate 12,17:input w$:if w$<>"":f3streu!=val(w$):case f3Streu!=0:f3Streu!=1:goto "weitr":endif
      83. locate 13,17:input w$:if w$<>"":f3amp!=val(w$):goto "weitr":endif
      84. locate 15,17:input w$:if w$<>"":f4pos!=val(w$):goto "weitr":endif
      85. locate 16,17:input w$:if w$<>"":f4streu!=val(w$):case f4Streu!=0:f4Streu!=1:goto "weitr":endif
      86. locate 17,17:input w$:if w$<>"":f4amp!=val(w$):goto "weitr":endif
      87. locate 19,17:input w$:if w$<>"":f5pos!=val(w$):goto "weitr":endif
      88. locate 20,17:input w$:if w$<>"":f5streu!=val(w$):case f5Streu!=0:f5Streu!=1:goto "weitr":endif
      89. locate 21,17:input w$:if w$<>"":f5amp!=val(w$):goto "weitr":endif
      90. locate 23,17:input w$:if w$="j":cls:goto "Default":endif
      91. weitr:
      92. cls
      93. goto "SCHLEIFE"
      Alles anzeigen

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

    • Liste bisheriger Schaltsekunden
      =========================
      Beginn war 1972, wo die gleichförmige "Feinstruktur-Atomzeit" TAI = UTC + 10 s betrug. GPS nutzt TAI, die Schaltsekunden werden für die User zwecks Anzeige von UTC aber automatisch dazugerechnet.
      Gruss

      Liste aller Schaltsekunden nach 23:59:59 UTC (...sollten auf Digital-Funkuhren eigentlich als 23:59:60 angezeigt werden, diese verharren aber eine Sekunde länger entweder auf 23:59:59 oder auf 00:00:00)

      • Jahr 30. Juni 31. Dez.
      • 1972 +1s +1s (1972 wurden gleich 2 Schaltsekunden eingefügt!)
      • 1973 – + 1 s
      • 1974 – + 1 s
      • 1975 – + 1 s
      • 1976 – + 1 s
      • 1977 – + 1 s
      • 1978 – + 1 s
      • 1979 – + 1 s
      • 1980 – –
      • 1981 + 1 s –
      • 1982 + 1 s –
      • 1983 + 1 s –
      • 1984 – –
      • 1985 + 1 s –
      • 1986 – –
      • 1987 – + 1 s
      • 1988 – –
      • 1989 – + 1 s
      • 1990 – + 1 s
      • 1991 – –
      • 1992 + 1 s –
      • 1993 + 1 s –
      • 1994 + 1 s –
      • 1995 – + 1 s
      • 1996 – –
      • 1997 + 1 s –
      • 1998 – + 1 s
      • 1999 – –
      • 2000 – –
      • 2001 – –
      • 2002 – –
      • 2003 – –
      • 2004 – –
      • 2005 – + 1 s
      • 2006 – –
      • 2007 – –
      • 2008 – + 1 s
      • 2009 – –
      • 2010 – –
      • 2011 – –
      • 2012 + 1 s –
      • 2013 – –
      • 2014 – –
      • 2015 + 1 s –

        SUMME bisher 11 s + 15 s
      --->> Zzgl. der ursprünglichen 10 s macht das insgesamt 36 Sekunden Plus gegenüber TAI-Atomuhren.

      P.S.: Schaltsekunden werden dann eingefügt, wenn die unregelmäßige Erdrotation um >0.9 s von der Atomzeit abweicht. Sinn: Gestirne und Satelliten würden ja sonst um 36 Sekunden zu spät am Horizont erscheinen! Da ist die ISS also ganz woanders! ;-)

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

    • Warum IQ-Tests Blödsinn sind!
      ====================
      Beweis anbei, er stammt aus einem Youtube-Video über Künstliche Idiotie.
      Gruss

      Quellcode

      1. WindowTitle upper$(" Warum IQ-Tests Blödsinn sind!"):declare antw$:hupf:
      2. Cls:print "\n Wie geht folgende Reihe weiter?:\n 2, 4, 6, 8, ... ?\n"
      3. print " Ihre Anwort: ";:input antw$:font 2
      4. if antw$="34":print "\n RICHTIG! Sie sind hochintelligent (oder haben geschummelt)!"
      5. sound 500,40:sound 1000,40:sound 1500,40:sound 2000,100 :goto "weiter"
      6. elseif antw$="10":font 2:print "\n In manchen Tests vielleicht - hier aber nicht!":sound 70,200
      7. else :print "\n Leider voll daneben!":sound 66,200:endif:font 0:waitinput 2000
      8. print "\n Möchten Sie nochmal? ";:input antw$:weiter:
      9. antw$=lower$(left$(antw$,1))
      10. case (antw$="j") or (antw$="y") or (antw$="1") or (antw$="+"):goto "hupf"
      11. proc x :parameters n!:return n!^4-10*n!^3+35*n!^2-48*n!+24
      12. Endproc
      13. print "\n Hier die Auflösung: "
      14. print "\n Die richtige Antwort lautet: ";:font 2:print "34":font 0
      15. print " Warum? Weil der IQ-Test das so wollte: "
      16. print " Für die n. Zahl berechnet sich der Wert aus"
      17. print " folgendem Poynom: z = n^4-10*n^3+35*n^2-48*n+24"
      18. print " Es gibt aber noch viele andere Polynome,"
      19. print " die den Reihenanfang mit 2, 4, 6, 8 haben!"
      20. Print "\n Die weiteren Zahlen lauten dann:\n"
      21. whileloop 14:print " ";int(x(&Loop));",";
      22. endwhile:print "...":waitinput 20000:end
      Alles anzeigen
    • Chudnovsky-Algorithmus
      =================
      Die Brüder Chudnovsky entwickelten 1989 eine der sog. "Ramanujan-Formel für die Zahl Pi" sehr ähnliche, aber viel schneller konvergierende Formel, mit der Shigeru Kondo und Alexander Yee im Jahre 2013 die Zahl Pi binen 94 Tagen auf (Jetzt bitte festhalten!) 12.100.000.000.050 Stellen berechnet haben. Diese sind damit derzeit Weltmeister in dieser Disziplin. Das Prinzip der Chudnovsky-Formel ist im nachstehenden Machwerk enthalten, das aber nur XProfans Double precision Floating Point Rechengenauigkeit nutzt (15 ... 16 signifikannte Stellen).

      Die Verifikation des Ergebnisses erfolgte übrigens mit Bellards Formel (=> Direkte Binärstelle berechnen - nachstehend ebenfalls im Prinzip dargestellt), welche dazu im Projekt "PiHex" sehr viele im Internet verteilte Rechner nutzte und immerhin 43% schneller als die vor kurzem noch beste Formel (Bailey–Borwein–Plouffe Algorithmus) ist.
      Gruss

      Quellcode

      1. WindowTitle "3.1415926535897932384626433832795028841971693993751058209"+\
      2. "7494459230781640628620899862803482534211706798214808651328230664709384"
      3. cls:set("decimals",16):font 2
      4. declare Pi_atn1!
      5. Pi_atn1!=4*arctan(1)
      6. print "\n 4*atn(1)=";Pi_atn1!,Pi()-Pi_atn1!,\
      7. format$("%g", (Pi()-Pi_atn1!)/pi() )
      8. waitinput 1000
      9. var Pi_Euler! = 20*arctan(1/7)+8*arctan(3/79)
      10. print "\n Euler_1748: ";Pi_Euler!,Pi()-Pi_Euler!,\
      11. format$("%g", (Pi()-Pi_Euler!)/pi() )
      12. waitinput 1000
      13. var Pi_Machin1! = 4*(4*arctan(1/5) - arctan(1/239))
      14. print "\n Machin1: ";Pi_Machin1!,Pi()-Pi_Machin1!,\
      15. format$("%g", (Pi()-Pi_Machin1!)/pi() )
      16. waitinput 1000
      17. var Pi_Machin2! = 176*arctan(1/57)+28*arctan(1/239)-48*arctan(1/682)+96*arctan(1/12943)
      18. print "\n Machin2: ";Pi_Machin2!,Pi()-Pi_Machin2!,\
      19. format$("%g", (Pi()-Pi_Machin2!)/pi() )
      20. waitinput 1000
      21. var Pi_FCW_Störmer_1896!=4*( 44*arctan(1/57)+7*arctan(1/239)-12*arctan(1/682)+24*arctan(1/12943) )
      22. print "\n= Störmer_1896: ";Pi_FCW_Störmer_1896!,Pi()-Pi_FCW_Störmer_1896!,\
      23. format$("%g", (Pi()-Pi_FCW_Störmer_1896!)/pi() )
      24. waitinput 1000
      25. var Pi_Machin!=48*arctan(1/49)+128*arctan(1/57)-20*arctan(1/239)+48*arctan(1/110443)
      26. print "\n Machin_: ";Pi_Machin!,Pi()-Pi_Machin!,\
      27. format$("%g", (Pi()-Pi_Machin!)/pi() )
      28. waitinput 1000
      29. var Pi_K_Takano_1982!=4*( 12*arctan(1/49)+32*arctan(1/57)-5*arctan(1/239)+12*arctan(1/110443) )
      30. print "\n= Takano_1982: ";Pi_K_Takano_1982!,Pi()-Pi_K_Takano_1982!,\
      31. format$("%g", (Pi()-Pi_K_Takano_1982!)/pi() )
      32. waitinput 1000
      33. proc fak :parameters k&:var prod!=1
      34. whileloop 1,k&:prod!=prod!*&Loop
      35. endwhile:return prod!
      36. endproc
      37. var summe!=0:var j&=0
      38. Whileloop 0,4,1:j&=&Loop
      39. summe!=summe!+fak(4*j&)*(1103+26390*j&)/(fak(j&)^4*396^(4*j&))
      40. endwhile
      41. var Pi_Ramanujan! = 9801/sqrt(8)*1/summe!
      42. print "\n Ramanujan_1914: ";Pi_Ramanujan!,Pi()-Pi_Ramanujan!,\
      43. format$("%g", (Pi()-Pi_Ramanujan!)/pi() )
      44. waitinput 1000
      45. declare Pi_GaussLegendre!,an!,bn!,tn!,pn!,tmp!,err!
      46. err!=10^-15
      47. an!=1:bn!=1/sqrt(2):tn!=1/4:pn!=1
      48. whilenot abs(an!-bn!)<=err!
      49. tmp!=(an!+bn!)/2
      50. bn!=sqrt(an!*bn!)
      51. tn!=tn!-pn!*sqr(an!-tmp!)
      52. pn!=2*pn!
      53. an!=tmp!
      54. endwhile
      55. Pi_GaussLegendre!=sqr(tmp!+bn!)/(4*tn!)
      56. print "\n GaußLegendre: ";Pi_GaussLegendre!,Pi()-Pi_GaussLegendre!,\
      57. format$("%g", (Pi()-Pi_GaussLegendre!)/pi() )
      58. waitinput 1000
      59. var Pi_F_Viete_1593!= 2 * \
      60. 2/sqrt(2) * \
      61. 2/sqrt(2+sqrt(2)) * \
      62. 2/sqrt(2+sqrt(2+sqrt(2))) * \
      63. 2/sqrt(2+sqrt(2+sqrt(2+sqrt(2)))) * \
      64. 2/sqrt(2+sqrt(2+sqrt(2+sqrt(2+sqrt(2))))) * \
      65. 2/sqrt(2+sqrt(2+sqrt(2+sqrt(2+sqrt(2+sqrt(2)))))) * \
      66. 2/sqrt(2+sqrt(2+sqrt(2+sqrt(2+sqrt(2+sqrt(2+sqrt(2))))))) * \
      67. 2/sqrt(2+sqrt(2+sqrt(2+sqrt(2+sqrt(2+sqrt(2+sqrt(2+sqrt(2))))))))
      68. print "\n Viete_1593: ";pi_F_Viete_1593!,Pi()-pi_F_Viete_1593!,\
      69. format$("%g", (Pi()-pi_F_Viete_1593!)/pi() )
      70. waitinput 1000
      71. proc faku :parameters k&:var prod!=1
      72. whileloop 1,k&:prod!=prod!*&Loop
      73. endwhile:return prod!
      74. endproc
      75. var su!=0:var k&=0
      76. whileloop 0,5,1:k&=&Loop
      77. su!=su!+if(k& mod 2,-1,1)*faku(6*k&)*(545140134*k&+13591409)/(faku(3*k&)*faku(k&)^3*(640320^3)^(k&+1/2))
      78. endwhile
      79. var Pi_D&G_Chudnovsky!=1/(12*su!)
      80. print "\n Chudnovsky1989: ";Pi_D&G_Chudnovsky!,Pi()-Pi_D&G_Chudnovsky!,\
      81. format$("%g", (Pi()-Pi_D&G_Chudnovsky!)/pi() )
      82. waitinput 1000
      83. var sm!=0:var i&=0
      84. whileloop 0,5,1:i&=&Loop
      85. sm!=sm!+if(i& mod 2,-1,1)/(2^(10*i&))* \
      86. ( -32/(4*i&+1)-1/(4*i&+3)+256/(10*i&+1)-64/(10*i&+3)-4/(10*i&+5)-4/(10*i&+7)+1/(10*i&+9) )
      87. endwhile
      88. var Pi_Bellard_1997! = sm!/64
      89. print "\n Bellard_1997: ";Pi_Bellard_1997!,Pi()-Pi_Bellard_1997!,\
      90. format$("%g", (Pi()-Pi_Bellard_1997!)/pi() )
      91. waitinput 1000
      92. print "\n Taylor-7:";
      93. declare sum!:var v!= +1
      94. whileloop 1,10000000,2
      95. sum!=sum!+v!*4/&Loop
      96. v!= -v!
      97. endwhile
      98. print sum!,pi()-sum!,format$("%g",(pi()-sum!)/pi() )
      99. beep:print "\n ok."
      100. waitinput
      101. End
      Alles anzeigen
      P.S.: Dieser unnötige Herr hier meint (pdf-Datei), daß die Berechnung von Pi ein Armutszeugnis für die Menschheit :!!: darstellt. Viel wichtiger als das Verhältnis Durchmesser zu Umfang sei doch jenes von Radius zu Umfang! Er schlägt deshalb die neue Konstante TAU vor... :P

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

    • Ohne Worte: ChrSwap$()
      ================

      Quellcode

      1. Cls
      2. font 2
      3. var b$="Wer anderen eine Grube gräbt, ist Erdarbeiter!"
      4. print "\n "+@chrswap$(b$,0,1)
      5. print "\n "+@chrswap$(b$,1,-1)
      6. print
      7. print "\n "+@chrswap$(b$,1,46)
      8. print "\n "+@chrswap$(b$,46,1)
      9. print
      10. print "\n "+@chrswap$(b$,2,3)
      11. print "\n "+@chrswap$(b$,3,2)
      12. print
      13. print "\n "+@chrswap$(b$,-2,-1)
      14. print "\n "+@chrswap$(b$,-1,-2)
      15. print
      16. print "\n "+@chrswap$(b$,1,-1)
      17. print "\n "+@chrswap$(b$,-1,1)
      18. print
      19. print "\n "+@chrswap$(b$,3,-3)
      20. print "\n "+@chrswap$(b$,-3,3)
      21. print "\n "+@chrswap$(b$,-46,46)
      22. waitinput
      23. end
      24. Proc chrswap$ :parameters b$,v&,w&
      25. case v&<0:v&=len(b$)+v&+1:case w&<0:w&=len(b$)+w&+1
      26. if v&>w&:var tmp&=v&:v&=w&:w&=tmp&:endif
      27. case (v&=0) or (w&=0) or (v&=w&) or \
      28. (v&<1) or (w&>len(b$)):return b$
      29. b$=mid$(b$,1,v&-1)+mid$(b$,w&,1)+mid$(b$,v&+1,w&-v&-1)\
      30. +mid$(b$,v&,1)+mid$(b$,w&+1,len(b$)-w&)
      31. return b$
      32. endproc
      Alles anzeigen
      P.S.: Geht sicher viel einfacher, ist auch nur als Grundgerüst für flotten Assemblercode gedacht
    • MemBrain, der Neuronale Netzwerksimulator
      --------------------------------------------------
      wurde jetzt noch schneller: Download-Link hier! Für Nichtkommerziellen und Unterrichts-Gebrauch vollkommen frei, für kommerzielle Anwendungen wie etwa Verkaufsversionen von Börsenkurs-Vorhersage sind relativ günstige Lizenzmodelle verfügbar.
      Gruss

      P.S.: Anlaß für dieses Posting: Die jüngsten Durchbrüche bei Artificial Intelligence (AI)-Systemen. Ein selbstlernendes Neuronales Netz hat beispielsweise kürzlich den GO-Weltmeister besiegt - und GO ist etwa 10^14 mal komplexer als Schach! Dass das gewisse Ängste auslöst, zeigt dieses Youtube-Video hier (engl.).

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

    • Max() und Min()
      ==========
      für Floatingpoint-Variablen sind Funktionen, welche bei unterschiedlicher Parameterzahl in reinem Profan-11-Code ziemlich aufwendig zu programmieren sind, wenn die Sache relativ schnell gehen soll. Rekursive Varianten haben sich leider als langsam erwiesen.

      Erlaubt sind hier 1 bis 15 Parameter, wobei die Variable %PCount nur bis zu 15 Parameter zählt, weil nur diese ersten 15 Parameter von Profan übergeben werden (Zwar können 16 oder mehr angegeben werden, diese werden aber ohne Fehlermeldung bei der Ermittlung des Ergebnisses ignoriert. Bisher wird dieser Fehler nicht abgefangen).

      Um an diese Beschränkungen zu erinnern, lauten die tatsächlichen Funktionsnamen Max15f() und Min15f(), wobei das f für "Floatingpoint" steht.
      Gruss

      P.S.: Elegantere Lösungen werden gerne angenommen...

      Quellcode

      1. CLS ' Nutzung auf eigne Gefahr!
      2. print "\n Max = ";Max15f(17,16,15,14,13,11,10,9,12,8,7,val("1e1"),6.4,5.2,18)
      3. print "\n Min = ";Min15f(17,16,15,14,13,11,10,9,12,8,7,val("1e-1"),6.4,5.2,18)
      4. waitinput
      5. proc Max15f
      6. var max!=val("-1e-306")
      7. select %PCount
      8. caseof 0:print "*** Too few parameters in Max15f() ***":return max!
      9. caseof 1:parameters a!:return a!
      10. caseof 2:parameters a!,b!:return if(a!>b!,a!,b!)
      11. caseof 3:parameters a!,b!,c!:return if(a!>b!,if(c!>a!,c!,a!),if(c!>b!,c!,b!))
      12. caseof 4:parameters a!,b!,c!,d!
      13. case max!<a!:max!=a!:case max!<b!:max!=b!:case max!<c!:max!=c!:case max!<d!:max!=d!:return max!
      14. caseof 5:parameters a!,b!,c!,d!,e!
      15. case max!<a!:max!=a!:case max!<b!:max!=b!:case max!<c!:max!=c!:case max!<d!:max!=d!
      16. case max!<e!:max!=e!:return max!
      17. caseof 6:parameters a!,b!,c!,d!,e!,f!
      18. case max!<a!:max!=a!:case max!<b!:max!=b!:case max!<c!:max!=c!:case max!<d!:max!=d!
      19. case max!<e!:max!=e!:case max!<f!:max!=f!:return max!
      20. caseof 7:parameters a!,b!,c!,d!,e!,f!,g!
      21. case max!<a!:max!=a!:case max!<b!:max!=b!:case max!<c!:max!=c!:case max!<d!:max!=d!
      22. case max!<e!:max!=e!:case max!<f!:max!=f!:case max!<g!:max!=g!:return max!
      23. caseof 8:parameters a!,b!,c!,d!,e!,f!,g!,h!
      24. case max!<a!:max!=a!:case max!<b!:max!=b!:case max!<c!:max!=c!:case max!<d!:max!=d!
      25. case max!<e!:max!=e!:case max!<f!:max!=f!:case max!<g!:max!=g!:case max!<h!:max!=h!
      26. return max!
      27. caseof 9:parameters a!,b!,c!,d!,e!,f!,g!,h!,i!
      28. case max!<a!:max!=a!:case max!<b!:max!=b!:case max!<c!:max!=c!:case max!<d!:max!=d!
      29. case max!<e!:max!=e!:case max!<f!:max!=f!:case max!<g!:max!=g!:case max!<h!:max!=h!
      30. case max!<i!:max!=i!:return max!
      31. caseof 10:parameters a!,b!,c!,d!,e!,f!,g!,h!,i!,j!
      32. case max!<a!:max!=a!:case max!<b!:max!=b!:case max!<c!:max!=c!:case max!<d!:max!=d!
      33. case max!<e!:max!=e!:case max!<f!:max!=f!:case max!<g!:max!=g!:case max!<h!:max!=h!
      34. case max!<i!:max!=i!:case max!<j!:max!=j!:return max!
      35. caseof 11:parameters a!,b!,c!,d!,e!,f!,g!,h!,i!,j!,k!
      36. case max!<a!:max!=a!:case max!<b!:max!=b!:case max!<c!:max!=c!:case max!<d!:max!=d!
      37. case max!<e!:max!=e!:case max!<f!:max!=f!:case max!<g!:max!=g!:case max!<h!:max!=h!
      38. case max!<i!:max!=i!:case max!<j!:max!=j!:case max!<k!:max!=k!:return max!
      39. caseof 12:parameters a!,b!,c!,d!,e!,f!,g!,h!,i!,j!,k!,l!
      40. case max!<a!:max!=a!:case max!<b!:max!=b!:case max!<c!:max!=c!:case max!<d!:max!=d!
      41. case max!<e!:max!=e!:case max!<f!:max!=f!:case max!<g!:max!=g!:case max!<h!:max!=h!
      42. case max!<i!:max!=i!:case max!<j!:max!=j!:case max!<k!:max!=k!:case max!<l!:max!=l!
      43. return max!
      44. caseof 13:parameters a!,b!,c!,d!,e!,f!,g!,h!,i!,j!,k!,l!,m!
      45. case max!<a!:max!=a!:case max!<b!:max!=b!:case max!<c!:max!=c!:case max!<d!:max!=d!
      46. case max!<e!:max!=e!:case max!<f!:max!=f!:case max!<g!:max!=g!:case max!<h!:max!=h!
      47. case max!<i!:max!=i!:case max!<j!:max!=j!:case max!<k!:max!=k!:case max!<l!:max!=l!
      48. case max!<m!:max!=m!:return max!
      49. caseof 14:parameters a!,b!,c!,d!,e!,f!,g!,h!,i!,j!,k!,l!,m!,n!
      50. case max!<a!:max!=a!:case max!<b!:max!=b!:case max!<c!:max!=c!:case max!<d!:max!=d!
      51. case max!<e!:max!=e!:case max!<f!:max!=f!:case max!<g!:max!=g!:case max!<h!:max!=h!
      52. case max!<i!:max!=i!:case max!<j!:max!=j!:case max!<k!:max!=k!:case max!<l!:max!=l!
      53. case max!<m!:max!=m!:case max!<n!:max!=n!:return max!
      54. caseof 15:parameters a!,b!,c!,d!,e!,f!,g!,h!,i!,j!,k!,l!,m!,n!,o!
      55. case max!<a!:max!=a!:case max!<b!:max!=b!:case max!<c!:max!=c!:case max!<d!:max!=d!
      56. case max!<e!:max!=e!:case max!<f!:max!=f!:case max!<g!:max!=g!:case max!<h!:max!=h!
      57. case max!<i!:max!=i!:case max!<j!:max!=j!:case max!<k!:max!=k!:case max!<l!:max!=l!
      58. case max!<m!:max!=m!:case max!<n!:max!=n!:case max!<o!:max!=o!:return max!
      59. endselect
      60. endproc
      61. proc Min15f
      62. var min!=val("1e306")
      63. select %PCount
      64. caseof 0:print "*** Too few parameters in Min15f() ***":return min!
      65. caseof 1:parameters a!:return a!
      66. caseof 2:parameters a!,b!:return if(a!<b!,a!,b!)
      67. caseof 3:parameters a!,b!,c!:return if(a!<b!,if(c!<a!,c!,a!),if(c!<b!,c!,b!))
      68. caseof 4:parameters a!,b!,c!,d!
      69. case min!>a!:min!=a!:case min!>b!:min!=b!:case min!>c!:min!=c!:case min!>d!:min!=d!:return min!
      70. caseof 5:parameters a!,b!,c!,d!,e!
      71. case min!>a!:min!=a!:case min!>b!:min!=b!:case min!>c!:min!=c!:case min!>d!:min!=d!
      72. case min!>e!:min!=e!:return min!
      73. caseof 6:parameters a!,b!,c!,d!,e!,f!
      74. case min!>a!:min!=a!:case min!>b!:min!=b!:case min!>c!:min!=c!:case min!>d!:min!=d!
      75. case min!>e!:min!=e!:case min!>f!:min!=f!:return min!
      76. caseof 7:parameters a!,b!,c!,d!,e!,f!,g!
      77. case min!>a!:min!=a!:case min!>b!:min!=b!:case min!>c!:min!=c!:case min!>d!:min!=d!
      78. case min!>e!:min!=e!:case min!>f!:min!=f!:case min!>g!:min!=g!:return min!
      79. caseof 8:parameters a!,b!,c!,d!,e!,f!,g!,h!
      80. case min!>a!:min!=a!:case min!>b!:min!=b!:case min!>c!:min!=c!:case min!>d!:min!=d!
      81. case min!>e!:min!=e!:case min!>f!:min!=f!:case min!>g!:min!=g!:case min!>h!:min!=h!
      82. return min!
      83. caseof 9:parameters a!,b!,c!,d!,e!,f!,g!,h!,i!
      84. case min!>a!:min!=a!:case min!>b!:min!=b!:case min!>c!:min!=c!:case min!>d!:min!=d!
      85. case min!>e!:min!=e!:case min!>f!:min!=f!:case min!>g!:min!=g!:case min!>h!:min!=h!
      86. case min!>i!:min!=i!:return min!
      87. caseof 10:parameters a!,b!,c!,d!,e!,f!,g!,h!,i!,j!
      88. case min!>a!:min!=a!:case min!>b!:min!=b!:case min!>c!:min!=c!:case min!>d!:min!=d!
      89. case min!>e!:min!=e!:case min!>f!:min!=f!:case min!>g!:min!=g!:case min!>h!:min!=h!
      90. case min!>i!:min!=i!:case min!>j!:min!=j!:return min!
      91. caseof 11:parameters a!,b!,c!,d!,e!,f!,g!,h!,i!,j!,k!
      92. case min!>a!:min!=a!:case min!>b!:min!=b!:case min!>c!:min!=c!:case min!>d!:min!=d!
      93. case min!>e!:min!=e!:case min!>f!:min!=f!:case min!>g!:min!=g!:case min!>h!:min!=h!
      94. case min!>i!:min!=i!:case min!>j!:min!=j!:case min!>k!:min!=k!:return min!
      95. caseof 12:parameters a!,b!,c!,d!,e!,f!,g!,h!,i!,j!,k!,l!
      96. case min!>a!:min!=a!:case min!>b!:min!=b!:case min!>c!:min!=c!:case min!>d!:min!=d!
      97. case min!>e!:min!=e!:case min!>f!:min!=f!:case min!>g!:min!=g!:case min!>h!:min!=h!
      98. case min!>i!:min!=i!:case min!>j!:min!=j!:case min!>k!:min!=k!:case min!>l!:min!=l!
      99. return min!
      100. caseof 13:parameters a!,b!,c!,d!,e!,f!,g!,h!,i!,j!,k!,l!,m!
      101. case min!>a!:min!=a!:case min!>b!:min!=b!:case min!>c!:min!=c!:case min!>d!:min!=d!
      102. case min!>e!:min!=e!:case min!>f!:min!=f!:case min!>g!:min!=g!:case min!>h!:min!=h!
      103. case min!>i!:min!=i!:case min!>j!:min!=j!:case min!>k!:min!=k!:case min!>l!:min!=l!
      104. case min!>m!:min!=m!:return min!
      105. caseof 14:parameters a!,b!,c!,d!,e!,f!,g!,h!,i!,j!,k!,l!,m!,n!
      106. case min!>a!:min!=a!:case min!>b!:min!=b!:case min!>c!:min!=c!:case min!>d!:min!=d!
      107. case min!>e!:min!=e!:case min!>f!:min!=f!:case min!>g!:min!=g!:case min!>h!:min!=h!
      108. case min!>i!:min!=i!:case min!>j!:min!=j!:case min!>k!:min!=k!:case min!>l!:min!=l!
      109. case min!>m!:min!=m!:case min!>n!:min!=n!:return min!
      110. caseof 15:parameters a!,b!,c!,d!,e!,f!,g!,h!,i!,j!,k!,l!,m!,n!,o!
      111. case min!>a!:min!=a!:case min!>b!:min!=b!:case min!>c!:min!=c!:case min!>d!:min!=d!
      112. case min!>e!:min!=e!:case min!>f!:min!=f!:case min!>g!:min!=g!:case min!>h!:min!=h!
      113. case min!>i!:min!=i!:case min!>j!:min!=j!:case min!>k!:min!=k!:case min!>l!:min!=l!
      114. case min!>m!:min!=m!:case min!>n!:min!=n!:case min!>o!:min!=o!:return min!
      115. endselect
      116. endproc
      Alles anzeigen
    • MAGISCHE QUADRATE
      ==============
      Der Stich "Magie" von Albrecht Dürer führte mich auf das Thema "Magische Quadrate". Es ist erstaunlich, wieviel Literatur und wie viele Internetseiten dazu existieren. Besonders gut fand ich DIESE Seite hier.

      Hier eine kurze Zusammenfassung meiner bisherigen Suchergebnisse:

      Brainfuck-Quellcode

      1. Es gibt ein triviales "magisches Quadrat" der Seitenllänge 1, nämlich "1".
      2. Es gibt KEIN magisches Quadrat 2x2. Die Existenz magischer
      3. Quadrate ist aber für alle Seitenlängen >=3 gesichert!
      4. Kleinstes magisches Quadrat n x n = 3x3: Magische Summe M = 15
      5. (Solche Quadrate weisen 8 Symmetrien auf, die als gleich gelten.
      6. Deshalb zählt das nur als ein einziges Quadrat !).
      7. 8 1 6
      8. 3 5 1
      9. 4 9 2
      10. Formel für die Berechnung Magischer Zahlen M:
      11. GESAMTSUMME = 1 + 2 + 3 + ... + (n²-1) + n² =
      12. = ( n²+1 ) * n² / 2 == n_Zeilen * M (!!!)
      13. ==> M = ( n²+1 ) * n² /(2*n) = (n²+1)*n/2
      14. zB: n = 3: M = 10 * 3 / 2 = 15 qed.
      15. Magisches Quadrat 4x4: n = 4: Magische Summe M = 17 * 4 / 2 = 34
      16. (Es gibt 12 unterschiedliche Strukturgruppen solcher Quadrate und
      17. ingesamt 880 verschiedene magische 4x4-Quadrate).
      18. 16 _1 12 _7
      19. 11 _8 13 _2
      20. _5 10 _3 16
      21. _4 15 _6 _9
      22. Der bekannte Stich "Magie" von Albrecht Dürer ist ein 4x4-Quadrat:
      23. 16 _3 _2 13
      24. _5 10 11 _8
      25. _9 _6 _7 12
      26. _4 15 14 _1
      27. Das einfachste Rezept zur Erzeugung eines magischen Quadrates:
      28. 1. Schreibe alle Zahlen aufsteigend zeilenweise auf.
      29. 2. Lasse die Zahlen in den Ecken und in der Mitte stehen.
      30. 3. Ersetze die übrigen Zahlen durch 17-Feldzahl.
      31. Magisches Quadrat 5x5:
      32. - Zeilen=Spalten=Hauptdiagonalen-Summe 65
      33. - Es gibt 1394 Summandenzerlegungen(5) der Zahl 65.
      34. - Es gibt 275 305 224 verschiedene magische
      35. 5x5–Quadrate mit den Zahlen 1 bis 25, z.B.:
      36. 23 _6 19 _2 15
      37. _4 12 25 _8 16
      38. 10 18 _1 14 22
      39. 11 26 _7 20 _3
      40. 17 _5 13 21 _9
      41. Magisches Quadrat 6x6:
      42. _1 35 _4 33 32 _6
      43. 30 _8 27 28 11 _7
      44. 24 23 15 16 14 19
      45. 13 17 21 22 20 18
      46. 12 26 10 _9 29 25
      47. 31 _2 34 _3 _5 36
      48. Magisches Quadrat 7x7:
      49. 40 _1 _2 _3 42 41 46
      50. 38 31 13 14 32 35 12
      51. 39 30 26 21 28 20 11
      52. 43 33 27 25 23 17 _7
      53. _6 16 22 29 24 34 44
      54. _5 15 37 36 18 19 45
      55. _4 49 48 47 _8 _9 10
      56. Magisches Quadrat 8x8:
      57. 58 _7 29 36 54 11 17 48
      58. 59 _6 32 33 55 10 20 45
      59. _8 57 35 30 23 53 47 18
      60. _5 60 34 31 _9 56 46 19
      61. 62 _3 21 44 50 15 25 40
      62. 63 _2 24 41 51 14 28 37
      63. _4 61 43 22 16 49 39 26
      64. _1 64 42 23 13 52 38 27
      65. Die magischen Zahlen dazu lauten lt. obiger Formel für
      66. 3x3: 15, 4x4: 34, 5x5: 65, 6x6: 111
      67. 7x7: 175, 8x8: 260, 9x9: 369, 10x10: 505
      68. ---------------------------------------------------------------------
      69. Hat das Quadrat noch die zusätzliche Eigenschaft, dass die Summen
      70. der "gebrochenen" Diagonalen auch noch den Wert der magischen
      71. Zahl haben, so heißt es panmagisch.
      72. ================================================
      73. Das einzig existierende Magische Hexagon
      74. hat Seitenlänge=3 und die magische Summe 34:
      75. ______3
      76. ___17___19
      77. 15____7____16
      78. ___1_____2
      79. 11____5____12
      80. ___6_____4
      81. _9____8____10
      82. ___14___13
      83. ______15
      84. Gesamt-Summe im Hexagon bei Seitenlänge n:
      85. 1 + 2 + 3 + ... + 3*n*(n-1) + 1 =
      86. = (3*n*(n-1)/2 + 1) * (3*n*(n-1)+2) == (2*n-1) * M
      87. ==> M = (3*n*(n-1)/2 + 1) * (3*n*(n-1)+2) / (2*n-1)
      88. ==> 32*M = 72 * n^3-108*n^2+90*n-27 + 5 / (2*n-1)
      89. Trick: Bei allen Termen ausser 5 / (2*n-1) ist eine Ganzzahl
      90. sichergestellt. Damit auch bei 5 / (2*n-1) eine Ganzzahl
      91. rauskommt, muss n entweder 1 sein (Trivialer Fall) oder
      92. aber 3. Deshalb gibt es keine magischen Hexagons mit
      93. anderer Seitenlänge als 3, qed.
      94. --------------------------------------------------------------------------------------
      95. Es gibt magische Multiplikationsquadrate:
      96. Dieses 3x3-Quadrat ist das Quadrat mit dem kleinsten Produkt,
      97. nämlich der Magischen Produktzahl 216:
      98. _2 _9 12
      99. 36 _6 _1
      100. _3 _4 18
      101. -------------------------------------------------------------
      102. Es gibt sogar magische Würfel 3 x 3 x 3. Allerdings sind die
      103. Flächendiagonalen nicht magisch, nur alle Raumdiagonalen!
      104. =============================================================
      Alles anzeigen
    • In welcher Tiefe im Erdboden ist Winter, wenn oben Sommer ist?
      ==================================================
      Theorie im Spoiler!
      Spoiler anzeigen

      (Q: Gewöhnliche Differentialgleichungen: Einführung in Lehre und Gebrauch von Harro Heuser, 6. Aufl., S 227, Vieweg+Teubner Vlg.)
      :
      Wärme breitet sich in Körpern nach physikalischen Gesetzen aus, siehe:
      grund-wissen.de/physik/waermel…sbreitung-von-waerme.html, die
      bestimmten Differentialgleichungen folgen. Auf der Erde schwankt die Temperatur
      -no-na - jahreszeitlich nach komplexen Funktionen, die man z.B. durch Fourierzerlegung
      formalisieren kann. Zur Vereinfachung nehmen wir als Anregungsfunktion nur die
      Grundwelle der Fouriertransformierten an:
      :
      : : : : Temp(t) = A/2 + A1*cos(omega*t)+B1*sin(omega*t)
      :
      (Bei einer bestimmten Wärmeleitfähigkeit der Erde von tau ) folgt die
      Temperatur in einer Tiefe von x [m] dann folgender Gleichung:
      :
      : : : : Temp(Tiefe_x, Zeit_im_Jahr) = A0/2 * sqrt(A1² + B1²) \
      * exp( -1*sqrt(Pi/tau*Jahr*x) )*cos( 2pi/Jahr*Zeit_im_Jahr+phi-sqrt(x*pi/(tau*Zeit_im_Jahr)) )
      :
      Dabei ist A0 / 2 = die mittlere Temperatur einer Gegend, über das Jahr gemessen.
      :
      Die Schwingungsamplitude um dieses A0/2 herum errechnet sich zu Sqrt(A1^2+B1^2).
      :
      Die Temperatur in der Tiefe x schwingt cosinusförmig um das Oberflächenmittel,
      und zwar mit der tiefenabhängigen Amplitude:
      : : : : Y = Oberflächenamplitude * exp( -x*sqrt(pi/(tau*1Jahr)) ), und der
      : : : : Frequenz = Oberflächenfrequenz.
      :
      In hinreichender Tiefe unterliegt die Tempeartur daher nur mehr unwesentlichen Schwankungen
      und stimmt dort mit dem Oberflächenmittel A0/2 überein.
      :
      Hingegen ist ihre Phase gegenüber der Oberflächenphase verzögert um
      : : : : Zeit_im_Jahr = x * sqrt(Pi/(tau*1Jahr))
      :
      Die Oberflächenzustände pflanzen sich daher mit der Geschwindigkeit
      : : : : v = 2 * Sqrt(pi*tau / Jahr ) gedämpft im Erdinneren fort.
      Praktische Anwendung
      =============
      Die Temperaturleitfähigkeit der Erde (über alle Erdsorten und Erdfeuchtigkeiten gemittelt) beträgt ungefähr 1/500 [cm²/s].
      :
      Als Periode T nehmen wir 1 Normaljahr zu 365 Tagen. Dieses hat also 31536000 Sekunden.
      :
      In einer Tiefe von 1 m = 100 cm haben wir daher schon einen Dämpfungsfaktor von
      : : : : D = exp(-100*sqrt(500*pi/31536000)) ~ 0.4937 ~ ca. 1/2,
      und somit in x Meter Tiefe näherungsweise den Dämpfungsfaktor (1/2)^x .
      :
      Der Dämpfungsfaktor ist also für eine Tiefe von [m]
      : : : :1 m: 0.5, 2 m: 0.25, 3 m: 0.125, ..., 10 m: 0.001
      :
      In einer realiv warmen Stadt (z.B. Karlsruhe) beträgt das Jahresmittel
      : : : : 9.9°C, das Jännermittel 0.9°C und das Julimittel 19.2°C.
      :
      In n Meter Tiefe ist der Maximalwert daher
      ____ 2m _4m _6m
      Max 12.2, 10.5, 10 °C
      Min_ 7.7, 9.3, 9,8 °C
      Diff_ 4.5, 1.2, 0.2 °C
      :
      Über eine Jahresperiode beträgt die Fortpflanzungsgeschwindigkeit also
      : : : : 2*sqrt(pi/(500*31536000) ~ 0.000028 cm/s
      :
      In einem halben Jahr (31536000 / 2 s) dringt der Oberflächenzustand also
      in eine Tiefe von 4.4 m vor. Dort ist dann Winter, wenn oben Sommer ist, ABER:
      es gibt kaum noch einen Unterschied zum Jahresmittel, im Beispiel also ~ 9.9°C)
      ==============================================================
    • Max/Min
      für die alten Versionen kenne ich keine Vereinfachung. In neueren Versionen kann der Parameter ein Array sein.

      Dann kann mit Max(Array[...,...,...]) auch eine größere Anzahl verarbeitet werden und mittels Nearly() kann dann auch noch als 2. Parameter eine Genauigkeit gesetzt werden. Bei Float ja nicht ganz unwichtig.

      War das Parameter-Problem nicht mal eine alte Microsoft-Grenze?
      Na egal, viele Parameter sollte man anders handhaben. Über Strukturen oder Arrays hat man da einfach mehr Möglichkeiten.
      Programmieren, das spannendste Detektivspiel der Welt.
    • Danke, stimmt! Ich vermute sogar, diese Grenze stammt sogar noch aus DOS-Zeiten. Mit Arrayvariablen ginge es natürlich besser, aber mein Problem tauchte bei einer Übersetzung eines Fortran-77 Programms nach XProfan 11 auf, und da wollte ich möglichst nahe am Original bleiben.
      Gruss

      P.S.: Noch ein kleiner Nachtrag zum Thema "Magische Quadrate"
      =========================================
      Vollständig ganzzahlige Kubikwurzeln eines Magischen 7x7-Quadrats,
      2014 gefunden im Rahmen eines Preisausschreibens (Gewinn 500 Eur).
      Die Zeilen-/Spalten-/Diagonalensumme der Feldzahlen^3 ist 616617:

      24 65 25 58 38 32 31
      39 16 49 56 33 60 20
      10 54 74 11 37 _6 _9
      15 14 35 55 _4 23 73
      62 28 17 21 _8 64 43
      67 53 22 41 _3 13 44
      _2 19 27 _1 78 45 29
    • Abt. Wußten Sie schon, daß ...
      ===================
      10 ! Sekunden genau 6 Wochen sind? Beweis anbei!
      Gruss
      Spoiler anzeigen
      Beweis:
      = 10*9*8*7*6*5*4*3*2*1 Sekunden
      = 10*9*8*7*6*5*4*3*2__ Sekunden
      = ___9*8*7*6*5*4______ Minuten
      = ___9*8*7*6*5*2*2____ Minuten
      = ___9*8*7______*2____ Stunden
      = _3*3*8*7______*2____ Stunden
      = _3____*7______*2____ Tage
      = _3____________*2____ Wochen
      = 6 Wochen
    • Abt. Sudoku-Kombinatorik
      ==================
      Sudoku wird bekanntlich in einem 9x9-Feld (9 Stück 3x3-Quadrate) gespielt. Su = Zahl, doku = alleine: Gemeint ist, daß in allen Zeilen, in allen Spalten und allen Quadraten alle Ziffern von 1 bis 9 untergebracht werden müssen, aber jede Ziffer nur genau 1 mal.

      Mathematiker haben errechnet: Es gibt insgesamt genau 6.670.903.752.021.072.936.960 verschiedene Sudoku-Lösungen. Diese lassen sich in insgesamt 5.472.730.532 Symetriefamilien einteilen. Selbst bei 16 vorgegebenen Hinweisen (vor-ausgefüllten Feldern) gibt es immer noch 33.000.000.000.000.000 verschiedene Sudokus!

      Andereseits gibt es ab 17 geeignet platzierten Hinweisen nur mehr eine einzige, eindeutige Lösung (bewiesen mit Computerhilfe Ende 2011). Diese Lösung ist allerdings sehr sehr schwer zu ermitteln. Mittelschwere Sudokus in Zeitungen weisen deshalb so um die 25 vorausgefüllte Felder auf, damit die Sache zumutbar bleibt.

      Falls alle Stricke reissen, bietet sich im Internet ein Online-Sudoku-Solver an, der einem auch Schritt für Schritt seine Tricks beibringen kann.
      Gruss
      Spoiler anzeigen


      P.S.: Ein Sudoku-artiges Spiel wurde erstmals 1982 in den USA beim Rätselverlag Dell riddles unter dem Namen "Number place" erfunden, dortigen Rätselzeitungen angeboten und von allen diesen Zeitungen als zu schwer abgelehnt. Daher wurden alle Rechte 1984 an den japanischen Verlag Nikoli verkauft. Weil ursprünglich über 30 der 81 Felder vorgegeben waren, war den Japanern dieses Spiel aber zu leicht (!!!). Erst als 1986 weniger als 30 Felder vorbesetzt wurden und die Vorgaben einem symmetrischen Muster folgten, wurde das Spiel unter der Bezeichnung Su-do-ku in Japan zum absoluten Renner.

      Später mussten es die U.S.-Verlage für den Einsatz in Amerika um teures Geld erst wieder zurückiizenzieren, den dortigen Durchbruch schaffte es aber erst 1997, als es einem Australier gelant, einen Sudoku-Generator zu programmieren, sodaß täglich ein Rätsel gebracht werden konnte. Nach Europa kam Sudoku erst im Jahr 2004, wo es dem Verlag der Zeitschrift "The Times" gelang, einen bis heute anhaltenden Boom auszullösen.

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