Forth и другие саморасширяющиеся системы программирования Locations of visitors to this page
Текущее время: Чт дек 13, 2018 07:41

...
Google Search
Forth-FAQ Spy Grafic

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




Ответить
Имя пользователя:
Заголовок:
Текст сообщения:
Введите текст вашего сообщения. Длина сообщения в символах не более: 60000

Размер шрифта:
Цвет шрифта
Настройки:
BBCode ВКЛЮЧЕН
[img] ВЫКЛЮЧЕН
[flash] ВЫКЛЮЧЕН
[url] ВКЛЮЧЕН
Смайлики ВЫКЛЮЧЕНЫ
Отключить в этом сообщении BBCode
Не преобразовывать адреса URL в ссылки
Вопрос
Теперь гостю придется вводить здесь пароль. Не от своей учетной записи, а ПАРОЛЬ ДЛЯ ГОСТЯ, получить который можно после регистрации на форуме через ЛС.:
Этот вопрос предназначен для выявления и предотвращения автоматических регистраций.
   

Обзор темы - дублирование одиночных цифр
Автор Сообщение
  Заголовок сообщения:   Ответить с цитатой
тоже самое что и выше :))


Код:
VARIABLE A

: NUM  S" 012345000" ;

CREATE CNT 10  ALLOT
CREATE BUFF NUM  2* ALLOT DROP

: S+   ( CH -- )  48 + BUFF  A @ + C!  A @ 1+ A !  ;
: COUNTED ( --) NUM OVER + SWAP DO I C@ 48 -  CNT + DUP C@ 1+ SWAP C! LOOP ;
: MAKE ( --) NUM OVER + SWAP DO I C@ 48 - DUP  DUP CNT + C@ 1 = IF DUP S+ S+ ELSE S+ THEN LOOP ;
: SHOW  ( --)  NUM TYPE CR BUFF A @ TYPE ;
: BOSS  ( --)  COUNTED MAKE SHOW ;

CR  BOSS CR  KEY DROP
Сообщение Добавлено: Ср апр 16, 2008 22:12
  Заголовок сообщения:   Ответить с цитатой
Код:
VARIABLE Позиция

: ВХодное_Число  S" 012345000" ;

CREATE Счётчик_Цифр 10  ALLOT
CREATE ВЫходное_Число ВХодное_Число  2* ALLOT DROP

: Цифру_в_Позицию   ( CH -- ) 
  48 + ВЫходное_Число  Позиция @ + C!  Позиция @ 1+ Позиция ! 
;

: Подсчёт_Цифр ( --)
  ВХодное_Число  OVER + SWAP
        DO I C@ 48 -  Счётчик_Цифр + DUP C@ 1+ SWAP C!
       LOOP
;

: Создание_Числа_по_Правилу ( --)   
   ВХодное_Число  OVER + SWAP
        DO  I C@ 48 - DUP  DUP Счётчик_Цифр + C@ 1 =   
                      IF DUP Цифру_в_Позицию Цифру_в_Позицию
                      ELSE Цифру_в_Позицию
                      THEN
        LOOP
;

: Вывод_Результата  ( --) 
  ВХодное_Число TYPE CR
  ВЫходное_Число Позиция @ TYPE
;

: BOSS  ( --) 
  Подсчёт_Цифр 
  Создание_Числа_по_Правилу
  Вывод_Результата
;

CR  BOSS CR  KEY DROP BYE
Сообщение Добавлено: Ср апр 16, 2008 22:09
  Заголовок сообщения:   Ответить с цитатой
еще один вариант.
Код:
\ 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
          #> ;
Сообщение Добавлено: Ср апр 16, 2008 18:31
  Заголовок сообщения:   Ответить с цитатой
оптимальностью тут и не пахет :)

Код:
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
Сообщение Добавлено: Ср апр 09, 2008 21:11
  Заголовок сообщения:   Ответить с цитатой
chess писал(а):
Вывод: основное время кушает TYPE.

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

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

человек впервые выложил ТЗ, так что простительно 8)
Сообщение Добавлено: Ср апр 09, 2008 11:07
  Заголовок сообщения:   Ответить с цитатой
mOleg писал(а):
многовато, однако получается в обоих случаях.

Немного попрофилировал код решений.
Вывод: основное время кушает TYPE.
Без него(только формирование выходного набора символов в памяти) латентность
падает при 1 цифре во входном числе примерно до 1000 тиков, а при 10 цифрах до 5000 тиков, то есть 400 тиков на 1 цифру.
Вот еще одно замечание к ТЗ в части отсутствия требований к представлению выходного результата.
Сообщение Добавлено: Ср апр 09, 2008 09:43
  Заголовок сообщения:   Ответить с цитатой
chess писал(а):
Проверил латентность кода.
У моего 170000 тиков, у твоего 150000 тиков(мой медленнее потому, что вместо внутреннего цикла
DO LOOP нужно было делать цикл с Begin, поэтому есть холостая работа).

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

вообще, вложенные циклы без особой нужды лучше не делать никогда - очень сложно такой код править, разбирать, развивать.
Сообщение Добавлено: Вт апр 08, 2008 15:26
  Заголовок сообщения:   Ответить с цитатой
mOleg писал(а):
ТЗ не очень качественное

Согласен. Также ничего не сказано о базе системы счисления, максимальной разрядности чисел.
Проверил латентность кода.
У моего 170000 тиков, у твоего 150000 тиков(мой медленнее потому, что вместо внутреннего цикла
DO LOOP нужно было делать цикл с Begin, поэтому есть холостая работа).
Сообщение Добавлено: Вт апр 08, 2008 14:46
  Заголовок сообщения:   Ответить с цитатой
chess писал(а):
mOleg писал(а):написать: 2 MOD IF DUP HOLD cstat 1+! ELSE DROP THEN
Да, с этой коррекцией все работает.

ТЗ не очень качественное 8( могут быть и другие варианты, например, ведь не обязательно добавлять пару сразу за цифрой?
например так: 1231 --> 231231
Сообщение Добавлено: Вт апр 08, 2008 14:29
  Заголовок сообщения:   Ответить с цитатой
mOleg писал(а):
написать: 2 MOD IF DUP HOLD cstat 1+! ELSE DROP THEN

Да, с этой коррекцией все работает.
Сообщение Добавлено: Вт апр 08, 2008 14:26
  Заголовок сообщения:   Ответить с цитатой
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
          #> ;
Сообщение Добавлено: Вт апр 08, 2008 14:23
  Заголовок сообщения:   Ответить с цитатой
mOleg, вот же в ТЗ как написано:
Jelsay писал(а):
продублировав все цифры, которые не имеют себе пары
Сообщение Добавлено: Вт апр 08, 2008 14:19
  Заголовок сообщения:   Ответить с цитатой
chess писал(а):
Не работает, например, в таком случае:
Код:S" 888" sample CR
Должно получиться 8888(так как для одной из восьмерок нет пары), а получается 888.

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

тогда проще всего вместо: 1 - IF DROP ELSE HOLD THEN
написать: 2 MOD IF DUP HOLD cstat 1+! ELSE DROP THEN
Сообщение Добавлено: Вт апр 08, 2008 14:19
  Заголовок сообщения:   Ответить с цитатой
mOleg писал(а):
мой вариант.

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

Должно получиться 8888(так как для одной из восьмерок нет пары), а получается 888.
Сообщение Добавлено: Вт апр 08, 2008 14:09
  Заголовок сообщения:   Ответить с цитатой
мой вариант. Не оптимизировал, но подозреваю, что будет быстрее первого 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
Сообщение Добавлено: Вт апр 08, 2008 13:56

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


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