ALGORITHMEN - Teil XVII: Im Gruselkeller der Hirnwindungen

    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.

    • ALGORITHMEN - Teil XVII: Im Gruselkeller der Hirnwindungen

      In unserem nun schon allseits bekannten "ALGORITHMEN-Stadel für gestrandete Progammier-Existenzen" schlagen wir nun ein neues Kapitel auf. Es wird zwischen Genie und Wahnsinn angesiedelt sein, mit starker Tendenz zu letzterem. Was daran neu ist, fragt Ihr? Nun, z.B. Programmierwettbewerbe zu kleinen Aufgaben der täglichen Praxis, sozusagen Schnipsel, die vor allem auch Anfänger brauchen können. Die könnten wir dann anschließend gemeinsam bewerten nach Kriterien wie "schnellster Beitrag" :ball: , "kürzester Sourcecode" :hmmm: , "eleganteste Lösung" :idee: , "performanteste Variante" 8-) , "pflegeleichtester Code" :lesen: etc.
      Was haltet Ihr davon?
      Gruss


      P.S.: Hier setze ich schon mal ein Link auf das letzte GESAMTINHALTSVERZEICHNIS der bisherigen ALGORITHMEN-Beiträge. Dauert aber noch ein bisschen!
      Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3

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

    • Ich probier´s mal:

      Abt. KLEINE PROGRAMMIERAUFGABEN - KPA Nr.1 "Schachbrett"
      ===========================================
      Setze ein Schachbrett-Muster (8 x 8 Felder) auf. Es sollte auch einen Rand von 2 Feldbreiten aufweisen und die theoretische Möglichkeit, es später mit Feldwerten zu besetzen, die irgendwann vielleicht Schachfiguren oder Damesteine bedeuten werden.

      Wer macht mit?

      P.S.: Bitte die XProfan-Version des Beitrags dazuschreiben!
    • Abt. Noch mehr Rätsel - NmR 1
      -----------------------------------
      Die Zahlen 309, 41, 5, 7, 68, und 2 dürfen in beliebiger Reihenfolge zu einer 10stelligen Zahl kombiniert werden. Wie lautet die größte dieser Zahlen, wie die kleinste?

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

    • Abt. Gibts dafür Verwendung?
      ===================
      Die Logikfunktion ´=´ liefert einen Wahrheitswert, in XProfan is das 0 (false) und 1 (true).
      Ketten solcher Funktionen werden laut Hilfe von RECHTS NACH LINKS aufgelöst, in der Praxis scheint sich aber eine Tree-Funktion von links und rechts mit Vergleichen an die Mitte der Kette heranzuarbeiten. Es ist daher gut, daß in neueren XProfan-Versionen ´==´ als Vergleichszeichen gilt.

      (Wert:Vergleich) 1: 0=0, 0: 0=1, 0: 1=0, 1: 1=1 <<< Hier läuft noch alles normal.

      Wie reagiert das System aber auf
      0=0=0, 0=0=1, 0=1=0, 0=1=1, 0=2=2, 2=0=2 etc.? <<< Hier gilt die Regel aus der Hilfe,

      Das nachfolgende Progi zeigt bei längeren Ketten aber unterschiedliche Verhaltensweisen, je nachdem ob z.B. eine gerade oder ungerade Anzahl an Vergleichen angegeben ist. Es dient zum Studium der Frage, ob dafür irgend eine sinnvolle Anwendung gefunden werden kann.
      Gruss

      Quellcode

      1. CLS:font 2:declare i&,j&,k&,u&,v&,w&
      2. Whileloop 0,2:i&=&Loop:Whileloop 0,2:j&=&Loop:Whileloop 0,2:k&=&Loop
      3. Whileloop 0,2:u&=&Loop:Whileloop 0,2:v&=&Loop:Whileloop 0,2:w&=&Loop
      4. print " ";i&=j&=k&=u&=v&=w& ;" := ";i&;"=";j&;"=";k&;"=";u&;"=";v&;"=";w&
      5. if %csrlin>31:waitinput:locate 1,1:endif
      6. endwhile:endwhile:endwhile:endwhile:endwhile:endwhile:beep:waitmouse

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

    • KPA 1

      OpenGL wär sicher schöner anzusehen...
      Spoiler anzeigen

      Brainfuck-Quellcode

      1. 'v11
      2. 'Damit auch Pferde in der Arena bleiben... 2,2 .. 9,9
      3. '..abcdefgh..
      4. '............
      5. '8.wbwbwbwb.8
      6. '7.bwbwbwbw.7
      7. '6.wbwbwbwb.6
      8. '5.bwbwbwbw.5
      9. '4.wbwbwbwb.4
      10. '3.bwbwbwbw.3
      11. '2.wbwbwbwb.2
      12. '1.bwbwbwbw.1
      13. '............
      14. '..abcdefgh..
      15. ' (K) König, (K) King
      16. ' (D) Dame, (Q) Queen
      17. ' (T) Turm, (R) Rock
      18. ' (L) Läufer, (B) Bishop
      19. ' (S) Springer, (N) Knight
      20. ' (B) Bauer, (P) Pawn
      21. ' Schach - Chess, Schach Ansage - Check, Schachmatt - Checkmate
      22. ' https://en.wikipedia.org/wiki/Chess
      23. ' https://de.wikipedia.org/wiki/Schach
      24. Set("TrueColor",1)
      25. Font 2
      26. cls
      27. Declare Chessboard$[11,11]
      28. Declare white_field%, black_field%, blank_field%
      29. white_field% = rgb(255,206,158)
      30. black_field% = rgb(209,139, 71)
      31. blank_field% = ord(" ")
      32. Proc odd
      33. Parameters x%
      34. Return TestBit(x%,0) <> 0
      35. EndProc
      36. Proc even
      37. Parameters x%
      38. Return TestBit(x%,0) = 0
      39. EndProc
      40. Proc empty_board
      41. Declare s$,t$, i%,j%
      42. s$ = " abcdefgh "
      43. t$ = " 87654321 "
      44. WhileLoop 0,11
      45. i% = &loop
      46. WhileLoop 0,11
      47. j% = &loop
      48. Chessboard$[i%,j%] = chr$(blank_field%)
      49. EndWhile
      50. EndWhile
      51. WhileLoop 0,11
      52. Chessboard$[ 0,&loop] = Mid$(s$,&loop+1,1)
      53. Chessboard$[11,&loop] = Mid$(s$,&loop+1,1)
      54. Chessboard$[&loop, 0] = Mid$(t$,1+&loop,1)
      55. Chessboard$[&loop,11] = Mid$(t$,1+&loop,1)
      56. EndWhile
      57. EndProc
      58. Proc chess_start_pos
      59. Declare s$,t$, i%,j%
      60. s$ = "TSLDKLST"
      61. t$ = "BBBBBBBB"
      62. WhileLoop 2,9
      63. Chessboard$[2,&loop] = Mid$(s$,&loop-1,1)
      64. Chessboard$[3,&loop] = Mid$(t$,&loop-1,1)
      65. Chessboard$[8,&loop] = Mid$(t$,&loop-1,1)
      66. Chessboard$[9,&loop] = Mid$(s$,&loop-1,1)
      67. EndWhile
      68. EndProc
      69. /*
      70. Proc show_field
      71. Parameters i%, j%
      72. Declare c$
      73. c$ = Chessboard$[i%,j%]
      74. Case (c$ = " ") or (c$ = "") : c$ = chr$(blank_field%)
      75. color 0,15
      76. If Between(i%,2,9) and Between(j%,2,9)
      77. case even(i%) and odd(j%) : color 0,7
      78. case odd(i%) and even(j%) : color 0,7
      79. EndIf
      80. Locate i% * 3+1,j% * 3+1 : print chr$(blank_field%);chr$(blank_field%);chr$(blank_field%);
      81. Locate i% * 3+2,j% * 3+1 : print chr$(blank_field%);chr$(blank_field%);chr$(blank_field%);
      82. Locate i% * 3+3,j% * 3+1 : print chr$(blank_field%);chr$(blank_field%);chr$(blank_field%);
      83. Locate i% * 3+2,j% * 3+1 : print c$;
      84. EndProc
      85. */
      86. Proc show_field
      87. Parameters i%, j%
      88. Declare c$
      89. c$ = Chessboard$[i%,j%]
      90. Case (c$ = " ") or (c$ = "") : c$ = chr$(blank_field%)
      91. color 0,15
      92. If Between(i%,2,9) and Between(j%,2,9)
      93. case even(i%) and odd(j%) : color 0,7
      94. case odd(i%) and even(j%) : color 0,7
      95. EndIf
      96. Locate i%+1,j%+1 : print c$;
      97. EndProc
      98. Proc show_whole_board
      99. Declare i%,j%
      100. WhileLoop 0,11
      101. j% = &loop
      102. WhileLoop 0,11
      103. i% = &loop
      104. show_field(i%,j%)
      105. EndWhile
      106. EndWhile
      107. EndProc
      108. empty_board()
      109. chess_start_pos()
      110. show_whole_board()
      111. waitinput
      112. end
      Alles anzeigen

      Programmieren, das spannendste Detektivspiel der Welt.

      Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von Michael Wodrich () aus folgendem Grund: die auskommentierte Funktion lief nicht

    • @Michael Wodrich: NmR 1 ist korrekt gelöst! Sagt auch das Prüfprogramm:

      Quellcode

      1. WindowTitle "NmR 1: Max und Min aus möglichen Zahlenkombinationen"
      2. cls:font 2:declare z$[],n&,w$, i&,j&,k&,u&,v&,w&, val&,max&,min&
      3. z$[]=explode("309,41,5,7,68,2",","):n&=sizeof(z$[])-1
      4. max&=-1:min&=999999999:whileloop 0,n&:i&=&Loop:w$=z$[i&]
      5. whileloop 0,n&:j&=&Loop:case (j&=i&):continue
      6. whileloop 0,n&:k&=&Loop:case (k&=j&) | (k&=i&):continue
      7. whileloop 0,n&:u&=&Loop:case (u&=k&) | (u&=j&) | (u&=i&):continue
      8. whileloop 0,n&:v&=&Loop:case (v&=u&) | (v&=k&) | (v&=j&) | (v&=i&):continue
      9. whileloop 0,n&:w&=&Loop:case (w&=v&) | (w&=u&) | (w&=k&) | (w&=i&) | (w&=j&)
      10. continue:val&=val(z$[i&]+z$[j&]+z$[k&]+z$[u&]+z$[v&]+z$[w&])
      11. 'print z$[i&],z$[j&],z$[k&],z$[u&],z$[v&],z$[w&]:waitinput
      12. case max&<val&:max&=val&:case min&>val&:min&=val&
      13. endwhile:endwhile:endwhile:endwhile:endwhile:endwhile
      14. print "\n MAX.= ";max&," MIN.= ";min&:beep:waitinput:end
      Alles anzeigen
    • Ad Beitrag #6: @Michael Wodrich zu KPA Nr.1 "Schachbrett"
      Eine gültige Lösung samt Figuren-Fleissaufgabe, die aber den Schachbrettalgorithmus selbst durch ihre klare Gliederung und gute Lesbarkeit nicht verdeckt! Da kann man unzweifelhaft schon mal den Preis als schnellster eingetroffener Beitrag vergeben: :ball: TOOOOOOOOR!

      Aber wer weiß, was da noch alles an eleganten, kurzen und/oder gefinkelten Lösungen eintrudelt?
      Das Thema bleibt also vorerst offen - bitte um rege Beteiligung, dann lernen wir alle was dazu!
      :bravo:
    • Quellcode zu NmR 1
      Spoiler anzeigen

      Quellcode

      1. '*** v12 -variablentypen
      2. 'v13 -for..endfor, sortlist
      3. cls
      4. declare x$[5], int i0,i1,i2,i3,i4,i5
      5. x$[0] = "309"
      6. x$[1] = "41"
      7. x$[2] = "5"
      8. x$[3] = "7"
      9. x$[4] = "68"
      10. x$[5] = "2"
      11. clearlist 0
      12. for i0,0,5
      13. for i1,0,5
      14. for i2,0,5
      15. for i3,0,5
      16. for i4,0,5
      17. for i5,0,5
      18. case i0 = i1 : continue
      19. case i0 = i2 : continue
      20. case i0 = i3 : continue
      21. case i0 = i4 : continue
      22. case i0 = i5 : continue
      23. case i1 = i2 : continue
      24. case i1 = i3 : continue
      25. case i1 = i4 : continue
      26. case i1 = i5 : continue
      27. case i2 = i3 : continue
      28. case i2 = i4 : continue
      29. case i2 = i5 : continue
      30. case i3 = i4 : continue
      31. case i3 = i5 : continue
      32. case i4 = i5 : continue
      33. print i0,i1,i2,i3,i4,i5
      34. print "--- ";
      35. addstring(0, x$[i0] $ x$[i1] $ x$[i2] $ x$[i3] $ x$[i4] $ x$[i5] )
      36. print i0,i1,i2,i3,i4,i5,getstring$(0,getcount(0) - 1)
      37. endfor 'i5
      38. endfor 'i4
      39. endfor 'i3
      40. endfor 'i2
      41. endfor 'i1
      42. endfor 'i0
      43. print "-----"
      44. sortlist 5
      45. print getstring$(0,0)
      46. print getstring$(0,getcount(0) - 1)
      47. print "fertig"
      48. waitkey
      49. end
      Alles anzeigen


      Durch das Sortieren ist es langsamer, aber erster und letzter Wert lassen sich einfach herausgreifen.
      Programmieren, das spannendste Detektivspiel der Welt.
    • KPA 1
      -------
      Hab' demnächst eh mit der Umsetzung von Spielbrettern zu tun, von daher kam mir die Übungsaufgabe gelegen.
      Ich hatte mich bisher nur mit Objekten in dynamischen Arrays beschäftigt und wollte nun Dank Deiner Anregung auch mal ein mehrdimensionales probieren.
      Feldeigenschaften und Methoden sind aber so gut wie nicht vorhanden, also rechtfertige ich diesen Post allein damit, daß Herr Specht Schachbretter sehen wollte..
      Danke für Deine Anregungen!
      Gruß
      KJ

      Spoiler anzeigen

      //XProfan X4
      Declare end&
      UserMessages $10
      //-----------------------------------------------
      Declare mem feld[11,11] // 8x8 plus 2 Randfelder
      Class einzelfeld = color&,\ // weiss, schwarz, oder Randfarbe
      x&, y&,\ // Position des Feldes
      FigurID&,\ // 0 = Feld ist frei
      setFigurID@


      Proc einzelfeld.SetFigurID
      Parameters Long id
      .FigurID& = id
      EndProc


      Dim feld[],einzelfeld
      //-------------------------------------------------


      Declare mem brett
      Class schachbrett = feldgroesse&,\ // Kantenlänge eines Feldes in Pixel
      offset&,\ // Rand linksoben im Clientbereich
      weiss&,\
      schwarz&,\
      rand&,\
      schachbrett@,\
      anzeigen@

      Proc schachbrett.schachbrett
      Parameters Long offset, weiss, schwarz, rand
      Declare long i, j, x, y
      .offset& = offset
      .weiss& = weiss : .schwarz& = schwarz: .rand& = rand
      .feldgroesse& = (Height(&hwnd) - (2* offset)) / 12
      For i,0,11
      For j,0,11
      feld[i,j].x& = i * .feldgroesse& + offset
      feld[i,j].y& = j * .feldgroesse& + offset

      If Between(i,2,9) And Between(j,2,9)
      If Not(TestBit(i,0) Or TestBit(j,0)) Or (TestBit(i,0) And TestBit(j,0))
      feld[i,j].color& = .weiss&
      Else
      feld[i,j].color& = .schwarz&
      EndIf
      Else
      feld[i,j].color& = .rand&
      EndIf

      EndFor
      EndFor
      .anzeigen()
      EndProc


      Proc schachbrett.anzeigen
      Declare long i, j
      For i,0,11
      For j,0,11
      Rectangle feld[i,j].x&, feld[i,j].y& - feld[i,j].x& + .feldgroesse&, feld[i,j].y& + .feldgroesse&
      UseBrush 1, feld[i,j].color&
      Fill feld[i,j].x& +1, feld[i,j].y& +1,0
      EndFor
      EndFor
      EndProc

      Window 800,800
      brett = New(schachbrett, 15, $D0F0F0,$303030, $001040)


      '---------------------------------
      WhileNot end&
      WaitInput


      If (%UMessage = $10)
      end& = 1
      Shutdown


      EndIf
      EndWhile
      '---------------------------------


      Proc Shutdown
      Dispose feld[]
      Dispose brett
      EndProc

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

    • Das als Objekt zu planen ist natürlich noch besser.

      Hab einfach mal die Farben geändert
      brett = New(schachbrett, 15, rgb(255,206,158),rgb(209,139, 71), $001040)

      Sieht echt cool aus.

      Wenn jetzt noch jemand die Figuren als Einfach-Zeichnung hinbekommt, dann belebt sich das Ganze.

      Bin auf glChess bei Gnome gestossen. Ist 2D und bissl 3D. Mal sehen, vielleicht geht da noch was...
      Programmieren, das spannendste Detektivspiel der Welt.
    • Abteilung Schachbrett :
      Der IF hatte mal was in dem anderen Forum gemacht :
      xprofan.net/intl/de/spiele/schach-brett-engine/

      Da gibt es einen Bereich (mem#), der alle Bilder als Bmp enthält.

      Vielleicht kann man ja die Einzelbilder (Abschnitte der Bmp) in eine ImageList
      transferieren. Das Catchen geht ja wunderbar mit :

      Quellcode

      1. Proc CatchBmp
      2. Parameters MemPointer&
      3. Declare hDC&, BITMAPFILEHEADER#, BMPInfo&, init&, hImage&
      4. Var cv$ = Get("CallConv")
      5. Set("CallConv", "STDCALL")
      6. hDC& = External("user32.dll", "GetDC", External("user32.dll", "GetDesktopWindow"))
      7. Dim BITMAPFILEHEADER#, 14
      8. BITMAPFILEHEADER# = MemPointer&
      9. BMPInfo& = MemPointer& + 14
      10. init& = MemPointer& + Long(BITMAPFILEHEADER#, 10)
      11. hImage& = External("gdi32.dll", "CreateDIBitmap", hDC&, BMPInfo&, 4, init&, BMPInfo&, 0)
      12. External("user32.dll", "ReleaseDC", External("user32.dll", "GetDesktopWindow"), hDC&)
      13. Dispose BITMAPFILEHEADER#
      14. Set("CallConv", cv$)
      15. Return hImage&
      16. EndProc
      Alles anzeigen




      Vorteil : man braucht dann keine extra bmp-Datei.
    • Auflösung zu NmR 3
      -------------------
      @Verzweifelte200 hat den Vogel abgeschossen: 36.März = 5.April !
      Spoiler anzeigen
      1.3.
      ** Mo Di Mi Do ** Sa
      So Mo Di ** Do Fr Sa
      So ** Di Mi Do Fr **
      So Mo Di Mi ** Fr Sa
      So Mo ** Mi Do Fr Sa
      **<< 5.4

      P.S.: Wer das per Computer ausrechnen will: Hier hilft das ´Kleinste gemeinsame Vielfache kgV´ mit den Werten 5*n = 7*m; n,m = Integer

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

    • Abt. Schachbrettmuster
      ==================
      Konnte mir´s nicht verkneifen, auch ein Minibeispiel beizusteuern. Figuren würden bei mir als ASCII-Zeichen draufgestellt.

      Quellcode

      1. cls:font 1:declare i&
      2. whileloop 12:i&=&Loop:whileloop 12
      3. if between(i&,3,10) and between(&Loop,3,10)
      4. print if((i&+&Loop) mod 2," ",chr$(176));
      5. else :print ":";:endif:endwhile:print
      6. Endwhile
      7. 'print:print "Bitte jeweils Tastendruck zum Aussuchen von Figurzeichen"
      8. 'Whileloop 0,255:print &Loop,chr$(&Loop)
      9. 'waitinput
      10. 'endwhile
      11. font 1
      12. print "\n Weiss\n"
      13. print " Bauer ";chr$(1),chr$(9)
      14. print " Turm ";chr$(64),chr$(35),chr$(20),chr$(244)
      15. print " Springer ";chr$(156),chr$(36)
      16. print " Laeufer ";chr$(24),chr$(173)
      17. print " Dame ";chr$(15),chr$(12),chr$(209)
      18. print " Koenig ";chr$(11)
      19. print "\n Schwarz\n"
      20. print " Bauer ";chr$(2)
      21. print " Turm ";chr$(254)
      22. print " Springer ";chr$(21)'§
      23. print " Laeufer ";chr$(4),chr$(30)
      24. print " Dame ";chr$(3)
      25. print " Koenig ";chr$(5)
      26. waitmouse
      27. END
      Alles anzeigen

      Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von p. specht () aus folgendem Grund: Figurenvorschlag eingearbeitet