FreeBasic
Главная
Вход
Регистрация
Пятница, 19.04.2024, 21:43Приветствую Вас Гость | RSS
[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]
  • Страница 1 из 1
  • 1
Форум » Freebasic » Исходники » Num2Text - алгоритм преобразования чисел в пропись (Преобразуем числа в сплошном тексте в слова)
Num2Text - алгоритм преобразования чисел в пропись
electrikДата: Вторник, 15.02.2022, 17:11 | Сообщение # 1
Полковник
Группа: Друзья
Сообщений: 180
Репутация: 3
Статус: Offline
Этот алгоритм преобразует числа вида "123" в "сто двадцать три". Алгоритм не преобразует дробные числа, тоесть если написать "3.5", вы увидите не "три целых пять десятых", а просто "три пять". Также не ждите чудес типа "1995-го года, он преобразует в "тысяча девятьсот девяносто пять-го года".
Алгоритм писался для синтеза речи. Могут быть лишние пробелы между преобразованными числами и словами в тексте. Это всё можно убрать.
Если число слишком большое, больше того, что заложено в массиве кратных тысяче, оно будет разбиваться.
В алгоритме используются функци из Window9, поэтому эта библиотека должна стоять на компе.
Программу нужно сохранить в юникоде UTF16.
Идею до тысячи подсмотрел:
https://www.cyberforum.ru/cpp-beginners/thread337519.html"

Качаем, или смотрим код ниже:
https://disk.pm/s/R9jWNnxoYMwR3dX/download

Код
#define UNICODE
#include "window9.bi"
#include "crt/string.bi"
#include "extWstring.bi"

' Пара функций для удобств. Можно было бы вынести в отдельный файл, но пока их мало, поэтому они вместе с исходником.
static shared specials as wstring ptr = @!"~!@#$%^&*()_+{}:\"|<>?[];'\\,./—…" ' спец символы.
function CharIsSpecial(byval symbol as long) as boolean
    ' Проверяет, является ли символ спецсимволом.
    dim SpecialSymbol as wstring ptr = specials
    While *specialSymbol
        If symbol = *specialSymbol then Return True
        *specialSymbol += 1
    Wend
    return False
end function

function CharIsDigit(byval symbol as long) as boolean
    ' проверяет, является ли символ десятичным числом.
    If symbol >= asc("0") andalso symbol <= asc("9") then
        Return True
    EndIf
    return False
End function

' Код, непосредственно самих функций преобразования чисел в пропись.

' Единицы.
static shared units(0 to ...) as wstring ptr = {@"один",@"два",@"три",@"четыре",@"пять",@"шесть",@"семь",@"восемь",@"девять"}

' Единицы женского рода.
static shared wUnits(0 to ...) as wstring ptr = {@"одна",@"две"}

' Десятки.
static shared tens(0 to ...) as wstring ptr = {@"десять",@"двадцать",@"тридцать",@"сорок",@"пятьдесят",@"шестьдесят",@"семьдесят",@"восемьдесят",@"девяносто"}

' Последние девять чисел второго десятка.
static shared secondTens(0 to ...) as wstring ptr = {@"одиннадцать",@"двенадцать",@"тринадцать",@"четырнадцать",@"пятнадцать",@"шестнадцать",@"семнадцать",@"восемнадцать",@"девятнадцать"}

' Сотни.
static shared hundreds(0 to ...) as wstring ptr = {@"сто",@"двести",@"триста",@"четыреста",@"пятьсот",@"шестьсот",@"семьсот",@"восемьсот",@"девятьсот"}

' Именованные названия Степеней тысячи.
static shared what(0 to ...) as wstring ptr = _
{ _
    @"тысяч",@"миллион",@"миллиард",@"триллион",@"квадриллион",@"квинтиллион",@"секстиллион",@"септиллион",@"октиллион",@"нониллион", _
    @"дециллион",@"ундециллион",@"дуодециллион",@"тредециллион",@"кваттуордециллион",@"квиндециллион",@"сексдециллион",@"септендециллион",@"октодециллион",@"новемдециллион", _
    @"вигинтиллион",@"унвигинтиллион",@"дуовигинтиллион",@"тревигинтиллион",@"кваттуорвигинтиллион",@"квинвигинтиллион",@"сексвигинтиллион",@"септенвигинтиллион",@"октовигинтиллион",@"новемвигинтиллион", _
    @"тригинтиллион",@"унтригинтиллион",@"дуотригинтиллион",@"третригинтиллион",@"кваттуортригинтиллион",@"квинтригинтиллион",@"секстригинтиллион",@"септентригинтиллион",@"октотригинтиллион",@"новемтригинтиллион", _
    @"квадрагинтиллион",@"унквадрагинтиллион",@"дуоквадрагинтиллион",@"треквадрагинтиллион",@"кваттуорквадрагинтиллион",@"квинквадрагинтиллион",@"сексквадрагинтиллион",@"септенквадрагинтиллион",@"оптоквадрагинтиллион",@"новемквадрагинтиллион" _
}

' Окончания степеней тысячи.
' Окончание "а" пример: одна тысяча, два миллиона.
' Окончание "и" пример: две тысячи.
' Окончание "ов" пример: пять триллионов.
static shared end_1 as wstring ptr = @"а" ' ' окончание для случаев тысяч равных одной:
#define end_24 end_1 ' оно же для случаев от двух до четырёх в миллионах
static shared end_t24 as wstring ptr = @"и" ' Окончания для тысяч от 2 до 4
static shared End_05 as wstring ptr = @"ов" ' окончание в случае равным нулю и больше пяти, для миллионов, миллиардов и т.д:

' нули.
static shared zero as wstring ptr = @"нол" ' основа слова ноль (не по правилу русского языка). Так же написано "нол" заместа "нул" - для синтеза речи для произношения удобней как говорится и слышится. По правилам языка, вроде можно и ноль и нуль.
static shared zero_05 as wstring ptr = @"ей" ' окончание слова в случае больше или равным пяти, нулю или равным числам 10, 20, 30 и т.д.
static shared zero_1 as wstring ptr = @"ь" ' окончание слова в случае равным единице, или 21 или 51 и т.д.
static shared zero_24 as wstring ptr = @"я" ' окончание в случае больше или равным двум и меньше или равным четырём, пример, 2 ноля, 244 ноля и т.д.

function StringByTriad(byval sName as wstring ptr, byval nLeft as integer, byval nCenter as integer, byval nRight as integer, byval end_1 as wstring ptr = NULL, byval end_2 as wstring ptr = NULL, byval end_3 as wstring ptr = NULL) as extWstring
    ' Склонение названий степеней тысячи.
    ' параметры:
    ' sName - строка, к примеру: тысяч.
    ' nLeft, nCenter, nRight - левая, средняя и правая цифры триады.
    ' end_1 - окончания слова в случае нуля или больше пяти.
    ' end_2 - Окончание слова в случае единицы.
    ' end_3 - окончание слова в случае от двух до четырёх.
    dim resString as extWstring
    If nCenter = asc("1") then ' Если средняя цифра триады равна единице:
        resString &= " " & *sName & *end_1 ' Приклеим к результирующей строке пробел и название и окончание в случае равным или больше десяти
    ElseIf nRight  >= asc("5") then ' если правое цифра триады больше или равна пяти:
        resString &= " " & *sName & *End_1 ' приклеим  к результирующей строке пробел и название и окончание в случае равным или больше пяти.
    ElseIf nRight >= asc("2") then ' иначе если правая цифра больше или равна двум:
        resString &= " " & *sName & *end_3 ' приклеим  к результирующей строке пробел и название  и окончание в случае от двух до четырёх.
    ElseIf NRight = asc("1") then ' иначе если правая цифра равна единице
        resString &= " " & *sName & *end_2 ' приклеим  к результирующей строке пробел и название и окончание в случае равным единице.
    ElseIf nRight = asc("0") andalso (nCenter > asc("0") Or nLeft > asc("0")) then ' если правая цифра равна нулю и (средняя или левая цифры больше нуля)
        resString &= " " & *sName & *end_1 ' приклеим  к результирующей строке пробел и название и окончание в случаях 20, 130, 520 и т.д.
    EndIf
    If resString then resString &= ","
    function = resString
end function

function triad2Words(byval sNumber as wstring ptr, byval nSize as integer, byval triadNumber as integer, byval zerosFlag as boolean = False) as extWstring
    ' Преобразует число, строковую триаду цифр в слова.
    ' Параметры:
    ' sNumber - строка с числом от одной до трёх цифр. пример: "321".
    ' nSize - длина строки с цифрами.
    ' triadNumber - номер триады кратный тысяче. отсчёт кратных тысячи с единицы. 1 - тысяча, 2 -- миллион, 3 - миллиард и т.д. 0 - обработка последней триады без степеней тысячи.
    ' zerosFlag - подстановка слова ноль, ноля, нолей. Это нужно для объявления количества подсчитанных нулей перед числом. true - будет подставлять слово. на выходе будет так: двенадцать нолей.
    dim as integer nLeft = 0, nCenter = 0, nRight = 0 ' Переменные для левой, средней, и правой цифр триады.
    dim resString as extWstring ' Переменная для результирующей строки.

    If nSize = 3 then ' если длина строки с триадой равная трём:
        nLeft = sNumber[0] ' Получим левую цифру триады.
    EndIf
    If nSize >= 2 then ' если длина строки с триадой больше или равна двум:
        nCenter = sNumber[(nSize-2)] ' Получим среднюю цифру триады.
    EndIf
    nRight = sNumber[(nSize-1)] ' Получим правую цифру триады.
    
    If nLeft > asc("0") then ' Если левая цифра триады  больше нуля:
        resString &= " " & *hundreds(nLeft-49) ' приклеим к результирующей строке пробел и название  сотни из массива hundreds(nLeft-49). Почему отнимаем 49? Числа от нуля, начинаются с кода 48, чтобы преобразовать единицу с кодом 49 к нулевому индексу массива, нужно отнять 49. также чтобы преобразовать число 2 с кодом 50 к первому индексу массива, надо отнять 49 и т.д. можно для наглядности сначала отнять 48, а потом единицу.
    EndIf
    
    if nCenter > asc("0") then ' Если средняя цифра триады больше нуля:
        If nCenter = asc("1") Andalso nRight > asc("0") then ' Если средняя цифра триады равна единице, и правая цифра триады больше нуля:
            resString &= " " & *secondTens(nRight-49) ' Приклеим к результирующей строке пробел и название  последних девяти чисел второго десятка из массива secondTens(nRight-49), - это числа одиннадцать, двенадцать и т.д. Почему индексом является right? Если средняя цифра триады равна единице, а правая больше нуля, индексом последних девяти чисел второго десятка является правая цифра триады.
            
            ' обработаем названия степеней тысячи во втором десятке.
            If triadNumber = 1 then ' если triadNumber равен единице - это тысячи:
                resString &= StringByTriad(what(triadNumber-1), nLeft, nCenter, nRight) ' приклеим  к результирующей строке название степени тысячи из массива what(triadNumber-1).
            ElseIf triadNumber > 1 then ' если triadNumber больше единицы - это названия больше тысячи:
                resString &= StringByTriad(what(triadNumber-1), nLeft, nCenter, nRight,End_05) '' приклеим  к результирующей строке название степени тысячи из массива what(triadNumber-1) с окончанием end_05.
            EndIf
            
            If zerosFlag = True then ' если установлен флаг подстановки слов:
                resString &= " " & *zero & *zero_05 ' Подставим слово "нолей".
            EndIf
            Return resString ' поскольку последние девять чисел второго десятка обработаны - выходим.
        Else ' Иначе:
            resString &= " " & *tens(nCenter-49) ' Приклеиваем к результирующей строке пробел и название  десятка из массива tens(center-49), - это числа десять,  двадцать и т.д.
        EndIf
    EndIf
    
    If nRight > asc("0") then ' Если правая цифра триады > нуля:
        If nRight > asc("2") OrElse triadNumber <> 1 then ' Если правая цифра триады  больше двух или  triadNumber неравен  единице:
            resString &= " " & *units(nRight-49) ' Приклеиваем к результирующей строке пробел и название  единицы из массива units(nRight-49) - это числа один, два и т.д.
        Else ' Иначе:
            resString &= " " & *wUnits(nRight-49) ' Приклеиваем к результирующей строке пробел и название  единицы из массива wUnits[nRight-49) - это числа женского рода, одна, две.
        EndIf
    EndIf
    
    ' обработаем названия тысяч.
    If triadNumber = 1 then ' если triadNumber равен единице:
        resString &= StringByTriad(what(triadNumber-1), nLeft, nCenter, nRight, "", end_1, end_t24) ' Приклеим к результирующей строке полученное название степени тысячи с окончаниями end_1, end_t24.
    ElseIf triadNumber > 1 then ' Иначе если triadNumber больше единицы - это названия больше тысячи:  
        resString &= StringByTriad(what(triadNumber-1), nLeft, nCenter, nRight, End_05, "", end_24) ' Приклеим к результирующей строке полученное название степени тысячи с окончаниями End_05, end_24.
    EndIf
    
    If zerosFlag = True then ' если установлен флаг подстановки нулей:
        resString &= StringByTriad(zero, nLeft, nCenter, nRight, zero_05, zero_1, zero_24) ' приклеим к результирующей строке слово нулей с окончаниями zero_05, zero_1, zero_24.
    EndIf
    return resString
End function

function num2text(byval sNumber as wstring ptr, byval numSize as integer, byval zerosFlag as boolean = False) as extWstring
    ' Преобразует строковое число в слова.
    ' Параметры:
    ' sNumber - строка с числом.
    ' numSize - длина строки с ччислом.
    ' zerosFlag - подстановка слова ноль, ноля, нолей. Это нужно для объявления количества подсчитанных нулей перед числом. true - будет подставлять слово. на выходе будет так: двенадцать нолей.
    
    dim resString as extWstring
    dim numTriads as integer  = (numSize - 1) \ 3 ' путём вычитания единицы от длины числа и деления на три получим число триад кратных тысяче.
    dim triadSize as integer= numSize mod 3 ' получим остаток от деления длины числа на три.
    If triadSize = 0 then ' если остаток равен нулю:
        triadSize = 3 ' поскольку нулевой остаток, значит число кратное трём, пишем размер триады равный трём.
    EndIf
    While numTriads > -1 ' цикл пока число триад не станет минус единице.
        resString &=  triad2Words(sNumber,  triadSize, numTriads, zerosFlag) ' Приклеим к результирующей строке преобразованную в пропись триаду.
        sNumber += triadSize ' увеличим указатель на триаду.
        
        ' Поскольку вначале числа размер триады может быть меньше трёх цифр:
        If triadSize < 3 then ' если размер триады меньше трёх:
            triadSize = 3 ' все последующие будут по три.
        EndIf
        numTriads -= 1 ' отнимаем от числа триад единицу.
    Wend
    resString = RTrim(resString, ",")
    function = resString
end function

function ProcessNumbers(byval text as extWstring) as extWstring
    ' преобразует числа в пропись в сплошном тексте.
    ' Параметры:
    ' text - Строка с текстом.
    ' Возвращает строку с преобразованными числами, пример: В Петербурге проживает 5000000 Человек, А в москве 12000000. - Будет преобразована так: В петербурге проживает пять миллионов человек, а в москве двенадцать миллионов.
    dim resString as extWstring ' Результирующая строка.
    dim pText as wstring ptr = strptr(text) ' Создадим указатель на строку и получим указатель на text.
    dim startText as wstring ptr = pText ' Указатель на начало не числового текста.
    dim startNumber as wstring ptr= NULL ' указатель на начало числа.
    dim zeros as integer = 0 ' Счётчик нулей перед числом.
    dim numberSize as integer
    dim numTriads as integer = uBound(what) + 1 ' Максимальное число триад кратных тысяче.
    dim maxNumberSize as integer = (numTriads + 1)*3 ' максимальная длина числа.
    
    ' Главный цикл, в котором будет идти разбор строки.
    While *pText <> 0 ' Цикл пока не встретится нуль терминатор строки:
        If charIsDigit(*cast(short ptr, pText)) then ' Если текущий символ строки цифровой - это от нуля до девяти, нашли начало числа:
            startNumber = pText ' Записываем в указатель startNumber указатель на начало числа.
            If pText > startText then ' Если текущая позиция строки больше позиции начала не числового текста, значит перед числом есть текст:
                If CharIsSpecial(*cast(short ptr, startText)) = False then ' если символ по указателю  startText не является спец символом, таким как точка, восклицательный и т.д.:
                    resString &= " " ' Приклеиваем к результирующей строке пробел.
                EndIf
                resString &= PeekS(startText, (pText - startText)) ' Приклеим к результирующей строке текст перед числом.
            EndIf
            If *startNumber = asc("0") then ' если начало числа начинается на цифру ноль:
                zeros = 0 ' перед началом подсчёта обнулим счётчик нулей.
                ' Начинаем подсчёт нулей.
                While *pText = asc("0") andalso *pText <> 0 ' Цикл пока в строке встречается цифра ноль, и пока в строке не встретиться нуль терминатор:
                    zeros += 1 ' Добавим к счётчику нулей единицу.
                    pText += 1 ' плюсуем указатель строки
                Wend
                If zeros < 5 then ' Если Количество нулей перед числом меньше пяти:
                    For i as integer = 1 To zeros
                        resString &= " " & *zero & *zero_1 ' приклеим к результирующей строке столько раз слово "ноль", сколько сосчитали нулей. zero - часть слова "нол", zero_1 - последний символ "ь", условно говоря окончание, но не по правилам языка.
                    Next
                Else ' иначе:
                    dim sNumber as extWstring = wStr(zeros) ' Преобразуем счётчик нулей в строку.
                    dim nSize as integer = Len(sNumber) ' выясним длину числа.
                    resString &= num2text(strptr(sNumber), nSize, True) ' Приклеим к результирующей строке преобразованное в пропись число нулей.
                EndIf
                
                ' После подсчёта нулей, мы не знаем на какой символ попали, проверим:
                If CharIsDigit(*cast(short ptr, pText)) = False then ' если текущий символ не цифровой:
                    startText = pText ' изменим позицию начала не числового текста.
                EndIf
            EndIf
            
            ' Поскольку, при подсчёте нулей, смещался указатель позиции строки, проверим:
            If CharIsDigit(*cast(short ptr, pText)) then ' Если текущий символ строки цифровой:
                startNumber = pText  ' После обработки нулей, Меняем позицию указателя начала числа.
                numberSize = 0 ' обнулим длину числа.
                
                ' найдём конец числа.
                While CharIsDigit(*cast(short ptr,pText)) Andalso *pText <> 0 ' цикл пока в строке встречается цифровой символ и пока не встретится  нуль терминатор:
                    pText += 1                  ' плюсуем указатель строки на размер символа.
                    numberSize += 1 ' плюсуем подсчёт цифр в числе
                    If numberSize > maxNumberSize then ' Если число больше максимальной длины числа:
                        ' значит будем разбивать число.
                        If CharIsDigit(*cast(short ptr, (pText + 1))) then ' если следующий символ цифровой:
                            resString &= num2text(startNumber, (pText - startNumber)) ' Приклеим к результирующей строке преобразованное число в пропись.  
                            startNumber = pText
                            numberSize = 0 ' Обнулим размер числа.
                        EndIf
                    EndIf
                Wend  
                ' поскольку сейчас указатель строки указывает на следующий символ после числа,
                startText = pText ' Меняем начальную позицию не числового текста.
                ' проверим:
                If CharIsSpecial(*cast(short ptr, pText)) = False then ' если текущий символ строки не является спец символом, таким как точка, восклицательный и т.д.:
                    resString &= " " ' Приклеим к результирующей строке пробел.
                EndIf
                resString &= num2text(startNumber, (pText - startNumber)) ' Приклеим к результирующей строке преобразованное число в пропись.
                Continue while ' Вернёмся к началу ветви главного цикла.
            EndIf
        EndIf
        pText += 1 ' плюсуем указатель строки на размер символа.
    Wend
    
    ' обработаем всё что осталось в конце после нахождения последнего числа.
    If resString then ' если в результирующей строке есть данные:
        If pText > startText then ' если позиция строки больше начальной позиции не числового текста:
            If CharIsSpecial(*cast(short ptr, startText)) = False then ' если символ в *startText не является спец символом, таким как точка, восклицательный и т.д.:
2                resString &= " " ' Приклеиваем к результирующей строке пробел.
            EndIf
            resString &= PeekS(startText,(pText - startText)) ' Приклеиваем к результирующей строке остаток текста после найденного последнего числа.
        EndIf
        Return resString ' возвращаем результирующую строку
    EndIf
    return text ' если условие выше не сработало, возвращаем оригинальную строку
end function

' Пример использования:    
    print ProcessNumbers("В Петербурге проживает 5000000 человек, а в москве 12000000.")
    print  ProcessNumbers("73179731523595457346")
    print ProcessNumbers("000123")
    print processNumbers("0000000123")
    print ProcessNumbers("До солнца, среднее расстояние составляет 150000000 километров.")


 
Alex_ArtifexДата: Вторник, 15.02.2022, 18:17 | Сообщение # 2
Сержант
Группа: Пользователи
Сообщений: 22
Репутация: 0
Статус: Offline
Такие подробные комменты. Полезно. good
 
haavДата: Среда, 16.02.2022, 10:00 | Сообщение # 3
Генералиссимус
Группа: Администраторы
Сообщений: 1361
Репутация: 49
Статус: Offline
Пример рабочий. Я так понял , данный пример в принципе только и может быть как составная часть для анализатора синтеза речи? По крайней мере , других практических применений я пока придумать не могу.

Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
 
electrikДата: Четверг, 17.02.2022, 01:23 | Сообщение # 4
Полковник
Группа: Друзья
Сообщений: 180
Репутация: 3
Статус: Offline
Этот вариант рассчитывался для синтеза. Главное, есть основа, а если кто захочет, заточит для своих нужд.
Для иностранных языков, наверное не подойдёт, но если вписать украинские, или белорусские названия, почему бы и нет. Там, вроде, окончания слов строятся как и в русском.
 
Форум » Freebasic » Исходники » Num2Text - алгоритм преобразования чисел в пропись (Преобразуем числа в сплошном тексте в слова)
  • Страница 1 из 1
  • 1
Поиск: