игра "пятнашки" !!!

[ark]

Что-то там кода слишком много

Ага, я Пастернака не читал, но осуждаю..Не думаю, что с контролами будет намного меньшею

Эта комбинация не имеет решения

Раскомментируй Debug.Print в colCells Public Sub Shuffle - получишь последовательность перемешивания. Обратным ходом получишь решение.

[burik]

Эта комбинация действительно нерешаемая (я говорю не потому, что не смог решить, а потому что есть конкретная формула, позволяющая проверить решаемость). Но проблема не в перемешивании. Проблема в том, что ты не отрисовываешь первый элемент (а не пятнадцатый).

Код: Выделить всё

   For Each gc In game
       If gc.index <> 0 Then PrintCell gc
   Next

Т.е. в твоей реализации решением является такая комбинация, где первая клетка пуста.

[ark]

Т.е. в твоей реализации решением является такая комбинация, где первая клетка пуста

Ну да. А должна быть последняя? Так правится легко: индексы присваиваются не 0-rows*cols-1 а 1-rows*cols, соответственно всюду 0 меняется на rows*cols

game.zip

(5.04 Кб) Скачиваний: 91

[Qwertiy]

Не думаю, что с контролами будет намного меньше

Не в контролах дело, его просто много...

Пятнашки.7z

Вот :)

(8.67 Кб) Скачиваний: 96

UPDATE (+20 min)

Пятнашки 2.7z

Пофиксил баг с перетаскиванием

(8.66 Кб) Скачиваний: 99

[ark]

Не в контролах дело

Значит, на контролах свет клином не сошелся? Уже радует

его просто много

Задача минимизировать код не стояла. Если заменить длинные имена переменных на M, N, X, Y, убрать классы, с которыми удобнее работать, API, пожертвовать понятностью кода ради краткости, перерисовывать ВСЮ картинку по клику - то можно и меньше сделать.
В принципе, по размеру кода примеры сравнимы. Вот, перенес код класса на форму:

game.zip

(4 Кб) Скачиваний: 92

Пардон, воспользовался курсорами без ссылки на CopyRight Код читабельней не стал, размер сократился.

[Qwertiy]

Задача минимизировать код не стояла.

У меня тоже.

Если заменить длинные имена переменных на M, N, X, Y

И не в именах переменных дело.

убрать классы, с которыми удобнее работать, API

Чем они удобнее? Создать класс для игры - да можно, и даже правильнее будет. Но в моём коде это элементарно вынести в класс.

перерисовывать ВСЮ картинку по клику

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

пожертвовать понятностью кода ради краткости

0. Я бы не сказал, что твой код очень понятный.
1. Эффективность. Ты делаешь очень мало перемещений при перемешивании, игра заканчивается через несколько ходов. А если поставить то же число, какое используется у меня, то запуск твоей программы занимает около 5 секунд, а моя запускается мгновенно.
2. Если следовать логике разделения интерфейса и логики, то класс фишки не должен содержать её координат.
3. У меня реализована возможность перетаскивать фишку, у тебя - нет. У меня обрабатывается только действие, аналогичное по сути клику по фишке, у тебя - любой MouseUp. У меня размер шрифта меняется при изменении размера окна, у тебя - нет. У меня можно начать новую игру, у тебя - нет. У меня любой ход выполняется за O(1), если не рассматривать перерисовку формы, а у тебя - поиск пустой ячейки O(n*m) и проверка на победу O(n*m). Единственная неожиданность в твоей программе - то, что если мышь не убиралась с клетки после хода, то кликом можно отменить последний ход. Хотя я и не вижу кода, который это делает, оно работает, но не обновляет курсор...

[ark]

Ты рисуешь линии вокруг фишек, а я - фишки целиком

Не понял, а что мешает перерисовать только 2 (две) фишки - которые местами меняются? Остальные же не меняются.

0. Я бы не сказал, что твой код очень понятный

Согласен - на любителя. Мне мой привычнее. Всегда стараюсь избежать кучи IF'ов, через которые потом, когда идея забыта, трудно продираться. Для этого, даже в разовых случаях использую функции типа Min, Max, GetRandom и т.п.

Эффективность. Ты делаешь очень мало перемещений при перемешивании ... если поставить то же число, какое используется у меня,

Простая проверка даёт - из 64К пермещений примерно 24К - за пределы площадки (не проходят If NewX >= 0 And NewX < N And NewY >= 0 And NewY < M Then), 18К - сами в себя (Index(X, Y) = Index(NewX, NewY)) и ещё 4К*2 - "обратные" (т.е. когда пустая ячейка сдвигается, например, вверх, а следующим ходом вниз, что "перемешивания" не даёт - *2 потому что 2 хода лишних). Итого "полезных" перемещеий 14К. У меня "бесполезные" варианты проверяются в SwapCells. По части медленности моего перемешивания - мой косяк, причина - вызов PrintCell из SwapCell при перемешивании, когда отрисовка не нужна. Фиксится в SwapCell:

Код: Выделить всё

   If Me.Visible Then
      PrintCell emptyCell
      PrintCell curCell
   End If


Тогда скорость загрузки сравнима.
2. Discussible. В общем случае - да. В случае квадратных ячеек - координаты меняются только при ресайзе, можно и хранить, чтоб потом не пересчитывать при кликах

У меня реализована возможность перетаскивать фишку, у тебя - нет. У меня обрабатывается только действие, аналогичное по сути клику по фишке, у тебя - любой MouseUp.

Дело в том, что в эту игру я никогда не играл, поэтому специально сделал эту фичу (пардон, если не по правилам) - можно нажать на фишке, передумать и отпустить на другой. Если другая может двигаться - двинется, если нет - ничего не произойдет. В этом случае перетаскивание противоречит этой логике.

У меня размер шрифта меняется при изменении размера окна, у тебя - нет. У меня можно начать новую игру, у тебя - нет

А ещё - у меня форма называется Form1, а у тебя - "Пятнашки"!

У меня любой ход выполняется за O(1)

- ну, во-первых, как минимум за О(4) For Q=0 To 3 - это только в MouseUp. А во-вторых, эффективность часто зависит не от количества, а от "толщины" О.

у тебя - поиск пустой ячейки O(n*m)

- это в первом варианте, я класс перегрузил, по привычке, "на будущее", чтоб было. Во втором варианте этого нет.

проверка на победу O(n*m)

Это максимум, когда все ячейки на месте, иначе выскочит на первой несоответсвующей ( к тому же, в цикле всего одна проверка). Не думаю, что 4 вложенных IF'а с расчетами ItemsLeft +/- 1 намного быстрее.

Единственная неожиданность в твоей программе

это баг. Курсор (и текущая ячейка) меняются по MouseMove над другой ячейку, поэтому SwapCells таки свапает назад, а курсор остаётся.

[Qwertiy]

Не понял, а что мешает перерисовать только 2 (две) фишки - которые местами меняются? Остальные же не меняются.

Я же объяснял. Закрашенные фишки пересекаются на один пиксель. Если рисовать только две фишки, то они будут на пиксель крупнее остальных, что заметно. Вариантов 2 - либо перерисовывать строку + столбец для обеих фишек, либо ставить попиксельный ScaleMode и вычислять координаты самому. Мне было лень это делать, т. к. Form_Paint выполняется мгновенно и форма не мерцает, в отличие от вызова Me.Refresh().

Простая проверка даёт - из 64К пермещений примерно 24К - за пределы площадки (не проходят If NewX >= 0 And NewX < N And NewY >= 0 And NewY < M Then), 18К - сами в себя (Index(X, Y) = Index(NewX, NewY)) и ещё 4К*2 - "обратные" (т.е. когда пустая ячейка сдвигается, например, вверх, а следующим ходом вниз, что "перемешивания" не даёт - *2 потому что 2 хода лишних). Итого "полезных" перемещеий 14К.

Бред.
1. Из 64К пермещений примерно 24К - за пределы площадки. Пусть пустая клетка равновероятно находится на поле. Там 4 угловые клетки, (n-2)*(m-2) боковые. Для боковых клеток вероятность выйти за пределы поля 1/3, для угловых 2/3, для всех остальных 0. Получаем вероятность выхода за границы поля ((n-2)*(m-2)*1/3+4*2/3) / (n*m). Для поля 4*4 это (2*2/3+4*2/3)/16 = 4/14 = 1/4. Т. о. Только 16К. Хотя, рассчёты не слишком точные. Расскажи, как ты получил 24К.
2. 18К - сами в себя (Index(X, Y) = Index(NewX, NewY)). Ход "в себя" вообще невозможен.
3. Ещё 4К*2 - "обратные" (т.е. когда пустая ячейка сдвигается, например, вверх, а следующим ходом вниз). Мой код исключает такую возможность... Кроме одного случая - когда между ними находится невыполнимый ход.

Дело в том, что в эту игру я никогда не играл, поэтому специально сделал эту фичу (пардон, если не по правилам) - можно нажать на фишке, передумать и отпустить на другой. Если другая может двигаться - двинется, если нет - ничего не произойдет. В этом случае перетаскивание противоречит этой логике.

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

ну, во-первых, как минимум за О(4) For Q=0 To 3 - это только в MouseUp. А во-вторых, эффективность часто зависит не от количества, а от "толщины" О.

1. O(1) = O(4) = O(100) = ... Учи матанализ
2. Эффективность в первую очерезь зависит от ассимптотики, затем от константы. Что будет, если сделать поле 100*100, например? У меня - ничего не изменится, т. к. количество выполняемых действий - константа, а количество действий при перерисовке это O(площадь_формы_в_пискелях). А у тебя будут два вложенных цикла до 100 при каждом ходе.
3. Твоя константа даже на 4*4 не будет меньше моей, т. к. если первая строка уже расставлена, то ты эти же 4 действия гарантированно выполнишь.

это баг. Курсор (и текущая ячейка) меняются по MouseMove над другой ячейку, поэтому SwapCells таки свапает назад, а курсор остаётся.

Многие удобные фишки вначале бывают багами, ark

[Qwertiy]

Итого "полезных" перемещеий 14К.

Добавил счётчик выполненных перемещений: 41584, 41298, 41824, 41851.

Мой код исключает такую возможность... Кроме одного случая - когда между ними находится невыполнимый ход.

Пофиксил:

Код: Выделить всё

    Dim Q As Long, X As Integer, Y As Integer, NewX As Integer, NewY, D As Integer, NoD As Integer
    'Dim Steps As Long
   
    X = N - 1
    Y = M - 1
    NoD = 1
    Randomize Timer()
   
    For Q = 1 To Moves
      D = Int(Rnd() * 3)
      If D >= NoD Then D = D + 1
      NewX = X + DX(D)
      NewY = Y + DY(D)
      If NewX >= 0 And NewX < N And NewY >= 0 And NewY < M Then
        'Steps = Steps + 1
        Index(X, Y) = Index(NewX, NewY)
        X = NewX
        Y = NewY
        NoD = 4 - D
      End If
    Next Q
   
    Index(X, Y) = NM
    'MsgBox Steps
   
    For X = 0 To N - 1
      For Y = 0 To M - 1
        If X * M + Y <> Index(X, Y) Then ItemsLeft = ItemsLeft + 1
      Next Y
    Next X
   
    Form_Paint

4 вложенных IF'а

Первый проверяет, что если игра уже закончилась, то ничего делать не надо. Его можно сделать не вложенным, поставив противоположное условие и Exit Sub. Второй и третий должны быть одним - я не виноват, что в VB6 нет логического И.

[ark]

Что будет, если сделать поле 100*100, например

Сделал. Оба примера с таймингом в аттаче (заметь - в твоем коде я из MouseUp для тайминга Form_Paint убрал). Там же проверка на "лишние ходы" - без последнего фикса.

Game_Timing.zip

(8.59 Кб) Скачиваний: 99

[Qwertiy]

проверка на "лишние ходы" - без последнего фикса

Ты набажил (как минимум) тут: Index(X, Y) = Index(NewX, NewY). (X, Y) задаёт текущую пустую клетку, но значение Index(X,Y) не обновляется в цикле, поэтому эта штука считает количество обратных ходов.
Сейчас под рукой VB6 нету, вечером посмотрю и скажу подробнее. И результаты ты не привёл.

заметь - в твоем коде я из MouseUp для тайминга Form_Paint убрал

Тайминг я пока вижу только в Form_Load из которого вообще не вызывается Mouse_Up, в котором ты закомментировал перерисовку
К тому же, твои If'ы жрут время сравнимое (если не большее) со временем выполнения моего кода

[ark]

Тайминг я пока вижу только в Form_Load

Ты в Immediate window смотрел? Или не дождался загрузки своей формы? Тайминг в Form_Load, Form_Resize (там как раз начальная отрисовка) и после начального ресайза 10К кликов (имеется в виду MouseMove/Down/Up).

form_load = 203
form_resize = 889
clicks*10000 = 327

==============================
За площадкой Равны Обратные
16003 18414 4918
==============================
'Убрал все свои IF'ы - не помогло
form_load = 1076
form_resize = 3260
clicks*10000 = 281

Ты набажил (как минимум) тут:

Домашнее задание: перед своей строкой Index(X, Y) = Index(NewX, NewY) помещаешь:

Код: Выделить всё

If Index(X, Y) = Index(NewX, NewY) Then
   Debug.Print "Нафига присваивать, если они и так равны???"
End If

И читаешь все 18К строк.
Насчет "обратных" ходов, если тебя хоть как-то можно убедить, поставь Moves = 2 и с вероятностью 33% получишь окошко WIN (т.е. первым ходом пустая клетка двинулась влево (или вверх) а потом назад - ура, победа!)

[Qwertiy]

Ты в Immediate window смотрел?

Я же тебе написал, что нету VB6, как ты предлягаешь без него куда-то смотреть?
Сегодня утром смотрел. В твоём коде баги. Поле 4*4 и 128 перемешиваний, стрелками отмечены места, где ты увеличиваешь счётчик обратных ходов:

Код: Выделить всё

2             3
3             3
3             2
2             2
1             2
0             2
0             3
<---
1             3
2             3
1             3
1             2
<---
0             2
0             3
0             2
0             1
0             2
0             1
0             0
0             1
0             0
0             1
0             0
0             1
0             0
0             1
1             1
2             1
1             1
1             0
<---
0             0
0             1
0             0
0             1
<---
1             1
0             1
0             0
0             1
1             1
0             1
0             2
0             3
0             2
0             3
0             2
0             1
0             0
0             1
1             1
1             2
1             1
1             2
1             1
1             2
<---
0             2
0             3
<---
1             3
2             3
2             2
2             1
2             0
2             1
2             0
1             0
1             1
2             1
3             1
3             2
<---
2             2
1             2
1             1
1             0
1             1
0             1
0             0
0             1
0             0
0             1
0             0
0             1
1             1
За площадкой  Равны         Обратные
48            34            7

За площадкой Равны Обратные
16003 18414 4918

Правильные числа (если убрать твою блокировку ходов) около: 16К 0 3К.

[burik]

Тут прям такой челендж развернулся, может мне тоже свою версию написать и будем уже втроем спорить кто круче?

[burik]

Прям захотелось написать . Вот реализация без перемешиваний. Поле изначально заполняется рандомными значениями из списка.

[ark]

В твоём коде баги

Действительно, недосмотрел, банальная очепятка, NewY вместо NewX при проверке. Исправил. Счётчик обратных ходов увеличился в 3 раза. Вот исправленная процедура для Form_Click:
'4х4, Moves=128, проверка Index(X,Y)==Index(NewX,NewY) отключена
Строка Столбец Направление
3 3 Влево
3 2 Вверх
2 2 Вверх
1 2 Влево
1 1 Вниз
2 1 Вправо
2 2 Влево <--- Обратный
2 1 Вниз
3 1 Вверх <--- Обратный
2 1 Вверх
1 1 Влево
1 0 Вниз
2 0 Вверх <--- Обратный
1 0 Вниз
2 0 Вверх <--- Обратный
1 0 Вверх
0 0 Вниз <--- Обратный
1 0 Вправо
.................
За площ Равны Обратн
40 0 32
'4x4, Moves=64K, проверка Index(X,Y)==Index(NewX,NewY) отключена, Debug.Print на обратные хода, естественно, тоже
За площадкой Равны Обратные
23663 0 13175

Пятнашки_Form1.zip

(2.44 Кб) Скачиваний: 97

PS. Ещё один прокол в DoClicks - не заметил, что формы отмасштабирована, потому кликал по твипам, исправил на клик по 0 - N-1, 0 - M-1. Все исправления в аттаче Код с поста убрал - он с комментами там же.

[Qwertiy]

Пятнашки_Form1.zip

Этот файл ничем не отличается от предыдущего...

[ark]

Sorry, не тот файл прицепил. Исправил.

[Qwertiy]

Моя очередь исправлять баги. Надо NoD = 4 - D заменить на NoD = 3 - D

Получаются примерно такие результаты:

Код: Выделить всё

За площадкой  Равны         Обратные
1270          311           275

При

Код: Выделить всё

Const N As Long = 100, M As Long = 100, NM As Long = N * M - 1, Moves As Long = 65536

и

Код: Выделить всё

count2 = count2 - (Index(X, Y) = Index(NewX, NewY))

Обращаю внимание, что Count2 и Count3 почему-то не равны, что мне кажется странным... Надо подумать.

[burik]

Вот черт, видимо, без перемешиваний в competition не принимают..

[Mikle]

И я свой вариант решил написать, где-то полчаса потратил, может чуть больше.
Кто компактнее сделает, не в ущерб наглядности кода?

[Qwertiy]

И я свой вариант решил написать, где-то полчаса потратил, может чуть больше.

Из минусов:
1. Намертво захардкожен размер поля 4*4
2. Невозможно не совершать ход (действие по MouseDown совершается до отпускания мыши).
3. Форма не ресайзится.

С кодом не разобрался (он точно наглядный? ), но подозрительно, что функция MoveBrick принимает число от 0 до 16.

[ark]

Хм...
Может я от жизни отстал... Перерисовывать всю поляну при изменении только двух клеток - это модный тренд?
За биты вместо IF'ов и For'ов +1
По компактности - надо функциональность сперва оговаривать (размер поля, ресайз, курсор по MouseMove, тень под цифрой и т.п.)

без перемешиваний в competition не принимают

Дело в том, что без перемешиваний возможна нерешаемая комбинация.

[Mikle]

Невозможно не совершать ход (действие по MouseDown совершается до отпускания мыши).

Это осознанный выбор. Я пробовал и так, и так, мне, как игроку, приятнее, когда ход совершается быстрее, тем более, что отменить сделанный ход совсем не сложно. В DOOM-е ракетница тоже стреляет на MouseDown .

подозрительно, что функция MoveBrick принимает число от 0 до 16.

Ты про то, что Int(Rnd * 16) может получиться равным 16-ти? Не может.

Намертво захардкожен размер поля 4*4

Это классическая игра "15", не вижу смысла что-то менять, всё равно геймплей не меняется, а только удлинняется, это не кубик Рубика, где от добавления размера меняется стратегия.

Форма не ресайзится.

В сапёре тоже, хотя там клетки мельче, возможно там это бы и пригодилось. А в пасьясе "Косынка" ресайзится так, что уж лучше бы не ресайзилось (посмотрите на большом мониторе).

Перерисовывать всю поляну при изменении только двух клеток - это модный тренд?

Так код проще и нагляднее, всё равно ты не найдёшь компьютера, где глаз бы успел заметить перерисовку.
Ещё у меня делается 1024 ПОПЫТОК перемешать кубики, из них удачных - меньше четверти, зачем что-то менять, если всё равно это происходит мгновенно?

По компактности - надо функциональность сперва оговаривать (размер поля, ресайз, курсор по MouseMove, тень под цифрой и т.п.)

Я не устраиваю соревнований с жёсткими рамками, просто демонстрация простоты исполнения, какая, на мой взгляд, и требуется для подобных игр.
А тени - это маленькое украшательство, для демонстрации кода они излишни, но если делать ИГРУ, то украшать, конечно, нужно больше.

[ark]

демонстрация простоты исполнения

15_2355.zip

(1.07 Кб) Скачиваний: 104

1. Нету лишних ходов при перемешивании
2. Перерисовываются только 2 ячейки

[Mikle]

Мои 1024 перемешивания дают тоже около 200 "попаданий", но моё перемешивание занимает около 200 мс, а твоё около 950. Или 400 мс на 980, если не компилировать.
Слишком много операторов в одной строке, жертвуешь форматированием.

[ark]

твоё около 950

мс - это милли? У меня 20 000 перемешиваний занимает 140 миллисекунд (через GetTickCount). Но ты прав - твоё априори должно быть быстрее - издержки коллекции.

Слишком много операторов в одной строке, жертвуешь форматированием.

То же, что с коллекцией - чем-то надо жертвовать для краткости

[Mikle]

мс - это милли?

"Микросекунд", мерял с помощью QueryPerformanceCounter.
burik, понравилось это:

Код: Выделить всё

    pbGame.Scale (0, 0)-(4, 4)

Так, действительно, проще. Я, почему-то, сразу не допёр так сделать.
Не понравилось отсутствие Option Explicit. Да и вообще, код "тяжеловат".

[ark]

Так, действительно, проще

А тени как отрисовывать будешь?

[Qwertiy]

ark, ты про меня не забыл?

Моя очередь исправлять баги. Надо NoD = 4 - D заменить на NoD = 3 - D

Нало будет ещё другой фикс применить, тогда вообще 0 обратных получится (только в нём тоже должно быть 3-D, а не 4-D). И безо всяких коллекций.

Ты про то, что Int(Rnd * 16) может получиться равным 16-ти? Не может.

Нет. Я про то, что есть 16 возможных значений, тогда как возможных направлений только 4.

Ещё у меня делается 1024 ПОПЫТОК перемешать кубики, из них удачных - меньше четверти, зачем что-то менять, если всё равно это происходит мгновенно?

Как-то маловато успешных. У меня даже с багом намного больше.

burik, понравилось это:

Код: Выделить всё

    pbGame.Scale (0, 0)-(4, 4)

Так у меня тоже Scale используется... С другой стороны, если всё считать в пикселях, то можно точно определять границы, благодаря чему не будет пересечения фишек и станет можно перерисовывать две, а не все.