Artificial Intelligence - هوش مصنوعی

تقریبا یک سال از ارسال این سوال از طرف شما میگذره ولی من این موضوع رو تازه دیدم. (انقدر که تو انجمن فعالم:65:)

خب اگه از بحث تعداد وزیر ها بخواهیم بگذریم کار خیلی سخت نیست. اول یه ماکرو در اکسل ایجاد می کنیم. بعد از طریق vba محتوای کد های داخل اون ماکرو رو با کد های زیر به طور کامل عوض می کنیم. بعد هم ماکرو رو اجرا می کنیم. فقط در مورد تعداد وزیر ها اینو بگم که ما یه تعدادی عدد هشت و نه تو برنامه داریم حالا اگه این تعداد رو تغییر بدیم اون وقت می تونیم تعداد وزیر ها رو بیشتر یا کمتر هم بکنیم. و باید به ازای اون تعداد تعداد ستون ها رو هم عوض کنیم. مثلا A:H رو به A:Q برای 17 تا وزیر تغییر بدیم. ماکرو بجای وزیر ها از علامت ستاره استفاده می کنه.

كد:

Sub Eight_Queens()

    Dim Conflict As Boolean

    Dim i As Integer

    Dim j As Integer

    Dim k As Integer

    

    Dim x(1 To 8) As Integer

    For i = 1 To 8

        x(i) = 0

    Next

    

    i = 1

    While (i < 9)

        For j = x(i) + 1 To 8

            Conflict = False

            ' check for collision

            If i <> 1 Then

                ' horizental

                For k = 1 To i - 1

                    If x(k) = j Then

                        Conflict = True

                        Exit For

                    End If

                Next

                ' diagonal

                ' 1-up left

                i_copy = i

                j_copy = j

                Do While (i_copy > 1 And j_copy > 1 And Not Conflict)

                    i_copy = i_copy - 1

                    j_copy = j_copy - 1

                    If x(i_copy) = j_copy Then

                        Conflict = True

                    End If

                Loop

                

                ' 2-down left

                i_copy = i

                j_copy = j

                Do While (i_copy > 1 And j_copy < 9 And Not Conflict)

                    i_copy = i_copy - 1

                    j_copy = j_copy + 1

                    If x(i_copy) = j_copy Then

                        Conflict = True

                    End If

                Loop

            End If

            

            If Not Conflict Then

                x(i) = j

                Exit For

            End If

        Next

        If Conflict Then ' no position for current column then reset and return to previuse

            x(i) = 0

            i = i - 1

        Else ' if last queen set goto next queen

            i = i + 1

        End If

    Wend

    

    ' show resault

    For i = 1 To 8

        Range("A1").Select

        ActiveCell.Offset(x(i) - 1, i - 1).Select

        ActiveCell.FormulaR1C1 = "*"

    Next

    Columns("A:H").Select

    Columns("A:H").EntireColumn.AutoFit

    Rows("1:8").Select

    Rows("1:8").EntireRow.AutoFit

    Range("A1").Select

End Sub