ALGORITHMEN - Teil XX: Zwischen Fersuch und Irrdumm

    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.

    • Lösung zu EaR 24
      ----------------
      Spoiler anzeigen

      Sqrt(w^2 + w^2 + ... + w^2) = w^10
      Sqrt(w^2 * x ) = w^10 | .^2
      w^2 * x = w^(10*2)
      x = w^20 / w^2
      x = w^(20-2)
      x = w^18
      Antwort: Es gibt w^18 Summanden unter der Wurzel!
      So viele, weil w^10 = w*w*w*w*w*w*w*w*w*w ja hier
      nur durch Addieren erzeugt werden kann.

      Testbeispiel: w = 2
      Sqrt(2^2 + ... + 2^2) = 2^10
      Sqrt(4+4+ ... +4) = 1024
      Sqrt(x * 4) = 1024
      x * 4 = 1024^2 = 1048576
      x = 262144 = 2^18
      Probe: Sqrt(2^2 * 2^18)= 1048576. Passt!
    • Abt. Interessante Links
      ==================
      Prof. Shoshana Zuboff fasst den Inhalt ihres Buches "The Rise of Surveilance Capitalism" (Der Aufstieg des Überwachungskapitalismus) in einem Youtube-Referat zusammen (Englisch, 12 min, + Diskussion). Sie reflektiert das Unbehagen mit der Machtballung von Daten in Händen von Privatfirmen und Staaten und zeigt Mechanisnen zur Erhaltung des Privaten auf. Denkanstösse bloss, aber potentiell wichtig.
      Gruss
    • Abt. Zugriffsstatistik
      ===============
      Die Reihe "Algorithmen", begonnen am 20.08.2009, hat sich inzwischen bis zu diesem Kapitel XX (röm. 20) entwickelt. Rechnet man nur diese Hauptkapitel, und zieht man meine eigenen Serviceklicks ab, dann wurde gestern die Zahl von 400.000 CLicks überschritten. Mit Ausgliederungen und Nebenbeiträgen steht der Zähler derzeit (3.03.2019) auf etwas über 480.000. Da zahlreiche alte, schlaue Algorithmen noch nicht umgesetzt sind, dürfte irgendwann die halbe Million drinnen sein. Schaun mer mal ...
      Gruss
    • Abt. EaR 25 ´Geheimcode´
      ====================
      Gesucht ist ein achtstelliger Code aus dem Zeichenvorrat "A","A","B","B","C","C","D" und "D".
      Die Meldungen unsrer Agenten haben folgendes Lagebild ergeben: Zwischen den beiden Zeichen "A" und "A" befindet sich genau 1 anderer Buchstabe, zwischen "B" und "B" zwei andere, "C" und "C" drei andere, zwischen "D" und "D" vier andere. Zuletzt kam noch folgende Information: Sollte es mehrere Möglichkeiten geben, so sei stets der alphabetisch letzte der Richtige. Zentrale: Wiie lautet der Code?
    • Auflösung zu EaR 25:
      --------------------

      Quellcode

      1. WindowTitle "EaR-25-Löser":cls:font 2
      2. Declare t$,t$[],n&,k&,j&,u&,v&,e%,z&,st$
      3. e%=1:t$="A,A,B,B,C,C,D,D" 'Aufsteigend eingeben!
      4. t$[]=explode(t$,","):n&=SizeOf(t$[])
      5. While e%:inc z&
      6. st$="":WhileLoop n&:st$=st$+t$[&Loop-1]:EndWhile
      7. 'print st$
      8. if mid$(st$,instr("D",st$)+5,1)="D"
      9. if mid$(st$,instr("C",st$)+4,1)="C"
      10. if mid$(st$,instr("B",st$)+3,1)="B"
      11. if mid$(st$,instr("A",st$)+2,1)="A"
      12. print "\n ";st$ : beep
      13. endif
      14. endif
      15. endif
      16. endif
      17. if n&<2:e%=0:break:endif' Knuth-Shuffle permutiert Anordnung
      18. k&=n&-2:While t$[k&]>=t$[k&+1]:Dec k&:case k&<0:break:EndWhile
      19. if k&<0:e%=0:break:endif
      20. j&=n&-1:While t$[j&]<=t$[k&]:dec j&:EndWhile
      21. t$=t$[k&]:t$[k&]=t$[j&]:t$[j&]=t$:u&=k&+1:v&=n&-1
      22. :While u&<v&:t$=t$[u&]:t$[u&]=t$[v&]:t$[v&]=t$:inc u&:dec v&:EndWhile
      23. EndWhile
      24. print "\n ";z&;" Anordnungen geprüft.":waitinput:End
      Alles anzeigen
    • Abt. EaR 26 ´GESUNDE ZAHL´
      ======================
      Gerüchte besagen, es gebe neben normalen auch ´gesunde´ natürliche Zahlen.
      Derartige GESUNDE ZAHLEN folgen nachstehenden Regeln:

      1. Zumindest eine der Regeln 9 und 10 ist richtig.
      2. Dies ist entweder die erste richtige oder die erste falsche Regel.
      3. Es gibt hier drei aufeinander folgende Regeln, die falsch sind.
      4. Eine GESUNDE ZAHL ist teilbar durch die Differenz der Nummern der
      __ letzten und der ersten richtigen Regel, falls diese größer als 2 ist.
      5. Die Summe der Nummern der zutreffenden Regeln ist eine GESUNDE ZAHL.
      6. Dies hier ist nicht die letzte zutreffende Regel.
      7. Die GESUNDE ZAHL ist durch die Nummer jeder der hier zutreffenden Regeln restlos teilbar.
      8. Die GESUNDE ZAHL entspricht dem Prozentwert des Anteils an zutreffenden Regeln.
      9. Die Anzahl der Teiler der GESUNDEN ZAHL (abgesehen von 1 und der Zahl selbst)
      __ ist größer als die Summe der Nummern der zutreffenden Regeln.
      10. Es gibt hier keine drei aufeinander folgenden korrekten Regeln.

      Aufgabe: Ermittle eine GESUNDE ZAHL!
    • Abt. Webseite unkompliziert begrenzte Zeit anzeigen
      =======================================
      ... z.B. beim Systemstart, etwa via AUTOSTART-Verzeichnis.
      Gruss

      Quellcode

      1. WindowTitle "XPROFAN WEBSITE-DISPLAY"
      2. WindowStyle 24:Window 0,0-%maxx,%maxy:showmax
      3. Usermessages 16:Declare WebControl&,sText$
      4. sText$ = "https://www.zamg.ac.at/cms/de/wetter/"+\
      5. "produkte-und-services/weltwetter/analyse/europe/germany"
      6. '"www.google.at" 'Startseite
      7. WebControl&=create("HTMLWin",%hWnd,sText$,\
      8. 4,0,0,width(%hwnd),height(%hwnd))
      9. WindowTitle "XPROFAN: "+upper$(sText$)
      10. While 1:waitinput 8000 ' = 8 Sekunden
      11. case (%umessage=16):break
      12. case %key=0:break
      13. endwhile:destroywindow(WebControl&):End
      Alles anzeigen
    • Lösung Nr. 1 zu EaR 26
      -----------------------------
      mittels Brute-force, Regel-Tests und Geduld: Das Verfahren generiert alle möglichen Permutationen von Wahr=1 oder Falsch=0 über die 10 Regeln. Jede Variante wird darauf geprüft, ob eine der Regeln verletzt wird, und diesfalls sofort verworfen. Über bleibt die (einzige) Lösung.
      Gruss

      Quellcode

      1. WindowTitle "EaR-26 Löser"
      2. Cls:font 2
      3. 'appendmenubar 100,
      4. declare z&,r&[10],sum&,i&,w&,first&,last&,tlr&
      5. Whileloop 1,999:z&=&Loop
      6. Whileloop 0,1:r&[1]=&Loop
      7. Whileloop 0,1:r&[2]=&Loop
      8. Whileloop 0,1:r&[3]=&Loop
      9. Whileloop 0,1:r&[4]=&Loop
      10. Whileloop 0,1:r&[5]=&Loop
      11. Whileloop 0,1:r&[6]=&Loop
      12. Whileloop 0,1:r&[7]=&Loop
      13. Whileloop 0,1:r&[8]=&Loop
      14. Whileloop 0,1:r&[9]=&Loop
      15. Whileloop 0,1:r&[10]=&Loop
      16. locate %Csrlin,1
      17. print z&,tab(10);r&[1],r&[2],r&[3],r&[4],r&[5],r&[6],r&[7],r&[8],r&[9],r&[10],
      18. 'r1. Zumindest eine der Regeln 9 und 10 ist richtig:
      19. w&=(r&[9]=1) or (r&[10]=1)
      20. if r&[1]=w&
      21. 'r2. Dies ist entweder die erste richtige oder die erste falsche Regel.
      22. w&=(r&[2]=not(r&[1]))
      23. if r&[2]=w&
      24. 'r3. Es gibt hier drei aufeinander folgende Regeln, die falsch sind:
      25. w&=0:sum&=0
      26. whileloop 1,8:i&=&Loop
      27. sum&=not(r&[i&])+not(r&[i&+1])+not(r&[i&+2])
      28. if sum&>=3:w&=1:break:endif
      29. endwhile
      30. if r&[3]=w&
      31. 'r4. Eine GESUNDE ZAHL ist restlos teilbar durch die Differenz der Nummern der
      32. ' letzten und der ersten richtigen Regel.
      33. w&=0:first&=11:last&=0
      34. whileloop 1,10
      35. case r&[&Loop]=1:last&=&Loop
      36. case (first&=11) and (r&[&Loop]=1):first&=&Loop
      37. endwhile
      38. w&=0
      39. if last&>(first&+2)'löst das NICHT-NICHT-Interpretationsproblem von Regel 6
      40. casenot z& mod (last&-first&):w&=1
      41. endif
      42. if r&[4]=w&
      43. 'r5. Die Summe der Nummern der zutreffenden Regeln ist eine GESUNDE ZAHL.
      44. sum&=0:whileloop 10:sum&=sum&+r&[&Loop]:endwhile:w&=(z&=sum&)
      45. if r&[5]=w&
      46. 'r6. R6 ist nicht die letzte zutreffende Regel.
      47. w&=0:whileloop 7,10:if r&[&Loop]=1:w&=1:break:endif:endwhile
      48. if r&[6]=w&
      49. '7. Die GESUNDE ZAHL ist durch die Nummer jeder der hier zutreffenden Regeln restlos teilbar:
      50. w&=1
      51. whileloop 10
      52. if r&[&Loop]=1
      53. if Z& mod &Loop
      54. w&=0:break
      55. endif
      56. endif
      57. endwhile
      58. if r&[7]=w&
      59. '8. Die GESUNDE ZAHL ist der Prozentanteil der zutreffenden Regeln.
      60. w&=0:sum&=0:Whileloop 10:sum&=sum&+r&[&Loop]:endwhile:sum&=sum&/10*100
      61. w&=(z&=sum&)
      62. if r&[8]=w&
      63. '9. Die Anzahl der Teiler der GESUNDEN ZAHL (abgesehen von 1 und der Zahl selbst) ...
      64. tlr&=0:Whileloop 2,z&-1:casenot z& mod &Loop:inc tlr&:endwhile
      65. ' ... ist größer als die Summe der Nummern der hier zutreffenden Regeln:
      66. sum&=0:Whileloop 10:sum&=sum&+(r&[&Loop]=1)*&Loop:endwhile
      67. w&=(tlr&>sum&)
      68. if r&[9]=w&
      69. '10. Es gibt hier keine drei aufeinander folgenden korrekten Regeln.
      70. w&=1
      71. Whileloop 1,8:i&=&Loop
      72. if r&[i&] and r&[i&+1] and r&[i&+2]
      73. w&=0
      74. endif
      75. endwhile
      76. if r&[10]=w&
      77. print " GESUNDE ZAHL = ";z&
      78. sound 300,80
      79. waitinput 120000
      80. else :print " -10",:endif
      81. else :print " -9",:endif
      82. else :print " -8",:endif
      83. else :print " -7",:endif
      84. else :print " -6",:endif
      85. else :print " -5",:endif
      86. else :print " -4",:endif
      87. else :print " -3",:endif
      88. else :print " -2",:endif
      89. else :print " -1",:endif
      90. endwhile
      91. endwhile
      92. endwhile
      93. endwhile
      94. endwhile
      95. endwhile
      96. endwhile
      97. endwhile
      98. endwhile
      99. endwhile
      100. endwhile
      101. Beep
      102. waitinput
      103. end
      104. ProgEnd
      105. ' Zahl & Regeln 1 2 3 4 5 6 7 8 9 19 & ´-R´=Verletzte Regel
      106. '" 420 0 1 1 1 0 1 1 0 0 0" 1=Trifft zu, 0=trifft nicht zu
      Alles anzeigen
      P.S.: Erinnerung: EaR 27 ist noch offen!
    • Lösungsweg Nr.2 zu EaR 26: Mit Logik!
      -----------------------------------------------
      Hier nochmals die 10 Regel-Aussagen. Diese können wahr oder falsch sein. Die Aufgabe ist nur dann zu lösen, wenn der Wahrheitswert jeder der 10 Aussagen widerspruchsfrei zu allen anderen Aussagen gesetzt werden kann - mehr was für Kriminalisten!
      Gruss

      1. Zumindest eine der Regeln 9 und 10 ist richtig.
      2. Dies ist entweder die erste richtige oder die erste falsche Regel.
      3. Es gibt hier drei aufeinander folgende Regeln, die falsch sind.
      4. Eine GESUNDE ZAHL ist teilbar durch die Differenz der Nummern der
      letzten und der ersten richtigen Regel.
      5. Die Summe der Nummern der zutreffenden Regeln ist eine GESUNDE ZAHL.
      6. Dies hier ist nicht die letzte zutreffende Regel.
      7. Die GESUNDE ZAHL ist durch die Nummer jeder der hier zutreffenden Regeln restlos teilbar.
      8. Die GESUNDE ZAHL ist der Prozentanteil der zutreffenden Regeln.
      9. Die Anzahl der Teiler der GESUNDEN ZAHL (abgesehen von 1 und der Zahl selbst)
      ist größer als die Summe der Nummern der hier zutreffenden Regeln.
      10. Es gibt hier keine drei aufeinander folgenden korrekten Regeln.

      Daraus kann man nun folgende Schlüsse ziehen:
      Spoiler anzeigen

      A: Nr. 6 muss immer wahr sein!
      (Wäre Nr.6 unzutreffend, wäre das Gegenteil zutreffend, also richtig.)

      B: Nr. 1 muss falsch sein und Nr. 2 muss wahr sein.
      (Wegen der Formulierung von Aussage 2 existiert nur eine logische Kombination von Aussage 1 und 2,
      nämlich Aussage 1 ist falsch und Aussage 2 damit richtig.)

      C: Nr. 9 und Nr. 10 sind falsch
      (Das folgt nun aus Nr. 1, die ja falsch ist.)

      D: Entweder Nr. 7 oder Nr. 8 ist wahr.
      (Das folgt aus der wahren Aussage Nr. 6. Beide können nicht wahr sein, weil kein Prozentsatz durch 6 und 7 teilbar ist)

      I): Nun müssen wir eine Annahme treffen: Setzen wir Nr. 7 auf wahr und Nr. 8 auf falsch:

      E?: Nr. 3 muss wahr sein, weil Nr. 8, Nr. 9 und Nr. 10 falsch sind.

      F?: Nr. 5 muss falsch sein, weil ich sonst nicht Nr. 7 erfüllen kann.

      G?: Nr. 2 und Nr. 4 sind wahr (Wegen Nr. 10 braucht man 3 wahre Aussagen hintereinander)


      Also sind die Aussagen 2, 3, 4, 6 und 7 wahr sowie die Aussagen 1, 5, 8, 9 und 10 falsch.
      ----------------------------------------------------------------------------------------------------------------

      Da nun die Wahrheitswerte der Aussagen bekannt sind, können wir uns auf die Suche nach der GESUNDEN ZAHL machen:

      Aussage 4 (wahr): "Die gesuchte Zahl ist teilbar durch die Differenz der Nummern der letzten (7) und der ersten (2) richtigen Behauptung". Also muss die gesuchte Zahl durch 5 teilbar sein.

      Aussage 7 (wahr): "Die gesuchte Zahl ist durch die Nummer jeder richtigen Behauptung teilbar".
      Also muss sie durch 2, 3, 4, 6 und 7 teilbar sein.

      Daraus folgt: Die kleinste Zahl, die die Aussagen 4 und 7 erfüllt, ist 3*4*5*7 = 420. (210 zB ist nicht restlos durch 4 teilbar.)

      Probe:
      Aussage 9 (falsch): "Die Anzahl der Teiler der gesuchten Zahl (abgesehen von 1 und der Zahl selbst) ist größer als die Summe der Nummern der richtigen Behauptungen". Es gibt 22 Teiler von 420: 210, 140, 105, 84, 70, 60, 42, 35, 30, 28, 21, 20, 15, 14, 12, 10, 7, 6, 5, 4, 3, 2. Die Summe der Nummern der wahren Aussagen ist 2+3+4+6+7 = 22. Nr. 9 ist also falsch, da 22 nicht größer als 22 ist.

      Aussage 8 (falsch): "Die gesuchte Zahl ist der Prozentanteil der richtigen Behauptungen". 420 ist ungleich 50.

      Aussage 5 (falsch): "Die Summe der Nummern der richtigen Behauptungen ist die gesuchte Zahl." 420 ist ungleich 22.

      Die gesuchte Zahl ist also tatsächlich 420.
      ==============================
    • Abt. HÄNGMÄN (deutsch) :super:
      ===================
      Das bekannte Buchstabenratespiel im Retro-Look, zum dran rumbasteln!
      Gruss

      Quellcode

      1. WindowTitle " H Ä N G M Ä N (deutsch)"
      2. '(CL) Copyleft 2019 by p.specht, Vienna/EU
      3. WindowStyle 24
      4. CLS
      5. font 2
      6. randomize
      7. declare auswahl$,wort$,ok$,bu$,alph$
      8. declare versuche&,hang&,good&,bad&,gelöst&,anz&
      9. 'Um Spaß zu erhalten, Absatz nicht lesen!:
      10. auswahl$=upper$(\
      11. "Heizöl,Rückstoss,Dampfschiff,"+\
      12. "Typ,Lokomotive,Dampfkessel,Druckventil,"+\
      13. "Verschlussklappe,Kirschkernweitspuckwettbewerb,"+\
      14. "Recycling,Weihnachtsmann,Schok olade,"+\
      15. "Atmosphäre,Lebenszyklus,Flugmodell,Entwicklung,"+\
      16. "Urlaubsort,Entdeckung,Pionier,Massentourismus,"+\
      17. "Verfallsdatum,Riese,Zyklop,Gymnastik,Rhythmus,"+\
      18. "Desoxyribonukleinsäure,Metapher,Indikatorpapier,"+\
      19. "Papierschnipsel,Krankschreibung,Hundehalsband,"+\
      20. "Haftpflichtversicherung,Vorsorgeuntersuchung")
      21. whileloop len(auswahl$)
      22. case mid$(auswahl$,&Loop,1)=",":inc anz&
      23. endwhile
      24. case auswahl$>"":inc anz&
      25. proc spac :parameters wor$:var spaced$=" "
      26. whileloop len(wor$):spaced$=spaced$+mid$(wor$,&Loop,1)+" "
      27. endwhile:return spaced$
      28. endproc
      29. outerlup:
      30. CLS
      31. wort$=Substr$(auswahl$,1+rnd(anz&),",")
      32. ok$=mkstr$("=",len(wort$))
      33. alph$="ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜß "
      34. bad&=0
      35. nochma:
      36. locate 3,1
      37. 'print spac(wort$) 'cheat mode für Testzwecke
      38. print tab(12);spac(ok$)
      39. locate 6,1:print " Zur Wahl: ";spac(alph$)
      40. locate 9,1:Print " Welchen Buchstaben vermutest du?: ";
      41. locate %csrlin,36:input bu$:bu$=upper$(bu$)
      42. casenot instr(bu$,alph$):bu$=""
      43. print "\n\n Zuletzt geraten: ";bu$
      44. if bu$>""
      45. alph$=left$(alph$,instr(bu$,alph$)-1)+" "+\
      46. mid$(alph$,instr(bu$,alph$)+1,len(alph$)-instr(bu$,alph$)+1)
      47. endif
      48. good&=0
      49. whileloop len(wort$)
      50. if mid$(Wort$,&Loop,1)=bu$
      51. ok$=del$(ok$,&Loop,1)
      52. ok$=ins$(bu$,ok$,&Loop)
      53. good&=1
      54. endif
      55. endwhile
      56. Ifnot good&
      57. inc bad&
      58. sound 75,150
      59. locate 18,1:print " Fehlversuche: ";bad&,
      60. print ". Noch ";int(13-bad&);if(bad&=12," Versuch! "," Versuche!")
      61. case HANGMAN(bad&):goto "hung"
      62. else
      63. sound 1000,100 'richtig geraten
      64. endif
      65. gelöst&=0
      66. whileloop len(ok$)
      67. case mid$(ok$,&loop,1)<>"=":inc gelöst&
      68. endwhile
      69. gelöst&= gelöst&/len(ok$) * 100
      70. locate 15,1:print " Gelöst: ";format$("##0",gelöst&);" %"
      71. IF gelöst&=100 '%
      72. locate 3,1:print tab(12);spac(ok$)
      73. locate 15,20:print " BRAVO, RECHTZEITIG GELÖST !"
      74. sound 500,100:sound 580,100:sound 700,100:sound 1000,200
      75. waitinput 1000
      76. locate 23,1:print " NOCHMAL ? ";:input ok$
      77. if (ok$="j") or (ok$="y") or (ok$="ja") or (ok$="1") or (ok$="")
      78. goto "outerlup"
      79. else
      80. Print "\n\n War recht spannend! Tschüss!"
      81. waitinput 2500
      82. END
      83. endif
      84. ENDIF
      85. goto "nochma"
      86. hung:
      87. locate 3,1:print tab(12);spac(Wort$)
      88. locate 15,20:print " LEIDER NICHT ERRATEN! "
      89. waitinput 1000
      90. locate 23,1:print " NOCHMAL ? ";:input ok$
      91. if (ok$="j") or (ok$="y") or (ok$="ja") or (ok$="1") or (ok$="")
      92. CLS
      93. else
      94. Print "\n\n Na dann: Tschüss!"
      95. waitinput 3000
      96. END
      97. Endif
      98. goto "outerlup"
      99. proc hangman :parameters level&
      100. case level&<=0:return
      101. var x&=450:var y&=400:var r&=50
      102. if level&>=1
      103. usepen 0,5,rgb(0,0,200)
      104. whileloop 20,160,3
      105. if &Loop=20:moveto x&+r&*cos(pi()/180*&Loop),y&-r&*sin(pi()/180*&Loop)
      106. else: lineto x&+r&*cos(pi()/180*&Loop),y&-r&*sin(pi()/180*&Loop)
      107. endif
      108. endwhile
      109. endif
      110. if level&>=2
      111. usepen 0,5,rgb(0,0,200)
      112. line x&,(y&-r&) - x&,y&-4*r&
      113. endif
      114. if level&>=3
      115. usepen 0,5,rgb(0,0,200)
      116. line x&,(y&-4*r&) - x&+2.5*r&,y&-4*r&
      117. endif
      118. if level&>=4
      119. usepen 0,5,rgb(0,0,200)
      120. line x&,(y&-3*r&) - x&+r&,y&-4*r&
      121. endif
      122. if (level&>=5) and (level&<>13)
      123. usepen 0,5,rgb(0,0,200)
      124. line x&+1.5*r&,(y&-r&) - x&+2.5*r&,y&-r&
      125. line x&+1.5*r&,(y&-r&) - x&+1.5*r&,y&-r&/2
      126. line x&+2.5*r&,(y&-r&) - x&+2.5*r&,y&-r&/2
      127. endif
      128. if level&>=6
      129. usepen 0,3,rgb(0,0,200)
      130. line x&+2*r&,(y&-3*r&) - x&+2*r&,y&-4*r&
      131. endif
      132. if level&>=7
      133. usepen 0,3,rgb(0,0,200)
      134. ellipse x&+1.8*r&,(y&-2.5*r&) - x&+2.2*r&,y&-3*r&
      135. endif
      136. if level&>=8
      137. usepen 0,3,rgb(0,0,200)
      138. line x&+2*r&,(y&-2.5*r&) - x&+2*r&,y&-1.8*r&
      139. endif
      140. if level&>=9
      141. usepen 0,3,rgb(0,0,200)
      142. line x&+2*r&,(y&-1.8*r&) - x&+1.7*r&,y&-r&
      143. endif
      144. if level&>=10
      145. usepen 0,3,rgb(0,0,200)
      146. line x&+2*r&,(y&-1.8*r&) - x&+2.3*r&,y&-r&
      147. endif
      148. if level&>=11
      149. usepen 0,3,rgb(0,0,200)
      150. line x&+2*r&,(y&-2.2*r&) - x&+1.7*r&,y&-1.7*r&
      151. endif
      152. if level&>=12
      153. usepen 0,3,rgb(0,0,200)
      154. line x&+2*r&,(y&-2.2*r&) - x&+2.3*r&,y&-1.7*r&
      155. endif
      156. if level&>=13
      157. usepen 0,5,rgb(255,255,255)
      158. line x&+1.5*r&,(y&-r&) - x&+2.5*r&,y&-r&
      159. line x&+1.5*r&,(y&-r&) - x&+1.5*r&,y&-r&/2
      160. line x&+2.5*r&,(y&-r&) - x&+2.5*r&,y&-r&/2
      161. locate 15,1:print spac(" HANGMAN!")
      162. sound 100,200:waitinput 200
      163. sound 100,100:waitinput 100
      164. sound 100,100:waitinput 100
      165. sound 100,300:waitinput 400
      166. return 1 'Hangman-Indikator
      167. endif
      168. return 0
      169. endproc
      Alles anzeigen
    • Abt. Genauigkeits-Benchmark für verschiedene Verfahren der Matrizen-Inversion
      ============================================================
      Im Bereich 3D-Computergrafik werden gerne 4x4-Matrizen zur Berechnung der Geometrie verwendet. Deshalb haben alle modernen Graphic-Coprozessoren (GPU) jede Menge spezialisierte Schaltkreise für derartige Operationen. Eine der heikleren Aufgaben ist die Inversion einer Matrix: In der Matrizenrechnung gibt es keine Division, sondern eben nur eine Multiplikation mit der Inversen einer Matrix (Gebraucht wird das z.B. bei der Berechnung von Greifvorgängen von Roboterarmen).

      Zur Inversion existieren nun verschiedene Verfahren: Determinantenmethode, Sarrus-Regel, Entwicklung nach einer Zeile und/oder nach einer Spalte. Im nachstehenden Benchmark wird allerdings nur die CPU benutzt, es geht ja um einen reinen Verfahrensvergleich. Dabei ergibt sich ein Trade-off zwischen Genauigkeit und Schnelligkeit der Berechnung.
      Diesmal habe ich mir die Determinantenmethode für 4x4-Matrizen vorgenommen. Weitere Verfahrensvergleiche sind geplant.
      Gruss

      Quellcode

      1. WindowTitle "Genauigkeits-Bench: Inversion einer 4x4 Matrix in reinem XProfan"
      2. WindowStyle 24:Window 0,0-%maxx,%maxy
      3. CLS:font 1:randomize:set("decimals",15)
      4. var n&=4
      5. declare matrix![0--n&-1,0--n&-1],invmat![0--n&-1,0--n&-1],Nenn!,z&,s&,tm&
      6. print "\n PRUEFUNG DER FEHLERANFAELLIGKEIT VON MATRIZENINVERSIONSVERFAHREN (1)"
      7. print "\n Dimension der quadratischen Matrix: ";int(sqrt(sizeof(matrix![])))
      8. 'matrix![0,0]=1:matrix![0,1]=0:matrix![0,2]=0:matrix![0,3]=0
      9. 'matrix![1,0]=0:matrix![1,1]=1:matrix![1,2]=0:matrix![1,3]=0
      10. 'matrix![2,0]=0:matrix![2,1]=0:matrix![2,2]=1:matrix![2,3]=0
      11. 'matrix![3,0]=0:matrix![3,1]=0:matrix![3,2]=0:matrix![3,3]=1
      12. Matrix![]=rnd(2^30)-2^29
      13. print "\n\n Die zufallsbelegte Matrix lautet: "
      14. Mat4x4Prt matrix![]
      15. tm&=Invert4x4(matrix![],InvMat![])
      16. print "\n Die in",tm&,"[ms] invertierte Matrix lautet:"
      17. Mat4x4Prt InvMat![]
      18. print "\n Die Inversion der invertierten Matrix sollte wieder die Ausgangsmatrix ergeben:"
      19. tm&=Invert4x4(InvMat![],Matrix![])
      20. Mat4x4Prt Matrix![]
      21. print
      22. print " ";tm&;" [ms]";
      23. waitinput
      24. end
      25. proc Mat4x4Prt :parameters matrix![]
      26. print
      27. print
      28. print tab( 2);format$("%g",matrix![0,0]),
      29. print tab(27);format$("%g",matrix![0,1]),
      30. print tab(52);format$("%g",matrix![0,2]),
      31. print tab(77);format$("%g",matrix![0,3])
      32. print
      33. print tab( 2);format$("%g",matrix![1,0]),
      34. print tab(27);format$("%g",matrix![1,1]),
      35. print tab(52);format$("%g",matrix![1,2]),
      36. print tab(77);format$("%g",matrix![1,3])
      37. print
      38. print tab( 2);format$("%g",matrix![2,0]),
      39. print tab(27);format$("%g",matrix![2,1]),
      40. print tab(52);format$("%g",matrix![2,2]),
      41. print tab(77);format$("%g",matrix![2,3])
      42. print
      43. print tab( 2);format$("%g",matrix![3,0]),
      44. print tab(27);format$("%g",matrix![3,1]),
      45. print tab(52);format$("%g",matrix![3,2]),
      46. print tab(77);format$("%g",matrix![3,3])
      47. print
      48. print
      49. endproc
      50. proc Invert4x4 :parameters matrix![],invmat![]
      51. var tm&=&gettickcount
      52. case sizeof(matrix![])<>16:return -1
      53. declare a!,b!,c!,d! , e!,f!,g!,h! , i!,j!,k!,l! ,m!,n!,o!,p!,Nenn!
      54. a!=matrix![0,0]:b!=matrix![0,1]:c!=matrix![0,2]:d!=matrix![0,3]
      55. e!=matrix![1,0]:f!=matrix![1,1]:g!=matrix![1,2]:h!=matrix![1,3]
      56. i!=matrix![2,0]:j!=matrix![2,1]:k!=matrix![2,2]:l!=matrix![2,3]
      57. m!=matrix![3,0]:n!=matrix![3,1]:o!=matrix![3,2]:p!=matrix![3,3]
      58. var kplo!=k!*p!-l!*o!
      59. var jpln!=j!*p!-l!*n!
      60. var jokn!=j!*o!-k!*n!
      61. var iplm!=i!*p!-l!*m!
      62. var iokm!=i!*o!-k!*m!
      63. var injm!=i!*n!-j!*m!
      64. Nenn!=1/ \
      65. (a!*( f!*kplo!-g!*jpln!+h!*jokn!)+\
      66. b!*(-e!*kplo!+g!*iplm!-h!*iokm!)+\
      67. c!*( e!*jpln!-f!*iplm!+h!*injm!)+\
      68. d!*(-e!*jokn!+f!*iokm!-g!*injm!))
      69. invmat![0,0]=( f!*kplo!-g!*jpln!+h!*jokn!)*Nenn!
      70. invmat![0,1]=(-b!*kplo!+c!*jpln!-d!*jokn!)*Nenn!
      71. invmat![0,2]=( b!*(g!*p!-h!*o!)-c!*(f!*p!-h!*n!)+d!*(f!*o!-g!*n!))*Nenn!
      72. invmat![0,3]=(-b!*(g!*l!-h!*k!)+c!*(f!*l!-h!*j!)-d!*(f!*k!-g!*j!))*Nenn!
      73. invmat![1,0]=(-e!*kplo!+g!*iplm!-h!*iokm!)*Nenn!
      74. invmat![1,1]=( a!*kplo!-c!*iplm!+d!*iokm!)*Nenn!
      75. invmat![1,2]=(-a!*(g!*p!-h!*o!)+c!*(e!*p!-h!*m!)-d!*(e!*o!-g!*m!))*Nenn!
      76. invmat![1,3]=( a!*(g!*l!-h!*k!)-c!*(e!*l!-h!*i!)+d!*(e!*k!-g!*i!))*Nenn!
      77. invmat![2,0]=( e!*jpln!-f!*iplm!+h!*injm!)*Nenn!
      78. invmat![2,1]=(-a!*jpln!+b!*iplm!-d!*injm!)*Nenn!
      79. invmat![2,2]=( a!*(f!*p!-h!*n!)-b!*(e!*p!-h!*m!)+d!*(e!*n!-f!*m!))*Nenn!
      80. invmat![2,3]=(-a!*(f!*l!-h!*j!)+b!*(e!*l!-h!*i!)-d!*(e!*j!-f!*i!))*Nenn!
      81. invmat![3,0]=(-e!*jokn!+f!*iokm!-g!*injm!)*Nenn!
      82. invmat![3,1]=( a!*jokn!-b!*iokm!+c!*injm!)*Nenn!
      83. invmat![3,2]=(-a!*(f!*o!-g!*n!)+b!*(e!*o!-g!*m!)-c!*(e!*n!-f!*m!))*Nenn!
      84. invmat![3,3]=( a!*(f!*k!-g!*j!)-b!*(e!*k!-g!*i!)+c!*(e!*j!-f!*i!))*Nenn!
      85. return &gettickcount-tm&
      86. Endproc
      Alles anzeigen
    • Abt. Interessante Links: Neue Technologien
      =================================
      1. "Definiert nachgiebige Mechanik-Systeme" (Compliant Systems) schaffen es, in einem einzigen Werkstück - also ohne Gelenke und Achsen -bewegliche Bauteile herzustellen. Die Plastik-Brotdose mit im selben Arbeitsgang angespritztem Deckel ohne traditionelles Scharnier war also nur der Anfang! Materialien von Nylon, Plastik über Stahl und Titan bis zum glasharten Silizium für Mikrostrukturen erhalten so preiswert neue Bewegungsmöglichkeiten, die in der Elastizität des Materials selbst begründet sind. Hier ein Youtube Video (engl.) dazu. Werden dadurch Haushaltsroboter für uns alle erschwinglich?

      2. Eine weitere neue Technologie beim 3D-Druck steht vor der Markteinführung: Aus einer Polymer-Lösung wird eine 3D-Figur mittels 3 gekreuzter Laserstrahlen räumlich vergleichsweise schnell ausgehärtet. Das Verfahren beschleunigt 3D-Druck wesentlich, und zwar ohne Stufeneffekte, die normalerweise eine weitere Nachbearbeitung erforderlich machen. Auch in der Prothetik interessant! Youtube Video dazu (US-englisch). Eine Verbindunng mit Technologie 1 da oben wäre möglich!

      3. Wär es nicht toll, dünnste Langlöcher in beliebig harte Werkstücke zu bohren? Das geht neben der teuren Laser-Technik nun auch elektrisch: Durch Abrasiv-Schweissen. Engl. Youtube-Video dazu: Lin


      Gruss

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

    • Abt. Neue Festlegung physikalischer Basiskonstanten
      =======================================
      Um sich von materiellen Dingen wie dem Pariser Ur-Meter und nun auch dem Ur-Kilogramm, das bekanntlich in Sevres bei Paris in einem gesicherten Keller lagert, unabhängig zu machen, haben die Messtechnik-Gurus der CODATA im November 2018 folgende exakte Werte von Naturkonstanten festgelegt - und das soll Ende März nun auch offiziell abgesegnet werden:

      Die Planck-Länge (2019) beträgt 6.62607015E-34 [J s], per Definition.
      Die Stoffmenge 1 mol ergibt sich zu 6.02214076E23 Moleküle [Stück] = Avogadro-Konstante(2019)
      Die Elementarladung des Elektrons (2019) beträgt künftig -1.602176634E-19 Coulomb [C, exakt],
      und die Boltzmann-Konstante k wird festgeschrieben zu 1.380649E-23 J/K , exakt.

      Ergebnis: Das Volt ändern sich dadurch um 1/10 000 000, was sich aber nur in Eichlabors auswirkt.
      Mit anderen Worten: Alles bleibt gleich, aber viel klarer definiert.
      Gruss