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