ALGORITHMEN TEIL XI: Genaue Planung ersetzt Zufall durch Irrtum

    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. Icon-Spielereien
      =============
      Nicht der Rede wert...

      Quellcode

      1. WindowTitle "XProfan-11 Interne Icons"
      2. Windowstyle 24:cls: var name$=""
      3. var in$="A MUELL BAUM MUENZE COMPUTER PROFAN DOS SAND DRUCKER STEIN EDITOR "+\
      4. "TEXT EIMER WASSER EIS WEG FILEICON WINDOWS GESICHT KNOPF1 KNOPF2"
      5. usefont "Arial",12,6,0,0,0
      6. whileloop 21
      7. name$=substr$(in$,&Loop," ")
      8. drawicon name$,10+64*((&Loop-1) mod 10),10+64*int((&Loop-1)/10)
      9. drawtext 10+64*((&Loop-1) mod 10),50+64*int((&Loop-1)/10),name$
      10. endwhile
      11. whileloop 7
      12. drawicon &Loop,10+80*((&Loop-1) mod 7),10+64*int(3+(&Loop-1)/7)
      13. drawtext 30+80*((&Loop-1) mod 7),50+64*int(3+(&Loop-1)/7),str$(&Loop)
      14. endwhile
      15. repeat
      16. whileloop 21
      17. name$=substr$(in$,&Loop," ")
      18. UseIcon name$
      19. waitinput 500
      20. case %key>0:end
      21. endwhile
      22. until 0
      Alles anzeigen
      P.S.: Kann sich noch jemand an den 16bit-Screensaver Johnny Castaway erinnern? Auf 64bit-Systemen läuft er trotz DosBox nicht gut, aber es gibt ein Youtube Video von allen Szenen!

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

    • Abt. INVXOREXP-Crypto
      ===============
      Eines der einfacheren Verschlüsselungsverfahren. Ein bisschen a la Enigma, funktioniert das ganze nur dann, wenn man mit jeder Klarnachricht auch einen brandneuen, niemals wiederverwendeten Verschlüsselungscode übermittelt - und zwar immer! Der Rest ist eine verzerrte, invertierte XOR-Angelegenheit.
      Gruss

      Quellcode

      1. Windowtitle "INVXOREXP-Crypto":cls
      2. var Klartext$="Zu verschlüsselnder Satz unbestimmter Länge!"
      3. var Schlüssel$="GgG6!eD3bA<<<"
      4. var z$="":var y$=""
      5. var Ls&=len(Schlüssel$)
      6. Print "\n Klartext = ";Klartext$
      7. whileloop len(Klartext$)
      8. z$=z$+chr$( (xor(255-ord(mid$(Klartext$,&Loop,1)), exp(ord(mid$(Schlüssel$,&Loop mod ls&,1))) )))
      9. endwhile
      10. print "\n Cryptogramm = ";z$
      11. whileloop len(z$)
      12. y$=y$+chr$( (xor(255-ord(mid$( z$ ,&Loop,1)), exp(ord(mid$(Schlüssel$,&Loop mod ls&,1))) )))
      13. endwhile
      14. print "\n Entschlüsselt = ";y$
      15. waitinput
      Alles anzeigen
    • 6) IDApro Free Letzte Freie Version dieses bekannten Disassemblers *)
      _ Tipp: Umbenennen der exe verhindert, daß die Microsoft Essentials
      _ Anti-Malware Suite dieses als "Hacker-Tool" automatisch löscht!

      7) OllyDebug v1.10 Free for private use - samt OllyDebug64 Shareware

      8) HxD 1.7.7.0 Freeware HexEditor mit Disk-EditorHxD 1.7.7.0 Freeware HexEditor mit Disk-Editor

      9) Ressource Hacker, unverzichtbar zum Packen von eigenen Icons etc. in XProfan EXE-Dateien

      10) GIF-Construction Set: Animierte GIF-Bilder erzeugen: Shareware

      11) JWlink, der JWasm-Original Linker. Auf 64bit-Systemen klappt der Linker von MASM besser

      12) Undeleter File Recovery Tool

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

    • Abt. Klassische Kabarettnummern
      =====================
      A) Worüber sich meine Großeltern stundenlang totlachen konnten:
      _ Youtube-Link: Karl Valentin & Lisl Karlstadt

      B) Worüber sich meine anderen Großeltern stundenlang totlachen konnten:
      _ Youtube-Link: Äffle und Pferdle (Deutsche Kurzcartoons in Schwäbisch)

      C) Worüber unsere Urgroßeltern staunten:
      _ Die ersten "bewegten Bilder" der Gebrüder Lumiere
      _ Die ersten "Movies" in England und USA
      _ Due frühesten Bewegtphotographie-Effekte

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

    • Abt. Rätselecke Nr. 20
      ==============
      Die Mutter gibt jedem ihrer drei Kinder 5 Äpfel. Anna gibt 3 Äpfel ihrerSchwester Berta, danach gibt Berta die Hälfte ihrer Äpfel ihrem Bruder Michael. Wie viele Äpfel hat nun Michael?

      Nr. 21
      ====
      Die Katz&Maus-Rennbahn habe 14 gleich lange Felder, dahinter ist Gestrüpp. Katz und Maus spielen Katz und Maus, also Nachrennen. Katz startet auf Feld 1 und gibt Maus 6 Felder Vorsprung (Maus startet also auf Feld 7. Katz ist doppelt so schnell wie Maus. Auf welchem Feld fängt Katz Maus? Oder entkommt Maus? Die beiden starten gleichzeitig!

      Nr. 22
      ====
      Corinna hat 3 Brüder und 3 Schwestern. Wie viele Brüder und Schwestern hat ihr Bruder Markus?

      Nr. 23
      ====
      Eine Birne kann gegen zwei Äpfel, ein Apfel gegen drei Pflaumen und eine Erdbeere gegen zwei Pflaumen eingetauscht werden. Andres möchte seine 6 Birnen gegen Erdbeeren eintauschen. Wie viele erhält er?

      Nr. 24
      ====
      Von einem 3x3x3-Würfel kann man vier Eckwürfel entfernen. Wieviele verschiedene Abdrücke (Rotationen zählen als der gleiche Abdruck) kann man so erzeugen?

      Nr. 25
      ====
      Markus legt aus 5 Zündhölzern ein "Haus", dann baut er dataus ein Reihenhaus bestehend aus sieben Häusern. Wieviele Zündhölzer braucht er?

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

    • Abt. Parametertyp feststellen
      ==================
      Für XProfan-11 war der Befehl PType$() noch relativ einfach. In späteren Versionen kamen
      %, %[], %[n] für Integer (Int) (in Profan 10 bis 11.2a als &, &[]; &[] ausgewiesen)
      Q, Q[], Q[n] für Quadint (Quad), S, S[], S[n] für Single
      W, µ[], µ[n] für Widestring (Wide) und Q, H[], --- für Hash (assoziative Arrays) hinzu.

      Sinn des Befehles ist ja u.a., daß der selbe Prozedurname je nach Parametertyp (und Parameterzahl = Systemvariable %PCount) unterschiedlich reagieren kann. Für meine derzeitige Version 11.2a liefert PType$(<Parameter_Nr>) gemäß Testprogramm jedenfalls keine Überraschungen.

      Gruss

      Quellcode

      1. WindowTitle " Die PType()-Funktion in XProfan 11"
      2. 'Parametertyp$=@PType$(parameterpositionsnr&)
      3. 'Der Typ eines Parameters der Prozedur wird ermittelt.
      4. 'Die Ermittlung des Typs muß direkt am Anfang der Prozedur vor einem etwaigen
      5. 'ersten Funktions- oder Prozeduraufruf stehen!
      6. 'Ein- und derselbe Prozeduraufruf (Name) kann also für verschiedene Parametersituationen
      7. ' angepasst reagieren, so kann etwa PLUS Floats addieren oder Stings zusammenconcatenieren
      8. 'Das Ergebnis ist der Typ des Parameters:
      9. '& = LongInt bzw. Integer
      10. '! = Float
      11. '$ = String
      12. 'b = Bereich
      13. 's = Struktur
      14. 'o = Objekt
      15. 'Dynamische Arrays: Parametertyp + leere eckigen Klammern, zB. "$[]".
      16. 'Array mit vordefinierter Größe, stehen in Klammern die Dimensionsgrößen, etwa "&[8,8,2]".
      17. 'Ab Version X3 gibt es weitere Aufgliederungen:
      18. ' %, %[], %[n] Integer (Int) (in Profan 10 bis 11.2a: &, %[]; %[]
      19. ' Q, Q[], Q[n] Quadint (Quad)
      20. ' S, S[], S[n] Single
      21. ' W, µ[], µ[n] Widestring (Wide) !!! hier wird für Array ein "micro"-Zeichen gesetzt !!!
      22. ' Q, H[], --- Hash (assoziatives Array) !!! hier wird ohne Klammer einfach QUADINT gesetzt !!!
      23. Cls
      24. proc pptype
      25. print pType$(1)
      26. endproc
      27. declare I1%,I2%[2],I3%[1,1],I4%[]
      28. declare L1&,L2&[2],L3&[2,1],L4&[]
      29. declare F1!,F2![2],F3![1,2],F4![]
      30. declare S1$,S2$[2],S3$[1,1],S4$[1,2,3],S5$[]
      31. declare B1#,B2#[2]
      32. Dim B1#,200
      33. declare Kunde#
      34. Struct Kund = Name$(40),Strasse$(40),Ort$(40),Umsatz&,Status%
      35. Dim Kunde#,Kund
      36. Declare Hunde#
      37. Class Hund = Name$(40)
      38. Dim Hunde#,Hund
      39. print " I1% =",tab(12);:pptype I1%
      40. print " I2%[2] =",tab(12);:pptype I2%[]
      41. print " I3%[x,y]=",tab(12);:pptype I3%[]
      42. print " I4%[] =",tab(12);:pptype I4%[]
      43. print " L1& =",tab(12);:pptype L1&
      44. print " L2&[2] =",tab(12);:pptype L2&[]
      45. print " L3%[x,y]=",tab(12);:pptype L3&[]
      46. print " L4%[] =",tab(12);:pptype L4&[]
      47. print " F1! =",tab(12);:pptype F1!
      48. print " F2![2] =",tab(12);:pptype F2![]
      49. print " F3![x,y]=",tab(12);:pptype F3![]
      50. print " F4![] =",tab(12);:pptype F4![]
      51. print " S1$ =",tab(12);:pptype S1$
      52. print " S2$[2] =",tab(12);:pptype S2$[]
      53. print " S3$[x,y]=",tab(12);:pptype S3$[]
      54. print " S4$[,,] =",tab(12);:pptype S4$[]
      55. print " S5$[] =",tab(12);:pptype S5$[]
      56. print " B1# =",tab(12);:pptype B1#
      57. print " B2#[] =",tab(12);:pptype B2#[]
      58. print " Kunde# =",tab(12);:pptype Kunde#
      59. print " Hunde# =",tab(12);:pptype Hunde#
      60. waitinput
      61. End
      Alles anzeigen
    • Hm, Widestrings sollten immer das "W" (bzw. W[] oder W[n] haben und Hasharrays immer das "H[]".

      Das µ ist eine interne Kennung für Widestrings. Da muss ich für die nächste Version wohl noch mal nach dem Rechten schauen, was da los ist.

      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. Lösungen 20 - 25
      ==============
      Eines ist sicher: Unsere Chemische Industrie arbeitet mit Hochdruck an Lösungen! :lol:

      Nr.20: Michael hat nun 9 Äpfel.
      Nr.21: Katz fängt Maus auf Feld 14.
      Nr.22: Markus hat 2 Brüder und 4 Schwestern.
      Nr.23: 1 Birne = 6 Pflaumen = 3 Erdbeeren >>> 6 Birnen = 18 Erdbeeren
      Nr.24: 6 verschiedene Abdrücke:
      XXX | _XX | _X_ | _XX | _X_ | _X_
      XXX | XXX | XXX | XXX | XXX| XXX
      XXX | XXX | XXX | XX_ | _XX | _X_
      Nr.25: 5+4+4+4+4+4+4 = 7*4+1 = 29

      Gruss

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

    • RGH schrieb:

      Hm, Widestrings sollten immer das "W" (bzw. W[] oder W[n] haben und Hasharrays immer das "H[]".
      Beim Hasharray soll ja auch nur das Array funktionieren.
      Ich hatte dort sowohl bei der Übergabe als auch bei Parameters keine Array-Klammern gesetzt.

      Ist in diesem Fall ein Anwenderfehler! (Allerdings ohne jegliche Warnung).
      Programmieren, das spannendste Detektivspiel der Welt.

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

    • Abt. Multiple nichtlineare Regression
      =======================
      Multipel bedeutet, daß im folgenden Programm bis zu 9 Einflußgrössen X1...X9 auf eine Ergebnisvariable Y wirken können. Weiters wird dadurch in der jeweiligen Dimension eine Parabel bestimmten Grades (je Einflußgröße verschieden) nach dem Kriterium der kleinsten quadratischen Abweichungssumme angepasst. Das klappt allerdings nur, wenn die Einflußgrößen X voneinander unabhängig sind, was z.B. in den Sozialwissenschaften nur sehr schwer zu beurteilen ist. In der Technik finden sich oft gute Argumente, warum ein Einfluß z.B. kubisch in das Ergebnis eingeht: Masse geht natürlich mit der 3. Potenz der Längenabmessungen etc.

      Funktionsweise: Nach Eingabe des jeweiligen Ergebniswertes werden die zugehörigen Einflußgrößen eingegeben (Dabei sollten genügend Daten unter unterschiedlichsten Bedingungen vorliegen, etwa aus Laborversuchen). Das Programm errechnet die (bis zu 9-)dimensionale Vandermonde-Matrix und passt iterativ-zyklich alle Parabeln so lange an, bis die Gesamtvarianz nicht weiter verbessert werden kann.
      Ergebnis ist dann der Vektor der Koeffizienten der Einflußgrößen-Kombinationen.

      Gruss

      P.S.: Beispiel für eine Vandermonde-Matrix für 2 Einflußgrößen x1 und x2, die bis zu quadratisch in das Ergebnis eingehen können:

      1 ____ X2______ x2^2
      x1 ____ x1*x2___ x1*x2^2
      X1^2__ x1^2*x2_ x1^2*x2^2

      Programm folgt in 3 Teilen:

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

    • TEIL 1:

      Brainfuck-Quellcode

      1. WindowTitle "Mehrdimensionale nichtlineare Regression"
      2. 'Q: http://jean-pierre.moreau.pagesperso-orange.fr/Basic/regiter_bas.txt
      3. 'XProfan-11.2a-Demo (D) transponiert 2017-02 by P.Specht, Vienna/Austria
      4. WindowStyle 24:window 0,0-%maxx,%maxy:font 2:CLS:set("decimals",17)
      5. '*******************************************************
      6. '* Program to demonstrate multidimensional operation *
      7. '* of the multi-nonlinear regression subroutine with *
      8. '* iterative error reduction *
      9. '* --------------------------------------------------- *
      10. '* Ref.: BASIC Scientific Subroutines Vol. II, By *
      11. '* F.R. Ruckdeschel, Byte/McGRAW-HILL, 1981 *
      12. '* --------------------------------------------------- *
      13. '* SAMPLE RUN: *
      14. '* MULTI-DIMENSIONAL AND MULTI-NONLINEAR REGRESSION *
      15. '* *
      16. '* How many data points ? 10 *
      17. '* *
      18. '* How many dimensions ? 2 *
      19. '* *
      20. '* What is the fit for dimension 1 ? 2 *
      21. '* What is the fit for dimension 2 ? 1 *
      22. '* *
      23. '* Input the data as prompted: *
      24. '* *
      25. '* Y( 1) = ? 7 *
      26. '* X( 1, 1) = ? 1 *
      27. '* X( 1, 2) = ? 6 *
      28. '* *
      29. '* Y( 2) = ? 7 *
      30. '* X( 2, 1) = ? 6 *
      31. '* X( 2, 2) = ? 1 *
      32. '* *
      33. '* Y( 3) = ? 6 *
      34. '* X( 3, 1) = ? 3 *
      35. '* X( 3, 2) = ? 3 *
      36. '* *
      37. '* Y( 4) = ? 8 *
      38. '* X( 4, 1) = ? 2 *
      39. '* X( 4, 2) = ? 6 *
      40. '* *
      41. '* Y( 5) = ? 9 *
      42. '* X( 5, 1) = ? 1 *
      43. '* X( 5, 2) = ? 8 *
      44. '* *
      45. '* Y( 6) = ? 9 *
      46. '* X( 6, 1) = ? 7 *
      47. '* X( 6, 2) = ? 2 *
      48. '* *
      49. '* Y( 7) = ? 6 *
      50. '* X( 7, 1) = ? 3 *
      51. '* X( 7, 2) = ? 3 *
      52. '* *
      53. '* Y( 8) = ? 7 *
      54. '* X( 8, 1) = ? 3 *
      55. '* X( 8, 2) = ? 4 *
      56. '* *
      57. '* Y( 9) = ? 7 *
      58. '* X( 9, 1) = ? 4 *
      59. '* X( 9, 2) = ? 3 *
      60. '* *
      61. '* Y( 10) = ? 2 *
      62. '* X( 10, 1) = ? 0 *
      63. '* X( 10, 2) = ? 2 *
      64. '* *
      65. '* The calculated coefficients are: *
      66. '* *
      67. '* 1 0 *
      68. '* 2 .999999 *
      69. '* 3 0 *
      70. '* 4 .999999 *
      71. '* 5 0 *
      72. '* 6 0 *
      73. '* *
      74. '* Standard deviation: 0 *
      75. '* *
      76. '* Number of iterations: 4 *
      77. '* *
      78. '*******************************************************
      79. 'DEFINT I-N
      80. 'DEFDBL A-H, O-Z
      81. declare i&,j&,k&,L&,M&,n&,n1&,n2&,n3&,n4&
      82. declare i1&,i2&,i3&,i4&,i5&,i6&,i7&,i8&,i9&
      83. declare m&[9],m1&,m2&,m3&,m4&,L1&,sw&
      84. declare b!,c!,d!,d1!,y!
      85. Print "\n Frage: Programmiertes Beispiel rechnen [blank oder 0 = Nein]? Beispl.Nr.= ";
      86. input sw&
      87. case sw&<>0:sw&=1 ' 0:Eigene Eingabe. 1:Obiges Beispiel rechnen
      88. print
      89. PRINT " MULTIDIMENSIONAL NONLINEAR REGRESSION"
      90. PRINT
      91. print " How many data points ? ";
      92. case sw&=1:m&=10
      93. case sw&=0:INPUT m&
      94. PRINT
      95. print " How many dimensions ? ";
      96. case sw&=1:L&=2
      97. case sw&=0:Input L&
      98. PRINT
      99. if sw&=0
      100. whileloop l&:i&=&Loop '=FOR i& = 1 TO l&
      101. PRINT " What is the grade of the fit for dimension Nbr."; i&;": x^";
      102. INPUT m&[i&]
      103. endwhile '=NEXT i
      104. elseif sw&=1
      105. m&[1]=2
      106. m&[2]=1
      107. else
      108. Print "\n\n Beispiel noch nicht eingegeben!":sound 200,10:waitinput:end
      109. endif
      110. n& = 1
      111. Whileloop l&:i&=&Loop '=FOR i = 1 TO l
      112. n&=n&*(m&[i&]+1)
      113. endwhile '=NEXT i
      114. case m&<n&:m&=n& '=IF m < n THEN m = n
      115. Declare x![m&,l&],y![m&],z![m&,n&],d![n&],A![m&,m&],B![m&,2*m&],C![m&,m&],d1![n&],y1![m&]
      116. '=DIM x(m, l), y(m), z(m, n), d(n), A(m, m), b(m, 2 * m), c(m, m), d1(n), y1(m)
      117. PRINT
      118. if sw&=0
      119. PRINT " Input the data as prompted:"
      120. PRINT
      121. Whileloop m&:i&=&Loop '=FOR i = 1 TO m
      122. PRINT " Y("; i&; ") = "; : INPUT y![i&]
      123. whileloop l&:j&=&Loop '=FOR j = 1 TO l
      124. PRINT " X("; i&; ","; j&; ") = "; : INPUT x![i&, j&]
      125. endwhile '=NEXT j
      126. PRINT
      127. endwhile '=NEXT i
      128. else
      129. y![1]=7:x![1,1]=1:x![1,2]=6
      130. y![2]=7:x![2,1]=6:x![2,2]=1
      131. y![3]=6:x![3,1]=3:x![3,2]=3
      132. y![4]=8:x![4,1]=2:x![4,2]=6
      133. y![5]=9:x![5,1]=1:x![5,2]=8
      134. y![6]=9:x![6,1]=7:x![6,2]=2
      135. y![7]=6:x![7,1]=3:x![7,2]=3
      136. y![8]=7:x![8,1]=3:x![8,2]=4
      137. y![9]=7:x![9,1]=4:x![9,2]=3
      138. y![10]=2:x![10,1]=0:x![10,2]=2
      139. endif
      140. 'Call iteration supervisor
      141. GOSUB "S2000"
      142. PRINT
      143. PRINT " The calculated coefficients are:"
      144. PRINT
      145. Whileloop n&:i&=&Loop '= FOR i = 1 TO n
      146. PRINT " "; i&; " "; INT(1000000 * d![i&]) / 1000000
      147. endwhile '=NEXT i
      148. PRINT
      149. PRINT " Standard deviation: "; INT(1000000 * d!) / 1000000
      150. PRINT
      151. PRINT " Number of iterations: "; l1&
      152. PRINT
      153. print "============================================================="
      154. sound 2000,200
      155. waitinput
      156. beep:cls:Print "\n\n\n\n\n BYE!"
      157. waitinput 1000
      158. END
      Alles anzeigen
    • TEIL 2:

      Brainfuck-Quellcode

      1. '*************************************************************
      2. '* Coefficient matrix generation subroutine *
      3. '* for multiple non-linear regression. *
      4. '* --------------------------------------------------------- *
      5. '* Also calculates the standard deviation d, even though *
      6. '* there is some redundant computing. *
      7. '* The maximum number of dimensions is 9. *
      8. '* The input data set consists of m data sets of the form: *
      9. '* Y(i),X(i,1),X(i,2) ... X(i,l) *
      10. '* The number of dimensions is l. *
      11. '* The order of the fit to each dimension is M(j). *
      12. '* The result is an (m1+1)(m2+1)...(ml+1)+1 column by m row *
      13. '* matrix, Z. This matrix is arranged as follows *
      14. '* (Ex.:l=2,M(1)=2,M(2)=2): *
      15. '* 1 X1 X1*X1 X2 X2*X1 X2*X1*X1 X2*X2 X2*X2*X1 X2*X2*X1*X1 *
      16. '* This matrix should be dimensioned in the calling program *
      17. '* as should also the X(i,j) matrix of data values. *
      18. '*************************************************************
      19. 'Calculate the total number of dimensions
      20. S1000:
      21. n& = 1
      22. Whileloop l&:i&=&Loop '= FOR i = 1 TO l
      23. n& = n& * (m&[i&]+1)
      24. endwhile '= NEXT
      25. d! = 0
      26. Whileloop m&:i&=&Loop '= FOR i = 1 TO m
      27. 'Branch according to dimension l (return if l > 9)
      28. case l&>0:GOTO "G10"
      29. l& = 0: RETURN
      30. G10:
      31. case l&<=9 : GOTO "G15"
      32. l& = 0: RETURN
      33. G15:
      34. j& = 0
      35. case l& = 1:GOSUB "S40"
      36. case l& = 2:GOSUB "S50"
      37. case l& = 3:GOSUB "S60"
      38. case l& = 4:GOSUB "S70"
      39. case l& = 5:GOSUB "S80"
      40. case l& = 6:GOSUB "S90"
      41. case l& = 7:GOSUB "S100"
      42. case l& = 8:GOSUB "S110"
      43. case l& = 9:GOSUB "S120"
      44. y! = 0
      45. Whileloop n&:k&=&Loop '= FOR k& = 1 TO n
      46. y! = y! + d![k&] * z![i&, k&]
      47. endwhile '= NEXT k
      48. d! = d! + (y![i&] - y!) * (y![i&] - y!)
      49. endwhile '= NEXT i
      50. 'Calculate standard deviation (if m > n)
      51. G30:
      52. case (m&-n&)>0:GOTO "G35"
      53. d! = 0: RETURN
      54. G35:
      55. d!=d!/(m&-n&)
      56. d!=SQRT(d!) 'Quickbasic: sqr
      57. RETURN
      58. 'Subroutines used by subroutine 1000
      59. S40:
      60. b! = 1
      61. S41:
      62. c! = b!
      63. Whileloop 0,m&[1]:i1&=&Loop '= FOR i1& = 0 TO m&[1]
      64. j&=j&+1: z![i&,j&] = b!: b! = b! * x![i&,1]
      65. endwhile '=NEXT i1
      66. b! = c!
      67. RETURN
      68. S50:
      69. b!= 1
      70. S51:
      71. c!= b!
      72. Whileloop 0,m&[2]:i2&=&Loop '= FOR i2 = 0 TO m(2)
      73. GOSUB "S41"
      74. b!=b!*x![i&,2]
      75. endwhile '= NEXT i2
      76. b!= c!
      77. RETURN
      78. S60:
      79. b!= 1
      80. S61:
      81. c!= b!
      82. Whileloop 0,m&[3]:i3&=&Loop '= FOR i3 = 0 TO m(3)
      83. GOSUB "S51"
      84. b!= b!* x![i&,3]
      85. endwhile '= NEXT i3
      86. b! = c!
      87. RETURN
      88. S70:
      89. b!= 1
      90. S71:
      91. c!= b!
      92. Whileloop 0,m&[4]:i4&=&Loop '= FOR i4 = 0 TO m(4)
      93. GOSUB "S61"
      94. b!= b!*x![i&,4]
      95. endwhile '=NEXT i4
      96. b!= c!
      97. RETURN
      98. S80:
      99. b!= 1
      100. S81:
      101. c! = b!
      102. whileloop 0,m&[5]:i5&=&Loop '=FOR i5 = 0 TO m(5)
      103. GOSUB "S71"
      104. b!= b!*x![i&,5]
      105. endwhile '=NEXT i5
      106. b!= c!
      107. RETURN
      108. S90:
      109. b!= 1
      110. S91:
      111. c!= b!
      112. Whileloop 0,m&[6]:i6&=&Loop '= FOR i6 = 0 TO m(6)
      113. GOSUB "S81"
      114. b! = b!* x![i&,6]
      115. endwhile '=NEXT i6
      116. b!= c!
      117. RETURN
      118. S100:
      119. b!= 1
      120. S101:
      121. c!= b!
      122. whileloop 0,m&[7] '= FOR i7 = 0 TO m(7)
      123. GOSUB "S91"
      124. b!= b!* x![i&, 7]
      125. endwhile '= NEXT i7
      126. b!=c!
      127. RETURN
      128. S110:
      129. b!= 1
      130. S111:
      131. c!= b!
      132. whileloop 0,m&[8]:i8&=&Loop '= FOR i8 = 0 TO m(8)
      133. GOSUB "S101"
      134. b! = b! * x![i&,8]
      135. endhwile '= NEXT i8
      136. b!= c!
      137. RETURN
      138. S120:
      139. b!= 1
      140. S121:
      141. c!= b!
      142. whileloop 0,m&[9] '= FOR i9 = 0 TO m(9)
      143. GOSUB "S111"
      144. b! = b! * x![i&,9]
      145. endwhile '= NEXT i9
      146. b!= c!
      147. RETURN
      148. '**********************************************************
      149. '* Least squares fitting subroutine, general purpose *
      150. '* subroutine for multidimensional, nonlinear regression *
      151. '* ------------------------------------------------------ *
      152. '* The equation fitted has the form: *
      153. '* Y = D(1)X1 + D(2)X2 + ... + D(n)Xn *
      154. '* The coefficients are returned by the program in D(i). *
      155. '* The X(i) can be simple powers of x, or functions. *
      156. '* Note that the X(i) are assumed to be independent. *
      157. '* The measured responses are Y(i), there are m of them. *
      158. '* Y is a m row column vector, Z(i,j) is a m by n matrix. *
      159. '* m must be >= n+2. The subroutine inputs are m, n, Y(i) *
      160. '* and Z(i,j) previously calculated. The subroutine calls *
      161. '* several other matrix routines during the calculation. *
      162. '**********************************************************
      163. S1200:
      164. m4& = m&
      165. n4& = n&
      166. whileloop m&:i&=&Loop '= FOR i = 1 TO m
      167. Whileloop n&:j&=&Loop '= FOR j = 1 TO n
      168. A![i&,j&] = z![i&, j&]
      169. endwhile '= NEXT j
      170. endwhile '= NEXT i
      171. GOSUB "S5100" 'b=Transpose(a)
      172. n1&= m&: n2& = n&: GOSUB "S5400" 'move A to C
      173. n1&= n&: n2& = m&: GOSUB "S5200" 'move B to A
      174. n1&= m&: n2& = n&: GOSUB "S5300" 'move C to B
      175. m1&= n&: n1& = m&: n2& = n&: GOSUB "S5000" 'multiply A and B
      176. n1&= n&: GOSUB "S5500" 'move C to A
      177. GOSUB "S6000" 'b=Inverse(a)
      178. m& = m4& 'restore m
      179. GOSUB "S5200" 'move B to A
      180. Whileloop m&:i&=&Loop '= FOR i = 1 TO m
      181. Whileloop n&:j&=&Loop '= FOR j = 1 TO n
      182. b![j&,i&] = z![i&,j&]
      183. endwhile '=NEXT j
      184. endwhile '= NEXT i
      185. m2& = n&: n2& = m&: GOSUB "S5000" 'multiply A and B
      186. n1& = n&: n2& = m&: GOSUB "S5500" 'move C to A
      187. whileloop m&:i&=&Loop '=FOR i = 1 TO m
      188. b![i&,1] = y![i&]
      189. endwhile '=NEXT
      190. m1& = n&: n2& = 1: n1& = m&: GOSUB "S5000" 'multiply A and B
      191. 'Product C is N by 1 - Regression coefficients are in C(I,1)
      192. whileloop n&:i&=&Loop '= FOR i = 1 TO n
      193. d![i&] = c![i&,1]
      194. endwhile '= NEXT
      195. RETURN
      196. S5000:
      197. 'Matrix multiplication
      198. whileloop m1&:i&=&Loop '= FOR i = 1 TO m1
      199. whileloop n2&:j&=&Loop '= FOR j = 1 TO n2
      200. c![i&,j&] = 0
      201. whileloop n1&:k&=&Loop '= FOR k = 1 TO n1
      202. c![i&,j&] = c![i&,j&] + A![i&,k&] * B![k&,j&]
      203. endwhile '= NEXT k
      204. endwhile '= NEXT j
      205. endwhile '= NEXT i
      206. RETURN
      207. S5100:
      208. 'Matrix transpose
      209. whileloop n&:i&=&Loop '= FOR i = 1 TO n
      210. whileloop m&:j&=&Loop '= FOR j = 1 TO m
      211. b![i&,j&] = A![j&,i&]
      212. endwhile '= NEXT j
      213. endwhile '= NEXT i
      214. RETURN
      215. S5200:
      216. 'Matrix save (B in A)
      217. case (n1&*n2&)=0:RETURN
      218. Whileloop n1&:i1&=&Loop '= FOR i1 = 1 TO n1
      219. whileloop n2&:i2&=&Loop '= FOR i2 = 1 TO n2
      220. A![i1&,i2&] = b![i1&,i2&]
      221. endwhile '= NEXT i2
      222. endwhile '= NEXT i1
      223. RETURN
      224. S5300:
      225. 'Matrix save (C in B)
      226. case (n1& * n2&)=0:RETURN
      227. Whileloop n1&:i1&=&Loop '= FOR i1 = 1 TO n1
      228. whileloop n2&:i2&=&Loop '= FOR i2 = 1 TO n2
      229. b![i1&, i2&] = c![i1&, i2&]
      230. endwhile '= NEXT i2
      231. endwhile '= NEXT i1
      232. RETURN
      Alles anzeigen
    • TEIL 3 von 3 (Schlußteil)

      Brainfuck-Quellcode

      1. S5400:
      2. 'Matrix save (A in C)
      3. case (n1& * n2&)=0:RETURN
      4. whileloop n1&:i1&=&Loop '= FOR i1 = 1 TO n1
      5. whileloop n2&:i2&=&Loop '= FOR i2 = 1 TO n2
      6. c![i1&,i2&] = A![i1&,i2&]
      7. endwhile 'NEXT i2
      8. endwhile 'NEXT i1
      9. RETURN
      10. S5500:
      11. 'Matrix save (C in A)
      12. case (n1&*n2&)=0:RETURN
      13. whileloop n1&:i1&=&Loop '= FOR i1 = 1 TO n1
      14. whileloop n2&:i2&=&Loop '= FOR i2 = 1 TO n2
      15. A![i1&,i2&] = c![i1&,i2&]
      16. endwhile '=NEXT i2
      17. endwhile '=NEXT i1
      18. RETURN
      19. S6000:
      20. 'Matrix inversion
      21. Whileloop n&:i&=&Loop '= FOR i = 1 TO n
      22. whileloop n&:j&=&Loop '= FOR j = 1 TO n
      23. b![i&, j& + n&] = 0
      24. b![i&, j&] = A![i&, j&]
      25. endwhile '= NEXT j
      26. b![i&, i& + n&] = 1
      27. endwhile '= NEXT i
      28. whileloop n&:k&=&Loop '= FOR k = 1 TO n
      29. case k& = n&:GOTO "G6010"
      30. m& = k&
      31. whileloop k&+1,n&:i&=&Loop '= FOR i = k + 1 TO n
      32. case ABS(b![i&, k&]) > ABS(b![m&, k&]):m& = i&
      33. endwhile '= NEXT i
      34. case m& = k&:GOTO "G6010"
      35. whileloop k&,2*n&:j&=&Loop '= FOR j = k TO 2 * n
      36. b! = b![k&, j&]
      37. b![k&, j&] = b![m&, j&]
      38. b![m&, j&] = b!
      39. endwhile '= NEXT j
      40. G6010:
      41. whileloop k&+1,2*n&:j&=&Loop '= FOR j = k + 1 TO 2 * n
      42. b![k&, j&] = b![k&, j&] / b![k&, k&]
      43. endwhile '= NEXT j
      44. case k& = 1:GOTO "G6020"
      45. whileloop k&-1:i&=&Loop '= FOR i = 1 TO k - 1
      46. whileloop k&+1,2*n&:j&=&Loop '= FOR j = k + 1 TO 2 * n
      47. b![i&,j&] = b![i&,j&] - b![i&,k&] * b![k&,j&]
      48. endwhile '= NEXT j
      49. endwhile '= NEXT i
      50. Case k& = n&:GOTO "G6030"
      51. G6020:
      52. whileloop k&+1,n&:i&=&Loop '= FOR i = k + 1 TO n
      53. whileloop k&+1,2*n&:j&=&Loop '= FOR j = k + 1 TO 2 * n
      54. b![i&,j&] = b![i&,j&] - b![i&,k&] * b![k&,j&]
      55. endwhile '= NEXT j
      56. endwhile '=NEXT i
      57. endwhile '= NEXT k
      58. G6030:
      59. Whileloop n&:i&=&Loop '= FOR i = 1 TO n
      60. whileloop n&:j&=&Loop '= FOR j = 1 TO n
      61. b![i&,j&] = b![i&,j&+n&]
      62. endwhile '= NEXT j
      63. endwhile '= NEXT i
      64. RETURN
      65. '********************************************************************
      66. '* Multi-dimensional polynomial regression iteration subroutine *
      67. '* ---------------------------------------------------------------- *
      68. '* This routine supervises the calling of several other subroutines *
      69. '* in order to iteratively fit least squares polynomials in more *
      70. '* than one dimension. *
      71. '* The routine repeatedly calculates improved coefficients until *
      72. '* the standard deviation is no longer reduced. The inputs to the *
      73. '* subroutine are the number of dimensions l&, the degree of fit *
      74. '* for each dimension m(i), and the input data, x(i) and y(i). *
      75. '* The coefficients are returned in d(i), with the standard devia- *
      76. '* tion in d. Also returned is the number of iterations tried, l1&. *
      77. '* y1(i), d1(i) and d1 are used respectively to save the original *
      78. '* values of y(i) and the current values of d(i) and d. *
      79. '********************************************************************
      80. S2000:
      81. l1& = 0
      82. 'Save the y![i&]
      83. whileloop m&:i&=&Loop '= FOR i = 1 TO m
      84. y1![i&] = y![i&]
      85. endwhile '= NEXT
      86. 'Zero d1(i)
      87. whileloop n&:i&=&Loop '= FOR i = 1 TO n
      88. d1![i&] = 0
      89. endwhile '= NEXT
      90. 'Set the initial standard deviation high
      91. d1! = 10000000
      92. 'Call coefficients subroutine
      93. G2050:
      94. GOSUB "S1000"
      95. 'Call regression subroutine
      96. GOSUB "S1200"
      97. 'Get standard deviation
      98. GOSUB "S1000"
      99. 'If standard deviation is decreasing, continue
      100. case d1! > d!:GOTO "G2100"
      101. 'Terminate iteration
      102. whileloop n&:i&=&Loop '= FOR i = 1 TO n
      103. d![i&] = d1![i&]
      104. endwhile '= NEXT
      105. ' Restore y![i&]
      106. Whileloop m&:i&=&Loop '=FOR i = 1 TO m
      107. y![i&] = y1![i&]
      108. endwhile '= NEXT
      109. 'Get the final standard deviation
      110. GOSUB "S1000"
      111. RETURN
      112. 'Save the standard deviation
      113. G2100:
      114. d1! = d!: l1& = l1& + 1
      115. 'Augment coefficient matrix
      116. whileloop n&:i&=&Loop '= FOR i = 1 TO n
      117. d![i&] = d1![i&] + d![i&]
      118. d1![i&] = d![i&]
      119. endwhile '=NEXT
      120. 'Restore y![i&]
      121. whileloop m&:i&=&Loop '=FOR i = 1 TO m
      122. y![i&] = y1![i&]
      123. endwhile '= NEXT
      124. 'Reduce y![i&] according to the d(i)
      125. GOSUB "S2150"
      126. 'We now have a set of error values
      127. GOTO "G2050"
      128. 'End subroutine 2000
      129. 'Subroutine 2150
      130. S2150:
      131. whileloop m&:i&=&Loop '= FOR i = 1 TO m
      132. j& = 0
      133. Case l& = 1:GOSUB "S2160"
      134. Case l& = 2:GOSUB "S2170"
      135. Case l& = 3:GOSUB "S2180"
      136. Case l& = 4:GOSUB "S2190"
      137. Case l& = 5:GOSUB "S2200"
      138. Case l& = 6:GOSUB "S2210"
      139. Case l& = 8:GOSUB "S2230"
      140. Case l& = 9:GOSUB "S2240"
      141. 'Array generated for row i
      142. y! = 0
      143. whileloop n&:k&=&Loop '= FOR k = 1 TO n
      144. y! = y! + d![k&] * z![i&,k&]
      145. endwhile '= NEXT k
      146. y![i&] = y![i&] - y!
      147. endwhile '= NEXT i
      148. RETURN
      149. 'End subroutine S2150
      150. S2160:
      151. b!=1
      152. S2161:
      153. c!=b!
      154. whileloop 0,m&[1]:i1&=&Loop 'FOR i1 = 0 TO m(1)
      155. j&= j& + 1
      156. z![i&,j&] = b!: b! = b! * x![i&,1]
      157. endwhile 'NEXT i1
      158. b! = c!
      159. RETURN
      160. S2170:
      161. b!= 1
      162. S2171:
      163. c!= b!
      164. whileloop 0,m&[2]:i2&=&Loop '= FOR i2 = 0 TO m(2)
      165. GOSUB "S2161"
      166. b!= b!* x![i&,2]
      167. endwhile 'NEXT i2
      168. b!=c!
      169. RETURN
      170. S2180:
      171. b! = 1
      172. S2181:
      173. c! = b!
      174. whileloop 0,m&[3]:i3&=&Loop '= FOR i3 = 0 TO m(3)
      175. GOSUB "S2171"
      176. b = b * x(i, 3)
      177. endwhile '= NEXT i3
      178. b!= c!
      179. RETURN
      180. S2190:
      181. b!= 1
      182. S2191:
      183. c!= b!
      184. whileloop 0,m&[4]:i4&=&Loop '= FOR i4 = 0 TO m(4)
      185. GOSUB "S2181"
      186. b!= b!* x![i&,4]
      187. endwhile 'NEXT i4
      188. b! = c!
      189. RETURN
      190. S2200:
      191. b! = 1
      192. S2201:
      193. c!= b!
      194. whileloop 0,m&[5]:i5&=&Loop '= FOR i5 = 0 TO m(5)
      195. GOSUB "S2191"
      196. b! = b! * x![i&,5]
      197. endwhile 'NEXT i5
      198. b! = c!
      199. RETURN
      200. S2210:
      201. b! = 1
      202. S2211:
      203. c! = b!
      204. whileloop 0,m&[6]:i6&=&Loop '= FOR i6 = 0 TO m(6)
      205. GOSUB "S2201"
      206. b! = b! * x![i&,6]
      207. endwhile 'NEXT i6
      208. b! = c!
      209. RETURN
      210. S2220:
      211. b! = 1
      212. S2221:
      213. c! = b!
      214. whileloop 0,m&[7]:i7&=&Loop '= FOR i7 = 0 TO m(7)
      215. GOSUB "S2211"
      216. b!= b!* x![i&,7]
      217. endwhile '= NEXT i7
      218. b! = c!
      219. RETURN
      220. S2230:
      221. b! = 1
      222. S2231:
      223. c! = b!
      224. whileloop 0,m&[8]:i8&=&Loop '= FOR i8 = 0 TO m(7)
      225. GOSUB "S2221"
      226. b! = b! * x![i,8] ' war 7 ! Fehler?
      227. endwhile 'NEXT i8
      228. b! = c!
      229. RETURN
      230. S2240:
      231. b! = 1
      232. whileloop 0,m&[9]:i9&=&Loop '= FOR i9 = 0 TO m(9)
      233. GOSUB "S2231"
      234. b! = b! * x!(i&,9)
      235. endwhile 'NEXT i9
      236. RETURN
      237. 'End Pgm regiter.prf
      Alles anzeigen
    • Abt. Nicht leicht zu finden
      -----------------------------
      1. Der Befehl WAITEND klappt auch in XProfan 11.2a. Das Fenster ist dann am Programmende nur mit Schließkreuz, Menüpunkt Datei-Schließen oder ALT+F4 zu schließen.
      2. Die automatische Laufvariable &Index ist in der Hilfe von XProf.11 nur beim MAT-Befehl zu finden, wo sie "nicht zusammen verwendbar" ist. Sie ist bei bereits dimensionierten Dynamischen Arrays (z.B. mit setsize() ) aber sehr wohl nutzbar. Das Nullelement wird dabei 2x abgerufen, was aber nicht weiter tragisch ist, wenn man es weiß.
      3. Die Systemvariable &gettickcount fällt mir auch oft nicht ein, ein Suchbegriff dazu fehlt. Das bekannte Programm QueryPerformanceCounter liefert aber ohnehin viel genauere Ergebnisse.
      Gruss
      Spoiler anzeigen

      goto "init":done:
      Whileloop Durchläufe&
      inc n&
      Endwhile
      QueryPerformanceCounter(Addr(Ende&[0]))
      Ende! = if(Ende&[1]<0,Ende&[1]+2^32,Ende&[1])*2^32+if(Ende&[0]<0,Ende&[0]+2^32,Ende&[0])
      Start! = if(Start&[1]<0,Start&[1]+2^32,Start&[1])*2^32+if(Start&[0]<0,Start&[0]+2^32,Start&[0])
      print "-----------------------------------------------------------------------------"
      sound 2000,200:Test!=Ende!-Start!:Sekunden! = Test!/Frequenz!
      Print " Gesamtdauer: ";format$("%g",Sekunden!);" Sekunden"
      Print "\n Dauer je Durchlauf: ";format$("%g",10^6*Sekunden!/Durchläufe&);" Mikrosekunden"
      Print "\n Das entspricht ";\
      translate$(translate$(format$("###.###.###.###.##0,0####",Durchläufe&/Sekunden!),",","'"),".",",");\
      " Durchläufen pro Sekunde."
      print "-----------------------------------------------------------------------------"
      Print "\n Beenden mit Tastendruck!"
      WaitInput 1000*60*5
      End
      init:
      Windowtitle "CPU Performance Counters für Benchmark auslesen":WindowStyle 24
      Declare Frequenz&[1],Start&[1],Ende&[1],Test&[1],N&
      Declare Frequenz!,Start!,Ende!,Test!,Sekunden!,Durchläufe&
      Def QueryPerformanceFrequency(1), !"Kernel32", "QueryPerformanceFrequency"
      Def QueryPerformanceCounter(1) !"Kernel32", "QueryPerformanceCounter"
      QueryPerformanceFrequency(Addr(Frequenz&[0])):CLS:Font 2:Sleep 500
      Frequenz! = if(Frequenz&[1]<0,Frequenz&[1]+2^32,Frequenz&[1])*2^32 + \
      if(Frequenz&[0]<0,Frequenz&[0]+2^32,Frequenz&[0])
      print "\n CPU-Frequenz: ";Frequenz!*10^-6;" [GHz]\n"
      Durchläufe&=1000000:n&=0
      print "\n Test wird gestartet für ";format$("###,###,###,##0",Durchläufe&);" Durchläufe..."
      print "-----------------------------------------------------------------------------\n"
      QueryPerformanceCounter(Addr(Start&[0]))
      goto "done"
    • Am neuen Zeitzähler hatte ich auch schon geschraubt

      Include

      Quellcode: Zeitzaehler.inc

      1. 'XProfan X3.1
      2. '$I Zeitzaehler.inc
      3. $IFNDEF TICKCOUNTER
      4. $DEFINE TICKCOUNTER
      5. Def %TickCount.MicroSec 1
      6. Def %TickCount.MS 2
      7. Def %TickCount.Sec 3
      8. Declare Quad TickCount.Frequency
      9. Declare Quad TickCount.StartTime
      10. Declare Quad TickCount.StopTime
      11. Declare Long TickCount.DieDLL
      12. Proc TickCount.Init
      13. TickCount.DieDLL = UseDLL("Kernel32.DLL")
      14. TickCount.StartTime = 0
      15. TickCount.StopTime = 0
      16. ImportFunc(TickCount.DieDLL,"QueryPerformanceFrequency","TickCount_QPF")
      17. ImportFunc(TickCount.DieDLL,"QueryPerformanceCounter","TickCount_QPC")
      18. TickCount_QPF(Addr(TickCount.Frequency))
      19. Return TickCount.Frequency
      20. EndProc
      21. Proc TickCount.Exit
      22. FreeDLL TickCount.DieDLL
      23. EndProc
      24. Proc TickCount.Start
      25. TickCount_QPF(Addr(TickCount.Frequency))
      26. TickCount_QPC(Addr(TickCount.StartTime))
      27. Return TickCount.StartTime
      28. EndProc
      29. Proc TickCount.Stop
      30. TickCount_QPC(Addr(TickCount.StopTime))
      31. Return TickCount.StopTime
      32. EndProc
      33. Proc TickCount.Stopp
      34. TickCount_QPC(Addr(TickCount.StopTime))
      35. Return TickCount.StopTime
      36. EndProc
      37. // Parameter: GetTime(Einheit,stopp), GetTime(Einheit,start,stopp), GetTime(Einheit,frequ,start,stopp)
      38. // Einheit =
      39. // %TickCount.MicroSec == 1
      40. // %TickCount.MS == 2
      41. // %TickCount.Sec == 3
      42. Proc TickCount.GetTime
      43. Declare quad erg, start,stopp,frequ
      44. Declare int Einheit
      45. Select %PCount
      46. CaseOf 2
      47. Parameters int a0, quad a1
      48. Einheit = a0
      49. stopp = a1
      50. start = TickCount.StartTime
      51. frequ = TickCount.Frequency
      52. CaseOf 3
      53. Parameters int b0, quad b1,b2
      54. Einheit = b0
      55. start = b1
      56. stopp = b2
      57. frequ = TickCount.Frequency
      58. Otherwise // 4 Parameter
      59. Parameters int c0, quad c1,c2,c3
      60. Einheit = c0
      61. frequ = c1
      62. start = c2
      63. stopp = c3
      64. EndSelect
      65. Select Einheit
      66. CaseOf %TickCount.MicroSec
      67. erg = ((stopp - start) * 1000000) / frequ
      68. CaseOf %TickCount.MS
      69. erg = (((stopp - start) * 1000000) / frequ) / 1000
      70. CaseOf %TickCount.Sec
      71. erg = (((stopp - start) * 1000000) / frequ) / 1000000
      72. Otherwise // Hier ist der Vorgabewert "ms"
      73. erg = (((stopp - start) * 1000000) / frequ) / 1000
      74. EndSelect
      75. Return erg
      76. EndProc
      77. Proc TickCount.ShowTime
      78. Parameters int Einheit,dezi, float wert
      79. Declare string tmp,form
      80. tmp = Trim$(Str$(dezi))
      81. form = "%8." + if(Len(tmp)=0,"0",tmp) + "f"
      82. Select Einheit
      83. CaseOf %TickCount.MicroSec
      84. form = form + " µs"
      85. CaseOf %TickCount.MS
      86. form = form + " ms"
      87. CaseOf %TickCount.Sec
      88. form = form + " sec"
      89. Otherwise // Hier ist der Vorgabewert ""
      90. // form = form + ""
      91. EndSelect
      92. Return Format$(form,wert)
      93. EndProc
      94. $ENDIF
      Alles anzeigen


      und Beispiel

      Quellcode: Test_Zeitmessung.prf

      1. $I Zeitzaehler.inc
      2. TickCount.Init()
      3. cls
      4. declare r!, s!
      5. r! = -3.111111111111
      6. print " ----- "
      7. declare quad Start,Stopp,Verwaltung
      8. ' Vorab Messung des Loop-Overhead
      9. Start = TickCount.Start()
      10. whileloop 10000
      11. '
      12. endwhile
      13. Stopp = TickCount.Stop()
      14. Verwaltung = Stopp - Start
      15. ' Messschleife mit Zu prüfendem Algorithmus
      16. Start = TickCount.Start()
      17. whileloop 10000
      18. s! = Testbit(r!,31)
      19. endwhile
      20. Stopp = TickCount.Stop() - Verwaltung
      21. print TickCount.ShowTime( %TickCount.MS, 3, TickCount.GetTime(%TickCount.MS, start,stopp) ) + " netto"
      22. print s!
      23. TickCount.Exit()
      24. waitinput
      25. end
      Alles anzeigen
      Programmieren, das spannendste Detektivspiel der Welt.
    • cool, Michael! Spare schon auf die kommende Version von XProfan!

      Ergänzung zum Programm-Monster "Multiple nichtlineare Regression" da oben:
      ------------
      Ein Link zum Text der englischen Programmerläuterung von J-P Moreau gibt es HIER!

      Anzumerken ist noch, daß mit dem Programm tatsächlich nur Parabeln angepasst werden können.
      Bei Wachstumsvorgängen etc. sind aber oft Exponentialfunktionen, Logarithmusfunktionen, Sinusschwingungen u.v.a.m. im Spiel. Dafür gibt es dann auch andere Methoden und Herangehensweisen!

      Gruss
    • Abt. Feingold-Tanz Jänner 2017
      ====================
      Traditionell blödes Programm, diesmal mit Farbe: Man sieht zu Monatsbeginn einen deutlicher Anstieg, gegen Ende eine deutliche Preisdelle (was die Manipulationsgerüchte wieder anheizen dürfte).
      Gruss

      Quellcode

      1. WindowTitle "Feingold-Preistanz Eur/Unze 2.Jan.- 3.Feb.2017"
      2. Windowstyle 24:cls:font 2:declare g$[],w&:set("decimals",3)
      3. g$[]=explode("\
      4. 1128.190,1128.990,1129.570,1131.880,1120.480,1122.030,1123.170,1119.200,1118.730,\
      5. 1112.630,1106.770,1108.770,1112.850,1111.950,1113.860,1119.620,1130.040,1130.070,\
      6. 1130.620,1130.120,1126.240,1127.030,1129.190,1129.340,1137.010,1134.780,1135.060,\
      7. 1141.650,1134.790,1135.400,1122.500,1123.250,1129.370,1135.820,1125.400,1128.410,\
      8. 1122.650,1118.120,1119.220,1118.590,1114.000,1112.270,1116.690,1116.160,1113.140,\
      9. 1117.400,1109.560,1103.280",",")
      10. whileloop sizeof(g$[])-1,0,-1:w&=int(round(val(g$[&Loop]),0))
      11. cls rgb((w&-1060)*3,0,0)
      12. locate 2,2:print " ";:locate 2,2:print w&
      13. sound (w&-1000)*2,92
      14. endwhile
      15. waitinput
      Alles anzeigen
    • Abt. Steuerungstechnik nach DIN 19221
      =========================
      Inzwischen gibt es neuere Normen zur Regelungstechnik, aber die Bezeichnungen sind im wesentlichen gleich geblieben. Das ganze soll später einmal einen Rahmen für Experimente an Computermodellenn von Steuerungen und Regelungen ergeben. Im Moment handelt es sich nur um allererste Versuche. Die Steuerstrecke sollte in Zukunft z.B. auch Integral- und Differentialkomponenten enthalten.

      Das Modell hier soll das Gaspedal in einem Auto simulieren: Die Hersteller reissen den Vergaser ganz weit auf, solange sich das Pedal nach vorne bewegt: Um ihr Fahrzeug "spriziger" erscheinen zu lassen! Das entspricht einer positiven Differentialkomponente. Im Moment suche ich noch nach den richtigen Werten.

      Gruss

      Quellcode

      1. Windowtitle "Steuerungsstechnik nach Friedrich-Tabellenbuch_IT-KT_Kap.14"
      2. WindowStyle 24:Window 0,0-%maxx,%maxy:showmax // Din 19221
      3. declare Eingangsgröße_u!,Führungsgröße_w!,Störgröße_z!,Regeldifferent_d!
      4. declare Stellgröße_m!,Regelgröße_Y!,Aufgabengröße_Xa!,Rückführgröße_r!
      5. declare Zustandsgröße_X!,Führungsbereich_min!,Führungsbereich_max!
      6. declare Aufgabenbereich_Xmin!,Aufgabenbereich_Xmax!,Stellbereich_mmin!,Stellbereich_mmax!
      7. declare Störbereich_zmin!,Störbereich_zmax!,Regelbereich_Ymin!,Regelbereich_Ymax!
      8. declare Istwert!,Sollwert!,Sollwertabweichung!,Innere_Rückführung!,Zeitschritt_n&
      9. randomize
      10. ' Funktionsbox: Bildung der Führungsgröße w
      11. proc fg :parameters Eingangsgröße_u!
      12. var Führungsgröße_w!=exp(0.1*Eingangsgröße_u!)
      13. return Führungsgröße_w!
      14. endproc
      15. ' Funktionsbox: Steuerungseinrichtung
      16. proc ste :parameters Führungsgröße_w!
      17. var Regelgröße_Y!= 10*if(Führungsgröße_w!>0,ln(Führungsgröße_w!),0)
      18. return Regelgröße_Y!
      19. endproc
      20. ' Nebenfunktionsbox: Störstochastik
      21. proc stg
      22. var Störgröße_z!=rnd()-1.999999
      23. return Störgröße_z!
      24. endproc
      25. ' Hauptfunktionsblock: Steuerstrecke
      26. proc stst :parameters Regelgröße_Y!,Störgröße_z!,Innere_Rückführung!
      27. var Zustandsgröße_X!=Regelgröße_Y!-0.1*Störgröße_z!-0.2*Innere_Rückführung!
      28. return Zustandsgröße_X!
      29. endproc
      30. ' Nebenfunktionsbox: Innere Rückführung
      31. proc InRue :parameters Zustandsgröße_X!
      32. var Innere_Rückführung!=0.5*Zustandsgröße_X!
      33. return Innere_Rückführung!
      34. endproc
      35. ' Funktionsbox: Erzeugung der Aufgabengröße Xa
      36. proc erzXa :parameters Zustandsgröße_X!
      37. var Aufgabengröße_Xa!=if(Zustandsgröße_X!>0,Zustandsgröße_X!,0)
      38. return Aufgabengröße_Xa!
      39. endproc
      40. font 2:Print "\n Wirkplan einer Steuerung: Die Steuerkette ":font 0
      41. rept:
      42. locate 2,1
      43. print:inc Zeitschritt_n&
      44. print " Zeitschritt n = ";Zeitschritt_n&,
      45. print tab(50);"==> Eingangsgröße u = ";:input Eingangsgröße_u!
      46. print " Funktionsbox: Bildung der Führungsgröße w ",
      47. Führungsgröße_w!=fg(Eingangsgröße_u!)
      48. print tab(50);"==> Führungsgröße w = ";format$("%g",Führungsgröße_w!)
      49. print " Funktionsbox: Steuerungseinrichtung",
      50. Regelgröße_Y!=ste(Führungsgröße_w!)
      51. print tab(50);"==> Regelgröße Y = ";format$("%g",Regelgröße_Y!)
      52. print " Nebenfunktionsbox: Störstochastik ",
      53. Störgröße_z!=stg()
      54. print tab(50);"==> Störgröße Z = ";format$("%g",Störgröße_z!)
      55. print " Hauptfunktion: Steuerstrecke ",
      56. Zustandsgröße_X!=stst(Regelgröße_Y!,Störgröße_z!,Innere_Rückführung!)
      57. print tab(50);"==> Zustandsgröße X = ";format$("%g",Zustandsgröße_X!)
      58. print " Nebenfunktionsbox: Innere Rückführung ";
      59. Innere_Rückführung!=InRue(Zustandsgröße_X!)
      60. print tab(50);"==> Rückführung = ";format$("%g",Innere_Rückführung!)
      61. print " Funktionsbox: Erzgg. Aufgabengröße Xa ";
      62. Aufgabengröße_Xa!=erzXa(Zustandsgröße_X!)
      63. print tab(50);"==> Aufgabengröße Xa = ";
      64. font 2:print format$("%g",Aufgabengröße_Xa!):font 0
      65. goto "rept"
      Alles anzeigen
    • Abt. Rätselecke Nr. 26
      ==============
      Albert hat 7 Äpfel und 2 Bananen. Er gibt 2 Äpfel seinem Freund Bernd, der ihm dafür Bananen gibt. Danach hat Albert gleich viele Äpfel wie Bananen. Wie viele Bananen bekam Albert von Bernd?

      Nr.27
      ====
      Du liegst gut im Rennen und kannst den Zweiten überholen. An welcher Stelle liegst Du jetzt?

      Nr.28
      ====
      In einem Korb liegen 13 Paar blaue und 8 Paar rote Socken. Da fällt das Licht aus. Wieviele Socken mußt Du herausnehmen, damit Du garantiert ein gleiches Paar anziehen kannst?