1 / 0 / 0
Регистрация: 24.12.2011
Сообщений: 6
1

Перемещение фишки в поиске другой фишки

28.12.2011, 02:01. Показов 1405. Ответов 2
Метки нет (Все метки)

Здравствуйте !
Помогите, пожалуйста, решить задачу по перемещению фишки по полю 8 на 8.

На поле расположены 2 фишки. Первая фишка ищет на поле вторую. Ходить она может только буквой Г(как конь). На поле есть клетки, на которые наступать нельзя. Подскажите, пожалуйста, как написать код по поиску второй фишки и вывода количества ходов первой фишки. Вот код, который у меня пока есть. Думаю, что тут много пропущено:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
A=[1 1 1; 1 1 1; 1 1 1]
    A(1,2)=255'поле, на которое наступать нельзя
    A(3,1)=255
    A(1,1)=254
    A(2,1)=254
    A(2,2)=254' наступать можно
    A(2,3)=254
    A(3,2)=254
    A(1,3)=0'финишная клетка
    A(3,3)=253'начальная клетка
           Ni=0
           Nk=20
            For i=1 To 8
            For j=1 To 8
                    If A(i,j)=Ni Then
                    If A(i+2, j+1)=254 Then 
                    A(i+2, j+1)=Ni+1
                    ElseIf A(i+1, j+2)=254 Then
                    A(i+1, j+2)=Ni+1
                    ElseIf A(i-1, j-2)=254 Then
                    A(i-1, j-2)=Ni+1
                    ElseIf A(i-1, j-1)=254 Then
                    A(i-1, j-1)=Ni+1
                    ElseIf A(i-2, j+1)=254 Then 
                    A(i-2, j+1)=Ni+1
                    Else MsgBox Ni
            End If
        If Ni>Nk Then
        MsgBox ("Решения нет")
Заранее благодарю
__________________
Помощь в написании контрольных, курсовых и дипломных работ, диссертаций здесь
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
28.12.2011, 02:01
Ответы с готовыми решениями:

Игра: Выигрывает тот, кто снимает с игрового поля последние фишки
Нужно написать игру. В которой: Имеется игровое поле в виде горизонтальной полосы клеток...

Построить граф. Даны две плоские фишки каждая из которых имеет на одной стороне цифру 1, а на другой - цифру 2,
две плоские фишки, каждая из которых имеет на одной стороне цифру 1, а на другой - цифру 2,...

Фишки
Помогите решить задачу, пожалуйста. Файл с заданием во вложении. Добавлено через 1 час 1...

Фишки в Access
Подскажите можноли в access сделать так чтобы при открытии формы играла музыка? Заранее благодарен...

2
Эксперт WindowsАвтор FAQ
17842 / 7577 / 889
Регистрация: 25.12.2011
Сообщений: 11,316
Записей в блоге: 17
29.12.2011, 16:22 2
Код совсем сырой. И не соответствует всем условием топика. Хотя мне было бы очень интересно услышать описание окончательного принципа работы от автора.

После увиденного кода возникли вопросы:
1) "клетки, на которые наступать нельзя". По остальным ходить можно или они тоже строго определены?
2) Расположение фишек случайное?

Кажется понял суть, автор таким образом отмечал путь, чтобы повторно туда не возвращатся. Иначе перебор станет бесконечным циклом.

Добавлено через 46 минут
При чем каждый следующий шаг отмечался порядковым номером прямо на поле. Таким образом можно заполнить хоть все поле количеством минимальных шагов к каждой клетке, при этом с учетом запрещенных клеток. Возможно это и хотел сделать автор. Без этого кода я бы не додумался. Теперь можно модифицировать алгоритм перебора под эту задачу.

Добавлено через 13 часов 56 минут
Я не делал алгоритм полного перебора, так как полностью понял идею автора кода в топике. Метод дерева.

Извините делал на скорую руку - пока без трекинга и раскраски. Просто запустите и увидите.
Все цифры, которые >0 обозначают минимальное количество ходов к ним начиная с точки "0" (фишка № 1).

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Sub Fishka8ver2()
 
Dim base() As Variant
Dim col As Range
Dim xt As Integer, yt As Integer
Set rng = Range("A1:H8")
'ActiveSheet.UsedRange.Cells.Interior.ColorIndex = 0
 
With Application.WorksheetFunction
    If .CountIf(rng, 0) <> 1 Or .CountIf(rng, -2) <> 1 Then
        Cells(10, 1) = "Демонстрация"
        Cells(1, 1) = 0: Cells(1, 3) = -1
        Cells(2, 3) = -1: Cells(2, 4) = -1
        Cells(4, 4) = -1: Cells(5, 3) = -1
        Cells(8, 8) = -2: rng.HorizontalAlignment = xlCenter
        MsgBox "Фишка № 1 обозначается нулем '0'" & vbCr & "Фишка назначения № 2 обозначается '-2'" & vbCr & "Препятствия '-1'."
        Else: Cells(10, 1).Clear
    End If
End With
 
base = Application.Transpose(rng)
 
For Each col In rng
    If col.Value = 0 And CStr(col.Value) <> "" Then posX = col.Column: posY = col.Row
Next
 
a = 0 'Движение c клетки "0"
x = posX: y = posY
Do While a <> 20
    For y = 1 To 8
        For x = 1 To 8
            If base(x, y) = a And CStr(base(x, y)) <> "" Then
                For direct = 1 To 8
                    route x:=x, y:=y, xt:=xt, yt:=yt, direct:=direct
                    If xt >= 1 And xt <= 8 And yt >= 1 And yt <= 8 Then
                        If base(xt, yt) = -2 Then
                            MsgBox a + 1 & " шагов."
                            Exit Sub
                        End If
                        If (CStr(base(xt, yt)) = "" Or base(xt, yt) > a) And CStr(base(xt, yt)) <> "0" Then
                                base(xt, yt) = a + 1
                                Cells(yt, xt) = a + 1 'удалить?
                        End If
                    End If
                Next direct
            End If
        Next x
    Next y
    a = a + 1
Loop
MsgBox "Нет решения!"
End Sub
 
Private Sub route(ByVal x As Integer, ByVal y As Integer, ByRef xt As Integer, ByRef yt As Integer, ByVal direct As Integer)
Select Case direct 'направление хода конем
    Case 1
        xt = x + 1: yt = y - 2 'вверх2-направо
    Case 2
        xt = x + 2: yt = y - 1 'вверх-направо2
    Case 3
        xt = x + 2: yt = y + 1 'вниз-направо2
    Case 4
        xt = x + 1: yt = y + 2 'вниз2-направо
    Case 5
        xt = x - 1: yt = y + 2 'вниз2-налево
    Case 6
        xt = x - 2: yt = y + 1 'вниз-налево2
    Case 7
        xt = x - 2: yt = y - 1 'вверх-налево2
    Case 8
        xt = x - 1: yt = y - 2 'вверх2-налево
End Select
End Sub
0
Эксперт WindowsАвтор FAQ
17842 / 7577 / 889
Регистрация: 25.12.2011
Сообщений: 11,316
Записей в блоге: 17
31.12.2011, 19:33 3
Убрал лишний код.
Добавил задание размера поля, раскраску и обратный трекинг.
Код сильно не усложнял, но и не сокращал на подпрограммы, чтобы было проще к пониманию.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
Sub Fishka8ver2_1()
 
Dim base() As Variant
Dim col As Range
Dim xt As Integer, yt As Integer
 
Psize = CInt(InputBox("Введите размер поля: ", , 8))
 
Set rng = Range("A1", Cells(Psize, Psize).Address)
Range("A1:T20").Cells.Interior.ColorIndex = 0
 
With Application.WorksheetFunction
    If .CountIf(rng, 0) <> 1 Or .CountIf(rng, -2) <> 1 Then
        Cells(Psize + 2, 4) = "Демонстрация"
        Cells(1, 1) = 0: Cells(1, 3) = -1: Cells(2, 3) = -1: Cells(2, 4) = -1
        Cells(4, 4) = -1: Cells(5, 3) = -1: Cells(8, 8) = -2: rng.HorizontalAlignment = xlCenter
        MsgBox "Фишка № 1 обозначается нулем '0'" & vbCr & "Фишка назначения № 2 обозначается '-2'" & vbCr & "Препятствия '-1'.", , "Подсказка"
        Else: Range(Cells(Psize + 1, 4), "D100").Clear
    End If
End With
 
base = Application.Transpose(rng)
 
For Each col In rng
    If CStr(col.Value) = "0" Or CStr(col.Value) = "-2" Then col.Interior.ColorIndex = 4
    If CStr(col.Value) = "-1" Then col.Interior.ColorIndex = 3
Next
 
Do While noSteps = False
noSteps = True
    For y = 1 To Psize 'читаем все клетки
        For x = 1 To Psize
            If base(x, y) = a And CStr(base(x, y)) <> "" Then
                For direct = 1 To 8
                    route x:=x, y:=y, xt:=xt, yt:=yt, direct:=direct
                    If xt >= 1 And xt <= Psize And yt >= 1 And yt <= Psize Then 'пределы поля
                        If base(xt, yt) = -2 Then 'фишка № 2 надена
                            x = xt: y = yt 'обратный трекинг
                            For b = a To 1 Step -1
                                For direct2 = 1 To 8
                                    route x:=x, y:=y, xt:=xt, yt:=yt, direct:=direct2
                                        If xt >= 1 And xt <= Psize And yt >= 1 And yt <= Psize Then
                                            If base(xt, yt) = b Then
                                                Cells(yt, xt).Interior.ColorIndex = 8
                                                posX = xt: posY = yt 'записываем позицию ветки
                                            End If
                                        End If
                                Next direct2
                                x = posX: y = posY
                            Next b
                            MsgBox a + 1 & " шагов.": Exit Sub
                        End If
                        If (CStr(base(xt, yt)) = "" Or base(xt, yt) > a) And CStr(base(xt, yt)) <> "0" Then
                                base(xt, yt) = a + 1 'свободное поле найдено
                                Cells(yt, xt) = a + 1: noSteps = False
                        End If
                    End If
                Next direct
            End If
        Next x
    Next y
    a = a + 1
Loop
MsgBox "Нет решения! Вероятно слишком много запрещенных полей."
End Sub
 
Private Sub route(ByVal x As Integer, ByVal y As Integer, ByRef xt As Integer, ByRef yt As Integer, ByVal direct As Integer)
Select Case direct '8 направлений хода конем (порядок - по часовой стрелке)
    Case 1
        xt = x + 1: yt = y - 2 'вверх2-направо
    Case 2
        xt = x + 2: yt = y - 1 'вверх-направо2
    Case 3
        xt = x + 2: yt = y + 1 'вниз-направо2
    Case 4
        xt = x + 1: yt = y + 2 'вниз2-направо
    Case 5
        xt = x - 1: yt = y + 2 'вниз2-налево
    Case 6
        xt = x - 2: yt = y + 1 'вниз-налево2
    Case 7
        xt = x - 2: yt = y - 1 'вверх-налево2
    Case 8
        xt = x - 1: yt = y - 2 'вверх2-налево
End Select
End Sub
 
Sub Стереть_шаги()
Dim col As Range
For Each col In Range("A1:T20")
    If col.Value > 0 Then col.Clear
Next
End Sub
И небольшое пояснение алгоритма:
Ставим коня на позицию № 1.
Заполняем цифрой 1 все ближайшие клетки, на которые он может попасть.
Затем тоже самое делаем со всеми клетками с цифрой 1, потом 2 ...
При этом, если в клетке уже стоит цифра, ее трогать нельзя.
В конце концов добираемся до позиции фишки №2.
Когда делается такой перебор без спец. переменных по записи пути, пришлось делать
обратный трекинг: после построения дерева конь становится на позицию фишки № 2
и в обратном порядке ищет все номерки своих ходов, закрашивая их цветом.
Если заполнены все возможные клетки на доске, но до фишки № 2 не добрались - решения нет.
Вложения
Тип файла: xls fishka8ver2_1.xls (46.5 Кб, 21 просмотров)
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
31.12.2011, 19:33
Помогаю со студенческими работами здесь

Полезные фишки
Здравствуйте! Раньше всегда отмахивался от информации которая мне не нужна но могла бы пригодится...

Игра Фишки
ФИШКИ

путь фишки
фишка может двигаться по полю длины N только вперед. длина хода фишки не более К. найти число...

Освобождение памяти и фишки VS
1) Откуда delete знает, сколько элементов в массиве, ведь обычный sizeof(a), где a - (допустим)...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
3
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2022, CyberForum.ru