:: Архив конференции по VFP до 2005 года
• Войти
(Programmer) Перевод из одной сист. в другую
Grumax

Сообщений: 104
Откуда: г. Кинешма
Дата регистрации: 30.01.2005
Grumax
19.03.05 01:29:38
Господа программисты, будучи без спец.образования...затруднительно, т.е. вообще забыл как из одной системы в другую переводить. Речь идет о переводе из 2-ичной в 10-ричную и т.д...если кому не трудно, не могли бы превести алгоритм.
А если уж Вы совсем добрая душа, то перед мной стоит такая задачка...
Есть 33-ричная система "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ", необходимо перевести в десятиричную, прибавить +1, и вернуть обратно в 33-ричную, например переменную "ББ" сделать "БВ"
Спасибо. [sm128]




------------------
Я во все дела суюсь - всесторонне разовьюсь                                                                 Visual FoxPro 8.0
Ratings: 0 negative/0 positive
Re: (Programmer) Перевод из одной сист. в другую
matod

Сообщений: 3062
Откуда: Иркутск
Дата регистрации: 31.10.2001
matod
19.03.05 03:19:22
По поводу перевода из двоичной в десятиричную.
Пусть a(1),a(2), ...., a(n) - цифры двоичного числа. Тогда для перевода понадобится формула:
d = A(n) + A(n-1)*2 + A(n-2)*2^2 .... + A(1)*2^(n-1) т.е. получаем алгоритм, например для двоичного числа заданного строкой единиц и нулей:
function s2toN10
lparameters tcBin
    local n, i, d, p2
    n = len( m.tcBin )
    if m.n=0
        return 0
    endif
    d = val( substr( m.tcBin, n, 1) )    &&     Это будет результат
    p2 = 2                &&     Это степени двойки
    for i=m.n-1 to 1 step -1
        d = m.d + val( substr( m.tcBin, i, 1) ) * m.p2
        p2 = m.p2 * 2
    endfor
    return m.d
В принципе, по такому принципу переводятся все системы из системы с меньшим основанием в большую

Про вторую задачу. Здесь можно воспользоваться тем, что мы легко можем перевести в фоксе букву в число и обратно.
Что-то вроде этого. Думаю, по-аналогии можно легко переделать на сложение с любыми числами и для друних целей.
function Add1
lparameters c
    local i, n, k, p, nMax, res
    res = ''
    nMax = asc('Я')
    n = len( m.c )
    if m.n=0
        return 'А'
    endif
    p = 1
    for i=m.n to 1 step -1
        k = ASC( substr( m.c, m.i, 1) ) + m.p
        if m.k>m.nMax
            res = 'А' + m.res 
            p = 1        && перенос в следующий разряд
        else
            * Больше переносов не будет - просто оставляем остальную часть строки без изменения
            res = substr( m.c, 1, m.i-1) + chr(m.k) + m.res
            p=0
            exit
        endif
    endfor
    * Увеличение разрядности:
    if m.p>0
        res = 'А' + m.res
    endif
    return m.res
Ratings: 0 negative/0 positive
Re: (Programmer) Перевод из одной сист. в другую
Grumax

Сообщений: 104
Откуда: г. Кинешма
Дата регистрации: 30.01.2005
Grumax
19.03.05 12:23:46
matod
В принципе, по такому принципу переводятся все системы из системы с меньшим основанием в большую
С прескорбием понимаю, что это скорее подходит, чтобы решить вторую половину задачи из 10-ричной в 33-ичную.
Все еще нужна формула перевода из большего основания в меньшее...
matod
Про вторую задачу. Здесь можно воспользоваться тем, что мы легко можем перевести в фоксе букву в число и обратно.
На основе функций ASC(), CHR() всё уже сделано и претензий нет, просто рассматриваю другой вариант (более интересный и универсальный)
Если будет возможно перевести из 33 в -> 10+1 -> снова в 33, то что мешает сделать то же самое для 50-ричной(дальше больше) [sm128]




------------------
Я во все дела суюсь - всесторонне разовьюсь                                                                 Visual FoxPro 8.0
Ratings: 0 negative/0 positive
Re: (Programmer) Перевод из одной сист. в другую
Владимир Максимов

Сообщений: 14097
Откуда: Москва
Дата регистрации: 02.09.2000
Владимир Максимов
19.03.05 15:42:20
Цитата:
Есть 33-ричная система "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ", необходимо перевести в десятиричную, прибавить +1, и вернуть обратно в 33-ричную, например переменную "ББ" сделать "БВ"
А зачем здесь вообще надо переводить в 10-ричную систему? Делай все вычисления в той системе, в которой и работаешь!

* Арифметические действия в 33-ричной системе
CREATE CURSOR Items (ItemID I, Letter C(1))
INDEX ON ItemId TAG ItemId
INDEX ON Letter TAG Letter
INSERT INTO Items (ItemId, Letter) VALUES (0, "А")
INSERT INTO Items (ItemId, Letter) VALUES (1, "Б")
INSERT INTO Items (ItemId, Letter) VALUES (2, "В")
INSERT INTO Items (ItemId, Letter) VALUES (3, "Г")
INSERT INTO Items (ItemId, Letter) VALUES (4, "Д")
INSERT INTO Items (ItemId, Letter) VALUES (5, "Е")
INSERT INTO Items (ItemId, Letter) VALUES (6, "Ё")
INSERT INTO Items (ItemId, Letter) VALUES (7, "Ж")
INSERT INTO Items (ItemId, Letter) VALUES (8, "З")
INSERT INTO Items (ItemId, Letter) VALUES (9, "И")
INSERT INTO Items (ItemId, Letter) VALUES (10, "Й")
INSERT INTO Items (ItemId, Letter) VALUES (11, "К")
INSERT INTO Items (ItemId, Letter) VALUES (12, "Л")
INSERT INTO Items (ItemId, Letter) VALUES (13, "М")
INSERT INTO Items (ItemId, Letter) VALUES (14, "Н")
INSERT INTO Items (ItemId, Letter) VALUES (15, "О")
INSERT INTO Items (ItemId, Letter) VALUES (16, "П")
INSERT INTO Items (ItemId, Letter) VALUES (17, "Р")
INSERT INTO Items (ItemId, Letter) VALUES (18, "С")
INSERT INTO Items (ItemId, Letter) VALUES (19, "Т")
INSERT INTO Items (ItemId, Letter) VALUES (20, "У")
INSERT INTO Items (ItemId, Letter) VALUES (21, "Ф")
INSERT INTO Items (ItemId, Letter) VALUES (22, "Х")
INSERT INTO Items (ItemId, Letter) VALUES (23, "Ц")
INSERT INTO Items (ItemId, Letter) VALUES (24, "Ч")
INSERT INTO Items (ItemId, Letter) VALUES (25, "Ш")
INSERT INTO Items (ItemId, Letter) VALUES (26, "Щ")
INSERT INTO Items (ItemId, Letter) VALUES (27, "Ъ")
INSERT INTO Items (ItemId, Letter) VALUES (28, "Ы")
INSERT INTO Items (ItemId, Letter) VALUES (29, "Ь")
INSERT INTO Items (ItemId, Letter) VALUES (30, "Э")
INSERT INTO Items (ItemId, Letter) VALUES (31, "Ю")
INSERT INTO Items (ItemId, Letter) VALUES (32, "Я")
***************************************************
* Вычислить 
LOCAL lcValue1, lcValue2
lcValue1 = "БА"
lcValue2 = "Б"
***************************************************
* Складываем слова посимвольно справа-налево
LOCAL lnI, lnMaxLength
lnMaxLength = MAX(LEN(m.lcValue1),LEN(m.lcValue2))
LOCAL lcLetter1, lcLetter2
LOCAL lnItem1, lnItem2, lnNextUnit
lnNextUnit = 0
LOCAL lcResult
lcResult = ''
FOR m.lnI=1 TO m.lnMaxLength
    * Выделяем очередные буквы
    lcLetter1 = PADR(SubStr(m.lcValue1,LEN(m.lcValue1)-m.lnI+1,1),1)
    lcLetter2 = PADR(SubStr(m.lcValue2,LEN(m.lcValue2)-m.lnI+1,1),1)
    * Определяем порядковый номер каждой буквы
    =SEEK(m.lcLetter1,"Items","Letter")
    lnItem1 = Items.ItemId
    =SEEK(m.lcLetter2,"Items","Letter")
    lnItem2 = Items.ItemId
*   ?lcLetter1, lnItem1, lcLetter2, lnItem2 
    * Складываем очередные значения, определяя итоговую букву результата
    IF m.lnItem1+m.lnItem2+m.lnNextUnit>=Reccount("Items")
        =SEEK(m.lnItem1+m.lnItem2+m.lnNextUnit-Reccount("Items"),"Items","ItemId")
        lnNextUnit = 1
    ELSE
        =SEEK(m.lnItem1+m.lnItem2+m.lnNextUnit,"Items","ItemId")
        lnNextUnit = 0
    ENDIF
    * Записываем очередной символ результата
    lcResult = Items.Letter + m.lcResult
ENDFOR
IF m.lnNextUnit = 1
    =SEEK(m.lnNextUnit,"Items","ItemId")
    lcResult = Items.Letter + m.lcResult
ENDIF
?lcValue1,"+",lcValue2,"=",lcResult

Смысл заключается в следующем.

Когда ты складываешь 2 числа столбиком на бумажке (в 10-ричной системе), то действуешь примерно так:

62+1

-) 2+1 = 3 - это меньше, чем основание системы. Т.е. в данном случае меньше 10. Значит переносить 1 в старший разряд не надо. Оставлем это число как результат
-) 6+0 = 6
-) Результат 63

Абсолютно то же самое реализовано в приведенном коде. Тонкость заключается в том, что буква "А" соответствует цифре 0, поэтому если прибавить к "А" любую букву, то получим эту же букву.
Ratings: 0 negative/0 positive
Re: (Programmer) Перевод из одной сист. в другую
Rustam
Автор

Сообщений: 235
Откуда: Иркутск
Дата регистрации: 14.10.2000
Rustam
19.03.05 16:23:47
Как говорят дело было вечером и делать было нечего.
Написал три функции в определенной степени универсальные.
Функция FromAnyBase(tcNumber,tcFromBaseDigits) Перевод числа в десятичную с любой основы.
Пример для 16-ой системы, FromAnyBase('FFEFFE','0123456789ABCDEF')

Функция ToAnyBase(tcNumber,tcFromBaseDigits) Перевод числа c любой основы в 10-ную.
Пример для 16-ой системы, ToAnyBase(1023,'0123456789ABCDEF')

Функция Increment(tcNumber,tcBaseDigits) Прибавление единицы в число любой основой.
Пример для 16-ой системы, Increment(1023,'0123456789ABCDEF')


Function FromAnyBase(tcNumber,tcFromBaseDigits)
    Local lnRetNumber,llMinus,lnFromBase
    If Vartype(tcNumber)="N"
        tcNumber = Transform(tcNumber)
    Endif
    llMinus = (Left(tcNumber,1)=='-')
    If llMinus
        tcNumber = Substr(tcNumber,2)
    Endif
    lnFromBase=Len(tcFromBaseDigits)
    lnRetNumber = 0
    Do While !Empty(tcNumber)
        lnRetNumber = lnRetNumber * lnFromBase + At(Left(tcNumber,1),tcFromBaseDigits) - 1
        tcNumber = Substr(tcNumber,2)
    Enddo
    If llMinus
        lnRetNumber = -1*lnRetNumber
    Endif
    Return lnRetNumber
Endfunc
Function ToAnyBase(tnNumber,tcToBaseDigits)
    Local lcRetNumber,llMinus,lnToBase
    If Vartype(tnNumber)="C"
        tnNumber = Val(tnNumber)
    Endif
    If tnNumber<0
        tnNumber = -1*tnNumber
        llMinus    = .T.
    Endif
    lnToBase = Len(tcToBaseDigits)
    lcRetNumber = ''
    Do While tnNumber > 0
        lcRetNumber = Substr(tcToBaseDigits,tnNumber%lnToBase+1,1)+lcRetNumber
        tnNumber     = Floor(tnNumber/lnToBase)
    Enddo
    If llMinus
        lcRetNumber = '-'+lcRetNumber
    Endif
    Return lcRetNumber
Endfunc
Function Increment(tcNumber,tcBaseDigits)
    Local tnBase,lcLastDigit,lcLastDigit1,lnLastPos,lcFirtsDigit,lcRightPart
    tnBase = Len(tcBaseDigits)
    lcLastDigit = Right(tcNumber,1)
    lnLastPos   = At(lcLastDigit,tcBaseDigits)
    lcFirtsDigit = Left(tcBaseDigits,1)
    If lnLastPos < tnBase
        lcLastDigit =  Substr(tcBaseDigits,lnLastPos+1,1)
        tcNumber = Left(tcNumber,Len(tcNumber)-1)+lcLastDigit
    Else
        lcRightPart = ''
        lcLastDigit1 = lcLastDigit
        Do While !Empty(tcNumber) And lcLastDigit1==lcLastDigit
            lcRightPart     = lcRightPart+lcFirtsDigit
            tcNumber         = Left(tcNumber,Len(tcNumber)-1)
            lcLastDigit1     = Right(tcNumber,1)
        Enddo
        If Empty(tcNumber)
            tcNumber = Substr(tcBaseDigits,2,1)
        Else
            lnLastPos   = At(lcLastDigit1,tcBaseDigits)
            tcNumber    = Left(tcNumber,Len(tcNumber)-1)+Substr(tcBaseDigits,lnLastPos+1,1)
        Endif
Endfunc
Ratings: 0 negative/0 positive


:: Список Форумов•Список тем•Поиск•Войти
Извините, но у вас нет прав для того, чтобы оставлять сообщения в этом форуме.

On-line: 9 (Гостей: 9)
© 2000-2024 Fox Club 
Яндекс.Метрика