Кому не лень ...

[Daz]

Имеется головоломка : Квадратный корень из слова
"феодализм" = "еедди". Каждая из девяти букв слова
"феодализм" обозначает какую-то цифру(нуль не учитывается).
Надо найти эти числа.

Я посредством For..Next нашел эти цисла: 523814769 и 22887. Но
компьютер думал аж 25 минут! (Код прилагается)

Подскажите,пожалуйста, каким образом можно решить эту
задачу быстрее ?

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


Private Sub Command1_Click()
For f = 1 To 9
For e = 1 To 9
For o = 1 To 9
For d = 1 To 9
For a = 1 To 9
For l = 1 To 9
For i = 1 To 9
For z = 1 To 9
For m = 1 To 9

If 100000000 * f + 10000000 * e + 1000000 * o + 100000 * d + 10000 * a + 1000 * l + 100 * i + 10 * z + m = (10000 * e + 1000 * e + 100 * d + 10 * d + i) ^ 2 Then
List1.AddItem 100000000 * f + 10000000 * e + 1000000 * o + 100000 * d + 10000 * a + 1000 * l + 100 * i + 10 * z + m
List2.AddItem 10000 * e + 1000 * e + 100 * d + 10 * d + i
End If

Next
Next
Next
Next
Next
Next
Next
Next
Next
End Sub


[GSerg]

Ты делаешь сплошной перебор. А вместо этого стоимло бы учесть тот факт, что в "корне" есть одинаковые цифры, да ещё парами, да ещё подряд. Тогда нужно было бы перебрать (если исключить 0 как вариант) всего 9*9*9 комбинаций

[Daz]

Ты делаешь сплошной перебор. А вместо этого стоимло бы учесть тот факт, что в "корне" есть одинаковые цифры, да ещё парами, да ещё подряд. Тогда нужно было бы перебрать (если исключить 0 как вариант) всего 9*9*9 комбинаций

Можно код, please

[GSerg]

А не стыдно?

[GSerg]

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

Option Explicit

Private Sub Form_Load()
  Dim i As Long, j As Long, k As Long, s() As Byte
 
  Const MIN_NUMBER As Long = 1
  Const MAX_NUMBER As Long = 9
 
  Me.AutoRedraw = True
 
  For i = MIN_NUMBER To MAX_NUMBER
    For j = MIN_NUMBER To MAX_NUMBER
      If j <> i Then
        For k = MIN_NUMBER To MAX_NUMBER
          If k <> j And k <> i Then
            s = StrConv(CStr((i * 11000 + j * 110 + k) ^ 2), vbFromUnicode)
            If s(1) = vbKey0 + i Then
              If s(3) = vbKey0 + j Then
                If s(6) = vbKey0 + k Then
                  'В принципе, здесь нужно добавить проверку того,
                  'что все оставшиеся цифры разные.
                  'Но этот пример работает и без неё.
                  Me.Print StrConv(s, vbUnicode), CStr(i * 11000 + j * 110 + k)
                End If
              End If
            End If
          End If
        Next
      End If
    Next
  Next
End Sub

[Daz]

А не стыдно?

Стыдно, но очень надо