ALGORITHMEN TEIL X: Das hat uns noch gefehlt!

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

    • Abt. Alles, was Ihr nie wissen wolltet
      =======================
      Der Rubik-Würfel gilt als Lehrbeispiel in einem Spezialgebiet der Mathematik, der sogenannten Gruppentheorie. Die Anzahl möglicher Planlagen eines 3x3x3 Rubik-Würfels bei feststehendem Kern beträgt 43 252 003 274 489 856 000 Stellungen. Die Gruppentheorie kümmert sich nun um Dreh-, Spiegel- und Zentralsymmetrien solcher abstrakten "Systeme". Wird beispielsweise die Vorderseite des Würfels 4 x nach links gedreht, landet man wieder bei der Ausgangsituation. Eine zweimalige Drehung nach links entspricht einer zweimaligen Drehung nach rechts und führt zur selben Situation. Eine dreimalige Drehung nach links entspricht einer einmaligen Drehung nach rechts - und vice versa. Dies gilt nun aber auch, wenn man die Drehrichtungen "links" und "rechts" miteinander vertauscht, ferner gilt es für alle sechs Würfelseiten, nicht nur für die Frontschicht.
      Gruss

      P.S.: Natürlich gibt es wieder einen erklärenden Spoiler (wen's halt interessiert).
      Spoiler anzeigen
      Die obige Positionen-Zahl ergibt sich folgendermaßen:

      8 Ecksteine, die getauscht werden könnten: 8*7*6*5*4*3*2 mögliche Positionen.
      Diese 8 Ecksteine können aber auf 3 Arten farblich orientiert sein: 3^8

      12 Mittelstück-Ecken, die vertauscht werden könnten: 12*11*10*9*8*7*6*5*4*3*2
      und die zusätzlich noch in je 2 Richtungen schauen können: 2^12

      Da der Kern feststehend bleibt, bleiben auch die jeweiligen Seiten-Mittelstücke fest - also kommen dadurch keine weiteren Möglichkeiten mehr dazu.

      Die so entstehende Gesamtzahl aller Möglichkeiten, einen 3er-Rubikwüfel neu zusammenzusetzen, ergäbe 519.024.039.293.878.272.000 Positionen. Allerdings sind nicht alle diese Kombinationen in der Lage, einen auf jeder Seite einheitlich gefärben Rubik-Wüfel zu erzeugen: Der Standard-Rubikwürfel weist 12 "Universen" (unabhängige Gruppen) auf, bei denen Stellungen anderer Universen auch durch beliebig viele Drehungen nicht erreicht werden können! Daher:

      519 024 039 293 878 272 000 / 12 = 43 252 003 274 489 856 000,
      q.e.d.

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

    • Abt. Kleine Aufgaben zwischendurch
      =======================
      Gegeben sei ein Quadrat - z.B. mit Seitenlänge 1, sowie zwei INNERHALB dieses Quadrats zufällig ausgewählte Punkte. Frage: Wie weit sind solche Punkte im Durchschnitt der Fälle voneinander entfernt?

      Aufgabe: Überprüfe anhand von 1000, 5000 und 10000 Fällen, ob sich das Ergebnis der folgenden (angeblich exakten) Lösung nähert: d_mittel = (2+sqrt(2)+5*ln(1+sqrt(2))/15

      Viel Spass!

      P.S.: Quellenangabe hier!
    • Abt. Polynom 5. Ordnung anpassen nach Vieta
      ==============================
      Nachdem ich über ein Youtube-Video von Dr. J. Tanton (engl.) gestolpert war, in dem er ohne große Lösungsformeln, einfach unter Anwendung von Logik, eine Parabel durch drei Punkte legte, hat mich interessiert, ob das Verfahren auch für Polynom-Parabeln höherer Ordnung anwendbar ist. Was soll ich sagen: Es ist!
      Gruss
      Spoiler anzeigen

      WindowTitle "Linearer Fit, Quadradischer, kubischer, quartischer und quintischer "+\
      "Parabel-Fit nach Methode Tandon-Vieta: SCHEINT ZU KLAPPEN!"
      'Q: Q5L1 von DrJames Tanton
      '(CL) 2016-07 CopyLeft by P.Specht, Wien. No Warranty whatsoever! Ohne jede Gewähr!
      WindowStyle 24:Window 0,0-%maxx,%maxy
      var xh&=width(%hwnd)\2:var yh&=height(%hwnd)\2
      declare x!,y!, x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!,x5!,y5!,x6!,y6!

      var u!=20:var v!=20:var w!=30 'Maßstäbe für x,y und Granularity
      'Testpunkte (1. bis n+1. Punkt), die von den Polynomen n. Ordnung zu treffen sind:
      case 0:goto "TestSet2"
      x1!=0:y1!=5
      x2!=10:y2!=2
      x3!=3:y3!=7
      x4!=8:y4!=4
      x5!=-10:y5!=4
      x6!=-5:y6!=-6
      goto "Weiter"
      Testset2:
      x1!=0:y1!=5
      x2!=-10:y2!=2
      x3!=-3:y3!=7
      x4!=-8:y4!=4
      x5!=10:y5!=4
      x6!=-5:y6!=-6

      Weiter:

      proc funk1 :parameters x! ,x1!,y1!,x2!,y2!
      return y1!*(x!-x2!)/(x1!-x2!) \
      + y2!*(x!-x1!)/(x2!-x1!)
      endproc

      proc funk2 :parameters x! ,x1!,y1!,x2!,y2!,x3!,y3!
      return y1!*(x!-x2!)*(x!-x3!)/((x1!-x2!)*(x1!-x3!)) \
      + y2!*(x!-x1!)*(x!-x3!)/((x2!-x1!)*(x2!-x3!)) \
      + y3!*(x!-x1!)*(x!-x2!)/((x3!-x1!)*(x3!-x2!))
      endproc

      proc funk3 :parameters x! ,x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!
      return \
      y1!*(x!-x2!)*(x!-x3!)*(x!-x4!)/((x1!-x2!)*(x1!-x3!)*(x1!-x4!)) \
      + y2!*(x!-x1!)*(x!-x3!)*(x!-x4!)/((x2!-x1!)*(x2!-x3!)*(x2!-x4!)) \
      + y3!*(x!-x1!)*(x!-x2!)*(x!-x4!)/((x3!-x1!)*(x3!-x2!)*(x3!-x4!)) \
      + y4!*(x!-x1!)*(x!-x2!)*(x!-x3!)/((x4!-x1!)*(x4!-x2!)*(x4!-x3!))
      endproc

      proc funk4 :parameters x! ,x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!,x5!,y5!
      return y1!*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x5!)/((x1!-x2!)*(x1!-x3!)*(x1!-x4!)*(x1!-x5!)) \
      + y2!*(x!-x1!)*(x!-x3!)*(x!-x4!)*(x!-x5!)/((x2!-x1!)*(x2!-x3!)*(x2!-x4!)*(x2!-x5!)) \
      + y3!*(x!-x1!)*(x!-x2!)*(x!-x4!)*(x!-x5!)/((x3!-x1!)*(x3!-x2!)*(x3!-x4!)*(x3!-x5!)) \
      + y4!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x5!)/((x4!-x1!)*(x4!-x2!)*(x4!-x3!)*(x4!-x5!)) \
      + y5!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x4!)/((x5!-x1!)*(x5!-x2!)*(x5!-x3!)*(x5!-x4!))
      endproc

      proc funk5 :parameters x! ,x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!,x5!,y5!,x6!,y6!
      return \
      y1!*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x5!)*(x!-x6!)/((x1!-x2!)*(x1!-x3!)*(x1!-x4!)*(x1!-x5!)*(x1!-x6!))\
      +y2!*(x!-x1!)*(x!-x3!)*(x!-x4!)*(x!-x5!)*(x!-x6!)/((x2!-x1!)*(x2!-x3!)*(x2!-x4!)*(x2!-x5!)*(x2!-x6!))\
      +y3!*(x!-x1!)*(x!-x2!)*(x!-x4!)*(x!-x5!)*(x!-x6!)/((x3!-x1!)*(x3!-x2!)*(x3!-x4!)*(x3!-x5!)*(x3!-x6!))\
      +y4!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x5!)*(x!-x6!)/((x4!-x1!)*(x4!-x2!)*(x4!-x3!)*(x4!-x5!)*(x4!-x6!))\
      +y5!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x6!)/((x5!-x1!)*(x5!-x2!)*(x5!-x3!)*(x5!-x4!)*(x5!-x6!))\
      +y6!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x5!)/((x6!-x1!)*(x6!-x2!)*(x6!-x3!)*(x6!-x4!)*(x6!-x5!))
      endproc
      '---------------------------------------------------------
      Cls
      usepen 0,1,0:line 0,yh& - 2*xh&,yh&:line xh&,0 - xh&,2*yh&
      usepen 0,6,rgb(0,0,255)
      line xh&+u!*x1!,(yh&-v!*y1!) - xh&+u!*x1!+1,(yh&-v!*y1!):drawtext xh&+u!*x1!,yh&-v!*y1!-26,"1"
      line xh&+u!*x2!,(yh&-v!*y2!) - xh&+u!*x2!+1,(yh&-v!*y2!):drawtext xh&+u!*x2!,yh&-v!*y2!-26,"2"
      line xh&+u!*x3!,(yh&-v!*y3!) - xh&+u!*x3!+1,(yh&-v!*y3!):drawtext xh&+u!*x3!,yh&-v!*y3!-26,"3"
      line xh&+u!*x4!,(yh&-v!*y4!) - xh&+u!*x4!+1,(yh&-v!*y4!):drawtext xh&+u!*x4!,yh&-v!*y4!-26,"4"
      line xh&+u!*x5!,(yh&-v!*y5!) - xh&+u!*x5!+1,(yh&-v!*y5!):drawtext xh&+u!*x5!,yh&-v!*y5!-26,"5"
      line xh&+u!*x6!,(yh&-v!*y6!) - xh&+u!*x6!+1,(yh&-v!*y6!):drawtext xh&+u!*x6!,yh&-v!*y6!-26,"6"

      usepen 0,2,rgb(255,0,0)
      whileloop -1000,1000:x!=&Loop/w!
      y!=funk1(x!, x1!,y1!,x2!,y2!)
      line xh&+u!*x!,(yh&-v!*y!) - xh&+u!*x!+1,(yh&-v!*y!)
      endwhile

      usepen 0,2,rgb(255,200,0)
      whileloop -1000,1000:x!=&Loop/w!
      y!=funk2(x!, x1!,y1!,x2!,y2!,x3!,y3!)
      line xh&+u!*x!,(yh&-v!*y!) - xh&+u!*x!+1,(yh&-v!*y!)
      endwhile

      usepen 0,2,rgb(255,0,200)
      whileloop -1000,1000:x!=&Loop/w!
      y!=funk3(x!, x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!)
      line xh&+u!*x!,(yh&-v!*y!) - xh&+u!*x!+1,(yh&-v!*y!)
      endwhile

      usepen 0,2,rgb(0,100,250)
      whileloop -1000,1000:x!=&Loop/w!
      y!=funk4(x!, x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!,x5!,y5!)
      line xh&+u!*x!,(yh&-v!*y!) - xh&+u!*x!+1,(yh&-v!*y!)
      endwhile

      usepen 0,4,rgb(100,100,100)
      whileloop -1000,1000:x!=&Loop/w!
      y!=funk5(x!, x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!,x5!,y5!,x6!,y6!)
      case &Loop=-1000:moveto xh&+u!*x!,(yh&-v!*y!)
      lineto xh&+u!*x!,(yh&-v!*y!)
      endwhile

      sound 2000,50
      waitinput

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

    • Abt. Meterstab in Stücke hacken
      ========================
      In welche und wieviele verschiedene "Zerhackungs-Anordnungen" kann man einen Meßstab von z.B. 70 cm Länge hacken, vorausgesetzt die Schnitte sind äusserst dünn (Laser?) und alle Einzelteile müssen 1 cm oder ein Vielfaches davon lang sein? Dabei soll die physische Anordnung der Einzelstücke egal sein, zusammen müssen sie nur 70 cm ergeben.

      Die Frage taucht u.a. in der Wellenphysik, in der Technischen Chemie, aber auch beim Packen von Standardprodukten in vorggegebene Schachteln auf. Die Herren Zoghbi und Stojmenovic konnten dazu 1998 Ihren ZS1-Algorithmus vorstellen, der immerhin viermal schneller als alle bisherigen war. In reinem XProfan braucht man natürlich etwas länger als in Maschinencode, aber zu Demo-Zwecken reicht das nachstehende Machwerk durchaus. Die Antwort: 70 kann auf 146466 Arten in Stücke gehackt plus einmal ganz gelassen werden.
      Gruss

      P.S. Quellenangabe: Artikel aus "Fast Algorithms for Generating Integer Partitions. International Journal of Computer Mathematics, 70, 1998"

      Quellcode

      1. WindowTitle "Algorithm ZS1: Erzeugung einer vollständigen, "+\
      2. "revers-geordneten Partitionierung ohne Wiederholung"
      3. 'Q: Antoine Zoghbi, Ivan Stojmenovic: Fast Algorithms for Generating Integer Partitions
      4. ' published in: "International Journal of Computer Mathematics, 70, 1998, 319-332."
      5. 'S: [url]http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.42.1287&rep=rep1&type=pdf[/url]
      6. 'T: Translation to XProfan 11.2a 2016-07ff by P.Specht, Vienna/Austria
      7. 'No Warranty whatsoever! Ohne jedwede Gewähr!
      8. WindowStyle 24:Window 0,0-%maxx,%maxy:font 2:randomize
      9. declare z$,z&,tm&,cnt&,bench&: Rept:
      10. Cls:Print "\n ZAHL, die partitioniert werden soll (0: Ende; Minuszahl: Nur Zeitmessung)? : ";
      11. z$="":input z$:bench&=0:case val(z$)<0:bench&=1:z&=rnd(30):case z$>"":z&=abs(val(z$))
      12. if z&=0:print "\n Ergebnis: Leere Menge.\n\n Programm wird beendet! ":beep:waitinput 4000:END:endif
      13. case bench&:print "\n Messung läuft ..."
      14. tm&=&GetTickCount
      15. cnt& = Algorithm_ZS1(z&,bench&)
      16. print "\n ";cnt&;" Partitionen erzeugt."
      17. if bench& : tm&=&GetTickCount-tm&
      18. print "\n Laufzeit für n = ";z&;": ";tm&;" [ms] bzw. ";tm&/1000;" [s] bzw. ";tm&/60000;" [min]"
      19. endif
      20. sound 2000,60
      21. waitinput
      22. Goto "Rept"
      23. END
      24. Proc Algorithm_ZS1 :parameters n&,bench&
      25. declare x&[n&],i&,m&,h&,r&,t&,cnt&
      26. whileloop n&
      27. x&[&loop]=1
      28. endwhile
      29. x&[1]=n&
      30. m&=1:h&=1
      31. cnt&=1
      32. casenot bench&:print "\n>>> ";x&[1] 'show or do something useful
      33. while x&[1]<>1
      34. if x&[h&]=2 'Easy case, applies often
      35. ' h is the index of the last part of partition which is greater than 1
      36. ' m is the number of parts.
      37. inc m&:x&[h&]=1:dec h&
      38. else
      39. r&=x&[h&]-1
      40. t&=m&-h&+1
      41. x&[h&]=r&
      42. while t&>=r&
      43. inc h&
      44. x&[h&]=r&
      45. t&=t&-r&
      46. endwhile
      47. if t&=0
      48. m&=h&
      49. else
      50. m&=h&+1
      51. if t&>1
      52. inc h&:x&[h&]=t&
      53. endif
      54. endif
      55. endif
      56. inc cnt&
      57. ifnot bench&:print " ";:whileloop m&:print x&[&Loop],:endwhile:print:endif
      58. 'or do something useful with the result line
      59. endwhile
      60. return cnt&
      61. EndProc
      Alles anzeigen

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

    • ... und nun das ganze aufsteigend: Der ZS2-Algorithmus
      ===========================================
      nachgeliefert als Ergänzung zum obigen Beitrag. Interessant, daß niemandem die oben leider falsche Angabe zu den möglichen Partitionen von "70" aufgefallen ist: Es sind natürlich 4.087.968 Varianten. Cut 'n paste hat eben manchmal seine Tücken - Sorry!
      Gruss

      Quellcode

      1. WindowTitle "Algorithm ZS2: Erzeugung einer vollständigen, "+\
      2. "AUFSTEIGEND geordneten Partitionierung ohne Wiederholung"
      3. 'Q: Antoine Zoghbi, Ivan Stojmenovic: Fast Algorithms for Generating Integer Partitions
      4. ' published in: "International Journal of Computer Mathematics, 70, 1998, 319-332."
      5. 'S: http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.42.1287&rep=rep1&type=pdf
      6. 'T: Translation to XProfan 11.2a 2016-07ff by P.Specht, Vienna/Austria
      7. 'No Warranty whatsoever! Ohne jedwede Gewähr!
      8. '
      9. 'Test your results against "Partition Numbers" of https://oeis.org/A000041
      10. '00>>> 1, 1, 2, 3, 5, 7, 11, 15, 22, 30,
      11. '10>>> 42, 56, 77, 101, 135, 176, 231, 297, 385, 490,
      12. '20>>> 627, 792, 1002, 1255, 1575, 1958, 2436, 3010, 3718, 4565,
      13. '30>>> 5604, 6842, 8349, 10143, 12310, 14883, 17977, 21637, 26015, 31185,
      14. '40>>> 37338, 44583, 53174, 63261, 75175, 89134, 105558, 124754, 147273,173525
      15. '50>>> ...
      16. WindowStyle 24:Window 0,0-%maxx,%maxy:randomize:font 2
      17. declare z$,z&,tm&,cnt&,bench&: Rept:
      18. Cls:Print "\n ZAHL, welche partitioniert werden soll (0: Ende; Minuszahl: Nur Zeitmessung)? : ";
      19. z$="":input z$:bench&=0:case val(z$)<0:bench&=1:z&=rnd(30):case z$>"":z&=abs(val(z$))
      20. if z&=0:print "\n Ergebnis: Leere Menge.\n\n Programm wird beendet! ":beep:waitinput 4000:END:endif
      21. case bench&:print "\n Messung läuft ..."
      22. tm&=&GetTickCount
      23. cnt& = Algorithm_ZS2(z&,bench&)
      24. tm&=&GetTickCount-tm&
      25. print "\n ";cnt&;" Partitionen erzeugt."
      26. if bench&:print "\n Laufzeit für n = ";z&;": ";tm&;" [ms] bzw. ";tm&/1000;" [s] bzw. ";tm&/60000;" [min]"
      27. endif :sound 2000,60:waitinput
      28. Goto "Rept"
      29. END
      30. Proc Algorithm_ZS2 :parameters n&,bench&
      31. declare x&[n&],i&,m&,h&,r&,j&,cnt&
      32. if n&=1:print " ";1 :cnt&=1:goto "ZS2_exit":endif
      33. :whileloop n&:x&[&loop]=1:endwhile
      34. cnt&=1
      35. ifnot bench&:print "\n>>> ";:whileloop n&:print x&[&Loop],:endwhile:print
      36. endif 'or do something useful with the result line
      37. x&[0]=-1:x&[1]=2:m&=n&-1:h&=1:inc cnt&
      38. ifnot bench&:print " ";:whileloop m&:print x&[&Loop],:endwhile:print
      39. endif 'or do something useful with the result line
      40. while x&[1]<>n&
      41. if (m&-h&)>1
      42. inc h&
      43. x&[h&]=2
      44. dec m&
      45. else
      46. j&=m&-2
      47. While x&[j&]=x&[m&-1]
      48. x&[j&]=1
      49. dec j&
      50. endwhile
      51. h&=j&+1
      52. x&[h&]=x&[m&-1]+1
      53. r&=x&[m&]+x&[m&-1]*(m&-h&-1)
      54. x&[m&]=1
      55. case (m&-h&)>1:x&[m&-1]=1
      56. m&=h&+r&-1
      57. endif
      58. inc cnt&
      59. ifnot bench&:print " ";:whileloop m&:print x&[&Loop],:endwhile:print:endif
      60. 'or do something useful with the result line
      61. endwhile
      62. ZS2_exit:
      63. return cnt&
      64. EndProc
      Alles anzeigen

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

    • Abt. Hellsehen für Anfänger
      ==================
      Das nachstehende Scherzprogramm entstand bei der Auflösung von Anfänger-Rätseln, in denen man Zahlenreihen fortschreiben soll. Interessanterweise können damit sowohl viele arithmetische als auch geometrische Reihen erfolgreich fortgesetzt werden, vorausgesetzt die Sache weist nicht irgendwo eine Unstetigkeit auf. An der Börse würde ich damit lieber nicht spekulieren ;-)
      Gruss

      Quellcode

      1. WindowTitle upper$(" E x p o n e n t i e l l e r P r ä d i k t o r")
      2. Cls:font 2:print "\n\n Dieses Programm versucht, aus einem Basiswert und zwei Folge-"
      3. print "\n werten auf einen Wert nach einer weiteren Periode zu schließen."
      4. print "\n (NCL) Noncommercial CopyLeft 2016-07 ff by P. Specht, Vienna / Austria "
      5. print "\n OHNE JEGLICHE GEWÄHR! NUTZUNG AUF EIGENE GEFAHR DES ANWENDERS! \n\n"
      6. set("decimals",17):declare w0!,w1!,w2!,w3!:print :
      7. waitinput:waitinput 1000
      8. repeat
      9. CLS
      10. Print "\n\n\n Basiswert w0 = ";:input w0!
      11. Print "\n Folgewert w1 = ";:input w1!
      12. Print "\n Folgewert w2 = ";:input w2!
      13. print "\n\n Vorhersage W3: ";
      14. print if((w1!-w0!)=0,2*(w2!-w1!)+w1!,if((w2!-w1!)=0,w2!,(w2!*w2!-(w1!+w0!)*w2!+w1!*w1!)/(w1!-w0!)))
      15. waitinput
      16. until .
      Alles anzeigen

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

    • Abt. Brute Force-Enumerator
      ===================
      Will man für bestimmte Rätsel (wie etwa DIESES HIER) oder z.B. zum Test elektronischer Schaltungen mit Computerhilfe alle Lösungsvarianten ermitteln, bleibt in der Regel nichts anderes übrig, als sämtliche mögliche Kombinationen darauf abzuklopfen ob das geforderte Ziel erreicht wird oder nicht. Da die Anzahl grundsätzlich möglicher Konfigurationen bekanntlich mit der Zahl der Freiheitsgrade explodiert, stoßen solche Ansätze aber recht schnell an ihre Grenzen. Da ist man dann froh, die Anzahl der Möglichkeiten von den Vorgaben her deutlich einschränken zu können. Freilich muß der verwendete Testgenerator solche Einschränkungs-Möglichkeiten dann aber auch bieten.

      In XProfan11 scheinen Whileloop-Scheifen nur bis zu einer begrenzten Verschachtelungstiefe ohne Fehler zu arbeiten. Überschreitet man eine kritische Zahl, vergisst das System den Stand äusserer Schleifenwerte (was mir aber sehr vom verwendeten Betriebssystem und vom freien Auslagerungsspeicher abzuhängen scheint). Um dieses Verhalten zu umgehen, bieten sich Arrayvariablen als untere und obere Grenzwerte an, und diese Grenzwerte dienen dann auch gleich zur Werte-Einschränkung, wie oben gefordert, indem man z.B. Unter- und Obergrenze einengt oder gleichsetzt.

      Gruss

      P.S.: Das oben angesprochene Rätsel unterschätzt man leicht! Es wird vor allem deshalb komplex, weil neben den erlaubten Operatoren + - * / auch die Vorzeichen variieren können, ferner können eine oder auch mehrere Klammern/Klammerebenen gesetzt werden: Gibt in Summe 21 Variablen! Da verblüfft die vom Ersteller des Rätsels gewählte Methode ziemlich.

      Quellcode

      1. WindowTitle "Aufsteigender Von-Bis-Enumerator ohne Stack-Overflow"
      2. '(CL) CopyLeft 2016-07f by P.Specht, Vienna/Austria; OHNE JEGLICHE GEWÄHR!
      3. declare von$,bis$,n&,anz&,tmp$[],u&[],o&[],x&[],v&,nr&
      4. CLS
      5. ::Goto "Test3"
      6. ' DER ENUMERATOR MIT INDEX v&= ... ZÄHLT ...
      7. ' v&= 20__19____16__15_____12__11_____8____7____...___2_1_0"
      8. von$=" 0, 0,0,0,0, 0,0,0,0, 4,0,0,0, 8,6,2,0, 3,1,0,9"
      9. bis$=" 1, 9,0,0,0, 0,0,0,0, 4,0,0,0, 9,7,4,1, 5,2,1,9"
      10. Goto "Init"
      11. Test2:
      12. ' DER ENUMERATOR MIT INDEX v&=... ZÄHLT ...
      13. ' v&=_2_1_0"
      14. von$="0,1,0"
      15. bis$="2,2,0"
      16. Goto "Init"
      17. Test3:
      18. ' DER ENUMERATOR MIT INDEX v&= ... ZÄHLT ...
      19. ' v&= 20__19____16__15_____12__11_____8____7____...___2_1_0"
      20. von$=" 0, 0,0,0,0, 0,0,0,0, 4,0,0,0, 8,6,2,5, 6,7,8,9"
      21. bis$=" 1, 9,0,0,0, 0,0,0,0, 4,0,0,0, 9,7,4,5, 6,7,8,9"
      22. Goto "Init"
      23. '=================================================================
      24. Init:
      25. tmp$[]=explode(von$,","):n&=sizeof(tmp$[]):setsize u&[],n&:u&[]=val(tmp$[n&-1-&index])
      26. clear tmp$[]:tmp$[]=explode(bis$,","):setsize o&[],n&:o&[]=val(tmp$[n&-1-&index])
      27. clear tmp$[],von$,bis$:setsize x&[],n&
      28. anz&=1:whileloop 0,n&-1:anz&=anz&*(o&[&loop]-u&[&loop]+1):endwhile
      29. ::print "\n Es werden ";anz&;" Konfigurationen erzeugt:\n":waitinput 1500
      30. Start:
      31. x&[]=u&[&index]
      32. Whileloop anz&:Nr&=&Loop
      33. ::print " ";Nr&;": ";:whileloop n&-1,0,-1:print x&[&Loop];:endwhile :print
      34. ' ... oder etwas Nützliches damit machen.
      35. Repeat
      36. if x&[v&]<o&[v&]
      37. x&[v&]=x&[v&]+1
      38. break
      39. else
      40. x&[v&]=u&[v&]
      41. inc v&
      42. endif
      43. until v&>=n&
      44. v&=0
      45. endwhile
      46. Beep
      47. waitinput 30000
      48. END
      Alles anzeigen

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

    • Ergänzung zum Beitrag oben "Polynom 5. Ordnung anpassen nach Vieta"
      ===============================================
      Nachstehend noch die Formeln für Polynom-Anpassung 7. und 8. Ordnung (sprich: Kurve durch 8 bzw. 9 vorgegebene Funktionspunkte. Bei letzteren mußte von einer Parameterübergabe abgegangen werden, da (bei meiner Profan-Version) "nur" 15 Parameter übergeben werden können.
      Gruss

      P.S.: Die Formeln sind äußerst unelegant, funktionieren aber. Das Problem ist eher prinzipieller Natur: Je höher der Polynomgrad, umso "unruhiger" - und damit unplausibler - wird die Parabelanpassung, was den Nutzen sehr begrenzt...

      Brainfuck-Quellcode

      1. WindowTitle "Septimer und Oktonischer Parabel-Fit nach Methode Tandon-Vieta!"
      2. 'Q: Q5L1 von DrJames Tanton
      3. '(CL) 2016-07 CopyLeft by P.Specht, Wien. No Warranty whatsoever! Ohne jede Gewähr!
      4. WindowStyle 24:Window 0,0-%maxx,%maxy
      5. var xh&=width(%hwnd)\2:var yh&=height(%hwnd)\2
      6. declare x!,y!, x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!,x5!,y5!,x6!,y6!,x7!,y7!,x8!,y8!,x9!,y9!
      7. var u!=20:var v!=20:var w!=30 'Maßstäbe für x,y und Granularity
      8. 'Testpunkte (1. bis n+1. Punkt), die von den Polynomen n. Ordnung zu treffen sind:
      9. case 0:goto "TestSet2"
      10. x1!=0:y1!=5
      11. x2!=10:y2!=2
      12. x3!=3:y3!=7
      13. x4!=8:y4!=4
      14. x5!=-10:y5!=4
      15. x6!=-5:y6!=-6
      16. x7!= 11.5:y7!=-13
      17. x8!=-13:y8!=-13
      18. x9!= 30:y9!=-10
      19. goto "Weiter"
      20. Testset2:
      21. x1!=0:y1!=5
      22. x2!=-10:y2!=2
      23. x3!=-3:y3!=7
      24. x4!=-8:y4!=4
      25. x5!=10:y5!=4
      26. x6!=-5:y6!=-6
      27. x7!= 11.5:y7!=-13
      28. x8!= -13:y8!=-13
      29. x9!= 18:y9!=1
      30. Weiter:
      31. proc funk7 ' x! ,x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!,x5!,y5!,x6!,y6!,x7!,y7!,x8!,y8!
      32. return \
      33. y1!*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x5!)*(x!-x6!)*(x!-x7!)*(x!-x8!)/((x1!-x2!)*(x1!-x3!)*(x1!-x4!)*(x1!-x5!)*(x1!-x6!)*(x1!-x7!)*(x1!-x8!))\
      34. +y2!*(x!-x1!)*(x!-x3!)*(x!-x4!)*(x!-x5!)*(x!-x6!)*(x!-x7!)*(x!-x8!)/((x2!-x1!)*(x2!-x3!)*(x2!-x4!)*(x2!-x5!)*(x2!-x6!)*(x2!-x7!)*(x2!-x8!))\
      35. +y3!*(x!-x1!)*(x!-x2!)*(x!-x4!)*(x!-x5!)*(x!-x6!)*(x!-x7!)*(x!-x8!)/((x3!-x1!)*(x3!-x2!)*(x3!-x4!)*(x3!-x5!)*(x3!-x6!)*(x3!-x7!)*(x3!-x8!))\
      36. +y4!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x5!)*(x!-x6!)*(x!-x7!)*(x!-x8!)/((x4!-x1!)*(x4!-x2!)*(x4!-x3!)*(x4!-x5!)*(x4!-x6!)*(x4!-x7!)*(x4!-x8!))\
      37. +y5!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x6!)*(x!-x7!)*(x!-x8!)/((x5!-x1!)*(x5!-x2!)*(x5!-x3!)*(x5!-x4!)*(x5!-x6!)*(x5!-x7!)*(x5!-x8!))\
      38. +y6!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x5!)*(x!-x7!)*(x!-x8!)/((x6!-x1!)*(x6!-x2!)*(x6!-x3!)*(x6!-x4!)*(x6!-x5!)*(x6!-x7!)*(x6!-x8!))\
      39. +y7!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x5!)*(x!-x6!)*(x!-x8!)/((x7!-x1!)*(x7!-x2!)*(x7!-x3!)*(x7!-x4!)*(x7!-x5!)*(x7!-x6!)*(x7!-x8!))\
      40. +y8!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x5!)*(x!-x6!)*(x!-x7!)/((x8!-x1!)*(x8!-x2!)*(x8!-x3!)*(x8!-x4!)*(x8!-x5!)*(x8!-x6!)*(x8!-x7!))
      41. endproc
      42. proc funk8 ' x! ,x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!,x5!,y5!,x6!,y6!,x7!,y7!,x8!,y8!,,x9!,y9!
      43. return \
      44. y1!*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x5!)*(x!-x6!)*(x!-x7!)*(x!-x8!)*(x!-x9!)/((x1!-x2!)*(x1!-x3!)*(x1!-x4!)*(x1!-x5!)*(x1!-x6!)*(x1!-x7!)*(x1!-x8!)*(x1!-x9!))\
      45. +y2!*(x!-x1!)*(x!-x3!)*(x!-x4!)*(x!-x5!)*(x!-x6!)*(x!-x7!)*(x!-x8!)*(x!-x9!)/((x2!-x1!)*(x2!-x3!)*(x2!-x4!)*(x2!-x5!)*(x2!-x6!)*(x2!-x7!)*(x2!-x8!)*(x2!-x9!))\
      46. +y3!*(x!-x1!)*(x!-x2!)*(x!-x4!)*(x!-x5!)*(x!-x6!)*(x!-x7!)*(x!-x8!)*(x!-x9!)/((x3!-x1!)*(x3!-x2!)*(x3!-x4!)*(x3!-x5!)*(x3!-x6!)*(x3!-x7!)*(x3!-x8!)*(x3!-x9!))\
      47. +y4!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x5!)*(x!-x6!)*(x!-x7!)*(x!-x8!)*(x!-x9!)/((x4!-x1!)*(x4!-x2!)*(x4!-x3!)*(x4!-x5!)*(x4!-x6!)*(x4!-x7!)*(x4!-x8!)*(x4!-x9!))\
      48. +y5!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x6!)*(x!-x7!)*(x!-x8!)*(x!-x9!)/((x5!-x1!)*(x5!-x2!)*(x5!-x3!)*(x5!-x4!)*(x5!-x6!)*(x5!-x7!)*(x5!-x8!)*(x5!-x9!))\
      49. +y6!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x5!)*(x!-x7!)*(x!-x8!)*(x!-x9!)/((x6!-x1!)*(x6!-x2!)*(x6!-x3!)*(x6!-x4!)*(x6!-x5!)*(x6!-x7!)*(x6!-x8!)*(x6!-x9!))\
      50. +y7!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x5!)*(x!-x6!)*(x!-x8!)*(x!-x9!)/((x7!-x1!)*(x7!-x2!)*(x7!-x3!)*(x7!-x4!)*(x7!-x5!)*(x7!-x6!)*(x7!-x8!)*(x7!-x9!))\
      51. +y8!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x5!)*(x!-x6!)*(x!-x7!)*(x!-x9!)/((x8!-x1!)*(x8!-x2!)*(x8!-x3!)*(x8!-x4!)*(x8!-x5!)*(x8!-x6!)*(x8!-x7!)*(x8!-x9!))\
      52. +y9!*(x!-x1!)*(x!-x2!)*(x!-x3!)*(x!-x4!)*(x!-x5!)*(x!-x6!)*(x!-x7!)*(x!-x8!)/((x9!-x1!)*(x9!-x2!)*(x9!-x3!)*(x9!-x4!)*(x9!-x5!)*(x9!-x6!)*(x9!-x7!)*(x9!-x8!))
      53. endproc
      54. '---------------------------------------------------------
      55. Cls
      56. usepen 0,1,0:line 0,yh& - 2*xh&,yh&:line xh&,0 - xh&,2*yh&
      57. usepen 0,6,rgb(0,0,255)
      58. line xh&+u!*x1!,(yh&-v!*y1!) - xh&+u!*x1!+1,(yh&-v!*y1!):drawtext xh&+u!*x1!,yh&-v!*y1!-26,"1"
      59. line xh&+u!*x2!,(yh&-v!*y2!) - xh&+u!*x2!+1,(yh&-v!*y2!):drawtext xh&+u!*x2!,yh&-v!*y2!-26,"2"
      60. line xh&+u!*x3!,(yh&-v!*y3!) - xh&+u!*x3!+1,(yh&-v!*y3!):drawtext xh&+u!*x3!,yh&-v!*y3!-26,"3"
      61. line xh&+u!*x4!,(yh&-v!*y4!) - xh&+u!*x4!+1,(yh&-v!*y4!):drawtext xh&+u!*x4!,yh&-v!*y4!-26,"4"
      62. line xh&+u!*x5!,(yh&-v!*y5!) - xh&+u!*x5!+1,(yh&-v!*y5!):drawtext xh&+u!*x5!,yh&-v!*y5!-26,"5"
      63. line xh&+u!*x6!,(yh&-v!*y6!) - xh&+u!*x6!+1,(yh&-v!*y6!):drawtext xh&+u!*x6!,yh&-v!*y6!-26,"6"
      64. line xh&+u!*x7!,(yh&-v!*y7!) - xh&+u!*x7!+1,(yh&-v!*y7!):drawtext xh&+u!*x7!,yh&-v!*y7!-26,"7"
      65. line xh&+u!*x8!,(yh&-v!*y8!) - xh&+u!*x8!+1,(yh&-v!*y8!):drawtext xh&+u!*x8!,yh&-v!*y8!-26,"8"
      66. line xh&+u!*x9!,(yh&-v!*y9!) - xh&+u!*x9!+1,(yh&-v!*y9!):drawtext xh&+u!*x9!,yh&-v!*y9!-26,"9"
      67. draw7:
      68. usepen 0,3,rgb(0,150+rnd(100),150+rnd(100))
      69. whileloop -1000,1000:x!=&Loop/w!
      70. y!=funk7() 'x!,x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!,x5!,y5!,x6!,y6!,x7!,y7!,x8!,y8!
      71. case &Loop=-1000:moveto xh&+u!*x!,(yh&-v!*y!)
      72. lineto xh&+u!*x!,(yh&-v!*y!)
      73. endwhile
      74. draw8:
      75. usepen 0,5,255
      76. whileloop -1000,1000:x!=&Loop/w!
      77. y!=funk8() 'x!,x1!,y1!,x2!,y2!,x3!,y3!,x4!,y4!,x5!,y5!,x6!,y6!,x7!,y7!,x8!,y8!,x9!,y9!
      78. case &Loop=-1000:moveto xh&+u!*x!,(yh&-v!*y!)
      79. lineto xh&+u!*x!,(yh&-v!*y!)
      80. endwhile
      81. sound 2000,50
      82. waitinput
      Alles anzeigen
    • Abt. Muß mal für kleine Primzahlen
      ======================
      Ohne Kommentar (War für ein Mathe-Rätsel gedacht...)
      Gruss

      Quellcode

      1. WindowTitle " N A I V E R P R I M T E S T bis max. "+str$(int(2^31-1))
      2. 'Q: Wikipedia "Primzahlen"
      3. declare i&,n&:font 2:Restart:
      4. Cls:Print "\n Zu testende positive ganze Zahl: ";:input n&
      5. print "\n ";n&;" ist ";:if (n&<2):print "per Definition NICHT PRIM."
      6. elseif (n&=2):print "die einzige gerade PRIMZAHL!":elseif (n&=3):print "PRIM."
      7. elseif ((n& mod 2) = 0)
      8. print "nicht prim, weil alle geraden Zahlen >2 durch 2 restlos teilbar sind."
      9. elseif ((n& mod 3) = 0)
      10. print "nicht prim weil durch 3 restlos teilbar (";n&;" = ";3;" * ";int(n&\3);")."
      11. else :i&=5
      12. while sqr(i&)<=n&
      13. if (n& mod i&)=0
      14. print "NICHT PRIM weil durch ";i&;\
      15. " restlos teilbar (";n&;" = ";i&;" * ";int(n&\i&);")."
      16. goto "Ex_it"
      17. elseif (n& mod (i&+2))=0
      18. print "NICHT PRIM weil restlos durch ";int(i&+2);\
      19. " teilbar (";n&;" = ";int(i&+2);" * ";int(n&\i&);")."
      20. goto "Ex_it"
      21. endif
      22. inc i&,6
      23. endwhile
      24. print "PRIM."
      25. endif: Ex_it:
      26. waitinput :goto "Restart"
      Alles anzeigen
    • Abt. Multinomialkoeffizient (n über k1,k2,...)
      ============================
      Für die Anwendung der Formel von Faa di Bruno war ein Multinomialkoeffizient zu programmieren. Klappt ganz gut, weil Bereichsüberschreitungen weitestgehend vermieden werden.
      Gruss

      Quellcode

      1. WindowTitle " M U L T I N O M I A L K O E F F I Z I E N T"
      2. declare w$,z$[],anz&[],c$,i&,n&,flg&:CLS:font 2
      3. print "\n Die Prozedur berechnet die Anzahl unterschiedlich aussehender \n"
      4. print " Anordnungen aller Zeichen, wobei manche Zeichen auch wiederholt\n"
      5. print " auftreten (= Gruppen un-unterscheidbarer Zeichen bilden) können.\n"
      6. nochmal:
      7. Print "\n\n Geben Sie eine Zeichenkombination ein: ";:input w$:case w$="":end:n&=-1
      8. Whileloop len(w$):c$=mid$(w$,&Loop,1):flg&=1
      9. whileloop 0,n&:i&=&Loop:if z$[i&]=c$:anz&[i&]=anz&[i&]+1:flg&=0:break:endif
      10. endwhile:if flg&:inc n&:z$[n&]=c$:anz&[n&]=1:endif
      11. endwhile:print
      12. :whileloop 0,n&:print " ";z$[&Loop];" kommt ";anz&[&loop];" mal vor.":endwhile
      13. print "\n Daher gibt es ";
      14. print format$("#################",multinomkoeff(len(w$),n&,anz&[]));" unterscheidbare Anordnungen!"
      15. waitinput:cls:goto "nochmal"
      16. proc multinomkoeff :parameters k&,n&,anz&[]:declare p!:p!=1
      17. :whileloop 0,n&:whileloop anz&[&Loop]:p!=p!*k&/&Loop
      18. dec k&:endwhile:endwhile:return p!
      19. endproc
      Alles anzeigen
    • Abt. Nicht schon wieder...
      ================
      Als Fingerübung zwischendurch wieder mal die Sophomore-Gleichung y=x^x. Gesucht ist bei gegebenem y das x, daß diese Gleichung erfüllt. Die Funktion ist in der Zahlentheorie nicht unwichtig, dort kommen dann auch noch ganz andere Kaliber vor...
      Gruß

      Quellcode

      1. Windowtitle " Sophomore-Gleichung: Approximation mittels Newton-Raphson"
      2. AppendMenuBar 100," y = f(x) = x^x ; Geg. 0<y<=142 , Ges: x = ? "
      3. cls:declare x!,y!,eps!:set("decimals",17):eps!=val("1e-15"):rept:
      4. locate 1,1:print "\n\n Y = ";:locate 3,7
      5. input y!:case (y!<=0) or (y!>142):goto "rept":x!=1
      6. repeat:x!=x!-(y!-x!^x!)/(-(x!^x!)*(ln(x!)+1))':print x!,
      7. case (abs(x!^x!-y!)/y!)<eps!:break
      8. until 0:font 2:print "\n X = ",x!:font 0
      9. print "\n Probe: ";x!^x!,"Abs.Fehler: ";abs(x!^x!-y!):goto "rept"

      P.S.: ... und das gleiche für die Additive Sophomore-Gleichung y=x^x+x

      Quellcode

      1. Windowtitle " Additive Sophomore-Gleichung: Approximation mittels Newton-Raphson"
      2. AppendMenuBar 100," y = f(x) = x^x + x ; Geg. 0<y<=284 , Ges: x = ? "
      3. cls:declare x!,y!,eps!:set("decimals",17):eps!=val("1e-15"):rept:
      4. locate 1,1:print "\n\n Y = ";:locate 3,7
      5. input y!:case (y!<=0) or (y!>284):goto "rept":x!=1
      6. repeat:x!=x!-(y!-(x!^x!+x!))/(-(x!^x!)*(ln(x!)+1)-1)':print x!,
      7. case (abs(x!^x!+x!-y!)/y!)<eps!:break
      8. until 0:font 2:print "\n X = ",x!:font 0
      9. print "\n Probe: ";x!^x!+x!,"Abs.Fehler: ";abs(x!^x!+x!-y!):goto "rept"
    • Abt. XProfan zum sprechen bringen
      ======================
      ACHTUNG, EXPERIMENTELLER HUSCH-PFUSCH! Verwendet den Wscript.exe Windows scripting host. KEINE GEWÄHR - Nutzung auf eigene Gefahr des Anwenders / der Anwenderin!

      Meine Konfiguration funktioniert: XProfan 11.2a, Win7-64 home premium Service Pack 1, eingelogged als "Admin". Hoffe, es klappt - Viel Spaß!
      Gruss

      P.S.: Leider kann meine Konfiguration nur Englisch parlieren, daher müssen deutsche Sätze händisch in "Englische Lautschrift" übersetzt werden - zumindest, solange niemand ein Lautschrift-Übersetzungsprogramm schreibt :-)

      Quellcode

      1. Var t$="Wheel komehnn auff eehrem Compjuther: leehbar at ministrahtohr !"
      2. Windowtitle "Willkommen!":WindowStyle 24:Window 300,300-100,100
      3. var fn$=getenv$("USERPROFILE")+"\\desktop\\welc.vbs":assign #6,fn$
      4. rewrite #6:print #6,"Dim speaks, speech:speaks="+\
      5. chr$(34)+t$+chr$(34)+":Set speech=CreateObject("+\
      6. chr$(34)+"sapi.spvoice"+chr$(34)+"):speech.Speak speaks"+chr$(13)
      7. close #6:case fileexists(fn$):winexecWait("wscript.exe "+fn$,1)
      8. erase #6:End
    • Sehr nette Idee, diese Lautschrift. Man könnte aber auch eine deutsche Stimme installieren. Ob es inzwischen was Akzeptables gibt? Was ich bisher gefunden hatte klang eher bescheiden oder kostete richtig Kohle. Also bleibe ich erst mal bei meinem LOGOX4. Lieder hat das GData schon vor Jahren aus dem Programm verbannt, dabei konnte das mit mehreren Stimmen perfekt deutsch.

      Gruß Volkmar
    • p. specht schrieb:

      Abt. XProfan zum sprechen bringen
      Liest du mit? Wenn ja, hast du meinen Gedankengang da sehr genau verstanden.
      Da fehlt aber noch was, das prüft, ob der Scripting Host deaktiviert wurde - sonst gibt es eine Fehlermeldung von Windows. Auch das findest du in dem besagten Artikel.
      ________________________________________________________

      PPFScanner PPFS Android MisterXMail@web.de
      Mfg AHT
    • Link bitte!
      Vorläufige Lautschrift-Übersetzungstafeln anbei. Bin am basteln... Gruss
      Spoiler anzeigen
      'http://www.wikihow.com/Pronounce-German-Words

      var Doppelvokale$="au,äu,ei,eu"
      var Vokale$="a,e,i,o,u,y,ä,ö,ü"

      flag=0 : case (next = not doppelvokal) or (next=not vokal and übernext=not vokal):flag=1

      var table$="äus,OYZ,sch,SH,ch,SH,äu,OY,ie,EE,ei,EYE,au,OW,sp,SHP,ss,SS,st,SHT,pf,PF,ph,F,qu,KV"


      IF vokal is followed by two or more consonants: Kurze Vokale
      var tablekurz$="a,AH,e,AY,i,EE,o,OH,u,OOH,ä,AY,A,ö,OI,ü,OOI"

      IF vokal is doubled OR vokal is followed by h or vokal is followed by a single consonant only:
      var tablelang$="a,AHH,e,AY,i,EE,o,OH,u,OOH,y,EE,ä,AY,A,ö,OI,ü,OOI"


      IF single character is preceded by (\n or \t or _space or BOF or Not_a(Letter) ) \
      AND this single character is followed by _space or a NonLetter or EOL/EOF:
      einzel$="b,BAY,c,SAY,d,DAY,f,EFF,g,GAY,h,HAH,j,YOT,k,CAR,l,AL,m,EMM,n,ENN,p,PAY,q,COO,r,AIR,s,ESS,ß,SHARFAZ ESS,t,TAY,v,FOW,w,VAY,x,ICKS,y,OIPSILONE,z,TSETT"
      P.S. Manchmal ist die Zeit für neue Ideen einfach reif ;-)

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

    • Und nochmals: Deine Methode, hier VBScript für eine Sprachausgabe zu nutzen halte ich gerade für XProfan für besonders geeignet:
      • XProfan ist nicht multithreadingfähig. Die weitere Programmausführung wird während des Sprechens nicht behindert, da die Sprache im Windows Scripting Host läuft.
      • Funktioniert das Sprechen nicht, stürzt die Sprache ab, nicht das Restprogramm.
      Den Code, den ich da verwende, kann man mit Sicherheit noch weiter verbessern.
      Um zu testen, ob gesprochen werden kann, musst du auf jeden Fall zwei Registryschlüssel auswerten. Welche das sind, findest du zumindestens in den Scripten des PPFScanners, die sprechen.
      Die Sprache unter Windows10 ist übrigens schon recht gut. Da wird auch die deutsche Sprache mitgeliefert.
      ________________________________________________________

      PPFScanner PPFS Android MisterXMail@web.de
      Mfg AHT
    • Abt. AMI-SLANG FÜR ALLE
      =================
      Ein Horror, wie schief manche Projekte gehen können. Das da unten ist so ein Beispiel. OHNE HAND-TUNING GEHT DA ERST MAL GARNIX! Mögen begnadetere Profaner retten, was zu retten ist - Ich werfe erst mal das Handtuch...
      Schöne Woche Euch allen!

      Brainfuck-Quellcode

      1. Windowtitle "DEUTSCH MIT AMI-SLANG ERZEUGEN V.0.00001 Early minus alpha"
      2. 'FREE TO EXPERIMENTAL USE. KEINE GARANTIE, AUF GARNICHTS! NO WARRANTY WHATSOEVER!
      3. Cls:declare t$,L$[]
      4. L$[]=explode("ca.,TSEERCA,ist,EEST ,äus,OYZ ,sch,SH,ch,CK,äu,OY,ie,EEH,ei,AI,eu,OI,au,OW,"+\
      5. "sp,SHP,ss,SS,st,SHT,pf,PF,ph,F,qu,KV,he,HEH,in,IN,a,A,e,E,i,ee,o,O,u,OO,y,EE,ä,AY,ö,OI,"+\
      6. ,OI,w,WH,mm,M,z,TS,ß,SS,!,_!,?,_?,+,_+ , -,_-_,*,_*_,10,TSEIN ,11,ELF ,12,TSWOILF ,0,NOOL ,"+\
      7. "1,EINS ,2,TSWOI ,3,DRY ,4,FEAR ,5,FUINF ,6,SEX ,7,SEEBAN ,8,ACKT ,9,NOIN " , ",")
      8. ' = EXPERIMENTAL
      9. ' BEST UNTIL NOW:
      10. '"ist,EEST ,äus,OYZ ,sch,SH,ch,CK,äu,OY,ie,EEH ,ei,EYE ,eu,OI ,au,OW ,"+\
      11. '"sp,SHP,ss,SS,st,SHT,pf,PF,ph,F,qu,KV,he,HEH,in,IN ,a,A,e,AI,i,ee,o,O,u,OO,y,EE,ä,AY ,ö,OI ,"+\
      12. '"ü,OOI ,w,WH,mm,M,z,TS,ß,SS,!,_!,?,_?,+,_+ , -,_-_,*,_*_,10,TSEIN ,11,ELF ,12,TSWOILF ,0,NOOL ,"+\
      13. '"1,EINS ,2,TSWOI ,3,DRY ,4,FEAR ,5,FUINF ,6,SEX ,7,SEEBAN ,8,ACKT ,9,NOIN " , ",")
      14. 't$="Willkommen auf ihrem Computer, lieber Administrator!"
      15. 't$="Viele Häuser schlimmer Buben stehen still in dummen Gruben!"
      16. 't$="Abera ka dabera, das waren Zeiten, daß ist wahr!"
      17. t$="0: 1: 2: 3 4 5 6 7 8 9 10 11 12 : : : "+\
      18. "Das Deutsche Textarchiv stellt einen disziplin- und gattungs über greifen den "+\
      19. "Grundbestand deutschsprachiger Texte aus dem Zeitraum von ca. 1600 bis 1900 be reit. "
      20. '+"Die Textauswahl erfolgte auf der Grundlage einer von Akademiemitgliedern erstellten "\
      21. '+"und ausführlich kommentierten, umfangreichen Bibliographie. In Ergänzung wurden "\
      22. '+"einschlägige Literaturgeschichten und (Fach-)Bibliographien ausgewertet."
      23. print
      24. whileloop 0,sizeof(L$[])-2,2
      25. print L$[&loop],L$[&Loop+1]
      26. endwhile
      27. print "-------------------------------------------"
      28. cls:print t$+"\n"
      29. print "-------------------------------------------"
      30. t$=UK2GER(t$)
      31. 'Var t$="Wheel komehnn auff eehrem Compjuther: leehbar at ministrahtohr !"
      32. var fn$=getenv$("USERPROFILE")+"\\desktop\\welc.vbs":assign #6,fn$
      33. rewrite #6:print #6,"Dim speaks, speech:speaks="+\
      34. chr$(34)+t$+chr$(34)+":Set speech=CreateObject("+\
      35. chr$(34)+"sapi.spvoice"+chr$(34)+"):speech.Speak speaks"+chr$(13)
      36. close #6:case fileexists(fn$):winexecWait("wscript.exe "+fn$,1)
      37. erase #6
      38. waitinput 5000
      39. End
      40. proc UK2GER :parameters t$
      41. declare n&:t$=lower$(t$)
      42. whileloop 0,sizeof(L$[])-2,2
      43. n&=0
      44. nochmal:
      45. inc n&
      46. t$=translate$(t$,L$[&Loop],L$[&Loop+1])
      47. case n&<16:goto "nochmal"
      48. endwhile
      49. :::::::::print t$
      50. t$=translate$(t$,"_"," ")
      51. return lower$(t$)
      52. endproc
      Alles anzeigen
    • Speaking XProfan

      So - das hier müsste gehen:

      Quellcode: Speak.prf

      1. '#####################################################################################
      2. '######### Code von AHT #########
      3. '######### Gepostet für http://www.paules-pc-forum.de #########
      4. '#####################################################################################
      5. Declare Fehler%, RegHandle%, ValueName$, RegSize&, PlaySound&, RegType&, RegKey$
      6. Declare Operation$, FilePath$, FileParameters$, Directory$
      7. WindowTitle "Sprechendes XProfan"
      8. WindowStyle 31 + 256
      9. Window 0, 0 - 640,440
      10. Usermessages $10
      11. PlaySound& = 1
      12. RegKey$ = "Software\Microsoft\Windows Script Host\Settings"
      13. ValueName$ = "Enabled"
      14. Fehler% = External("ADVAPI32", "RegOpenKeyExA", $80000002, addr(RegKey$), 0, $1, addr(RegHandle%))
      15. If Fehler% = 0
      16. RegSize& = 4
      17. External("ADVAPI32", "RegQueryValueExA", RegHandle%, addr(ValueName$), 0, addr(RegType&), addr(PlaySound&), addr(RegSize&))
      18. External("ADVAPI32", "RegCloseKey", RegHandle%)
      19. endif
      20. Fehler% = External("ADVAPI32", "RegOpenKeyExA", $80000001, addr(RegKey$), 0, $1, addr(RegHandle%))
      21. If Fehler% = 0
      22. RegSize& = 4
      23. External("ADVAPI32", "RegQueryValueExA", RegHandle%, addr(ValueName$), 0, addr(RegType&), addr(PlaySound&), addr(RegSize&))
      24. External("ADVAPI32", "RegCloseKey", RegHandle%)
      25. endif
      26. If Playsound& = 1
      27. Assign #20, $Tempdir + "\XProfSpeak.vbs"
      28. Rewrite #20
      29. Print #20, "Dim EnglishText, GermanText, VoiceName, VoiceNumber, SpokenText , Counter"
      30. Print #20, "VoiceNumber = -1"
      31. Print #20, "Set SAPI = CreateObject(" + chr$(34) + "SAPI.SpVoice" + chr$(34) + ")"
      32. Print #20, "GermanText = " + chr$(34) + "Hallo, hier spricht XProfan!" + chr$(34)
      33. Print #20, "EnglishText = " + chr$(34) + "Hello, XProfan is speaking to you!" + chr$(34)
      34. Print #20, "Counter = 0"
      35. Print #20, "For Each Token In SAPI.GetVoices"
      36. Print #20, " VoiceName = Token.GetDescription"
      37. Print #20, " VoiceName = ucase(VoiceName)"
      38. Print #20, " IF instr(1, VoiceName, " + chr$(34) + "GERMAN" + chr$(34) + ", 0) > 0 Then"
      39. Print #20, " VoiceNumber = Counter"
      40. Print #20, " SpokenText = GermanText"
      41. Print #20, " ElseIF instr(1, VoiceName, " + chr$(34) + "DEUTSCH" + chr$(34) + ", 0) > 0 Then"
      42. Print #20, " VoiceNumber = Counter"
      43. Print #20, " SpokenText = GermanText"
      44. Print #20, " ElseIF instr(1, VoiceName, " + chr$(34) + "ENGLISH" + chr$(34) + ", 0) > 0 Then"
      45. Print #20, " If VoiceNumber = -1 Then"
      46. Print #20, " VoiceNumber = Counter"
      47. Print #20, " SpokenText = EnglishText"
      48. Print #20, " End If"
      49. Print #20, " ElseIF instr(1, VoiceName, " + chr$(34) + "ENGLISCH" + chr$(34) + ", 0) > 0 Then"
      50. Print #20, " If VoiceNumber = -1 Then"
      51. Print #20, " VoiceNumber = Counter"
      52. Print #20, " SpokenText = EnglishText"
      53. Print #20, " End If"
      54. Print #20, " End If"
      55. Print #20, " Counter = Counter + 1"
      56. Print #20, "Next"
      57. Print #20, "IF VoiceNumber <> -1 Then"
      58. Print #20, " Set SAPI.voice = SAPI.getvoices.item(VoiceNumber)"
      59. Print #20, " SAPI.Speak SpokenText"
      60. Print #20, "End If"
      61. Close #20
      62. Operation$ = "open"
      63. FilePath$ = $SysPath + "\WSCRIPT.EXE"
      64. FileParameters$ =$Tempdir + "\XProfSpeak.vbs //B"
      65. External("Shell32.dll", "ShellExecuteA", %Hwnd, addr(Operation$), addr(FilePath$), addr(FileParameters$), addr(Directory$), 1)
      66. else
      67. Messagebox("Sorry, kann keinen Sound abspielen!", "Kein Sound!", 64)
      68. endif
      69. While (%Umessage <> $10)
      70. WaitInput
      71. EndWhile
      72. Erase #20
      73. End
      Alles anzeigen
      Der Code sucht nach einer installierten deutschen Sprache. Findet er die nicht, wird eine installierte englische Sprache gesucht.
      Findet er Deutsch, wird Deutsch gesprochen.
      Findet er Englisch, wird Englisch gesprochen.
      Findet er nichts, hält er die Klappe.
      Ist der Windows Script Host deaktiviert, gibt es eine Meldung.
      ________________________________________________________

      PPFScanner PPFS Android MisterXMail@web.de
      Mfg AHT

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