5
$\begingroup$

I asked how to make resizable chessboard in here. nickjamesuk help me . Here is the code. I thought I can put queens on the board chess board easily after created resizable board, but it didn't work out. Now, I want to write whole problem here.

For now, I don't need to solve the N-queens problem. I have some solution, and I want to represent that solutions of N-queens problem attractively.

Here is an example:

Board example

Also, number of solution is different for each board size. Here is the source. I want to include all the solution for individual board sizes.

End product should have two parameters. First one will resize the board from 1 to n. Second parameter will be used changing between different solutions for predefined board sizes.

It seems very hard task for me. I will really appreciated everybody try to do it.

$\endgroup$
2
  • 1
    $\begingroup$ Really no code from you at all? $\endgroup$
    – Yves Klett
    May 10 '14 at 14:07
  • 1
    $\begingroup$ Exactly, no code at all. It makes it very hard to figure out where you're stuck/what you need help with. $\endgroup$
    – C. E.
    May 10 '14 at 14:14
17
$\begingroup$

Since you already have an answer for the resizable part I will use a fixed chess board. In fact I replicated the graphics in the Wikipedia article for the eight queens problem a while back, and solved it, so I'll just share my solution. I guess the task left is to 1) Replace my solution with yours and 2) adapt the graphics to the n-queens problems.

dark = RGBColor[0.8196, 0.5451, 0.2784];
light = RGBColor[1, 0.8078, 0.6196];
queen = Import["http://upload.wikimedia.org/wikipedia/commons/thumb/1/15/Chess_qlt45.svg/200px-Chess_qlt45.svg.png"];
range = Partition[Range[64], 8];
range = MapAt[
   Boole[EvenQ[#]] &,
   range,
   1 ;; 8 ;; 2
   ];
range = MapAt[
   Boole[OddQ[#]] &,
   range,
   2 ;; 8 ;; 2
   ];
takenByQueen[{i_, j_}] := Module[{boardElements},
  boardElements = Array[List, {8, 8}];
  Union[
   boardElements[[i]],
   boardElements[[All, j]],
   Diagonal[boardElements, j - i],
   Diagonal[Reverse[board, 2], (Length[board] - j + 1) - i]
   ]
  ]
bt[board_, row_, occupied_] := Module[{available},
  available = Complement[Thread[{row, Range[8]}], occupied];
  If[row < 9,
   bt[ReplacePart[board, # -> 1], row + 1, 
      Union[occupied, takenByQueen[#]]] & /@ available,
   Sow[board /. {_, _} -> 0]
   ];
  ]
board = Array[List, {8, 8}];
solutions = Reap[bt[board, 1, {}]][[2, 1]];
drawBoard[board_] := ArrayPlot[
  range,
  ColorRules -> {0 -> light, 1 -> dark},
  Epilog -> (Inset[queen, # - 1, # - 1, 1] & /@ Position[board, 1])
  ]
ListAnimate[drawBoard /@ solutions]

The result looks like this:

eight queens solutions

$\endgroup$
17
  • $\begingroup$ Thanks for the solution. First of all, I want to say I am learning mathematica (Now, I can ask stupid questions :)). If I understood right, this code solves the N-queens problem. If I am right, this is not the thing I need for now. However, image shows the second requirement perfectly (changing between different solutions for predefined board size). I need one more slider for changing board size. Also, I run the code. There is no error message, but no graphical result too. :( As I said at the beginning; I am beginner. $\endgroup$
    – forumcash
    May 10 '14 at 14:39
  • 7
    $\begingroup$ Learning Mathematica can be hard. It takes time. This problem is not something that came up in, say, your research. It has no practical value, it's just practice. I don't see why it would help you if we would do everything for you. Then it just becomes another piece of example code, and there is already plenty of example code. Your problem as of now seems to be "I want to do stuff that I can't do yet" - you need to work through examples and so on to get to a level where you have just a few things you need to figure out before you can do what you want to do. Then you can ask good questions. $\endgroup$
    – C. E.
    May 10 '14 at 14:57
  • 1
    $\begingroup$ I made a mistake when I copy&pasted the code, it should work now. Of course this code will be very overwhelming for you, I am sure. The graphics part is easier than the solver part though, and you should be able to see which is which. drawBoard shows how to draw a fixed size board with queens. drawBoard takes an argument that is a matrix where 1 represents a queen (inspect the solutions list to get the format right). Using this you should try to accomplish what you're trying to accomplish. If you stumble upon something that you cannot solve with existing answers, you can ask. $\endgroup$
    – C. E.
    May 10 '14 at 15:03
  • 2
    $\begingroup$ Position[board,1] is a list of matrix indices like {{1,1},{5,4},...}. # assumes each of the values. {1,1} is the bottom left corner. However, in order to place a queen at the bottom left corner we need to specify {0,0}. So -1 is just there to translate correctly from the matrix indices to the position of the queen. Regarding Reap and Sow I don't think I can do it better than they do in the documentation, it warrants more than a comment. $\endgroup$
    – C. E.
    May 10 '14 at 21:50
  • 1
    $\begingroup$ @AliHashmi Yes, exactly. The board is a matrix of positions {{{1,1}, {1,2}, ...}, ...}. When I place a queen I replace the position with a 1. Before I Sow the board I replace all the remaining positions with 0 to indicate that these are empty. $\endgroup$
    – C. E.
    Mar 26 '17 at 22:16
10
$\begingroup$

In the same spirit as the answer of Pickett, here is my 5-6 years old code for the queens problem.

ClearAll[shiftBits, rowsToExclude, processRow, getSolutions];
shiftBits[bits_List, n_Integer] := 
   IntegerDigits[IntegerPart[FromDigits[bits, 2]/2^n], 2, Length[bits]];

rowsToExclude[{}] = {};
rowsToExclude[board_?MatrixQ] := 
   Flatten[#, 1] & @  MapIndexed[
       {#1, shiftBits[#1, -First[#2]], shiftBits[#1, First[#2]]} &,
       Reverse[board]
   ];

processRow[currentboard : _?MatrixQ | {}, size_Integer] := 
   Map[
      Append[currentboard, #] &, 
      Complement[IdentityMatrix[size], rowsToExclude[currentboard]]
   ];

getSolutions[size_Integer] := 
   Flatten[
     Fold[Map[processRow[#, size] &, #1, {#2}] &, {}, Range[0, size - 1]], 
     size - 1
   ];

Use this as:

getSolutions[4]

(* 
   {
     {{0, 0, 1, 0}, {1, 0, 0, 0}, {0, 0, 0, 1}, {0, 1, 0, 0}}, 
     {{0, 1, 0, 0}, {0, 0, 0, 1}, {1, 0, 0, 0}, {0, 0, 1, 0}}}
   }
*)

where in this example the board size was 4.

The main reason to post this is that I think this is reasonably compact, fast and idiomatic top - level Mathematica code, containing zero side effects (not to detract from other answers, of course), and using a somewhat different (than the most common one) algorithm to find the solutions. The boards are built row-by-row, where at each stage we select all "partial board candidates".

$\endgroup$
4
  • $\begingroup$ But it does not have the ultimate criterium for high ranking on stack exchange : a colorful image to catch the eye :-) $\endgroup$
    – chris
    May 11 '14 at 10:06
  • $\begingroup$ Having said that I personally regret that most of the questions are graphics related. It seems to me mathematica can do a lot more. $\endgroup$
    – chris
    May 11 '14 at 10:07
  • $\begingroup$ @chris Re: does not have colorful image - true. This was intentional, since Pickett already has this in his answer. Re: graphics-related - I think this simply means that graphics is one of the most powerful sides of Mathematica, outside the pure maths functionality. Its symbolic approach seems to be very beneficial for graphics. $\endgroup$ May 11 '14 at 11:18
  • $\begingroup$ It will be next step to solve N-Queens for me. When I work on solving, I won't use fancy interfaces. $\endgroup$
    – forumcash
    May 11 '14 at 14:45
3
$\begingroup$

Adapted from C.E. here is a way to do it with recursive backtracking. We backtrack in this solution because I use a variable which is accessible to all the local scoping constructs and is deliberately passed by reference:

With[{num = 10},

 Block[{queen = 
 Import@"https://cdn3.iconfinder.com/data/icons/chess-2/512/640621-queen_chess_piece-512.png",
 checkerboard, boardpos, boardposcopy, solution},
 checkerboard = Boole@NestList[RotateLeft, EvenQ /@ Range[num], num - 1];
 boardpos = Array[List, {num, num}];
 boardposcopy = boardpos;

 drawgrid[grid_] := ArrayPlot[checkerboard, ColorRules -> {0 -> LightBlue, 1 -> LightYellow},
Epilog -> (Inset[queen, # - 1, # - 1, 1] & /@Position[grid, \[BlackQueen]])];

 QueensLineOfSight[{row_, col_}] := Block[{currentcol, currentrow, diagL, diagR},
 currentcol = boardpos[[All, col]];
 currentrow = boardpos[[row]];
 diagR = Diagonal[boardpos, col - row];
 diagL = Diagonal[Reverse[boardpos, 2], num - row - col + 1];
 Union[currentcol, currentrow, diagR, diagL]
 ];

 NQueensSolve[num + 1, _] := Sow[boardposcopy]; (* base case *)

 NQueensSolve[row_Integer: 1, attackedPos_: {}] := Scan[col \[Function]
 (If[! MemberQ[attackedPos, {row, col}],
   boardposcopy[[row, col]] = \[BlackQueen];
   NQueensSolve[row + 1, Union[attackedPos, QueensLineOfSight[{row, col}]]];
   boardposcopy[[row, col]] = {row, col};]), Range[num]
 ];
 solution = Reap[NQueensSolve[]][[2, 1]];
 Print["number of solutions found for " <> ToString[num] <> " Queens: ", Length@solution];
 drawgrid@*RandomChoice@solution
 ] 
]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.