🚀 go-pugleaf

This was submitted by a reasonably good student in a second course in
programming.  The students were not given the algorithm.  I hope it is
useful (at least as a point of contrast).


------------------------------------------------------------------------------
--	queens													Greg Nichols
--															001-54-4816
--															cs250
--															10-21-88
------------------------------------------------------------------------------
-- This program finds solutions of the "eight queens" problem.  A 
-- characteristic of any solution must be that it has only one queen per row
-- and only one queen per column.  The board is represented by an eight digit 
-- octal number, where each digit indicates the row the queen occupies.  The 
-- program finds all permutations of "01234567" and tests each one to find if
-- two or more queens occupy the same diagonal.  The program prints each
-- solution to an output file "q.out", along with a count of the number
-- of solutions found.
------------------------------------------------------------------------------

with TEXT_IO;
procedure QUEENS is   
	use TEXT_IO;
	package Int_IO is new INTEGER_IO(INTEGER);
	use Int_IO;

	type array8 is ARRAY(0..7) of INTEGER;
	type boolean8 is ARRAY(0..7) of BOOLEAN;

	solCount: INTEGER := 0;		-- a count of the solutions found
	board : array8;				-- The elements of the array contian the
								-- number of the row the queen is in.
	rows : boolean8:= (TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE);
								-- This array indicates wether or not a 
								-- row is available for a queen.
	column : INTEGER;			-- the next available column.
	outFile : FILE_TYPE;

	--------------------------------------------------------------------------
	-- test
	--------------------------------------------------------------------------
	procedure TEST(testBoard : in array8; goodCount : in out INTEGER) is
	i, j : INTEGER;
	good : BOOLEAN := TRUE;
	begin
		for i in 0..7 loop		-- test the diagonals
			for j in i+1..7 loop
				if ( testBoard(j) = testBoard(i)-(j-i) ) 
								or ( testBoard(j) = testBoard(i)+(j-i) ) then
					good := FALSE;
				end if;
			end loop;
		end loop;

		if good then			-- output the solution
			for i in 0..7 loop
				PUT(outFile,testBoard(i));
			end loop;
			NEW_LINE(outFile);
			goodCount := goodCount + 1;
		end if;
	end TEST;

	--------------------------------------------------------------------------
	-- PERMUTE places a queen on the next available column, picking a row 
	-- from the list of available rows, the calls itself to continue setting 
	-- up the board.  It repeats this for each available row.
	--------------------------------------------------------------------------

	procedure PERMUTE(inBoard : in out array8; nextColumn : in INTEGER;
											 availRows : in out boolean8 ) is
	i : INTEGER;
	begin
		for i in 0..7 loop
			if availRows(i) then
				inBoard( nextColumn ) := i;
				if nextColumn < 7  then
					availRows(i) := FALSE;
					PERMUTE(inBoard, nextColumn + 1, availRows);
					availRows(i) := TRUE;
				else
					TEST(inBoard, solCount);
				end if;
			end if;
		end loop;
	end PERMUTE;

	--------------------------------------------------------------------------
	-- queens main procedure
	--------------------------------------------------------------------------
	begin
		CREATE(outFile, OUT_FILE, "q.out");
		PERMUTE(board, column, rows);
		PUT(outFile, solCount);
		PUT(outFile," solutions found");
		NEW_LINE(outFile);
		CLOSE(outfile);
	end QUEENS;