Writing generator crossword on Delphi

скриншот программы составления кроссвордовI dug out the disc in its archives crossword generation program, which I did a few years ago on an order for 11 student class. For this reason, many deliberately places in the program simplified and amateurishly writtenthat the student could give the code of his own.For this reason, the number of hard-coded words and placed the cells to enter answers – 12 pieces. But I think if someone wants to modify it it will not be difficult.

Source code is provided with a large number of detailed comments, so to understand the details will not be difficult. The very base of all the questions and answers contained in the file 1.txt, if anyone ever decides to fill that database must not forget to edit the line Cnt = 56 in the beginning.

Download the generation of crossword puzzles (Delphi 7)

I draw your attention that this is not a finished product, for lovers of crosswords, the program is very small base of questions – only 56, and there is no easy adjustment of the size of the crossword and the number of placed issues.

Algorithm generation of crossword

I have developed an algorithm selection and placement of words on the board, whose task is to get the maximum number of intersections with other words. An algorithm, choosing another word for random placement, consistently trying to place it horizontally and vertically, gradually moving from the top left corner to the bottom right of the board.At the same time if you do not give any crossing or word superimposed on the already placed the word is not correct that such options are discarded, and if deemed successful placement of the stored number of intersections obtained to then choose the option with the highest number.

When placing the words, the algorithm takes into account some limitations. For example you can not place the two words one after the other back to back, otherwise it will be clear where one ends and another begins.

Procedures and MapWord MapWordCheck – contain the bulk of the algorithm for placing the words on the board.

procedure TMainForm.MapWord(WUindex: integer);
var
  Len : integer;
  x,y,n : integer;
  i : integer;

  cnt : integer; // Number of found accommodation options
  POst : integer; // The remaining number of attempts to pick a word from the dictionary
  // array to store the options for placement of the words on the board
  MX : array[1..Tmax*Tmax] of integer; // X coordinate on the board
  MY : array[1..Tmax*Tmax] of integer; // Y coordinate on the board
  MN : array[1..Tmax*Tmax] of integer; // Direction of the word - 1 horizontal 2 - vertical
begin   // Select from the dictionary and place the word on the board
  // WUindex - serial number of the placed word

  POst := Pmax; // Grab the variable specified in the number of attempts to select a word
  cnt := 0; // Initially the number of variants that can be placed on the board the word

  while cnt=0 do begin //  twist loop until we find a word that can accommodate even be one way
    POst := POst-1; // decrease number of attempts
    if POst1)and(T[x-1,y]<>' ')and(T[x-1,y]<>'#') then begin // the word should not be molded to close another word
      Result := false; // Placement impossible
      Exit;
    end;
    if (x<Tmax)and(T[x+Len,y]<>' ')and(T[x+Len,y]<>'#') then begin // the word should not be molded to close another word
      Result := false; // Placement impossible
      Exit;
    end;

    for i := 1 to Len do begin // check character by character
      if T[x+i-1,y]<>' ' then begin // cell is busy
        if T[x+i-1,y]<>S[i] then begin // symbol in the cell is not the same as the character in the word - placing impossible
          Result := false;
          Exit;
        end else begin
          if (TS[x+i-1,y]=3)or(TS[x+i-1,y]=1) then begin // symbol coincide, but there is the intersection of words, or there is word, located in the same direction
            Result := false; // Placement impossible
            Exit;
          end else begin
            p := p + 1; // Register the successful crossing of the audited words already placed
          end;
        end;
      end;
    end;
  end else begin // VERTICAL
    if (y>1)and(T[x,y-1]<>' ')and(T[x,y-1]<>'#') then begin // the word should not clings close to another word
      Result := false; // Placement impossible
      Exit;
    end;
    if (y<Tmax)and(T[x,y+Len]<>' ')and(T[x,y+Len]<>'#') then begin // the word should not clings close to another word
      Result := false; // Placement impossible
      Exit;
    end;

    for i := 1 to Len do begin // check character by character
      if T[x,y+i-1]<>' ' then begin // the cell is busy
        if T[x,y+i-1]<>S[i] then begin // symbol in the cell is not the same as the character in the word - placing impossible
          Result := false;
          Exit;
        end else begin
          if (TS[x,y+i-1]=3)or(TS[x,y+i-1]=2) then begin // symbol coincide, but there is the intersection of words, or there is word, located in the same direction
            Result := false; // Placement impossible
            Exit;
          end else begin
            p := p + 1; // Register the successful crossing of the audited words already placed
          end;
        end;
      end;
    end;
  end;
  if p>0 then begin
    Result := true; // Placement with such parameters
  end else begin
    Result := false; // Placement impossible - nchego not interfere, but no intersections
  end;
end;
function TMainForm.RandWord: integer;
var
  r : integer;
  i : integer;
begin // select words from the dictionary, which is not yet used
  r := 0;
  while r=0 do begin
    r := 1 + Random(wCnt-1);
    for i := 1 to WUmax do begin
      if WU[i]=r then r := 0; // If the selected word is already used, reset the option to take another
    end;
  end;
  Result := r;
end;
procedure TMainForm.SetWord(WUindex: integer);
var
  Len : integer;
  S : string;
  i : integer;
  x,y : integer;
begin // word fits into the net, with (in table T and TS)
// WUindex - sequence number in the tables WU, WX, WY, WN (ablitsy these should be filled previously)
  S := W[WU[WUindex]]; // get the word
  Len := Length(S); // get the length
  x := WX[WUindex];
  y := WY[WUindex];
  // Mark the cells before and after the word as employed (that his word does not start or end clung closely to the words already placed)
  if WN[WUindex]=1 then begin // HORIZONTAL
    if (x-1)>0 then begin // Put restrictive sign before the word
      TS[x-1,y] := 3;
      T[x-1,y] := '#';
    end;
    if x+Len<=Tmax then begin // Put restrictive sign after the word
      TS[x+Len, y] :=3;
      T[x+Len, y] := '#';
    end;
  end else begin // ВЕРТИКАЛЬНО
    if (y-1)>0 then begin // Put restrictive sign before the word
      TS[x,y-1] := 3;
      T[x,y-1] := '#';
    end;
    if y+Len<=Tmax then begin // Put restrictive sign after the word
      TS[x, y + Len] :=3;
      T[x,y+Len] := '#';
    end;
  end;

  for i := 1 to Len do begin
    if WN[WUindex]=1 then begin // HORIZONTAL
      T[x+i-1,y] := S[i];             // Put the symbol
      TS[x+i-1,y] := TS[x+i-1,y] + 1; // Code word fits how it is positioned
//      if (i=1) then TS[x-1,y] := 3; // Mark the cage before the term of employment
    end else begin // VERTICAL
      T[x,y+i-1] := S[i];    // Put the symbol
      TS[x,y+i-1] := TS[x,y+i-1] + 2; // Code word fits how it is positioned
    end;
  end;
end;

Leave a Comment

Your email address will not be published.