ALGORITHMEN - Teil XIV: Jetzt noch irrer!

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

  • Lösung zu NR 33 ´Hoch damit´:
    Spoiler anzeigen

    Die Verrechnung von Hochzahlen von Hochzahlen funktioniert in XProfan entgegen den Mathe-Regeln von links nach rechts. Da aber alle Teile SQRT(2) sind und der Ausdurck symmetrisch ist, ist das hier egal, und wir können nach Mathe-Regeln vorgehen:
    A ^ B ^ C = (A^B)^C = A^(B^C)

    In unserem Beispiel ist A = SQRT(2), B = SQRT(2) undn C = SQRT(2), und somit steht hier:
    SQRT(2)^SQRT(2)^SQRT(2) = SQRT(2)^(SQRT(2)*SQRT(2) = SQRT(2)^(SQRT(2)^2) = SQRT(2)^2 = 2
    Der exakte Wert ist also tatsächlich genau 2.

    P.S.: Das funktioniert mit jeder Zahl unter der Wurzel:
    SQRT(5)^SQRT(5)^SQRT(5) = SQRT(5)^(SQRT(5)*SQRT(5)=SQRT(5)^(SQRT(5)^2) = SQRT(5)^2 = 5


    Lösung zu NR 34 ´Habt Acht´

    Quellcode

    1. $IFNDEF INTERPRETER :Print "\n Sorry, Execute-Befehl klappt nur mit Interpreter!"
    2. $ELSE :WindowStyle 24:WindowTitle "Acht Achter sollen sich zu 1000 summieren:"
    3. Cls:print:declare a$,b$,c$,d$,e$,f$,g$,x$,x&,z$[2]:z$[2]=" + "
    4. whileloop 2:a$=z$[&Loop]:whileloop 2:b$=z$[&Loop]
    5. :whileloop 2:c$=z$[&Loop]:whileloop 2:d$=z$[&Loop]
    6. :whileloop 2:e$=z$[&Loop]:whileloop 2:f$=z$[&Loop]:whileloop 2:g$=z$[&Loop]
    7. x$="LET x& = 8"+a$+"8"+b$+"8"+c$+"8"+d$+"8"+e$+"8"+f$+"8"+g$+"8":execute x$
    8. if x&=1000:font 2:print " ";x$;" = 1000 "+chr$(171):sound 400,40:waitinput 42:endif
    9. endwhile:endwhile:endwhile:endwhile:endwhile:endwhile:endwhile
    10. $ENDIF :beep:print " ________":waitinput 30000:end
  • Ah, danke! QuadInt kommt als Steuerwort hinzu, ab FreeProfan32 bzw. Profan64 vermute ich mal.

    Abt. Fensterputzer
    ==============
    Es gibt Window-Styles, die ziemlich exotisch sind. Damit man da mal experimentieren kann, gibt´s das nachstehende Progi, das die auf MSDN angegbenen Steuerelemente übersetzt. Der Windows-Befehl von XProfan erspart uns, am Ende immer die drei Nullen einzugeben, die beim API-Befehl erforderlich sind. NUTZUNG AUF EIGENE GEFAHR! Frank Abbings LemonEd-Editor bietet hier den Vorteil, Programme durch Drücken beider SHIFT-Tasten gleichzeitig jederzeit abbrechen zu können (- erspart häufig den Taskmanager!).
    Gruss

    Brainfuck-Quellcode

    1. 'Window Styles:
    2. 'After the window has been created, these styles cannot be modified, except as noted.
    3. 'Constant/value Description
    4. '-------------------------------------------------------------------------------------
    5. var WS_BORDER&=$00800000 'The window has a thin-line border.
    6. var WS_CAPTION&=$00C00000 'The window has a title bar (includes the WS_BORDER style).
    7. var WS_CHILD&=$40000000 'The window is a child window. A window with this style cannot
    8. ' have a menu bar. This style cannot be used with the WS_POPUP style.
    9. var WS_CHILDWINDOW&=$40000000 'Same as the WS_CHILD style.
    10. var WS_CLIPCHILDREN&=$02000000 'Excludes the area occupied by child windows when drawing
    11. 'occurs within the parent window. This style is used when creating the parent window.
    12. var WS_CLIPSIBLINGS&=$04000000 'Clips child windows relative to each other; that is, when a
    13. ' particular child window receives a WM_PAINT message, the WS_CLIPSIBLINGS style clips all other
    14. ' overlapping child windows out of the region of the child window to be updated.
    15. ' If WS_CLIPSIBLINGS is not specified and child windows overlap, it is possible, when drawing
    16. ' within the client area of a child window, to draw within the client area of a neighboring
    17. ' child window.
    18. var WS_DISABLED&=$08000000 'The window is initially disabled. A disabled window cannot receive
    19. ' input from the user. To change this after a window has been created, use the EnableWindow function.
    20. var WS_DLGFRAME&=$00400000 'The window has a border of a style typically used with dialog boxes.
    21. ' A window with this style cannot have a title bar.
    22. var WS_GROUP&=$00020000 'The window is the first control of a group of controls. The group
    23. ' consists of this first control and all controls defined after it, up to the next control with
    24. ' the WS_GROUP style. The first control in each group usually has the WS_TABSTOP style so that
    25. ' the user can move from group to group. The user can subsequently change the keyboard focus from
    26. ' one control in the group to the next control in the group by using the direction keys.
    27. ' You can turn this style on and off to change dialog box navigation. To change this style after
    28. ' a window has been created, use the SetWindowLong function.
    29. var WS_HSCROLL&=$00100000 'The window has a horizontal scroll bar.
    30. var WS_ICONIC&=$20000000 'The window is initially minimized. Same as the WS_MINIMIZE style.
    31. var WS_MAXIMIZE&=$01000000 'The window is initially maximized.
    32. var WS_MAXIMIZEBOX&=$00010000 'The window has a maximize button. Cannot be combined with
    33. ' the WS_EX_CONTEXTHELP style. The WS_SYSMENU style must also be specified.
    34. var WS_MINIMIZE&=$20000000 'The window is initially minimized. Same as the WS_ICONIC style.
    35. var WS_MINIMIZEBOX&=$00020000 'The window has a minimize button. Cannot be combined with
    36. ' the WS_EX_CONTEXTHELP style. The WS_SYSMENU style must also be specified.
    37. var WS_OVERLAPPED&=$00000000 'The window is an overlapped window. An overlapped window has
    38. ' a title bar and a border. Same as the WS_TILED style.
    39. var WS_SYSMENU&=$00080000 'The window has a window menu on its title bar. The WS_CAPTION style
    40. ' must also be specified.
    41. var WS_THICKFRAME&=$00040000 'The window has a sizing border. Same as the WS_SIZEBOX style.
    42. var WS_POPUP&=$80000000 'The windows is a pop-up window. This style cannot be used with
    43. ' the WS_CHILD style.
    44. var WS_SIZEBOX&=$00040000 'The window has a sizing border. Same as the WS_THICKFRAME style.
    45. var WS_TABSTOP&=$00010000 'The window is a control that can receive the keyboard focus when
    46. ' the user presses the TAB key. Pressing the TAB key changes the keyboard focus to the next
    47. ' control with the WS_TABSTOP style.
    48. ' You can turn this style on and off to change dialog box navigation. To change this style after
    49. ' a window has been created, use the SetWindowLong function. For user-created windows and
    50. ' modeless dialogs to work with tab stops, alter the message loop to call the IsDialogMessage function.
    51. var WS_TILED&=$00000000 'The window is an overlapped window. An overlapped window has a
    52. ' title bar and a border. Same as the WS_OVERLAPPED style.
    53. var WS_VISIBLE&=$10000000 'The window is initially visible.
    54. ' This style can be turned on and off by using the ShowWindow or SetWindowPos function.
    55. var WS_VSCROLL&=$00200000 'The window has a vertical scroll bar.
    56. var WS_OVERLAPPEDWINDOW& =\
    57. WS_OVERLAPPED& | WS_CAPTION& | WS_SYSMENU& | WS_THICKFRAME& | WS_MINIMIZEBOX& | WS_MAXIMIZEBOX&
    58. ' The window is an overlapped window. Same as the WS_TILEDWINDOW style.
    59. var WS_POPUPWINDOW&= WS_POPUP& | WS_BORDER& | WS_SYSMENU&
    60. ' The window is a pop-up window. The WS_CAPTION and WS_POPUPWINDOW styles must be combined
    61. ' to make the window menu visible.
    62. var WS_TILEDWINDOW& = \
    63. WS_OVERLAPPED& | WS_CAPTION& | WS_SYSMENU& | WS_THICKFRAME& | WS_MINIMIZEBOX& | WS_MAXIMIZEBOX&
    64. ' The window is an overlapped window. Same as the WS_OVERLAPPEDWINDOW style.
    65. 'Header: Winuser.h (include Windows.h)
    66. WindowStyle (\
    67. WS_OVERLAPPED& | \
    68. WS_CAPTION& | \
    69. WS_SYSMENU& | \
    70. WS_THICKFRAME& | \
    71. WS_MINIMIZEBOX& | \
    72. WS_MAXIMIZEBOX& \
    73. )\1000
    74. Window 300,200 - 300,400
    75. cls $A0A000
    76. Waitinput
    77. End
    Alles anzeigen

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

  • Abt. Potthässliche Uhr
    ===============
    Ich musste das Ding einfach loswerden: Ab auf den Software-Müll damit!
    Sorry!

    Quellcode

    1. Windowtitle "POTTHÄSSLICHE UHR":WindowStyle 16 | 64
    2. 'Window (%maxx-%maxy)/2,0 - %maxy,%maxy-41:Cls
    3. Window 0,0 - %maxx,%maxy
    4. '(CL)CopyLeft 2017-11 by P.Specht, Wien; Keine wie auch immer geartete Gewähr!
    5. var xx&=width(%hwnd):var yy&=height(%hwnd):var xh!=xx&/2:var yh!=yy&/2
    6. declare t!,r0&,r1&,r2&,r3&,b0&,b1&,b2&,b3&,b9& ,pi2!
    7. r0&=300 : r1&=130 : r2&=210 : r3&=260: pi2!=2*pi()
    8. b0&=7 : b1&=28 : b2&=20 : b3&=8 : b9&=3
    9. MCls xx&,yy&:REPEAT
    10. t!=(val(mid$(time$(0),1,2))*60+val(mid$(time$(0),4,2))+val(mid$(time$(1),1,2))/60)*pi2!
    11. StartPaint -1:ClS if(between(t!,2260,6785),$F0F0F0,$707070)':locate 1,1:print t!;" ";
    12. usebrush 1,$E0E0E0:usepen 0,2*b0&,$000000:Ellipse xh!+r0&+2,yh!+r0&+2 - xh!-r0&+2,yh!-r0&+2
    13. usebrush 0,$E0E0E0:usepen 0,b0&,$A0A000:Ellipse xh!+r0&,yh!+r0& - xh!-r0&,yh!-r0&
    14. usepen 0,b9&,0:line xh!,0 - xh!,yy& : line 0,yh! - xx&,yh!
    15. usepen 0,b1&,$A00000:line xh!,yh! - xh!+r1&*sin(t!/720),yh!-r1&*cos(t!/720)
    16. usepen 0,b2&,0:line xh!,yh! - xh!+r2&*sin(t!/60),yh!-r2&*cos(t!/60)
    17. usepen 0,b3&,200:line xh!,yh! - xh!+r3&*sin(t!),yh!-r3&*cos(t!)
    18. EndPaint:MCopyBMP 0,0-xx&,yy& > 0,0;0
    19. waitinput 1000:UNTIL (%key>0) or %mousepressed
    20. end
    Alles anzeigen
  • Abt. Euler’sche Quadrate
    ==================
    Die Felder eines n x n Rasters sind mit n Farben so einzufärben, dass jede Zeile und jede Spalte jede Farbe genau einmal enthält. Diese Regel gilt sowohl für das Innere als auch für den Rand der Felder. Außerdem darf jede Kombination von Innen- und Außenfarbe im gesamten Quadrat nur einmal vorkommen. Derart gefärbte Quadrate sind nach Leonhard Euler (1707 - 1783) benannt. Sie heißen auch griechisch-lateinische Quadrate, weil Euler anstelle von Innen- und Außenfarbe griechische und lateinische Buchstaben verwendete.

    Die Legende berichtet von einer Anfrage, die Zarin Katharina die Große an Euler richtete: Für einen Ball am Hofe sollte jedes der sechs anwesenden Regimenter jeweils sechs Offiziere abstellen, wobei außerdem jeder der sechs üblichen Dienstgrade vertreten sein musste. Diese 36 Offiziere sollten in einem Karree-Quadrat Aufstellung nehmen, und zwar so, dass in jeder Zeile und Spalte sowohl jedes Regiment als auch jeder Dienstgrad vorkommt.

    Aber nicht mal der große Euler schaffte das: Er fand zwar Lösungen für Quadrate der Seitenlänge n = 3, 4, 5, 7, 8, 9 sowie für beliebige ungerade n und durch 4 teilbare n, aber eben nicht für n = 6. Er vermutete, dass es in diesem Fall keine Lösung gibt. Ersst 1901 wurde seine Vermutung von Gaston Tarry (1843 - 1913) durch systematisches Probieren bestätigt.

    Und seit 1959 ist bekannt, daß es Lösungen für alle natürlichen Zahlen außer 2 und 6 gibt!

    Gruss

    P.S. - Q: tom.haimath.at/downloads/_files/Mathematik_im_Spiel.pdf

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

  • Abt. LED-Weihnachtsbeleuchtung steuern
    ==========================
    Für eine Auslage wurde ein Weihnachtsstern aus 6 x 25 LED entworfen, von denen 6 x 5 stets leuchten, die dabei aber sich möglichst selten wiederholende Muster bilden sollen. 5 aus 25 für jeden symmetrischen Ast bedeutet, daß es (25*24*23*22*21) / (5*4*3*2*1) = 53130 verschiedene Muster gibt. Nachstehend ein erster Test der Ansteuerlogik.
    Gruss

    Quellcode

    1. WindowTitle "Weihnachtsbeleuchtung: Schneeflockensechstel ansteuern"
    2. WindowStyle 24:Window 0,0-%maxx,%maxy:font 2:randomize
    3. declare a&,b&,c&,d&,e&, n&,z&,v&,x&,dx&,y$,u$,tb&
    4. v&=5:x&=25 : dx&=x&-v&:y$=mkstr$("-",dx&):tb&=1
    5. Whileloop 0,dx&+0:a&=(1<<&Loop)
    6. :whileloop &Loop+1,dx&+1:b&=(1<<&Loop)
    7. :whileloop &Loop+1,dx&+2:c&=(1<<&Loop)
    8. :whileloop &Loop+1,dx&+3:d&=(1<<&Loop)
    9. :whileloop &Loop+1,dx&+4:e&=(1<<&Loop)
    10. inc n&
    11. Ausgabe
    12. endwhile:endwhile:endwhile:endwhile:endwhile
    13. print:locate %csrlin,tb&:print n&:beep:waitinput:End
    14. proc Ausgabe : z&=a& | b& | c& | d& | e&
    15. u$=translate$(right$(y$+bin$(z&),x&),"0","-")
    16. 'locate %csrlin,tb&:print u$
    17. locate %csrlin,tb&:print mid$(u$,1,5)
    18. locate %csrlin,tb&:print mid$(u$,6,5)
    19. locate %csrlin,tb&:print mid$(u$,11,5)
    20. locate %csrlin,tb&:print mid$(u$,16,5)
    21. locate %csrlin,tb&:print mid$(u$,21,5):print
    22. if %csrlin>55-v&:tb&=tb&+2+v&
    23. if tb&>165:waitinput 500:cls:tb&=1:else:locate 1,tb&:endif
    24. endif
    25. endproc
    Alles anzeigen
  • Abt. Neue Rätselecke NR 35: ´Wieso?´
    ==========================
    Die Folge 1, 3, 5, 7, 9, 11, 13, 15, ... der ungeraden Natürlichen Zahlen kennt jedes Kind. Macht man daraus finite Reihen, also abbrechende Summen dieser Folge, kommt eine weitere bekannte Zahlenfolge heraus: 1, 4, 9, 16, ... Nach welcher Formel geht das?
    Gruss

    P.S.: Wieso?
  • Lösung zu NR 35:
    Spoiler anzeigen

    Nimmt man die Folge aller ungeraden Zahlen, so kann man das N-te Folgeglied darstellen als (2*N-1).
    Das Ergebnis der Summenbildung von 1 bis zu diesem N-ten Glied ist dann N*N bzw. N^2,
    es handelt sich also um die Folge der Quadratzahlen.

    Probe:
    1 = 1
    1 + 3 = 4 = 2*2 = Summe der ersten 2 Folgeglieder = 2^2
    1 + 3 + 5 = 9 = 3*3 = Summe der ersten 3 Folgeglieder = 3^2
    1 + 3 + 5 + 7 = 16 = 4*4 = Summe der ersten 4 Folgeglieder = 4^2
    1 + 3 + 5 + 7 + 9 = 25 = 5*5 = Summe der ersten 5 Folgeglieder = 5^2
    1 + 3 + 5 + 7 + 9 + 11 = 36 = 6*6 = Summe der ersten 6 Folgeglieder = 6^2
    ...
    1 + 3 + --- + (2*N-1)

    Zur Frage ´Wieso?´:
    Dazu gibt es sehr viele Beweise. Einer der einfachsten ist der folgende geometrische
    ´Beweis durch Anschauung´: Wir bilden ein Zahlenquadrat ...
    1|2|3|4|5|6
    2 2|3|4|5|6
    3 3 3|4|5|6
    4 4 4 4|5|6
    5 5 5 5 5|6
    6 6 6 6 6 6
    usw. usw.: q.e.d


    Neue Rätselecke Nr. 36: Das ´Stacked Oranges´ Problem:
    ==================
    Beispiel 35 war lehrreich, aber jetzt das Ganze erweitert auf dreidimensional:
    Bilde eine Orangenpyramide, wie sie oft auf Marktständen aufgetürmt ist.
    Die Seitenlänge der Pyramide [in Stück Orangen] sei N;
    dann sind für die Pyramide X Orangen notwendig. Hier eine Liste aus ersten Versuchen:

    N: X
    --------
    1: 1
    2: 4
    3: 6
    4: 10
    5: 20
    6: 35
    7: 56
    8: 84
    9: 120
    10: ??

    Gesucht ist X für eiine Seitenlänge von N=10 Orangen, und nach Möglichkeit eiine Formel, mit der man X aus gegebenem N berechnen kann.
    Gruss

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

  • Im obigen Rätsel Nr. 36 hat sich ein bedauerlicher Fehler eingeschlichen: Aus 6 Orangen kann kein Mensch eine regelmäßige Pyramide bauen. Bei euren Versuchen kamen hoffentlich keine Orangen zu Schaden! Die Lösung zu NR 36 lautet: Die nächstfolgende Zahl ist 165, und zwar nach der Formel X = N*(N+1)*(N+2)/6, gefunden vom 6-jährigen Inder Manjul Bhargava, heute Fields-Medaillenträger und Professor am UCLA (USA).
    Nochmals: Sorry!
  • Abt. 142857
    ==========
    Es gibt Zahlen, die auf den ersten Blick wie alle anderen aussehen. 142.857 ist so eine Zahl.
    Aber schauen wir mal weiter:
    Spoiler anzeigen
    142.857 * 1 = 142.857 (klar)
    142.857 * 2 = 285.714
    142.857 * 3 = 428.571
    142.857 * 4 = 571.428
    142.857 * 5 = 714.285

    142.857 * 6 = 857.142
    ... merkt ihr was? Und schließlich der krönende Abschluß:
    142.857 * 7 = 999.999
    Gruss

    P.S.: 1/7 = 0,_142857_periodisch!
    PPS: Nach Manul Bhargava erhält man eine 16-stellige Zahl mit ähnlichen Eigenschaften (in dem Fall 16 Ziffern-Permutationen) aus den Nachkommastellen von 1/17=0._0588235294117647_periodisch. Schaun wir mal:

    Quellcode

    1. cls:set("decimals",0):font 2
    2. var x!=val("0588235294117647")
    3. whileloop 17
    4. print right$("0"+str$(x!*&Loop),16)
    5. endwhile
    6. waitinput

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

  • Abt. Kusszahlen
    ============
    Wieviele Kugeln kann eine Einheitskugel in verschiedenen Dimensionen gleichzeitig "küssen" = ohne Überschneidung berühren: Ein in großen Teilen noch immer ungelöstes Problem. Auch ist eine allgemeine Formel nicht bekannt - Ihr könnt euch ja mal daran versuchen und um die Fields-Medaille rittern!
    Gruss

    Quellcode

    1. WindowTitle "Kusszahlen: Wieviele frei bewegliche Einheitskugeln kann eine Einheitskugel gleichzeitig ´küssen´?"
    2. 'Q: https://de.wikipedia.org/wiki/Kusszahl
    3. WindowStyle 24:Window 0,0-%maxx,%maxy:cls:font 2:showmax
    4. Print "\n Dimension:|Kusszahl-Min.|-Max. (-1:unbekannt)"
    5. Print " ============================================="
    6. var Kz$="\n1,2,2\n2,6,6\n3,12,12\n4,24,24\n5,40,44\n6,72,78\n7,126,134\n8,240,240\n9,306,364\n\
    7. 10,500,554\n11,582,870\n12,840,1357\n13,1130,2069\n14,1582,3183\n15,2564,4866\n16,4320,7355\n\
    8. 17,5346,11072\n18,7398,16572\n19,10688,24812\n20,17400,36764\n21,27720,54584\n22,49896,82340\n\
    9. 23,93150,124416\n24,196560,196560\n32,276032,-1\n36,438872,-1\n40,991792,-1\n\
    10. 44,294552,-1\n64,331737984,-1\n80,1368532064,-1"
    11. Print translate$(translate$(Kz$,"\n","\n "),","," , ")
    12. waitinput:cls
    13. WindowTitle upper$("Gitterkusszahlen: Wieviele Einheitskugeln am Einheitsgitter kann die Kugel berühren?")
    14. var gkz$="\n1,2\n2,6\n3,12\n4,24\n5,40\n6,72\n7,126\n8,240\n9,272\n10,336\n11,438\n12,756\n13,918\n\
    15. 14,1422\n15,2340\n16,4320\n17,5346\n18,7398\n19,10668\n20,17400\n21,27720\n22,49896\n23,93150\n24,196560"
    16. print "\n Dim., Gitterkusszahl:"
    17. print " ====================="
    18. print translate$(translate$(GKz$,"\n","\n "),","," , ")
    19. waitinput
    Alles anzeigen
    P.S. Quelle: de.wikipedia.org/wiki/Kusszahl
  • Abt. Geht das?
    ===========

    Quellcode

    1. CLS
    2. declare {AberHallo}!
    3. {AberHallo}!=1.12345
    4. print {Aberhallo}!
    5. waitinput

    Quellcode

    1. CLS:font 2:gosub "Subr":Goto "Skip":Subr:
    2. return if(0,"99 Luftballons!",val("12E-4")):Skip:
    3. print "$:";@$(0);"\n%:";@%(0);"\n&:";@&(0);"\n!:";@!(0)
    4. Waitinput

    Quellcode

    1. CLS:declare x&
    2. print "\n BASIC/ALGOL60/FORTRAN77´s ON x goto 100,120,999,300 nachbilden:\n"
    3. whileloop 0,5:x&=&Loop
    4. Select x&
    5. print " x = ";x&,tab(10);
    6. caseof 1,2,3,4:goto "L"+Substr$("100,120,999,300,",x&,",")
    7. endselect
    8. print "Hier kein Sprung!":goto "weiter":L100:
    9. print "Hier L100":goto "weiter":L120:
    10. print "Hier L120":goto "weiter":L999:
    11. print "Hier L999":goto "weiter":L300:
    12. print "Hier L300":weiter:
    13. endwhile
    14. waitinput
    Alles anzeigen

    Quellcode

    1. cls
    2. parameters a&,b&,c&,d&,e&
    3. parameters f&,g&,h&,i&,j&
    4. parameters k&,l&,m&,n&,o&,p&,q!
    5. a&=10
    6. o&=150
    7. p&=300
    8. q!=4.5678
    9. print a&,o&,p&,q!
    10. waitinput
    Achtung, letzteres klappt nur AUSSERHALB von PROCs! Innerhalb ist nur EIN Parameters-Befehl erlaubt, weil dort der jeweils letzte alle vorigen "overrulen" würde.

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

  • Abt. Weihnachtsstern-Strickmuster
    ==========================
    ... versehentlich beim experimentieren entstanden. Völlig daneben,
    Sorry!

    Quellcode

    1. WindowTitle upper$("Sterntest, early alpha")
    2. WindowStyle 24:Window 0,0-%maxx,%maxy:showmax
    3. font 1:randomize:declare t$[19],s$[19],i&,j&,z&[25]
    4. t$[00]=" yy "
    5. t$[01]=" wwxx "
    6. t$[02]=" ttuuvv "
    7. t$[03]=" ppqqrrss "
    8. t$[04]=" kkllmmnnoo "
    9. t$[05]=" yyxxvvssoo gghhiijj kkppttwwyy "
    10. t$[06]=" wwuurrnnjj ddeeff ggllqquuxx "
    11. t$[07]=" ttqqmmiiff bbcc ddhhmmrrvv "
    12. t$[08]=" ppllhheecc aa bbeeiinnss "
    13. t$[09]=" kkggddbbaa aaccffjjoo "
    14. t$[10]=" oojjffccaa aabbddggkk "
    15. t$[11]=" ssnniieebb aa cceehhllpp "
    16. t$[12]=" vvrrmmhhdd ccbb ffiimmqqtt "
    17. t$[13]=" xxuuqqllgg ffeedd jjnnrruuww "
    18. t$[14]=" yywwttppkk jjiihhgg oossvvxxyy"
    19. t$[15]=" oonnmmllkk "
    20. t$[16]=" ssrrqqpp "
    21. t$[17]=" vvuutt "
    22. t$[18]=" xxww "
    23. t$[19]=" yy "
    24. Whileloop 0,19:t$[&Loop]=t$[&Loop]+t$[&Loop]+t$[&Loop]+t$[&Loop]+t$[&Loop]:endwhile
    25. REPEAT:locate 1,1:MAT s$[]=t$[]:z&[]=rnd(4)/2
    26. whileloop 0,19:i&=&Loop
    27. whileloop 97,122:j&=&Loop
    28. s$[i&]=translate$(s$[i&],chr$(j&),if(z&[j&-97],chr$(2),"°"))
    29. endwhile
    30. print s$[i&]
    31. endwhile:print
    32. whileloop 0,19:print s$[&Loop]:endwhile:print
    33. whileloop 0,12:print s$[&Loop]:endwhile
    34. waitinput 1333
    35. UNTIL %Key>0
    Alles anzeigen
  • Abt. Anzahl an Primzahlen von 0 bis N
    ============================
    Eine schnelle _PI_(N)-Funktion: Mathematica und Maple haben eine. Maxima hat keine. Python hat eine. VB und Java haben keine. XProfan hat jetzt eine! :thumbsup:
    Gruss

    Quellcode

    1. WindowTitle upper$("PrimAnzahl-Funktion aka prime_PI(n)")
    2. '(CL) Copyleft 2017-12 by Jonathan & P.Specht - OHNE JEDE GEWÄHR!
    3. WindowStyle 24:CLS:Declare N0!,N&,tm&
    4. Repeat
    5. Print "\n Anzahl aller Primzahlen bis N = ?: ";
    6. Input N0!
    7. if (N0!<0) or (N0!>1e9) 'max. bis 2147483647, aber thermisch hohe Belastung!
    8. sound 2000,200
    9. Print " *** Out Of Range Error ***";
    10. locate %csrlin-2,1
    11. continue
    12. endif
    13. N&=int(N0!)
    14. Print "\n Gefundene Anzahl an Primzahlen: ";
    15. font 2
    16. tm&=&gettickcount
    17. Print format$("%g",PrimAnzahl(N&));
    18. N0!=(&gettickcount-tm&)/1000
    19. font 0
    20. Print ", ermittelt in ";N0!;" [s]"
    21. sound 70,42
    22. Until 0
    23. End
    24. Proc PrimAnzahl :Parameters ZahlenAnzahl&
    25. 'Q: Jonathan´s PrimTurbo-Assembler, adaptiert aus ALGORITHMEN IV Beitrag 12
    26. case ZahlenAnzahl&=2:return 1:case ZahlenAnzahl&<2:return 0
    27. Declare Daten#,PrimAnz&
    28. Declare Code#:Dim Code#,164:Clear Code#
    29. Long Code#,0=1397791846,1448563281,35048,-1959228672,12977264,21022208
    30. Long Code#,24=37799424,54576640,71353856,88131072,104908288,121685504
    31. Long Code#,48=16827904,16859334,441,-834977536,-796187532,311087363,1946286720
    32. Long Code#,76=-1047834384,-487075445,-1957113717,-958790696,-788332285
    33. Long Code#,96=-210315461,29087723,-1962934272,63013832,-150736757,225955387
    34. Long Code#,120=-1048374902,16416770,-347868555,63474671,428425679,1499094878
    35. Long Code#,144=-1654237093,321731,-854261760,-1957165221,49920
    36. Dim Daten#,ZahlenAnzahl& + 5
    37. Long Daten#,0 = ZahlenAnzahl&:Long Daten#,4 =(Sqrt(ZahlenAnzahl&)+1)\1
    38. WhileLoop 0,@SizeOf(Code#)-4
    39. If @Long(Code#,&loop)=123456789
    40. Long Code#,&loop=Daten#
    41. EndIf
    42. EndWhile
    43. @Call(Code#)
    44. PrimAnz&=@Long(Daten#,ZahlenAnzahl&+1)
    45. Dispose Code#,Daten#
    46. Return PrimAnz&
    47. EndProc
    48. 'Please verify: N! PrimAnzahl(N!):
    49. ' 1 0
    50. ' 10 4
    51. ' 100 25
    52. ' 1 000 168
    53. ' 10 000 1 229
    54. ' 100 000 9 592
    55. ' 1 000 000 78 498
    56. ' 10 000 000 664 579
    57. ' 100 000 000 5 761 455
    58. ' 1 000 000 000 50 847 534 ca.25 s, Coretemperatur>92° (Vorsicht!!!)
    59. ' 2 147 483 647 ??????????
    60. ProgEnd
    Alles anzeigen
  • Abt. Jonathan´s Trick
    ================
    Einige selbsterklärende Beispiele zu einer einer Formel "nachgestellten" Form von INT()-Funktion, die wir unserem Kollegen Jonathan und seinem Beitrag zum obigen Programm verdanken.
    Gruss
    Spoiler anzeigen

    Quellcode

    1. cls
    2. print Pi(),Pi()\1
    3. print 2^31-1,(2^31-1)\1
    4. print 2^60-1,(2^60-1)\1 'offenbar beschränkt auf LongInts
    5. waitinput

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

  • p.specht schrieb:

    #134
    Wem fallen XProfan-Befehle, eingebaute Funktionen, Systemvariablen, Create("- oder Set(" oder oGL("-Subbefehle mit den Anfangsbuchstaben Q, Y oder Z ein?
    #135
    Mit Y oder Z am Anfang ist mir kein Befehl oder Steuerwort / Systemvariable bekannt.
    Mit Q gibt es genau eines, und zwar den oGL("Quad",...) Befehl. Oder kennt jemand noch weitere?
    #142
    Ja, oGL("Quad",...)
    und den Datentyp QuadInt und seine Kurzform Quad


    und da habe auch ich noch einen übersehen:

    ZIP
    Programmieren, das spannendste Detektivspiel der Welt.
  • Abt. Eine Frage der Ehre
    ===================
    100 Samurai haben eine Schlacht verloren. Um der Schmach zu entgehen, haben Sie ein Schwert erbeten, um kollektiv ihrem Leben ein Ende zu setzen. Sie stehen im Kreis, und die Regel lautet: Töte den nächsten lebenden Nachbarn zu deiner Rechten, dann reiche das Schwert nach rechts weiter. Nur der Letzte soll verschont werden, auf dass er den nachkommenden Generationen berichte. Frage: Wer wird überleben?

    Dazu gibt es eine Formel, die im nachstehenden Progrämmchen durch ausprobieren verifiziert werden soll.
    Gruss

    Quellcode

    1. WindowTitle "Samurai-Rätsel (aka Josephus-Problem)"
    2. '(CL)Copyleft 2017-12 by P.Specht, Vienna. NO WARRANTY WHATSOEVER!
    3. 'Q: https://youtu.be/Xh7q4-OypzQ?t=291
    4. Windowstyle 24:Window 0,0-%maxx,%maxy
    5. Declare i&,j&,runde&,n&,s&[200]:n&=sizeof(s&[])-1
    6. print "\n Test läuft ..."
    7. Nochmal:
    8. i&=0:j&=0:runde&=0:s&[]=1
    9. SuchLebenden:
    10. inc i&:if i&>n&:i&=i&-n&:inc runde&:endif
    11. case runde&>n&:goto "Fertig"
    12. case s&[i&]=0:goto "SuchLebenden"
    13. j&=i&
    14. SuchOpfer:
    15. inc j&:case j&>n&:j&=j&-n&
    16. case s&[j&]=0:goto "SuchOpfer"
    17. Kill:
    18. case i&<>j&:s&[j&]=0
    19. goto "SuchLebenden"
    20. Fertig:
    21. font 2:print "\n Wenn ";n&;" Samurai, dann bleibt über Nr.";
    22. :Whileloop n&:case s&[&Loop]=1:print &Loop,:endwhile
    23. print " bzw. per Formel: ";int(2*(n&-2^int(lg(n&)/lg(2)))+1),
    24. n&=n&-1:if n&<2:beep:waitinput:end:endif
    25. goto "Nochmal"
    Alles anzeigen
  • Abt. Warum Träume wichtig sind
    ========================
    Ein kurzer Vergleich zeigt es:
    Mensch - Maschine
    ------------------------------------
    Sonne/Nahrung - Dampf/Strom
    Verständnis - Arbeitspensum
    Einsicht - Berechnung
    Sinn - Zweck
    Eigene Ziele - Fremde Anweisungen
    Leidenschaft - Objektivität
    Phantasie - Optimierung
    Ambitionen - Benchmarking
    Gefühl - Sensorinput
    Träume - ???

    mit anderen Worten: Träume machen uns menschlich...
    Gruss

    P.S.: ...nach Ex-Schachweltmeister Gary Kasparov, zu finden HIER.
  • Abt. Wieviele verschiedene Fussball-TorErgebnisse gibt es?
    ============================================
    Hier soll wieder-einmal eine Formel verifiziert werden.
    Gruss

    Quellcode

    1. Windowtitle "Wieviele Fussballergebnisse mit bis_zu_X_Toren gibt es?"
    2. Windowstyle 24:cls:font 2:Declare X&,N&,M1&,M2&: lup:
    3. Print "\n X <= ?:",:input X&:N&=0
    4. whileloop 0,x&:M1&=&Loop
    5. whileloop 0,x&:M2&=&Loop
    6. if (M1&+M2&)<=x&:inc n&
    7. print M1&;":";M2&;" ";
    8. endif
    9. endwhile
    10. endwhile
    11. print "\n ... = ";n&;" verschiedenen Spielausgänge, bzw. nach Formel: ";(sqr(x&+1)+x&+1)\2
    12. waitinput
    13. goto "lup"
    Alles anzeigen

    P.S.: Wen auch noch die Tipp-Basiswahrscheinlichkeiten interessieren:

    Quellcode

    1. Windowtitle "Wieviele Fussballergebnisse mit bis_zu_X_Toren gibt es?"
    2. Windowstyle 24:cls:font 2:Declare X&,N&,M1&,M2&,t1&,t2&,tx&: lup:
    3. Print "\n X <= ?:",:input X&:N&=0:t1&=0:t2&=0:tx&=0
    4. whileloop 0,x&:M1&=&Loop
    5. whileloop 0,x&:M2&=&Loop
    6. if (M1&+M2&)<=x&:inc n&
    7. print M1&;":";M2&;" ";
    8. if abs(m1&-m2&)=1:inc t1&
    9. elseif abs(m1&-m2&)>1:inc t2&
    10. elseif m1&=m2&:inc tx&
    11. endif
    12. endif
    13. endwhile
    14. endwhile
    15. print "\n\n ... = ";n&;" verschiedenen Spielausgänge, bzw. nach Formel: ";(sqr(x&+1)+x&+1)\2;","
    16. print " davon ";t1&;" Tipp-1 (";format$("#0.### %",100*t1&/n&);"), ";
    17. print t2&;" Tipp-2 (";format$("#0.### %",100*t2&/n&);"), ";
    18. print tx&;" Tipp-X (";format$("#0.### %",100*tx&/n&);")"
    19. goto "lup"
    Alles anzeigen

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

  • Das zuletzt dargestellte Programm nutzt eine österreichische Tippvariante ("Tordifferenz-Wette"), die international nicht üblich ist - sorry, ich wette so selten... Profaner können ja jederzeit die Tipp-Bedingungen verändern, z.B. 1 auf "Heimmannschaft (erstgenannt)" gewinnt vs. ": Auswärtsmannschaft (zweitgenannt)" gewinnt, X: Unentschieden.
    Gruss

    P.S.: Was es noch alles gibt an Wetten (Kopfschüttel) :8O: