Наверное все знаете игру Эрудит, у меня есть не большой вопрос как заставить процедуру поиска слов из слваря в 54 000 слов выполнятся ну, хотябы за 10 сек. Мои лучшие результаты это 40 сек.
кто нибудь может помочь

Модератор: здесь помогают, а не делают работу за Вас. И не высылают решения на мэйл. Регистрируйтесь, цитируйте основу своего кода - будем смотреть.

Это сообщение отредактировал(а) Akina - 1.12.2005, 09:35

Хорошо я вижу что дело двигается туго, объясняю на примере допустим у нас есть матрица 8 Х 8 пустые клетки допустим = (_)

_ _ _ _ _ _ _ _ в каждую ячейку можно записать только одну
_ _ _ _ _ _ _ _ букву например.
_ _ _ _ _ _ _ _
_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ машину нужно научить
_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ быстро находить слово
_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ так чтобы оно было увязано
_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ со словом которе уже
_ _ _ _ _ _ _ _ _ _ _ _ к _ _ _ имеется в матрице
_ _ _ т и г р _
_ _ _ _ т _ _ _ к примеру допустим что
_ _ _ _ _ _ _ _ первым словом был "тигр"
машина должна найти слово "кит". словарь программы состоит из 54 тыс. слов!

теперь то всем будет ясно

пример кода таков

Код

Dim Znach1 As Byte, teckSchot1 As Integer, umnogit1 As Integer   Dim x As Byte, y As Byte, n As Byte, ts1 As String, f As Byte, KS As Byte   Dim ts As String, i As Byte, lib As String Dim Te As String, Minimum As Long, Le As String Dim TmpStr As String, fso, u As Byte, Ks2 As Byte, b(6) As String Dim j As Byte, prosto As String Dim selekt  As Po ' загрузка словаря имеющий Формат 2 байта - длина (К) слова, следующие К байтов есть само слово  и так примерно 54000 слов Set fso = CreateObject("Scripting.FileSystemObject") Set ReadTemp = fso.OpenTextFile(App.Path & "\\Данные\КомпСловарь.Данные", 1) TmpStr = ReadTemp.ReadAll Ks2 = 0 'Здесь просто идет загрузка букв из каторых это слово может состоять здесь же определяется количесвто доступных букв For u = 0 To 6 If bukw(u + 7 * hod) <> " " Then Ks2 = Ks2 + 1 b(u) = bukw(u + 7 * hod) Next ' поиск осуществляется путем перебора всех возможных решений ' во первых по клеткам матрици 15Х15 For x = 0 To 14 For y = 0 To 14 ts1 = "" f = 0 ' во вторых по длине слова причем либо по вертикали либо по горизонтали For n = x To 14 ' суть этого ифа - если клетка пуста то к временной прибавляем "?" иначе букву  If (kl(y * 15 + n).Tag) = "" Then ts1 = ts1 & "?" Else ts1 = ts1 & (kl(y * 15 + n).Tag) f = 1 End If ' здесь определяем количесвто "?" KS = 0 For u = 1 To Len(ts1) If Mid(ts1, u, 1) = "?" Then KS = KS + 1 Next ' этот иф отвечает за то чтобы длины будущего слова была больше еденицы а количесвто "Окон" было не больше количества доступных букв ну и конечно количесвто уже поставленных букв было больше 0 If f = 1 And Len(ts1) > 1 And KS <= Ks2 And KS > 0 Then ' вызов поиска слов Te = ts1 Minimum = 1 ' здесь приводим длину слова к формату "??" If Len(Trim(Str(Len(Te)))) = 1 Then Le = "0" & Len(Te) Else Le = Len(Te) ' это есть сам поиск Do Until InStr(Minimum, TmpStr, Le) = 0 ts = Mid(TmpStr, InStr(Minimum, TmpStr, Le) + 2, Len(Te)) ' проверка соответсвия букв найденого слова с Эталоном For i = 1 To Len(Te) If Mid(UCase(Te), i, 1) = Mid(ts, i, 1) Or Mid(Te, i, 1) = "?" Then Else GoTo met2 Next ' здесь просто идет  проверка есть ли у нас на руках те буквы которые стоят в найденом слове вместо "?" For i = 1 To Len(ts) For j = i - 1 To 6 If Mid(ts, i, 1) = b(j) And Mid(Te, i, 1) = "?" Then TN = b(j) b(j) = b(i - 1) b(i - 1) = TN GoTo m3 End If If Mid(Te, i, 1) <> "?" Then GoTo m3 Next GoTo met2 m3: Next ' если поиск не перешел на 2 метку то слово соответсвует нашим буквам  'поиск завершен слово найдено ' Это просто проверка было ли использовано это слово For i = 0 To NumHod If ts = IspolSlowo(i) Then GoTo met2 Next ' здесь использовалась специальная переменная  ну думаю понятно selekt.KolSim = это количество символов, selekt.Mask это маска с "?", selekt.In1,selekt.In1 - начало и конец слова, selekt.Sim - ест само слово ' здесь выбирается самое длинное слово   If selekt.KolSim < Len(ts) Then selekt.KolSim = Len(ts) selekt.Mask = ts1 selekt.In1 = (y * 15 + x) selekt.In2 = (y * 15 + n) selekt.Sim = ts End If met2: ' и так до конца словаря Minimum = InStr(Minimum, TmpStr, Le) + 1 Loop End If Next ts1 = "" f = 0 ' а теперь в другом направлении For n = y To 14 If kl(n * 15 + x).Tag = "" Then ts1 = ts1 & "?" Else ts1 = ts1 & kl(n * 15 + x).Tag f = 1 End If KS = 0 For u = 1 To Len(ts1) If Mid(ts1, u, 1) = "?" Then KS = KS + 1 Next If f = 1 And Len(ts1) > 1 And KS <= Ks2 And KS > 0 Then ' вызов поиска слов Te = ts1 Minimum = 1 If Len(Trim(Str(Len(Te)))) = 1 Then Le = "0" & Len(Te) Else Le = Len(Te) Do Until InStr(Minimum, TmpStr, Le) = 0 ts = Mid(TmpStr, InStr(Minimum, TmpStr, Le) + 2, Len(Te)) For i = 1 To Len(Te) If Mid(UCase(Te), i, 1) = Mid(ts, i, 1) Or Mid(Te, i, 1) = "?" Then Else GoTo met12 Next For i = 1 To Len(ts) For j = i - 1 To 6 If Mid(ts, i, 1) = b(j) And Mid(Te, i, 1) = "?" Then TN = b(j) b(j) = b(i - 1) b(i - 1) = TN GoTo m13 End If If Mid(Te, i, 1) <> "?" Then GoTo m13 Next GoTo met12 m13: Next 'поиск завершен слово найдено For i = 0 To NumHod If ts = IspolSlowo(i) Then GoTo met12 Next umnogit1 = 1 teckSchot1 = 0   If selekt.KolSim < Len(ts) Then selekt.Mask = ts1 selekt.KolSim = Len(ts) selekt.In1 = (y * 15 + x) selekt.In2 = (n * 15 + x) selekt.Sim = ts End If met12: Minimum = InStr(Minimum, TmpStr, Le) + 1 Loop End If Next Next Next ' Здесь поиск как бы завершен 'выходное слово  - selekt.Sim

Цитата(Guest @ 2.12.2005, 07:20)

словарь программы состоит из 54 тыс. слов!

Пиши на C++ или оптимизируй до невозможности код. Или делай вставки на асме

Guest, оформи код нормально! Сразу может самому какие-нибудь моменты в глаза бросятся, которые можно улучшить. Сделай сдвиги как тут во всем коде:

Код

For u = 0 To 6     If bukw(u + 7 * hod) <> " " Then Ks2 = Ks2 + 1         b(u) = bukw(u + 7 * hod) Next ' поиск осуществляется путем перебора всех возможных решений ' во первых по клеткам матрици 15Х15 For x = 0 To 14     For y = 0 To 14     ...

Отредактированный код пости еще раз!

Во вторых GoTo это нездорово! Я не хочу дискутировать на эту религиозную тему, как здесь

я просто уверен, что можно без них, а значит и делать надо без них - код понятней будет. Этого аргумента ИМХО уже достаточно, чтобы неиспользовать GoTo где попало, только потому, что так проще.

Потом увидим, что дальше...

p.s. думаю улучшить тут можно до фига всего.

Спасибо за советы
Добавлено @ 05:15
Только есть ещё один вопрос как делать

Цитата

Или делай вставки на асме

Зайди в FAQ и почитай мою статью...