Forth и другие саморасширяющиеся системы программирования Locations of visitors to this page
Текущее время: Вс дек 16, 2018 19:18

...
Google Search
Forth-FAQ Spy Grafic

Часовой пояс: UTC + 3 часа [ Летнее время ]




Начать новую тему Ответить на тему  [ Сообщений: 17 ]  На страницу 1, 2  След.
Автор Сообщение
 Заголовок сообщения: дублирование одиночных цифр
СообщениеДобавлено: Вс апр 06, 2008 18:55 
Не в сети

Зарегистрирован: Сб янв 26, 2008 18:23
Сообщения: 71
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
вот нашел на просторах Интернета простую задачу которая, ИМХО, допускает большую степень оптимизации:

Цитата:
Дано целое натуральное n. Сформировать новое число, продублировав все цифры, которые не имеют себе пары (например: 213020 —> 21133020).


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пн апр 07, 2008 17:03 
Не в сети
Аватара пользователя

Зарегистрирован: Чт июл 20, 2006 11:31
Сообщения: 2120
Откуда: Екб
Благодарил (а): 0 раз.
Поблагодарили: 40 раз.
Jelsay писал(а):
Сформировать новое число, продублировав все цифры, которые не имеют себе пары (например: 213020 —> 21133020).

Решение без всякой оптимизации :?
Код:
CREATE I-B  20 ALLOT \ буфер символов входного числа
CREATE O-B  40 ALLOT \ буфер символов выходного числа
0 VALUE LN           \ длина символов входного числа
0 VALUE O-DP         \ указатель на символ выходного числа

: MARK! \ Маркировка цифр числа на предмет отсутствия парной цифры
I-B LN + I-B
DO I-B LN + I-B
   DO J I 1+ <
      IF  J C@ 0x3F AND I C@ 0x3F AND =
          J C@ 0x40 AND 0x40 <> I C@ 0x40 AND 0x40 <> OR AND
          IF  J C@ 0x80 XOR J C! J I <>
             IF  I C@ 0x40 OR I C! THEN
          THEN
      THEN
   LOOP
LOOP ;

: Qpar
NextWord DUP TO LN I-B SWAP CMOVE \ переслать символы вх. числа в буфер символов
MARK!
I-B LN + I-B  DO                  \ формир-ие символов вых. числа в вых. буфере
I C@ 0x80 AND IF I C@ 0x3F AND O-B O-DP + C! O-DP 1+ TO O-DP THEN
I C@ 0x3F AND O-B O-DP + C! O-DP 1+ TO O-DP  LOOP
O-B O-DP CR TYPE ;

Qpar 123210002221

лог
Код:
1122332100002221

_________________
С уважением, chess


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вт апр 08, 2008 13:56 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4956
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 18 раз.
Поблагодарили: 56 раз.
мой вариант. Не оптимизировал, но подозреваю, что будет быстрее первого 8)
да, писано под последний СПФ, хотя должно работать под любым стандартным фортом

(исправленный вариант)
Код:

\ 2008-04-08 ~mOleg
\ Сopyright [C] 2008 mOleg mininoleg@yahoo.com
\ удвоение уникальных цифр строки

  10 CONSTANT basedigits  \ ожидаемый диапазон цифр (шестнадцатиричные не предлагать)

\ по количеству значащих цифр создаем массив для хранения счетчиков
CREATE Сiphers basedigits CELLS ALLOT

\ стираем содержимое массива
: init ( --> ) Сiphers basedigits CELLS ERASE ;

\ найти поле в массиве, соответствующее цифре
: cstat ( char --> ) [CHAR] 0 - CELLS Сiphers + ;

\ подготовили массив
: prep ( asc # --> )
       OVER + SWAP
       BEGIN 2DUP <> WHILE
             DUP C@ cstat 1+!
           1 +
       REPEAT 2DROP ;

\ преоборазовали исходную строку
: transf ( asc # --> )
         OVER +
         <# BEGIN 2DUP <> WHILE 1 -
                  DUP C@ DUP HOLD
                         DUP cstat @
                         2 MOD IF DUP HOLD cstat 1+! ELSE DROP THEN
            REPEAT
          #> ;

\ собственно, главное слово
: sample ( asc # --> ) init 2DUP prep transf TYPE ;

S" 874205257" sample CR

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Последний раз редактировалось mOleg Чт апр 17, 2008 14:39, всего редактировалось 2 раз(а).

Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вт апр 08, 2008 14:09 
Не в сети
Аватара пользователя

Зарегистрирован: Чт июл 20, 2006 11:31
Сообщения: 2120
Откуда: Екб
Благодарил (а): 0 раз.
Поблагодарили: 40 раз.
mOleg писал(а):
мой вариант.

Не работает, например, в таком случае:
Код:
S" 888" sample CR

Должно получиться 8888(так как для одной из восьмерок нет пары), а получается 888.

_________________
С уважением, chess


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вт апр 08, 2008 14:19 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4956
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 18 раз.
Поблагодарили: 56 раз.
chess писал(а):
Не работает, например, в таком случае:
Код:S" 888" sample CR
Должно получиться 8888(так как для одной из восьмерок нет пары), а получается 888.

пардон, не так понял ТЗ

тогда проще всего вместо: 1 - IF DROP ELSE HOLD THEN
написать: 2 MOD IF DUP HOLD cstat 1+! ELSE DROP THEN

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Последний раз редактировалось mOleg Вт апр 08, 2008 14:21, всего редактировалось 1 раз.

Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вт апр 08, 2008 14:19 
Не в сети
Аватара пользователя

Зарегистрирован: Чт июл 20, 2006 11:31
Сообщения: 2120
Откуда: Екб
Благодарил (а): 0 раз.
Поблагодарили: 40 раз.
mOleg, вот же в ТЗ как написано:
Jelsay писал(а):
продублировав все цифры, которые не имеют себе пары

_________________
С уважением, chess


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вт апр 08, 2008 14:23 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4956
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 18 раз.
Поблагодарили: 56 раз.
chess писал(а):
mOleg, вот же в ТЗ как написано:
Jelsay писал(а):продублировав все цифры, которые не имеют себе пары

дык, не понял, насчет именно пары
Код:
\ заменить код transf на следующий
\ преоборазовали исходную строку
: transf ( asc # --> )
         OVER +
         <# BEGIN 2DUP <> WHILE 1 -
                  DUP C@ DUP HOLD
                         DUP cstat @
                         2 MOD IF DUP HOLD cstat 1+! ELSE DROP THEN
            REPEAT
          #> ;

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вт апр 08, 2008 14:26 
Не в сети
Аватара пользователя

Зарегистрирован: Чт июл 20, 2006 11:31
Сообщения: 2120
Откуда: Екб
Благодарил (а): 0 раз.
Поблагодарили: 40 раз.
mOleg писал(а):
написать: 2 MOD IF DUP HOLD cstat 1+! ELSE DROP THEN

Да, с этой коррекцией все работает.

_________________
С уважением, chess


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вт апр 08, 2008 14:29 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4956
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 18 раз.
Поблагодарили: 56 раз.
chess писал(а):
mOleg писал(а):написать: 2 MOD IF DUP HOLD cstat 1+! ELSE DROP THEN
Да, с этой коррекцией все работает.

ТЗ не очень качественное 8( могут быть и другие варианты, например, ведь не обязательно добавлять пару сразу за цифрой?
например так: 1231 --> 231231

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вт апр 08, 2008 14:46 
Не в сети
Аватара пользователя

Зарегистрирован: Чт июл 20, 2006 11:31
Сообщения: 2120
Откуда: Екб
Благодарил (а): 0 раз.
Поблагодарили: 40 раз.
mOleg писал(а):
ТЗ не очень качественное

Согласен. Также ничего не сказано о базе системы счисления, максимальной разрядности чисел.
Проверил латентность кода.
У моего 170000 тиков, у твоего 150000 тиков(мой медленнее потому, что вместо внутреннего цикла
DO LOOP нужно было делать цикл с Begin, поэтому есть холостая работа).

_________________
С уважением, chess


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вт апр 08, 2008 15:26 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4956
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 18 раз.
Поблагодарили: 56 раз.
chess писал(а):
Проверил латентность кода.
У моего 170000 тиков, у твоего 150000 тиков(мой медленнее потому, что вместо внутреннего цикла
DO LOOP нужно было делать цикл с Begin, поэтому есть холостая работа).

многовато, однако получается в обоих случаях.

вообще, вложенные циклы без особой нужды лучше не делать никогда - очень сложно такой код править, разбирать, развивать.

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Ср апр 09, 2008 09:43 
Не в сети
Аватара пользователя

Зарегистрирован: Чт июл 20, 2006 11:31
Сообщения: 2120
Откуда: Екб
Благодарил (а): 0 раз.
Поблагодарили: 40 раз.
mOleg писал(а):
многовато, однако получается в обоих случаях.

Немного попрофилировал код решений.
Вывод: основное время кушает TYPE.
Без него(только формирование выходного набора символов в памяти) латентность
падает при 1 цифре во входном числе примерно до 1000 тиков, а при 10 цифрах до 5000 тиков, то есть 400 тиков на 1 цифру.
Вот еще одно замечание к ТЗ в части отсутствия требований к представлению выходного результата.

_________________
С уважением, chess


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Ср апр 09, 2008 11:07 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4956
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 18 раз.
Поблагодарили: 56 раз.
chess писал(а):
Вывод: основное время кушает TYPE.

да, любой вызов API жрет непредсказуемое и большое число времени.

chess писал(а):
Вот еще одно замечание к ТЗ в части отсутствия требований к представлению выходного результата.

человек впервые выложил ТЗ, так что простительно 8)

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Ср апр 09, 2008 21:11 
Не в сети

Зарегистрирован: Сб янв 26, 2008 18:23
Сообщения: 71
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
оптимальностью тут и не пахет :)

Код:
VARIABLE SUM
CREATE BF 10 ALLOT

\  вставка цифры в нужный разряд 
:  S+ ( N --)  SUM  @ 10  * + SUM !  ;
\  сколько раз встречается данная цифра в числе
:  COUNTED ( N --)  BEGIN  10 /MOD  SWAP  BF + DUP C@ 1+ SWAP C!  DUP  0= UNTIL  DROP ;
\ формирование нового числа
:  NEW ( N --)   BEGIN  10 /MOD  SWAP DUP BF + C@  1 =  IF DUP S+ S+  ELSE S+ THEN DUP 0= UNTIL  DROP ;
\  выверт на изнанку нового числа
:  WEN ( N --)   BEGIN  10 /MOD  SWAP S+ DUP 0= UNTIL  DROP ;
\ главное слово
: MAIN ( N--) DUP COUNTED NEW SUM @  0 SUM ! WEN  SUM @  . ;

1223 MAIN KEY DROP BYE


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Ср апр 16, 2008 18:31 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4956
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 18 раз.
Поблагодарили: 56 раз.
еще один вариант.
Код:
\ 2008-04-16 ~mOleg

\ чтобы не подключать внешнюю либу:
\ преобразовать символ в цифру
: >CIPHER ( c --> u|-1 )
          DUP [CHAR] 0 [CHAR] : WITHIN IF 48 - EXIT THEN
          DUP [CHAR] A [CHAR] [ WITHIN IF 55 - EXIT THEN
          DUP [CHAR] a [CHAR] { WITHIN IF 87 - EXIT THEN
          DROP -1 ;

\ ----------------------------------------------------------------------------------
        USER-VALUE digits \ вместо списка одно число

\ вернуть маску указанной цифры и маску для всех цифр
: m&m ( char --> u u ) >CIPHER 1 SWAP LSHIFT digits ;

\ сканировать строку цифр (возможно и символов) собирать статистику
: scan ( asc # --> )
       OVER + SWAP
       BEGIN 2DUP <> WHILE
             DUP C@ m&m XOR TO digits
         1 +
       REPEAT 2DROP ;

\ преобразование исходной строки согласно ТЗ
: transf ( asc # --> asc # )
         2DUP <# HOLDS  OVER +
                 BEGIN 2DUP <> WHILE 1 -
                       DUP C@
                           DUP m&m OVER INVERT OVER AND TO digits
                               AND IF HOLD ELSE DROP THEN
                 REPEAT
               #> ;

\ собственно, главное слово
: sample ( asc # --> )
         0 TO digits
         2DUP scan transf
         TYPE ;


Используется битовый массив, для определения непарности цифр используется команда XOR.
все непарные цифры добавляются в начало строки.

P.S.
сразу в голову не пришло, что сканировать строку повторно не обязательно, посему слово transf можно заменить на следующее
Код:
\ преобразовать число в символ √
\ число не должно превышать значение находящееся в BASE
: >DIGIT ( u --> char ) DUP 0x09 > IF 7 + THEN 0x30 + ;

\ преобразование исходной строки согласно ТЗ
: transf ( asc # --> asc # )
         <# HOLDS
            0 digits 0x3FF AND
            BEGIN DUP WHILE
                  DUP 1 AND IF OVER >DIGIT HOLD THEN
              2/ SWAP 1 + SWAP
            REPEAT
          #> ;

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 17 ]  На страницу 1, 2  След.

Часовой пояс: UTC + 3 часа [ Летнее время ]


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1


Вы не можете начинать темы
Вы можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
phpBB сборка от FladeX // Русская поддержка phpBB