1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:

procedure TForm1.Button1Click(Sender: TObject);
var i,j,r,personen:integer;
    gefunden:boolean;
begin
    personen:=strtoint(edit1.Text);
    i:=2;
    gefunden:=false;
    repeat
      r:=0;
      for j:=1 to personen do r:=(r + i) mod j;
      if r=0 then gefunden:=true;
      inc(i);
    until gefunden or (i>=personen);
    if gefunden then label1.Caption:=inttostr(i-1)
                else label1.Caption:='kein Optimum';
end;                    

1:

In einer zusammenhängenden Gruppe von Ziffern müssen alle Ziffern zwischen der kleinsten und größten Ziffer (jeweils inklusive) der Gruppe genau einmal vorkommen, innerhalb der Gruppe in beliebiger Reihenfolge.                    

1:

3. Waagerecht oder senkrecht zusammenhängende weiße Felder dürfen nur Ziffern enthalten, die eine lückenlose Folge, eine Straße, bilden, gleichgültig in welcher Anordnung (Permutation).                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:

program KeinEisbaerBitte;
type
  tdw = record
         dx,dy : NativeInt;
       end;   

const
  maxX = 4;
  maxY = 4;
  Eisbaerpos :tdw = (dx:2;dy:2);
  Startpos   :tdw = (dx:0;dy:0);  
  EndPos     :tdw = (dx:maxX;dy:MaxY);    
  delta : array[0..2] of tdw = ((dx:1;dy:0),(dx:0;dy:1),(dx:1;dy:1));
var
  solution : NativeInt;

procedure NextStep(ps:tdw);
var
  i : integer;
  newPos : tdw;
begin
  For i := 0 to 2 do
  Begin
    with delta[i] do Begin
      newpos.dx := ps.dx+dx;
      newpos.dy := ps.dy+dy;     
      end;
    with newPos do Begin  
      IF (dx=Eisbaerpos.dx)  AND (dy=Eisbaerpos.dy)then   
        continue;                  
      IF (dx>maxx) or (dy>maxy)then
        continue;
      IF (dx=EndPos.dx) AND (dy=EndPos.dy)then Begin
        inc(solution);
//        BREAK;
        end
      else  
        NextStep(newPos);
      end;
  end;         
end;

Begin
  solution := 0;
  NextStep(Startpos); 
  writeln('Es gibt ',solution,' Wege');
end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:

procedure TForm1.Button1Click(Sender: TObject);
var
  freq, startTime, endTime: int64;
begin
  self.Funktionsaufrufe := 0;
  Wege := 0;
  QueryPerformanceFrequency(freq);
  QueryPerformanceCounter(startTime);

  self.PunktPruefen(XSTART, YSTART);
  self.LabeledEdit1.Text := IntToStr(self.Funktionsaufrufe);
  self.LabeledEdit2.Text := IntToStr(self.Wege);

  QueryPerformanceCounter(endTime);

  self.LabeledEdit3.Text := IntToStr((endTime-startTime)*1000000 div freq)+ ' us';
  self.LabeledEdit4.Text := IntToStr(freq);
end;

function TForm1.PunktPruefen(x, y: integer): integer;
var
  gueltig, endpunkt, baer: boolean;
begin
  Inc(self.Funktionsaufrufe);

  // Prüfen ob im Spielfeld und nicht auf Bär
  //gueltig := ((x <= XMAX)and(y <=YMAX)and not((x = XBAER)and(Y = YBAER)));
  baer := (x = XBAER)and(Y = YBAER);
  endpunkt:= (x = XMAX) and (y = YMAX);

  //Wenn im Spielfeld und nicht Bär dann Wege+1 und aufruf der Funktion drei mal, 1. mit x+1, 2. mit y+1, 3. mit x+1 und y+1
   if not (baer or endpunkt) then //gueltig and not (endpunkt) then
   begin
    if x < XMAX then
      self.PunktPruefen(x+1,y);
    if y < YMAX then
      self.PunktPruefen(x,y+1);
    if ((y < YMAX) and (x < XMAX)) then
      self.PunktPruefen(x+1,y+1);
   end;

   if endpunkt then
    Inc(self.Wege);

  result := 0;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:

program KeinEisbaerBitte;
type
  tdw = record
         dx,dy : NativeInt;
       end;

const
  maxX = 12;
  maxY = 12;
  Startpos   :tdw = (dx:0;dy:0);
  ZielPos    :tdw = (dx:maxX;dy:MaxY);
//delta : array[0..2] of tdw = ((dx:1;dy:0),(dx:0;dy:1),(dx:1;dy:1));

var
  chkFld   : array[0..MaxX+1,0..MaxY+1] of byte;
  Waystack : array[0..maxx+maxy] of tdw;
  solution : NativeInt;

procedure InitChkfld(n: NativeInt);
const
  symbols = '.ZS_B';
var
  x,y : NativeInt;
Begin
  //0 -> kann naechsten Schritt wagen
  Fillchar(chkFld,Sizeof(chkFld),#0);
  //3 -> bin ausserhalb
  For x := 0 to MaxX+1 do
    chkFld[x,MaxY+1] := 3;
  For y := 0 to MaxY do
    chkFld[MaxX+1,y] := 3;
  //1 -> Ziel  
  with ZielPos do
    chkFld[dx,dy] := 1;
  //2 -> Start      
  with StartPos do
    chkFld[dx,dy] := 2;
  //4 -> Eisbaer      

  // Ein paar zufaellige Baeren..
  repeat
    x := random(Maxx+1);
    y := random(Maxy+1);
    IF chkFld[x,y] = 0 then
      chkFld[x,y] := 4;
    dec(n)
  until n<= 0;
  //Ausgabe
  For y := MaxY downto 0 do
  Begin
    For x := 0 to MaxX do
      write(symbols[chkfld[x,y]+1]);
    writeln;
  end;
end;

procedure NextStep(idx:NativeInt); forward;

procedure Check(idx:NativeInt);inline;// etwas schneller
Begin
  with WayStack[idx+1] do
    case chkFld[dx,dy] of
      0:NextStep(idx+1);
      1:inc(solution);
    end;
end;

procedure NextStep(idx:NativeInt);
begin
  // loop unrolling
  with WayStack[idx+1] do begin
    dx := WayStack[idx].dx+1;//delta[0].dx;
    dy := WayStack[idx].dy+0;//delta[0].dy;
    end;
  Check(idx);
  with WayStack[idx+1] do begin
    dx := WayStack[idx].dx+0;//delta[1].dx;
    dy := WayStack[idx].dy+1;//((delta[1].dy;
    end;
  Check(idx);
  with WayStack[idx+1] do begin
    dx := WayStack[idx].dx+1;//delta[2].dx;
    dy := WayStack[idx].dy+1;//+delta[2].dy;
    end;
  Check(idx);
end;

Begin
  InitChkfld(50);
  solution := 0;
  WayStack[0] := StartPos;
  NextStep(0);
  writeln('Es gibt ',solution,' Wege');
end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:

12x12 mit 50 zufälligen Bären:
B.........B.Z
.....B.B...BB
.........BB.B
.B........B.B
.B...B..B.B..
....B..BB....
.B..BBB.....B
.......BB....
B.B.B...B....
.....B......B
...B.B.BB....
......BBBBB..
S..........B.
Es gibt 30480 Wege
--------------------------
12x12 ohne Baeren
............Z
10x
.............
S............
Es gibt 251595969 Wege
real  2.510s
--------------------------
10x10 ohne Baeren
Es gibt   8097453 Wege
real  0m0.081s                    

1:
2:
3:
4:
5:
6:

22: 1482376214227923
23: 8443414161166173
24: 48141245001931263
25: 274738209148561921
26: 1569245074591690083
27: 8970232353223635949