home *** CD-ROM | disk | FTP | other *** search
/ The Unsorted BBS Collection / thegreatunsorted.tar / thegreatunsorted / programming / misc_programming / TEST / QUEENS.ADA < prev    next >
Encoding:
Text File  |  1990-06-28  |  2.7 KB  |  109 lines
  1.  
  2.  
  3.  
  4.  
  5. --           Test program for Meridian Ada compiler.            --
  6. -- This program computes a solution to the eight queens problem --
  7. --     It is from "Ada: An Introduction" by Henry Ledgard.      --
  8. --      Copyright (C) 1986 Meridian Software Systems, Inc.      --
  9.  
  10. with ada_io; use ada_io;
  11. procedure queens is
  12.  
  13. min_row: constant integer := 1;
  14. max_row: constant integer := 8;
  15. min_col: constant integer := 1;
  16. max_col: constant integer := 8;
  17.  
  18. min_up_diag: constant integer := min_row + min_col;
  19. max_up_diag: constant integer := max_row + max_col;
  20. min_down_diag: constant integer := min_row - max_col;
  21. max_down_diag: constant integer := max_row - min_col;
  22.  
  23. field_width: constant integer := 3;
  24.  
  25. safe_row:       array(min_row..max_row)             of boolean;
  26. safe_up_diag:   array(min_up_diag..max_up_diag)     of boolean;
  27. safe_down_diag: array(min_down_diag..max_down_diag) of boolean;
  28. configuration:  array(min_col..max_col)             of integer;
  29.  
  30. row: integer;
  31. col: integer;
  32.  
  33. procedure clear_the_board is
  34. begin
  35.   safe_row       := (min_row..max_row => true);
  36.   safe_up_diag   := (min_up_diag..max_up_diag => true);
  37.   safe_down_diag := (min_down_diag..max_down_diag => true);
  38. end;
  39.  
  40. procedure set_queen(row, col: in integer) is
  41. begin
  42.   safe_row(row)           := false;
  43.   safe_up_diag(row+col)   := false;
  44.   safe_down_diag(row-col) := false;
  45.   configuration(col)      := row;
  46. end;
  47.  
  48. procedure remove_queen(row, col: in integer) is
  49.   vacant: constant integer := 0;
  50. begin
  51.   safe_row(row)           := true;
  52.   safe_up_diag(row+col)   := true;
  53.   safe_down_diag(row-col) := true;
  54.   configuration(col)      := vacant;
  55. end;
  56.  
  57. function is_safe(row, col: in integer) return boolean is
  58. begin
  59.   if safe_row(row) and safe_up_diag(row+col)
  60.   and safe_down_diag(row-col) then
  61.     return true;
  62.   else
  63.     return false;
  64.   end if;
  65. end;
  66.  
  67. procedure print_the_board is
  68.   square: string(1..field_width) := (others => ' ');
  69. begin
  70.   for i in min_col..max_col loop
  71.     for j in min_row..max_row loop
  72.       if j = configuration(i) then
  73.     square(1) := 'X';
  74.       else
  75.     square(1) := '.';
  76.       end if;
  77.       put(square);
  78.     end loop;
  79.     new_line;
  80.   end loop;
  81. end;
  82.  
  83. begin -- main program
  84.   row := 1;
  85.   col := 1;
  86.   clear_the_board;
  87.   put("PROGRAM TO SOLVE THE EIGHT QUEENS PROBLEM");
  88.   new_line;
  89.   while (col <= max_col) loop
  90.     while (row <= max_row) and (col <= max_col) loop
  91.       if is_safe(row, col) then
  92.     set_queen(row, col);
  93.     col := col+1;
  94.     row := 1;
  95.       else
  96.     row := row+1;
  97.       end if;
  98.     end loop;
  99.  
  100.     if (row = max_row + 1) then
  101.       col := col-1;
  102.       row := configuration(col);
  103.       remove_queen(row, col);
  104.       row := row+1;
  105.     end if;
  106.   end loop;
  107.   print_the_board;
  108. end;
  109.