Стандартный алгоритм.

[Mr_MIX]

Помогите пожалуйста написать прогу: есть слово из менее чем 10 разных букв, нужно найти все слова, которые можно получить перестановками букв в этом слове.
Зрарание спасибо, Mr. MIX.

[Шнурок]

анриал

[_Мика_]

Ну посему же сразу Анреал!

Надо во превых базу данных со всеми словами иметь
Потом каким-то образом искать по буквам в базе данных слов, ну короче это сложно!



Да, анреал

[Шнурок]

да...база данных со всеми словами...звучит забавно

забавней всего сделать еще вторую версию программы...так сказать english edition

Может человек вирус делает...хочет что бы комп повис

[Eugenio]

Человек, кстати, не сказал, что все слова должны что-то значить
Прогу, которая просто покажет все варианты расстановки символов, я очень просто могу представить
А если серьезно - можно, в принципе, функционал Word'а, который для проверки орфографии, заюзать..
Или (это уже опять смех)! Словари Lingvo! Чтобы прога возмущалась:

"ABYY Lingvo не установлен или установлен некорректно!"

[Шнурок]

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

[skord]

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

[Eugenio]

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

Теоретически, можно - там же есть редактор словарей. Поизменять словари, посмотреть, что меняется - выяснить формат записи в эти файлы. И читать их потом прогой - локализацией прог заниматься не понадобится: нашел в словаре что надо и всё
Но ближе нам word'овский spellchecker, наверное. Word поддерживает automation

[GSerg]

Думается мне, под термином "слово" понимается простая перестановка букв, и задача сводится к получению всех перестановок...

[ALX_2002]

Вот... Я тут наваял простенький пример.... Мож подойдёт

Dim MainWord As String
Dim TestWords(6) As String
Function Test(byval W1 As String, W2 As String)
Dim char
For N = 1 To Len(W2)
char = Mid(W2, N, 1)
If InStr(1, W1, char) <> 0 Then
W1 = Replace(W1, char, "", 1, 1)
Else
Test = "Нельзя составить"
Exit Function
End If
Next
Test = "Можно составить"
End Function

Private Sub Form_Click()
Me.Cls
MainWord = "фыывооо"
TestWords(0) = "оооо"
TestWords(1) = "зубр"
TestWords(2) = "зебра"
TestWords(3) = "ар"
TestWords(4) = "бар"
TestWords(5) = "роб"
TestWords(6) = "раб"

Print "из слова " & MainWord & vbCrLf

For N = 0 To UBound(TestWords)
Print Test(MainWord, TestWords(N)) & " " & TestWords(N)
Next
End Sub

[ALX_2002]

Во. Баги исправил. Пашет.

[ALX_2002]

Mr_Mix, так пошёл алгоритм или нет ? Или тебе что то дургое нужно ?

[VOS]

Не совсем верный код, ALX_2002!
В месте
Function Test(W1 As String, W2 As String)
надо
Function Test(ByVal W1 As String, W2 As String)
Ведь ты изменяешь W1 в процессе выполнения!

[A.A.Z.]

Наоборот, когда пишешь ByVal, то в функцию передается только значение переменной (By Value)

[VOS]

Дык ты попробуй сам запусти свой пример из
http://bbs.vbstreets.ru/viewtopic.php?p=83883#83883
подставь например в первый "фыво" и в последний "фыво" - пропрет только с первым! Почему? Изменяем переменные ByRef, хех...

[A.A.Z.]

В функциях и процедурах "ничего" = "ByRef", так что не хех
И, тем более, все работает. Так что вдвойне не хех

[VOS]

У меня VB6 Pro SP5
Итак, вот код:

Dim MainWord As String
Dim TestWords(6) As String
Function Test(W1 As String, W2 As String)
Dim char
For N = 1 To Len(W2)
char = Mid(W2, N, 1)
If InStr(1, W1, char) <> 0 Then
W1 = Replace(W1, char, "", 1, 1)
Else
Test = "Нельзя составить"
Exit Function
End If
Next
Test = "Можно составить"
End Function

Private Sub Form_Click()
Me.Cls
MainWord = "фыывооо"
TestWords(0) = "фыво"
TestWords(1) = "зубр"
TestWords(2) = "зебра"
TestWords(3) = "ар"
TestWords(4) = "бар"
TestWords(5) = "роб"
TestWords(6) = "фыво"

Print "из слова " & MainWord & vbCrLf

For N = 0 To UBound(TestWords)
Print Test(MainWord, TestWords(N)) & " " & TestWords(N)
Next
End Sub


Итак, вот вывод:
из слова фыывооо
Можно составить фыво
Нельзя составить зубр
Нельзя составить зебра
Нельзя составить ар
Нельзя составить бар
Нельзя составить роб
Нельзя составить фыво <=

Или это глюк моего VB?

[A.A.Z.]

Прости, я забыл, я чуть-чуть менял код

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

Option Explicit

Dim MainWord As String
Dim TestWords(6) As String
Function Test(W1 As String, W2 As String)
Dim char, N&, S$
S = W1
For N = 1 To Len(W2)
char = Mid(W2, N, 1)
If InStr(1, S, char) <> 0 Then
S = Replace(S, char, "", 1, 1)
Else
Test = "Я идиот! Убейте меня, кто-нибудь!? Я идиот! Убейте меня, кто-нибудь!????"
Exit Function
End If
Next
Test = "Я идиот! Убейте меня, кто-нибудь! Я идиот! Убейте меня, кто-нибудь!????"
End Function

Private Sub Form_Click()
Dim N&
Me.Cls
MainWord = "Я идиот! Убейте меня, кто-нибудь!??"
TestWords(0) = "????"
TestWords(1) = "????"
TestWords(2) = "Я идиот! Убейте меня, кто-нибудь!"
TestWords(3) = "??"
TestWords(4) = "???"
TestWords(5) = "???"
TestWords(6) = "????"

Print "?? Я идиот! Убейте меня, кто-нибудь! " & MainWord & vbCrLf

For N = 0 To UBound(TestWords)
Text1.Text = Text1.Text & Test(MainWord, TestWords(N)) & " " & TestWords(N) & vbCrLf
Next
End Sub

В фунции Test добавил переменную S и в начале присваивал ей W1: функция его изменяла, но не возвращала обратно

[ALX_2002]

2 VOS: Пасиба. Реал я проглючил

Хе... Ну главное пашет