ALGORITHMEN - Teil XIV: Jetzt noch irrer!

    Information: Wir verlosen 3 x das Buch "Nur noch dieses Level!" Spiel mit!

    • 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.
    • Neu

      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
    • Neu

      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.
    • Neu

      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 ()

    • Neu

      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: