Forth http://fforum.winglion.ru/ |
|
дублирование одиночных цифр http://fforum.winglion.ru/viewtopic.php?f=19&t=1228 |
Страница 1 из 2 |
Автор: | Jelsay [ Вс апр 06, 2008 18:55 ] |
Заголовок сообщения: | дублирование одиночных цифр |
вот нашел на просторах Интернета простую задачу которая, ИМХО, допускает большую степень оптимизации: Цитата: Дано целое натуральное n. Сформировать новое число, продублировав все цифры, которые не имеют себе пары (например: 213020 —> 21133020).
|
Автор: | chess [ Пн апр 07, 2008 17:03 ] |
Заголовок сообщения: | |
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
|
Автор: | mOleg [ Вт апр 08, 2008 13:56 ] |
Заголовок сообщения: | |
мой вариант. Не оптимизировал, но подозреваю, что будет быстрее первого да, писано под последний СПФ, хотя должно работать под любым стандартным фортом (исправленный вариант) Код: \ 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 |
Автор: | chess [ Вт апр 08, 2008 14:09 ] |
Заголовок сообщения: | |
mOleg писал(а): мой вариант.
Не работает, например, в таком случае: Код: S" 888" sample CR
Должно получиться 8888(так как для одной из восьмерок нет пары), а получается 888. |
Автор: | mOleg [ Вт апр 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 |
Автор: | chess [ Вт апр 08, 2008 14:19 ] |
Заголовок сообщения: | |
mOleg, вот же в ТЗ как написано: Jelsay писал(а): продублировав все цифры, которые не имеют себе пары
|
Автор: | mOleg [ Вт апр 08, 2008 14:23 ] |
Заголовок сообщения: | |
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 #> ; |
Автор: | chess [ Вт апр 08, 2008 14:26 ] |
Заголовок сообщения: | |
mOleg писал(а): написать: 2 MOD IF DUP HOLD cstat 1+! ELSE DROP THEN
Да, с этой коррекцией все работает. |
Автор: | mOleg [ Вт апр 08, 2008 14:29 ] |
Заголовок сообщения: | |
chess писал(а): mOleg писал(а):написать: 2 MOD IF DUP HOLD cstat 1+! ELSE DROP THEN
Да, с этой коррекцией все работает. ТЗ не очень качественное 8( могут быть и другие варианты, например, ведь не обязательно добавлять пару сразу за цифрой? например так: 1231 --> 231231 |
Автор: | chess [ Вт апр 08, 2008 14:46 ] |
Заголовок сообщения: | |
mOleg писал(а): ТЗ не очень качественное
Согласен. Также ничего не сказано о базе системы счисления, максимальной разрядности чисел. Проверил латентность кода. У моего 170000 тиков, у твоего 150000 тиков(мой медленнее потому, что вместо внутреннего цикла DO LOOP нужно было делать цикл с Begin, поэтому есть холостая работа). |
Автор: | mOleg [ Вт апр 08, 2008 15:26 ] |
Заголовок сообщения: | |
chess писал(а): Проверил латентность кода.
У моего 170000 тиков, у твоего 150000 тиков(мой медленнее потому, что вместо внутреннего цикла DO LOOP нужно было делать цикл с Begin, поэтому есть холостая работа). многовато, однако получается в обоих случаях. вообще, вложенные циклы без особой нужды лучше не делать никогда - очень сложно такой код править, разбирать, развивать. |
Автор: | chess [ Ср апр 09, 2008 09:43 ] |
Заголовок сообщения: | |
mOleg писал(а): многовато, однако получается в обоих случаях.
Немного попрофилировал код решений. Вывод: основное время кушает TYPE. Без него(только формирование выходного набора символов в памяти) латентность падает при 1 цифре во входном числе примерно до 1000 тиков, а при 10 цифрах до 5000 тиков, то есть 400 тиков на 1 цифру. Вот еще одно замечание к ТЗ в части отсутствия требований к представлению выходного результата. |
Автор: | mOleg [ Ср апр 09, 2008 11:07 ] |
Заголовок сообщения: | |
chess писал(а): Вывод: основное время кушает TYPE. да, любой вызов API жрет непредсказуемое и большое число времени. chess писал(а): Вот еще одно замечание к ТЗ в части отсутствия требований к представлению выходного результата.
человек впервые выложил ТЗ, так что простительно |
Автор: | Jelsay [ Ср апр 09, 2008 21:11 ] |
Заголовок сообщения: | |
оптимальностью тут и не пахет Код: 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 |
Автор: | mOleg [ Ср апр 16, 2008 18:31 ] |
Заголовок сообщения: | |
еще один вариант. Код: \ 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 #> ; |
Страница 1 из 2 | Часовой пояс: UTC + 3 часа [ Летнее время ] |
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group http://www.phpbb.com/ |