Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > ger.ct > #669850

Re: Kleines Rätsel

Show all headers | View raw

Am 29.07.2026 um 19:06 schrieb Bonita Montero:

Hier eine verständliche Pascal-Version ;-) :

Hier ist die 1:1-Übersetzung in moderneres Pascal (Free Pascal / 
Delphi). Die rekursive C++23-Lambda-Funktion wurde sauber als 
verschachtelte Prozedur übersetzt.

program TicTacToeRecursion;

{$mode objfpc}{$H+}{$J-} // Für Free Pascal

uses
   SysUtils;

const
   FreeCell: ShortInt = -3;

var
   board: array[0..2, 0..2] of ShortInt;
   undecided, wins: Cardinal;
   row, col: Integer;

   procedure Recurse(colour: ShortInt);
   var
     full, won: Boolean;
     row, col: Integer;
     needed, mid: Integer;
   begin
     full := True;

     for row := 2 downto 0 do
     begin
       for col := 2 downto 0 do
       begin
         if board[row, col] = FreeCell then
         begin
           full := False;
           board[row, col] := colour;

           if colour <> 0 then
             needed := 3
           else
             needed := 0;

           won := ((board[row, 0] + board[row, 1] + board[row, 2]) = 
needed) or
                  ((board[0, col] + board[1, col] + board[2, col]) = 
needed);

           mid := board[1, 1];
           if (not won) and ((row = col) or (row + col = 2)) then
           begin
             won := ((board[0, 0] + mid + board[2, 2]) = needed) or
                    ((board[0, 2] + mid + board[2, 0]) = needed);
           end;

           if not won then
           begin
             if colour <> 0 then
               Recurse(0)
             else
               Recurse(1);
           end
           else
           begin
             Inc(wins);
           end;

           board[row, col] := FreeCell;
         end;
       end;
     end;

     if full then
       Inc(undecided);
   end;

begin
   // Board initialisieren
   for row := 0 to 2 do
     for col := 0 to 2 do
       board[row, col] := FreeCell;

   undecided := 0;
   wins := 0;

   Recurse(0); // 0 entspricht 'false' im C++-Code

   WriteLn('wins:      ', 2 * wins);
   WriteLn('undecided: ', 2 * undecided);
end.

```
FW

Back to ger.ct | Previous | Next — Previous in thread | Next in thread | Find similar | Unroll thread

Thread

Kleines Rätsel Bonita Montero <Bonita.Montero@gmail.com> - 2026-07-29 17:24 +0200
  Re: Kleines Rätsel Ruediger Lahl <ruediger.lahl@gmx.de> - 2026-07-29 18:45 +0200
    Re: Kleines Rätsel Bonita Montero <Bonita.Montero@gmail.com> - 2026-07-29 19:06 +0200
      Re: Kleines Rätsel "F. W." <me@home.invalid> - 2026-07-30 07:14 +0200
      Re: Kleines Rätsel Ruediger Lahl <ruediger.lahl@gmx.de> - 2026-07-30 08:47 +0200
        Re: Kleines Rätsel Bonita Montero <Bonita.Montero@gmail.com> - 2026-07-30 12:15 +0200

csiph-web