Автор |
Сообщение |
|
|
Заголовок сообщения: |
|
|
|
тоже самое что и выше
Код: 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
тоже самое что и выше :))
[code]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 [/code]
|
|
|
|
Добавлено: Ср апр 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
[code]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[/code]
|
|
|
|
Добавлено: Ср апр 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 #> ;
еще один вариант.
[code] \ 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 ; [/code]
Используется битовый массив, для определения непарности цифр используется команда XOR. все непарные цифры добавляются в начало строки.
P.S. сразу в голову не пришло, что сканировать строку повторно не обязательно, посему слово transf можно заменить на следующее [code] \ преобразовать число в символ √ \ число не должно превышать значение находящееся в 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 #> ; [/code]
|
|
|
|
Добавлено: Ср апр 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
оптимальностью тут и не пахет :)
[code] 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 [/code]
|
|
|
|
Добавлено: Ср апр 09, 2008 21:11 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
chess писал(а): Вывод: основное время кушает TYPE. да, любой вызов API жрет непредсказуемое и большое число времени. chess писал(а): Вот еще одно замечание к ТЗ в части отсутствия требований к представлению выходного результата.
человек впервые выложил ТЗ, так что простительно
[quote="chess"]Вывод: основное время кушает TYPE.[/quote] да, любой вызов API жрет непредсказуемое и большое число времени.
[quote="chess"]Вот еще одно замечание к ТЗ в части отсутствия требований к представлению выходного результата.[/quote]
человек впервые выложил ТЗ, так что простительно 8)
|
|
|
|
Добавлено: Ср апр 09, 2008 11:07 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
mOleg писал(а): многовато, однако получается в обоих случаях.
Немного попрофилировал код решений.
Вывод: основное время кушает TYPE.
Без него(только формирование выходного набора символов в памяти) латентность
падает при 1 цифре во входном числе примерно до 1000 тиков, а при 10 цифрах до 5000 тиков, то есть 400 тиков на 1 цифру.
Вот еще одно замечание к ТЗ в части отсутствия требований к представлению выходного результата.
[quote="mOleg"]многовато, однако получается в обоих случаях. [/quote]
Немного попрофилировал код решений.
Вывод: основное время кушает TYPE.
Без него(только формирование выходного набора символов в памяти) латентность
падает при 1 цифре во входном числе примерно до 1000 тиков, а при 10 цифрах до 5000 тиков, то есть 400 тиков на 1 цифру.
Вот еще одно замечание к ТЗ в части отсутствия требований к представлению выходного результата.
|
|
|
|
Добавлено: Ср апр 09, 2008 09:43 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
chess писал(а): Проверил латентность кода. У моего 170000 тиков, у твоего 150000 тиков(мой медленнее потому, что вместо внутреннего цикла DO LOOP нужно было делать цикл с Begin, поэтому есть холостая работа).
многовато, однако получается в обоих случаях.
вообще, вложенные циклы без особой нужды лучше не делать никогда - очень сложно такой код править, разбирать, развивать.
[quote="chess"]Проверил латентность кода. У моего 170000 тиков, у твоего 150000 тиков(мой медленнее потому, что вместо внутреннего цикла DO LOOP нужно было делать цикл с Begin, поэтому есть холостая работа).[/quote]
многовато, однако получается в обоих случаях.
вообще, вложенные циклы без особой нужды лучше не делать никогда - очень сложно такой код править, разбирать, развивать.
|
|
|
|
Добавлено: Вт апр 08, 2008 15:26 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
mOleg писал(а): ТЗ не очень качественное
Согласен. Также ничего не сказано о базе системы счисления, максимальной разрядности чисел.
Проверил латентность кода.
У моего 170000 тиков, у твоего 150000 тиков(мой медленнее потому, что вместо внутреннего цикла
DO LOOP нужно было делать цикл с Begin, поэтому есть холостая работа).
[quote="mOleg"]ТЗ не очень качественное [/quote]
Согласен. Также ничего не сказано о базе системы счисления, максимальной разрядности чисел.
Проверил латентность кода.
У моего 170000 тиков, у твоего 150000 тиков(мой медленнее потому, что вместо внутреннего цикла
DO LOOP нужно было делать цикл с Begin, поэтому есть холостая работа).
|
|
|
|
Добавлено: Вт апр 08, 2008 14:46 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
chess писал(а): mOleg писал(а):написать: 2 MOD IF DUP HOLD cstat 1+! ELSE DROP THEN Да, с этой коррекцией все работает.
ТЗ не очень качественное 8( могут быть и другие варианты, например, ведь не обязательно добавлять пару сразу за цифрой?
например так: 1231 --> 231231
[quote="chess"]mOleg писал(а):написать: 2 MOD IF DUP HOLD cstat 1+! ELSE DROP THEN Да, с этой коррекцией все работает.[/quote]
ТЗ не очень качественное 8( могут быть и другие варианты, например, ведь не обязательно добавлять пару сразу за цифрой?
например так: 1231 --> 231231
|
|
|
|
Добавлено: Вт апр 08, 2008 14:29 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
mOleg писал(а): написать: 2 MOD IF DUP HOLD cstat 1+! ELSE DROP THEN
Да, с этой коррекцией все работает.
[quote="mOleg"]написать: 2 MOD IF DUP HOLD cstat 1+! ELSE DROP THEN[/quote]
Да, с этой коррекцией все работает.
|
|
|
|
Добавлено: Вт апр 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 #> ;
[quote="chess"]mOleg, вот же в ТЗ как написано: Jelsay писал(а):продублировав все цифры, которые не имеют себе пары[/quote]
дык, не понял, насчет именно пары
[code] \ заменить код 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 #> ; [/code]
|
|
|
|
Добавлено: Вт апр 08, 2008 14:23 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
mOleg, вот же в ТЗ как написано:
Jelsay писал(а): продублировав все цифры, которые не имеют себе пары
mOleg, вот же в ТЗ как написано:
[quote="Jelsay"]продублировав все цифры, которые не имеют себе пары[/quote]
|
|
|
|
Добавлено: Вт апр 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
[quote="chess"]Не работает, например, в таком случае: Код:S" 888" sample CR Должно получиться 8888(так как для одной из восьмерок нет пары), а получается 888.[/quote]
пардон, не так понял ТЗ
тогда проще всего вместо: 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.
[quote="mOleg"]мой вариант. [/quote]
Не работает, например, в таком случае:
[code]S" 888" sample CR [/code]
Должно получиться 8888(так как для одной из восьмерок нет пары), а получается 888.
|
|
|
|
Добавлено: Вт апр 08, 2008 14:09 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
мой вариант. Не оптимизировал, но подозреваю, что будет быстрее первого
да, писано под последний СПФ, хотя должно работать под любым стандартным фортом
(исправленный вариант)
Код: \ 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
мой вариант. Не оптимизировал, но подозреваю, что будет быстрее первого 8)
да, писано под последний СПФ, хотя должно работать под любым стандартным фортом
[color=red](исправленный вариант)[/color]
[code]
\ 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 [/code]
|
|
|
|
Добавлено: Вт апр 08, 2008 13:56 |
|
|
|
|