ALGORITHMEN - Teil XVI: Liberté - Fraternité - Pfefferminztee

    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.

    • Abt. Primzahlenprüfung mittels Divisionsverfahren
      ===============================
      Langsam, aber sicher.
      Gruss

      Quellcode

      1. Windowtitle "Primeigenschaftsprüfung: Langsames Divisionsverfahren"
      2. WindowStyle 24:CLS:font 1
      3. declare n!,k!,pr!
      4. k!=2^53-1
      5. k!=90000103
      6. set("decimals",0)
      7. repeat
      8. print "\n ?: ";
      9. input n!
      10. if n!=0:n!=k!:k!=k!-1:endif
      11. locate %csrlin-1,25
      12. pr!=Primes(n!)
      13. casenot pr!:print n!,
      14. print format$(" #0 ist prim!;Negativ??;Nicht prim!",pr!)
      16. waitinput 42
      17. until %key=27
      18. print "\n ---":beep
      19. Waitinput
      20. End
      22. Proc primes :parameters n!
      23. declare max!,prime!,i!
      24. if n!=2: prime!=2
      25. elseif (n!<=1) or (remodf(n!,2)=0): prime!=0
      26. else
      27. prime!=n!
      28. i!=3:max!=sqrt(n!)
      29. while i!<=max!
      30. if remodf(n!,i!)=0
      31. prime!=0
      32. Break
      33. endif
      34. i!=i!+2
      35. endwhile
      36. endif
      37. return prime!
      38. endproc
      40. proc floor :parameters x!
      41. case abs(x!)<(10^-35):return 0
      42. case x!>0:return intf(x!)
      43. return (abs(x!-intf(x!)) < 10^-35)-intf(abs(x!-1))
      44. endproc
      46. proc remodf :parameters x!,y!
      47. case abs(x!)<(10^-35):return 0
      48. case abs(y!)<(10^-35):return x!
      49. return ((x!>0)-(x!<0))*abs(x!-y!*floor(x!/y!))
      50. endproc
      52. proc frac :parameters x!
      53. var s!=(x!>0)-(x!<0)
      54. x!=abs(x!)
      55. x!=x!-round(x!,0)
      56. case x!<0:x!=1+x!
      57. return s!*x!
      58. endproc
      60. proc intf :parameters x!
      61. var s!=(x!>0)-(x!<0)
      62. x!=abs(x!)
      63. x!=x!-frac(x!)
      64. return s!*x!
      65. endproc
      Alles anzeigen

    • Abt. Gemütliche Primzahlen-Bereichssuche
      ===========================
      Die Math-Routinen wären noch etwas beschleunigbar.
      Gruss

      Quellcode

      1. Windowtitle upper$("Primgenerator: Mit Divisionsverfahren ins Clipboard")
      2. '(CL) 2018-06 by P.Specht, Wien; OHNE JEDE GEWÄHR!
      3. '2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,...
      4. '123456789059,123456789061,123456789083,... 99990000119,...
      5. WindowStyle 24:CLS:font 2:declare n!,k!,pr!
      6. Print "\n Gibt nächsthöhere Primzahl/en ins Clipboard!"
      7. Print " Sinnvoll bis ca. 12 Stellen (Rechenzeit)!"
      8. k!=99999999999
      9. set("decimals",0)
      10. print "\n Ab ?: ";:input n!
      11. if n!=0:n!=k!
      12. else :k!=n!
      13. endif
      14. print " Suche läuft ...\n"
      15. clearclip
      16. repeat
      17. n!=k!:k!=k!+1
      18. pr!=Primes(n!)
      19. if pr!
      20. print n!;",";:putclip str$(n!)+","
      21. if %pos>60:print:putclip "\n":endif
      22. endif
      23. until 0
      24. End
      26. Proc primes :parameters n!
      27. declare max!,prime!,i!
      28. if n!=2: prime!=2
      29. elseif (n!<=1) or (remodf(n!,2)=0): prime!=0
      30. else
      31. prime!=n!
      32. i!=3:max!=sqrt(n!)
      33. while i!<=max!
      34. if remodf(n!,i!)=0
      35. prime!=0
      36. Break
      37. endif
      38. i!=i!+2
      39. endwhile
      40. endif
      41. return prime!
      42. endproc
      44. proc floor :parameters x!
      45. case abs(x!)<(10^-35):return 0
      46. case x!>0:return intf(x!)
      47. return (abs(x!-intf(x!)) < 10^-35)-intf(abs(x!-1))
      48. endproc
      50. proc remodf :parameters x!,y!
      51. case abs(x!)<(10^-35):return 0
      52. case abs(y!)<(10^-35):return x!
      53. return ((x!>0)-(x!<0))*abs(x!-y!*floor(x!/y!))
      54. endproc
      56. proc frac :parameters x!
      57. var s!=(x!>0)-(x!<0)
      58. x!=abs(x!)
      59. x!=x!-round(x!,0)
      60. case x!<0:x!=1+x!
      61. return s!*x!
      62. endproc
      64. proc intf :parameters x!
      65. var s!=(x!>0)-(x!<0)
      66. x!=abs(x!)
      67. x!=x!-frac(x!)
      68. return s!*x!
      69. endproc
      Alles anzeigen

    • Abt. Schon etwas flotter: Primfilter mit Bereichssuche
      ==================================
      Die übervorsichtigen Math-Routinen wurden zusammengelegt und bereinigt, was die Sache etwa fünfmal schneller macht. Das bringt ca. eine weitere Ziffer.
      Gruss

      P.S.: Jetzt könnte man dann auch XPSE drüberlaufen lassen.

      Quellcode

      1. Windowtitle upper$("Primfilter: Mit Divisionsverfahren ins Clipboard")
      2. '(CL) 2018-06 by P.Specht, Wien; OHNE JEDE GEWÄHR!
      3. '2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,...
      4. '123456789059,123456789061,123456789083,... 98765432201,98765432257,...
      5. '999999999937,999999999959,999999999961,999999999989,1000000000039,...
      6. '9876543210997,9876543211001,9876543211019,...
      7. WindowStyle 24:CLS:font 2:declare n!,k!,pr!
      8. Print "\n Gibt nächsthöhere Primzahl/en ins Clipboard aus!"
      9. Print " Sinnvoll bis ca. 12..13 Stellen (Rechenzeit!)"
      10. k!=999999999937 '123456789059 '9876543210997
      11. set("decimals",0)
      12. print "\n Ab ?: ";:input n!
      13. if n!=0:n!=k!
      14. else :k!=n!
      15. endif
      16. print " Suche läuft ...\n"
      17. clearclip
      18. repeat
      19. n!=k!:k!=k!+1
      20. pr!=Primes(n!)
      21. if pr!
      22. print " ";n!;",";:putclip str$(n!)+","
      23. if %pos>60:print:putclip "\n":endif
      24. case pr!>99999999999:sound 50,21
      25. endif
      26. until 0
      27. End
      29. Proc primes :parameters n!
      30. declare max!,prime!,i!
      31. if n!=2: prime!=2
      32. elseif (n!<=1) or ((n!-2*round(n!/2,0))=0):prime!=0
      33. else
      34. prime!=n!
      35. i!=3:max!=sqrt(n!)
      36. while i!<=max!
      37. if if(abs(i!)<(10^-35),n!,n!-i!*round((n!/i!),0))=0
      38. prime!=0
      39. Break
      40. endif
      41. i!=i!+2
      42. endwhile
      43. endif
      44. return prime!
      45. endproc
      Alles anzeigen

    • Geht Rosettacode eigentlich nur über Zufallsseiten?
      Anders habe ich es nicht hin bekommen.

      Hier das Sprachenname in 3D - Beispiel. rosettacode.org/wiki/Write_language_name_in_3D_ASCII

      Erzeuge den Namen Deiner Programmiersprache in 3D-Ansicht.

      Spoiler anzeigen

      Quellcode: in3D.prf

      1. cls
      2. var string s1 = \
      3. "# # ### ### #### #### #### # # \n" +\
      4. " # # # # # # # # # # # ## # \n" +\
      5. " # ### ### # # #### #### # # # \n" +\
      6. " # # # # # # # # # # # ## \n" +\
      7. "# # # # # #### # # # # # \n"
      9. Proc in3D_001
      10. Parameters string s
      11. Print s
      12. waitinput
      13. EndProc
      14. Proc in3D_002
      15. Parameters string s
      16. s = translate$(s," "," ")
      17. s = translate$(s,"#","_/")
      18. Print s
      19. waitinput
      20. EndProc
      22. Proc get_alpha
      23. Parameters string desc
      24. Declare string buchstabe, int breite,code
      25. buchstabe = SubStr$(desc,1, ",")
      26. breite = Val(SubStr$(desc,1, ","))
      27. WhileLoop 2,6
      28. code = Val("$0" $ SubStr$(desc,&loop, ","))
      29. WhileLoop 0,breite - 1
      30. buchstabe = buchstabe $ if( testbit(code,&loop),"#"," ")
      31. EndWhile
      32. EndWhile
      33. Return buchstabe // erstes Zeichen ist die Breite
      34. EndProc
      35. Proc zeige_alpha
      36. Parameters string bu
      37. Declare int breite, i
      38. breite = Val(Left$(bu,1))
      39. bu = del$(bu,1,1)
      40. i = 1
      41. WhileLoop 1,5
      42. locate zeile + &loop, spalte
      43. Print Mid$(bu,i,breite)
      44. inc i,breite
      45. EndWhile
      46. inc spalte, breite + 1
      47. if spalte > (79 - 5)
      48. spalte = 1
      49. inc zeile, 6
      50. endif
      51. EndProc
      52. Proc newline_alpha
      53. spalte = 1
      54. inc zeile, 6
      55. EndProc
      56. Proc finde_alpha
      57. Parameters string c
      58. Declare int L,R,M
      59. L = 0 : R = sizeof(Alpha_001[]) - 1
      60. Repeat
      61. M = (R + L) \ 2
      62. If Left$(Alpha_001[M],1) < c
      63. R = M
      64. ElseIf Left$(Alpha_001[M],1) > c
      65. L = M
      66. Else
      67. Return Alpha_001[M]
      68. EndIf
      69. Until Left$(Alpha_001[M],1) == c
      70. EndProc
      71. Proc Wort_alpha
      72. Parameters string wort
      73. wort = Upper$(wort)
      74. whileloop 1, Len(wort)
      75. zeige_alpha( get_alpha( Alpha_001[ substr$(wort,&loop) ] ) )
      76. endwhile
      77. EndProc
      78. Proc Wort_über_002
      79. Parameters string wort
      80. Declare string buchstabe, oneTo5[5], int breite, i
      81. wort = Upper$(wort)
      82. whileloop 1, Len(wort)
      83. buchstabe = get_alpha( Alpha_001[ substr$(wort,&loop) ] )
      84. breite = Val(Left$(buchstabe,1))
      85. buchstabe = del$(buchstabe,1,1)
      86. i = 1
      87. WhileLoop 1,5
      88. oneTo5[&loop] = oneTo5[&loop] + Mid$(buchstabe,i,breite) + " "
      89. inc i, breite
      90. EndWhile
      91. endwhile
      92. wort = ""
      93. WhileLoop 1,5
      94. wort = wort + oneTo5[&loop] + "\n"
      95. EndWhile
      96. in3D_002(wort)
      97. EndProc
      99. cls
      100. var int zeile = 1
      101. var int spalte = 1
      102. Declare hash Alpha_001[]
      103. Alpha_001["A"] = "4,F,9,F,9,9"
      104. Alpha_001["B"] = "4,7,9,7,9,7"
      105. Alpha_001["C"] = "5,E,11,1,11,E"
      106. Alpha_001["D"] = "4,7,9,9,9,7"
      107. Alpha_001["E"] = "4,F,1,F,1,F"
      108. Alpha_001["F"] = "4,F,1,7,1,1"
      109. Alpha_001["G"] = "5,E,1,F,11,F"
      110. Alpha_001["H"] = "4,9,9,F,9,9"
      111. Alpha_001["I"] = "3,7,2,2,2,7"
      112. Alpha_001["J"] = "3,7,4,4,4,3"
      113. Alpha_001["K"] = "4,9,5,3,5,9"
      114. Alpha_001["L"] = "3,1,1,1,1,7"
      115. Alpha_001["M"] = "5,11,1B,15,11,11"
      116. Alpha_001["N"] = "5,11,13,15,19,11"
      117. Alpha_001["O"] = "4,F,9,9,9,F"
      118. Alpha_001["P"] = "4,7,9,7,1,1"
      119. Alpha_001["Q"] = "4,F,9,9,5,B"
      120. Alpha_001["R"] = "4,7,9,7,5,9"
      121. Alpha_001["S"] = "4,F,1,F,8,F"
      122. Alpha_001["T"] = "3,7,2,2,2,2"
      123. Alpha_001["U"] = "4,9,9,9,9,F"
      124. Alpha_001["V"] = "5,11,11,11,A,4"
      125. Alpha_001["W"] = "5,11,11,15,1B,11"
      126. Alpha_001["X"] = "5,11,A,4,A,11"
      127. Alpha_001["Y"] = "5,11,A,4,2,1"
      128. Alpha_001["Z"] = "4,F,8,F,1,F"
      130. declare string k,v
      131. ForEach Alpha_001[],K,V
      132. zeige_alpha( get_alpha( V ) )
      133. endfor
      134. newline_alpha()
      135. wort_alpha("XPROFAN")
      136. print ""
      137. in3D_001(s1)
      138. in3D_002(s1)
      139. Wort_über_002("XPROFAN")
      140. Print "\nENDE"
      141. waitkey
      142. end
      Alles anzeigen
      Programmieren, das spannendste Detektivspiel der Welt.

      Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von Michael Wodrich ()

    • Abt. SwR 23 - ´Unwichtig ungelöst´
      ===========================
      Ein Manchester-Board enthält statt 12 Uhrziffern die folgenden Zahlen;
      20 1 18 4 13 6 10 15 2 17 3 19 7 16 8 11 14 9 12 5 ... 20
      Die 20 steht ganz oben. Frage:
      Wozu dient das Ganze?
      Gruss

      P.S.: Niemand hat bisher das Bildungsgesetz dieser Zahlenreihe herausbekommen, auch die besten Mathmatiker nicht!

    • Abt. SysInternals-Link
      ===============
      zu einer neuen Verbreitungsmethode für die einzelnen Admin-
      Systemtools und sonstige angebotene Programme: LINK
      Von Microsoft wird allerdings dringend empfohlen, sich vorher auf
      DIESER SEITE über die einzelnen Funktionen und Schalter der
      angebotenen Programme zu informieren - sonst kann viel
      Unsinn damit passieiren!
      Gruss

    • Abt. SwR 23

      Kommt mir bekannt vor
      Spoiler anzeigen

      He, nicht einfach klicken.

      DIESE Uhr sollte man kennen
      Spoiler anzeigen
      Also echt jetzt....
      Spoiler anzeigen

      Die Dartscheibe...
      Wozu dient das Ganze? Wettstreit, Geschicklichkeit, Zeitvertreib, ...




      Ach, danke nochmal für den Link.
      So kann man mit der Seite auch etwas anfangen...
      Programmieren, das spannendste Detektivspiel der Welt.

    • p. specht schrieb:

      Abt. SwR 23 - ´Unwichtig ungelöst´
      ===========================
      Ein Manchester-Board enthält statt 12 Uhrziffern die folgenden Zahlen;
      20 1 18 4 13 6 10 15 2 17 3 19 7 16 8 11 14 9 12 5 ... 20
      Die 20 steht ganz oben. Frage:
      Wozu dient das Ganze?
      Gruss

      P.S.: Niemand hat bisher das Bildungsgesetz dieser Zahlenreihe herausbekommen, auch die besten Mathmatiker nicht!
      Es gibt auch Manchester-Boards mit folgender Zahlenreihe:
      4 20 1 16 6 17 8 12 9 14 5 19 2 5 3 18 7 11 10 13, wobei die 4 oben steht!


      Gruß
      Roland
      (Intel Duo E8400 3,0 GHz / 4 GB RAM / 250 GB HDD / ATI Radeon HD4770 512 MB / Windows Vista - ausgemustert zum Verkauf)
      AMD Athlon II X2 2,9 GHz / 8 GB RAM / 500 + 1000 GB HDD / ATI Radeon 3000 (onboard) / Windows 10(64) - XProfan X4

      http://www.xprofan.de

    • Abt. SwR 24: Kartenfolge
      ================
      In der ersten Anordnung sehen wir untereinander die Vorder- und Rückseiten von 11 Karten.

      In der zweiten Zeile unter == sehen wir *die selben* Karten in einer *anderen Anordnung*.

      Welche Antwort - (1),(2),(3),(4) oder (5) - könnte in der unteren Hälfte der zweiten Kartenzeile jeweils als Rückseite stehen (statt der ´_´)?

      Quellcode

      1. M I S S I S S I P P I <= vorn
      2. K I L I M A N J A R O <= hinten
      3. = = = = = = = = = = =
      4. P S I S I M I S S P I <= vorn
      5. _ _ _ _ _ _ _ _ _ _ _ <= ???
      7. A N J A M K I L I O R :? (1)
      8. R L I I M K O J N A A :? (2)
      9. J A N A M K I L I R O :? (3)
      10. A N M A I K O L I R J :? (4)
      11. R A O N J M I L I K A :? (5)
      Alles anzeigen

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

    • Lösungsweg SwR 24 ´Kartenfolge´
      ---------------------------------------
      Bravo, Michael W.!
      Spoiler anzeigen
      Tricks:
      1. Statt Spaltenschreibweise besser Zeilenschreibweise
      2. Mengenbetrachtung vor Positionsbetrachtung
      3. Man beginne mit den kleinsten Mengen (die schließen am meisten aus)
      4. Die 4 Lösungsvorschläge werden auf Gültigkeit abgeklopft

      ' MK II SL SI IM SA SN IJ PA PR IO : {MK} // M am wenigsten häufig
      ' P_ S_ I_ S_ I_ M_ I_ S_ S_ P_ I_
      '
      ' PA SN IJ SA IM MK II SL SI PO IR :? (1)
      ' PR SL II SI IM MK IO SJ SN PA IA :? (2)
      ' PJ SA IN SA IM MK II SL SI PR IO :? (3)
      ' PA SN IM SA II MK IO SL SI PR IJ :? (4)
      ' PR SA IO SN IJ MM II SL SI PK IA :? (5) "MM" gibt es nicht!
      '
      ' MK II SL SI IM SA SN IJ PA PR IO : {PA,PR}
      ' P_ S_ I_ S_ I_ M_ I_ S_ S_ P_ I_
      '
      ' PA SN IJ SA IM MK II SL SI PO IR :? (1) wegen "PO" nicht
      ' PR SL II SI IM MK IO SJ SN PA IA :? (2)
      ' PJ SA IN SA IM MK II SL SI PR IO :? (3) wegen "PJ" nicht
      ' PA SN IM SA II MK IO SL SI PR IJ :? (4)
      '
      ' MK II SL SI IM SA SN IJ PA PR IO : {SL SI SA SN}
      ' P_ S_ I_ S_ I_ M_ I_ S_ S_ P_ I_
      '
      ' ++ SL II SI IM MK IO SJ SN ++ IA :? (2) SA fehlt, daher nicht
      ' ++ SN IM SA II ++ IO SL SI ++ IJ :? (4) <== L Ö S U N G
      '=======================================

    • Lösung zu SwR-25
      ---------------------
      Das war ein Test, in wie weit wir alle von Rätseln erwarten, daß sie "getuned" sind auf etwas "Glattes", das dabei herauskommt, um uns zu "bestätigen". Man beachte aber, dass die Laufvariable der SUMME SUMY! nicht die &Loop-Variable ist, sondern j&=0, und dass das aber wiederum nicht bedeutet, daß jedes Summenglied Null ist. Was man glaubt und was wirklich ist, sind meist verschiedene Dinge...
      Gruss
      Spoiler anzeigen
      cls:set("decimals",0):font 2
      declare sumx!,sumy!
      :whileloop 1,2018:Sumx!=Sumx!+Sqr(&Loop):endwhile
      :whileloop 2,2017:Sumy!=Sumy!+(0-1)*(0+1):endwhile
      print "\n\n\n ";sumx!;" - ";sumy!;" = ";sumx!-sumy!
      waitinput

    • Offenbar derzeit zu viele Aufgaben. Höchste Zeit, das hier zu beenden! Demnächst stelle ich dann, wie üblich, ein Update der KAPITELÜBERSICHT zu allen bisherigen ALGORITHMEN-Beiträgen hier ein.

      Weiter gehts mit Kapitel XVII "Im Gruselkeller der Hirnwindungen"
      LG

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