Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

I have asked in the previous question the data structure I will follow for solving the N Queens problem.

Here is my previous question about N -queens algorithm.

http://www.experts-exchange.com/Programming/Q_21810242.html

It is better to read it first to understand this question.

I want to ask how can i now move the queens randomly according to the number of conflicts they have?

The bigger the number of conflicts the bigger probability to move further. The queens are also restricted in the N x N space.

Here is my previous question about N -queens algorithm.

http://www.experts-exchange.com/Programming/Q_21810242.html

It is better to read it first to understand this question.

I want to ask how can i now move the queens randomly according to the number of conflicts they have?

The bigger the number of conflicts the bigger probability to move further. The queens are also restricted in the N x N space.

Experts Exchange Solution brought to you by

Enjoy your complimentary solution view.

Get every solution instantly with premium.
Start your 7-day free trial.

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

_______________

Nayer Naguib

sub Fill_queens_the_board()

' these is the procedure to place randomly the queens

'I want to put the queens randomly in the board

Dim i As Integer, j As Integer, n As Integer

Dim Random As Double, Random2 As Double

Dim flag As Boolean

For n = 1 To Dimen

Do

Random = Rnd()

Random2 = Rnd()

'these are the row and the columns which are taken randomly

i = Int(Random * Upper_Of_rows) + 1

j = Int(Random2 * Upper_Of_rows) + 1

'in this if statement the array i check if the cell is placed another queen

If (Array1(i, j) = 0) Then

Array1(i, j) = n

flag = True

'The Queens ( n,3) are the main data structure for keeping information about each queen

Queens(n, 1) = i

Queens(n, 2) = j

Else

flag = False

End If

Loop Until flag = True

' Next

' Next

Next

End Sub

--------------------------

--------------------------

Function Objective_function() As Double

'this is the objective function. I will calculate every time this function to find out if i have improvement

Dim Conflicts As Integer, i As Integer, j As Integer

Conflicts = 0

For i = 1 To Dimen

For j = i + 1 To Dimen

' If (3 = 3) Then

If (Queens(i, 1) = Queens(j, 1) _

Or Queens(i, 2) = Queens(j, 2) _

Or (Abs(Queens(i, 1) - Queens(j, 1)) = Abs(Queens(i, 2) - Queens(j, 2))) _

) Then

Conflicts = Conflicts + 1

End If

Next

Next

Objective_function = Conflicts

End Function

--------------------------

--------------------------

Sub find_the_conflicts_for_all

'This sub i calculate for each individual queen the conflicts and i store it to Queens(n, 3)

Dim Conflicts As Integer

Dim i As Integer, q1 As Integer, q2 As Integer, n As Integer

For n = 1 To Dimen

Conflicts = -1

q1 = Queens(n, 1)

q2 = Queens(n, 2)

For i = 1 To Dimen

' If (3 = 3) Then

If (Queens(i, 1) = q1 _

Or Queens(i, 2) = q2 _

Or (Abs(Queens(i, 1) - q1) = Abs(Queens(i, 2) - q2)) _

) Then

Conflicts = Conflicts + 1

End If

Next

'here i insert in the code the number of the conflicts each queen has

'I will use it that for moving the queens in the board

Queens(n, 3) = Conflicts

Next

End Sub

--------------------------

--------------------------

What i want to write is movements of the queens in each stage.

I want to move the Queens that have Queens(n,3)>0.--Queens(n,3

and to move more the queens that have Queens(n,3) bigger than the others

and then i will use the simulated annealing algorithm to decide which stage was the best and how to proceed to the next stage.

Maybe it will be much faster to place only one queen in the row. This is an improvement but Now i want just to run the algorithm.

Here are the results:

1. If you randomly move *all* queens causing conflict during each state transition (whether you will randomly move them, or will move each queen according to the number of conflicts it has got), then the probability of reaching a solution is the same as the probability of reaching a solution while generating the initial state!! The total number of conflicts does *not* converge to zero.

You might keep waiting for days. :-)

2. Trying to move only the most annoying queen gives slightly better results (I tried different next-state generation approaches). The total number of conflicts quickly converges, but then gets stuck at low values. Less than 5% of the runs successfully generated a solution after iterating for only tens or few hundreds of times.

I can post you Visual Basic code that works either way. However, I strongly recommend that you consider other possible heuristic functions.

_______________

Nayer Naguib

You start at a high temperature which makes lots of different movements possible, and gradually lower the temperature to make moves that make the conflicts worse less and less likely.

For this particular problem, I'd expect simulated annealing to be slower on average than a systematic search.

nayernaguib thank you very much . What size space have you tried for the program? I have seen simulated annealing and it is very fast in 8x8 board.Maybe you must have more steps per temeprature. for the 8x8 it usually needs 600-700 moves to find the right. But it doesn't always find a solution.can you post me the solution?

First, this modified Objective_function() calculates the conflicts for each queen as a side effect. Now you do not need to call find_the_conflicts_for_all

__________________________

Function Objective_function() As Double

Dim conflicts As Integer, i As Integer, j As Integer

conflicts = 0

For i = 1 To Upper_Of_rows

Queens(i, 3) = 0

Next

For i = 1 To Upper_Of_rows

For j = 1 To Upper_Of_rows

If (i <> j) And ((Queens(i, 1) = Queens(j, 1) _

Or Queens(i, 2) = Queens(j, 2) _

Or (Abs(Queens(i, 1) - Queens(j, 1)) = Abs(Queens(i, 2) - Queens(j, 2))))) Then

conflicts = conflicts + 1

Queens(i, 3) = Queens(i, 3) + 1

Queens(j, 3) = Queens(j, 3) + 1

End If

Next

Next

For i = 1 To Upper_Of_rows

Queens(i, 3) = Queens(i, 3) / 2 'as each conflict gets added twice for each queen

Next

Objective_function = conflicts

End Function

__________________________

Second, this function randomly moves the most "annoying" queen (that has got most conflicts). The similar() array is filled and used to avoid sticking to only one queen when there are other queens having the maximum number of conflicts. Before using this array, almost all of the algorithm runs got into a deadlock.

__________________________

Private Sub MoveMostAnnoyingQueen()

Dim index As Integer, max As Integer

Dim oldi As Integer, oldj As Integer

Dim i As Integer, j As Integer

Dim newconflicts As Integer

Dim similarconflicts As Integer

Dim similar() As Integer

max = 0

similarconflicts = 1

For i = 1 To Upper_Of_rows

If Queens(i, 3) > max Then

index = i

similarconflicts = 1

max = Queens(i, 3)

ElseIf Queens(i, 3) = max Then

similarconflicts = similarconflicts + 1

End If

Next

index = 1

ReDim similar(similarconflicts)

For i = 1 To Upper_Of_rows

If Queens(i, 3) = max Then

similar(index) = i

index = index + 1

End If

Next

index = similar(Int(Rnd * similarconflicts) + 1)

oldi = Queens(index, 1)

oldj = Queens(index, 2)

newconflicts = Objective_function

Do

i = oldi + Sgn(Int(Rnd * 3) - 1) * (Int(Rnd * max) + 1) 'try different parameters here

j = oldj + Sgn(Int(Rnd * 3) - 1) * (Int(Rnd * max) + 1) 'here too

Loop Until IsBetterPosition(oldi, oldj, index, i, j, newconflicts)

End Sub

__________________________

Finally, this function tells whether the newly generated position is a better one. After a certain number of tries, the function accepts the new position (also to avoid deadlocks).

__________________________

Private Function IsBetterPosition(oldi As Integer, oldj As Integer, index As Integer, i As Integer, j As Integer, oldconflicts)

Dim newconflicts As Integer

If (i < 1) Or (i > Upper_Of_rows) Or (j < 1) Or (j > Upper_Of_rows) Then

IsBetterPosition = False

ElseIf Array1(i, j) <> 0 Then

IsBetterPosition = False

Else

Array1(i, j) = Array1(oldi, oldj)

Array1(oldi, oldj) = 0

Queens(index, 1) = i

Queens(index, 2) = j

newconflicts = Objective_function

If newconflicts <= oldconflicts Or NumberOfTries > Upper_Of_rows Then 'also try different boundary values for NumberOfTries

NumberOfTries = 0

IsBetterPosition = True

Else

NumberOfTries = NumberOfTries + 1

Array1(oldi, oldj) = Array1(i, j)

Array1(i, j) = 0

Queens(index, 1) = oldi

Queens(index, 2) = oldj

IsBetterPosition = False

End If

End If

End Function

__________________________

Notes:

* Don't forget to declare NumberOfTries as a global integer variable.

* You can use a global variable to count iterations.

* In your code, Dimen and Upper_Of_rows have the same value, so you can remove one of them and use the other.

_______________

Nayer Naguib

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial_______________

Nayer Naguib

Your initialization code should look like this:

__________________________

NumberOfTries = 0

iterations = 0

Randomize

Dim s As String

Upper_Of_rows = 8

ReDim Array1(1 To Upper_Of_rows, 1 To Upper_Of_rows) 'you can use only one array instead of both Queens() and Array1()

ReDim Queens(1 To Upper_Of_rows, 1 To 3) 'but this will require doing some modifications to the code

Fill_queens_the_board

__________________________

And the code that runs the algorithm should look like this:

__________________________

If Objective_function = 0 Then

MsgBox "solution found after " & iterations & " iterations"

Exit Sub

End If

Do

iterations = iterations + 1

MoveMostAnnoyingQueen

Loop Until Objective_function = 0

ShowBoard 'if you have some visualization function

MsgBox "solution found after " & iterations & " iterations"

__________________________

_______________

Nayer Naguib

Very good fantastic. You are correct about the most annoying queen. if i move every queen random then i will have a dead end.

furthermore your objective function is more compact and efficient.

I think that you code could be describe as hill climbing because you try to find the best solution but you are right about this kind of problem . I will write the simulated annealing algorithm and post my code.

I will closed this question and open a new one with the same question to give more points

Programming

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Experts Exchange Solution brought to you by

Enjoy your complimentary solution view.

Get every solution instantly with premium.
Start your 7-day free trial.

I think one possible heuristic would be to move the queen having the largest number of conflicts to a square in the same column where the number of conflicts would be minimum. Eventually, you will reach a solution.

_______________

Nayer Naguib