Страницы: 1
RSS
Решение математических буквенно-числовых ребусов в Excel, криптоарифметическая задача
 
Доброго здоровья всем!
Помогите пожалуйста решить детскую задачку по математике с помощью Эксель.
Когда-то  в школе в виде дополнительного задания на дом дали следующую задачу:
УДАР+УДАР =ДРАКА.
Надо вместо букв подставить цифры, чтобы выражение было верно. (Одна буква=одна цифра). Да и на олимпиадах такие задачи были в средних классах. Первый раз я её долго делал (типа перебором). Позже понял, что такие задачи решаются за несколько минут путем логических рассуждений. Наверно, чтобы  решить её при помощи Эксель надо гораздо больше времени (Мне так кажется). Как это сделать при помощи формул вообще не представляю (в формулах не силен). Макросом можно попробовать, но никогда такие задачи не решал. Обычно берем данные с листа, что-то делаем с ними и выгружаем на лист. Очень хотелось бы посмотреть, как это сделать в Эксель.
Заранее благодарен за предложенные варианты (Формула или макрос без использования всяких надстроек)

P.S. Для разнообразия и проверки универсальности решения КИС+КСИ=ИСК
Изменено: Евгений Смирнов - 15.01.2022 15:30:03 (Исправил ошибку в последней строке)
 
Можно решить через "Поиск решения", но считает не очень быстро: 8126 + 8126 = 16252
Удар.xlsx (11.41 КБ)

Цитата
Евгений Смирнов написал: КИС+КСИ=ИКС
Скорее всего записано с ошибкой, т.к. С+И=С, только при И=0, но ноль не может стоять в ИКС первым разрядом
 
ИСК
 
MCH Да последнее выражение с ошибкой =ИСК ( Ну более 40 лет прошло подзабыл к сожалению не всё помню со школы)
Ваш файл глянул но пока не понял сейчас некогда разбираться. В принципе наверно лучше это как-то кодом сделать чем поиском решения в принципе комп и методом подбора может сделать. Главное правильно условия проверки прописать
 
"Поиск решения" долго считает и не всегда находит решение, можно сделать полный перебор на VBA
 
MCH Ну я вот пока не представляю как полный перебор в VBA сделать
Изменено: Евгений Смирнов - 15.01.2022 11:30:24
 
Решение математических буквенно-числовых ребусов в Excel.
(Криптоарифметическая задача)
Код
Для удара (каникулярная задача) можно так (2Удара=Драка):
=ИНДЕКС(СТРОКА(1000:9999);
ПОИСКПОЗ(ИСТИНА;2*СТРОКА(1000:9999)=--(ПСТР(СТРОКА(1000:9999);2;1)&ПСТР(СТРОКА(1000:9999);4;1)&
ПСТР(СТРОКА(1000:9999);3;1)&A10&ПСТР(СТРОКА(1000:9999);3;1));0))

для 3 буквенных так же формирование 3-ех вспомогательных массивов, но тут попроще буквы все повторяются:
КИС: =СТРОКА(100:999)
КСИ: =ПСТР(СТРОКА(100:999);1;1)&ПСТР(СТРОКА(100:999);3;1)&ПСТР(СТРОКА(100:999);2;1)
ИСК: =ПСТР(СТРОКА(100:999);2;1)&ПСТР(СТРОКА(100:999);3;1)&ПСТР(СТРОКА(100:999);1;1)
в 3-ем ищем сумму первых 2-ух: =СТРОКА(100:999)--(ПСТР(СТРОКА(100:999);1;1)&ПСТР(СТРОКА(100:999);3;1)&ПСТР(СТРОКА(100:999);2;1))
Изменено: Тимофеев - 15.01.2022 14:10:47
 
Тимофеев классно. Я даже предположить не мог, что кто-то напишет формулу, ждал решение макросом. Теперь мне с ней месяц разбираться.

P.S. Не скучайте через месяц вернусь. Пошел разбираться с формулой
Изменено: Евгений Смирнов - 15.01.2022 14:18:01
 
Мне не очень нравится вариант провеки исползуемый в №7 но всеж модифицируем чтоб небыло доп столбцов  и ячеек.
=SUM(IFERROR(MMULT(ROW(1000:9999)*(2*ROW(1000:9999)=--(MID(ROW(1000:9999);2;1)&MID(ROW(1000:9999);4;1)&MID(ROW(1000:9999);3;1)&COLUMN(A:J)-1&MID(ROW(1000:9999);3;1)));ROW(1:10)^0);))
Изменено: БМВ - 15.01.2022 16:06:26
По вопросам из тем форума, личку не читаю.
 
Прошу прощения, но вчера не все сообщения посмотрел внимательно (Времени не было). Сегодня исправляюсь.
Тимофеев Вы просто умница и формулу написали и с карандашом можете решить Браво!!!.  В способностях БМВ я уже давно не сомневаюсь. Обе формулы рабочие. Использование подбора параметра для решения наверно можно, но скорее всего надо еще какие формулы добавлять. Только целевая формула это мало. Раз формулы от Тимофеева и БМВ практически мгновенно выдают результат, то и другие методы при правильном наборе входных параметров и условий должны сразу давать результат.
Еще раз благодарю всех кто откликнулся и потратил своё драгоценное время на эту тему.
 
Решение на VBA под конкретную задачу:
Код
Sub main()
    Dim u, d, a, r, k
    For u = 5 To 9
        d = 1
        For r = 2 To 9
            If r <> u Then
                a = r * 2 Mod 10
                If a <> u And a <> r Then
                    For Each k In Array(0, 2, 3, 4, 5, 6, 7, 8, 9)
                        If k <> u And k <> a And k <> r Then
                            If (u * 1000 + d * 100 + a * 10 + r) * 2 = d * 10000 + r * 1000 + a * 100 + k * 10 + a Then
                                MsgBox u & d & a & r & " + " & u & d & a & r & " = " & d & r & a & k & a
                                Exit Sub
                            End If
                        End If
                    Next k
                End If
            End If
        Next r
    Next u
End Sub


Для общей задачи можно перебрать все размещения из 10 по 5 и прорешать каждый вариант, количество вариантов не очень большое (10!/5 ! = 30240)
 
MCH Здравствуйте. Вы видимо настойчивый все-таки написали макрос, не пожалели время. Мне проще с макросом, с ним точно разберусь. По формулам не тяну до БМВ и Тимофеева.
Спасибо огромное за помощь и мое сэкономленное время.

PS С кодом разобрался быстро. В принципе несложно. Просто никогда не видел такого. Там только небольшой недочет. Присвоение значения переменной d надо сразу писать после объявления переменных (зачем 5 раз гонять в цикле)
Изменено: Евгений Смирнов - 16.01.2022 14:55:14
 
Упрощённая формула массива (не универсальная):
Код
=МАКС(СТРОКА(5000:9999)*(ПСТР(СТРОКА(5000:9999)*2;5;1)=ПСТР(СТРОКА(5000:9999);3;1))*(ПСТР(СТРОКА(5000:9999)*2;3;1)=ПСТР(СТРОКА(5000:9999);3;1))*(ПСТР(СТРОКА(5000:9999)*2;2;1)=ПСТР(СТРОКА(5000:9999);4;1))*(ПСТР(СТРОКА(5000:9999)*2;1;1)=ПСТР(СТРОКА(5000:9999);2;1)))
 
Универсальный способ, подходящий для любого подобного ребуса
АТАКА + УДАР + УДАР = НОКАУТ
93989 + 7492 + 7492 = 108973

Перебираем все размещения из 10 по 8, проверяем на правильность отдельной функцией (здесь как раз можно настроить любую проверку, под любой ребус)
если есть решение - выводим результат
С поиском решения справляется за пару секунд

Код
'АТАКА + УДАР + УДАР = НОКАУТ

Sub mainSet()
    Dim n As Long, m As Long, i As Long, txt As String, a() As Long

    n = 10
    m = 8
    ReDim a(1 To m) As Long
    For i = 1 To m: a(i) = i: Next i
    Do
        txt = CheckWords(a(1) - 1, a(2) - 1, a(3) - 1, a(4) - 1, a(5) - 1, a(6) - 1, a(7) - 1, a(8) - 1)
        If txt <> "" Then
            Debug.Print txt
            MsgBox txt
            Exit Do
        End If
    Loop While NextSet(a(), n, m)
End Sub

Function CheckWords(a As Long, t As Long, k As Long, u As Long, d As Long, r As Long, n As Long, o As Long) As String
    If a = 0 Or u = 0 Or n = 0 Then Exit Function
    If a * 10101 + t * 1000 + k * 10 + (u * 1000 + d * 100 + a * 10 + r) * 2 = _
        n * 100000 + o * 10000 + k * 1000 + a * 100 + u * 10 + t Then _
        CheckWords = a & t & a & k & a & " + " & u & d & a & r & " + " & u & d & a & r & " = " & n & o & k & a & u & t
End Function

Function NextPerm(a() As Long, n As Long) As Boolean  'следующая перестановка в лексикографическом порядке
    Dim i As Long, k As Long, t As Long, tmp As Long
    For k = n - 1 To 1 Step -1
        If a(k) < a(k + 1) Then Exit For
    Next k
    If k Then
        For i = n To k + 1 Step -1
            If a(k) < a(i) Then tmp = a(k): a(k) = a(i): a(i) = tmp: Exit For
        Next i
        NextPerm = True
    End If
    t = n
    For i = k + 1 To (n + k) \ 2
        tmp = a(i): a(i) = a(t): a(t) = tmp
        t = t - 1
    Next i
End Function

Function NextSet(a() As Long, n As Long, m As Long) As Boolean 'следующее размещение
    Dim b() As Long, c() As Boolean, i As Long, j As Long
    ReDim b(1 To n) As Long, c(1 To n) As Boolean
    For i = 1 To m
        b(i) = a(i)
        c(a(i)) = True
    Next i
    For j = n To 1 Step -1
        If Not c(j) Then
            b(i) = j
            i = i + 1
        End If
    Next j
    NextSet = NextPerm(b, n)
    For i = 1 To m
        a(i) = b(i)
    Next i
End Function
 
Еще варианты, решенные данным способом:
ВЕТКА + ВЕТКА = ДЕРЕВО
74235 + 74235 = 148470

ДЕДКА + БАБКА + РЕПКА = СКАЗКА
74750 + 90950 + 84650 = 250350

КОРОВА + ТРАВА + ДОЯРКА = МОЛОКО
140498 + 60898 + 542018 = 743414
540498 + 60898 + 142058 = 743454
 

Здравствуйте Светлый  Спасибо за отклик. Насколько я понял у вас немного урезан диапазон перебора значений конкретно для этой задачи. Когда писал тему думал будет куча макросов, а оказалось наоборот макрос только MCH пишет, а формул уже 3. Хотя я больше склоняюсь к решению макросом, с ними мне проще.

 
MCH Здравствуйте. Классно!!! Спасибо. Меня совсем лишили возможности, что-то написать самому. Кстати первый макрос очень быстро работает. Я так и не смог замерить время, показывает одни нули после запятой. Формулы все таки чуток заметно, что считают. Поэтому для этой задачи все-таки лучше решение макросом. Сейчас попробовал с карандашом одно выражение решить, за 5 минут не получилось. Давно уже не решал. Вообщем разобрал выражение
ДЕДКА + БАБКА + РЕПКА = СКАЗКА
Здесь не единственное решение есть ещё (Возможно какое-то пропустил)
74750+80850+94650=250250
84850+70750+94650=250250
Исходя из этого может не стоит останавливать цикл, а сохранить первое решение и продолжить поиск и вывести все решения, тогда можно использовать макрос для написания таких ребусов с единственным решением.
С последним вашим макросом пока еще не разбирался.
 
Цитата
написал:
84850+70750+94650=250250
"С"<>"З"

Цитата
написал:
Здесь не единственное решение есть ещё (Возможно какое-то пропустил)
4 решения для задачи: ДЕДКА + БАБКА + РЕПКА = СКАЗКА
74750 + 90950 + 84650 = 250350
84850 + 90950 + 74350 = 250150
94950 + 70750 + 84650 = 250350
94950 + 80850 + 74350 = 250150
 
MCH Последний макрос все решения выводит? Я сам еще не разбирался.
 
Цитата
Евгений Смирнов написал:
MCH Последний макрос все решения выводит?
В такой интерпретации (сделал перестановки 10 цифр, т.к. используется 9 цифр, убрал перебор размещений), выводит все варианты
Код
Sub main()
    Const n As Long = 10
    Dim i As Long, a() As Long, tmr As Single
    ReDim a(1 To n) As Long
    
    tmr = Timer
    For i = 1 To n: a(i) = i - 1: Next i
    Do
        CheckWords a(1), a(2), a(3), a(4), a(5), a(6), a(7), a(8), a(9)
    Loop While NextPerm(a(), n)
    Debug.Print Timer - tmr
End Sub

Sub CheckWords(d As Long, e As Long, k As Long, a As Long, b As Long, r As Long, p As Long, s As Long, z As Long)
    If d = 0 Or b = 0 Or r = 0 Or s = 0 Then Exit Sub
    If d * 10000 + e * 1000 + d * 100 + k * 10 + a + _
       b * 10000 + a * 1000 + b * 100 + k * 10 + a + _
       r * 10000 + e * 1000 + p * 100 + k * 10 + a = _
       s * 100000 + k * 10000 + a * 1000 + z * 100 + k * 10 + a Then _
        Debug.Print d & e & d & k & a & " + " & b & a & b & k & a & " + " & r & e & p & k & a & " = " & s & k & a & z & k & a
End Sub

Function NextPerm(a() As Long, n As Long) As Boolean  'следующая перестановка в лексикографическом порядке
    Dim i As Long, k As Long, t As Long, tmp As Long
    For k = n - 1 To 1 Step -1
        If a(k) < a(k + 1) Then Exit For
    Next k
    If k Then
        For i = n To k + 1 Step -1
            If a(k) < a(i) Then tmp = a(k): a(k) = a(i): a(i) = tmp: Exit For
        Next i
        NextPerm = True
    End If
    t = n
    For i = k + 1 To (n + k) \ 2
        tmp = a(i): a(i) = a(t): a(t) = tmp
        t = t - 1
    Next i
End Function

Перебор всех перестановок - 10! (3,6 млн комбинаций) - 3 секунды
Если нужен перебор размещений (если используется менее 9 цифр) - см. предыдущую реализацию, можно сократить количество комбинаций для перебора
Изменено: MCH - 17.01.2022 09:08:11
 

MCH Спасибо огромное!!! На пару дней вы меня загрузили.  С этим макросом сходу не могу разобраться первый был простой. Но я упертый, буду разбираться до полной победы.

 
Полный перебор всех комбинаций
УДАР + УДАР = ДРАКА
8126 + 8126 = 16252
0,3 секунды
Скрытый текст
 
ОТВЕТ + ОЧЕНЬ = ПРОСТ:
16476 + 18720 = 35196
18478 + 16720 = 35198
21651 + 27580 = 49231
24384 + 26890 = 51274
26386 + 24890 = 51276
27657 + 21580 = 49237
27937 + 28310 = 56247
28938 + 27310 = 56248
32582 + 34810 = 67392
34214 + 35170 = 69384
34584 + 32810 = 67394
35125 + 39260 = 74385
35215 + 34170 = 69385
39129 + 35260 = 74389
42132 + 45360 = 87492
42312 + 47150 = 89462
43763 + 48650 = 92413
45135 + 42360 = 87495
47317 + 42150 = 89467
48768 + 43650 = 92418
Скрытый текст
 
НИТКА + НИТКА = ТКАНЬ
15306 + 15306 = 30612
Скрытый текст
 
Off
Михаил сел на коНьбинаторику , теперь его долго от туда долго не снять будет.   :D
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
сел на коНьбинаторику
Я другим не запрещаю на нее садиться, пусть тоже едут
Цитата
Евгений Смирнов написал:
С этим макросом сходу не могу разобраться
Чтобы легче было разобраться - немного про комбинаторику на VBA: http://www.excelworld.ru/forum/3-36449-1
 
MCH Спасибо за ссылку. Файл очень помог разобраться. Правда пришлось почитать про комбинаторику, перемещения, сочетания, размещения.(Восполнить пробел из-за пропущенных лекций). Можно считать, что обучение прошло успешно. Выкладываю домашнее задание для разнообразия решений. Правда по скорости это не лучшее решение. Оказывается в этих макросах сильно влияет на скорость тип переменных. К сожалению в моем коде переменные Zx нельзя объявить типом Long.
Код
Sub mainForEach() 'УДАР+УДАР=ДРАКА
Dim Z1, Z2, Z3, Z4, Z5, Z6, Z7, Z8, Z9, tmr!: tmr = Timer
a1 = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
For Each Z1 In a1
    a2 = Filter(a1, Z1, 0, 1)
    For Each Z2 In a2
        a3 = Filter(a2, Z2, 0, 1)
        For Each Z3 In a3
            a4 = Filter(a3, Z3, 0, 1)
            For Each Z4 In a4
                a5 = Filter(a4, Z4, 0, 1)
                For Each Z5 In a5
If (Z1 * 1000 + Z2 * 100 + Z3 * 10 + Z4) * 2 = Z2 * 10000 + Z4 * 1000 + Z3 * 100 + Z5 * 10 + Z3 Then
Debug.Print Z1 & Z2 & Z3 & Z4 & " + " & Z1 & Z2 & Z3 & Z4 & " = " & Z2 & Z4 & Z3 & Z5 & Z3
Debug.Print FormatNumber(Timer - tmr, 4)
Exit Sub
End If
                Next Z5
            Next Z4
        Next Z3
    Next Z2
Next Z1
'Debug.Print FormatNumber(Timer - tmr, 4)
End Sub
Страницы: 1
Наверх