Forth и другие саморасширяющиеся системы программирования Locations of visitors to this page
Текущее время: Чт мар 28, 2024 21:25

...
Google Search
Forth-FAQ Spy Grafic

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




Начать новую тему Ответить на тему  [ Сообщений: 16 ]  На страницу 1, 2  След.
Автор Сообщение
 Заголовок сообщения: *найти все возможные комбинации бит внутри заданной маски
СообщениеДобавлено: Вт дек 11, 2007 01:18 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 5062
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 23 раз.
Поблагодарили: 63 раз.
Для заданного числа um, представляющего собой битовую маску, найти все варианты битовых сочетаний, таких что,
операция логического И с инверсной маской в результате вернет 0:
: test ( u mask --> flag ) INVERT AND ;
(То есть смысл фактически в том, чтобы биты двоичного счетчика раздвинуть так, чтобы они располагались в местах, где единички в маске стоят).

пример:
для маски b0011 должны получиться следующие значения: b0000 b0001 b0010 b0011;
для маски b1001 -- следующие: b0000 b0001 b1000 b1001;
для маски b0110 -- b0000 b0010 b0100 b0110; и так далее

Найти за минимальное время все возможные комбинации бит внутри маски um, сохранить их в массиве.
Размер маски 1 CELL, битовое заполнение маски не может превышать 25% величины.

Код:
\ найти все возможные комбинации бит внутри маски um
\ вернуть адрес и длину получившегося массива
: combs ( um --> addr # )

        ;


Последний раз редактировалось mOleg Чт мар 20, 2008 16:42, всего редактировалось 1 раз.

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

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
INVERT AND не равно ли XOR ?

что-то ночью плохо соображаю ...

_________________
понимаю некоторую бестолковость некоторых вопросов


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

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 5062
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 23 раз.
Поблагодарили: 63 раз.
вопрос писал(а):
INVERT AND не равно ли XOR ?

нет, не равно

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


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вт дек 11, 2007 04:33 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 13:19
Сообщения: 3565
Откуда: St.Petersburg
Благодарил (а): 4 раз.
Поблагодарили: 72 раз.
Итак, я сделал и проверил решение на "своем форте"
для 16-битного варианта Форта.


последняя версия кода:

Код:
\ решение делалось на своем Форте (Sprinter-FORTH)
\ взять его (для интересу) можно отсюда: http://winglion.ru/forth/pc_forth.zip
\ это 16-битный форт, работающий под DOS (в windows-XP у меня он тоже запускается)
\ распаковать зип в отдельный каталог (файлы forth.com и forth.frt)
\ запускать forth.com, в ком строке INCLUDE test.frt
\ в файл test.frt сохранить данный исходник

HEX \ изначально в шестнадцатеричной системе

\ определяем маску. видимо, надо это через VALUE переменные делать,
\ но не помню всех нужных слов из SPF, a решение делаю в "СвоемФорте"

45 CONSTANT MASK \ значение маски здесь не имеет особого значения
\ потом она переписывается для адаптации под SPF тут надо использовать VALUE переменные

\ определяем инверсную маску

MASK -1 XOR CONSTANT nMASK

\ определяем слово, увеличивающее на единичку счетчик с "разреженными" разрядами.

: MASK++ ( NN -- NN+1 )
  DUP \ для сохранения немаскированных битов числа, не участвующих в счете
  nMASK \ маскируем биты, через которые должен насквозь проходить перенос
  OR 1+ MASK AND  \ следующее число
  SWAP nMASK AND OR  \ эту часть слова можно удалить вместе с первым DUP-ом,
  \ т.к. биты числа вне маски по ТЗ не требуется.
  ;

\ определяем слово для вычисления предела для счетчика комбинаций
\ просто счетчик битов с одновременным возведением двойки в степень
: maxima 1 MASK 32 0 DO DUP 1 AND IF SWAP 2* SWAP THEN 2/ LOOP DROP ;

CREATE massive 100 CELLS ALLOT \ массив нa 256 значений

\ решаем...
: combs ( um --> )
-> MASK \ слово -> вписывает значение со стека в константу
MASK -1 XOR -> nMASK \ переписываем инверсную константу
maxima \ вычисление количества комбинаций
\ защита "от дурака" (от длинного цикла)
DUP 100 > IF . ." более 25% заполнение маски. задача остановлена. " EXIT THEN
DECIMAL DUP ." Для числа " MASK . ." -- " . ." комбинаций:" CR HEX
0 \ начальное значение "разреженного счетчика"
SWAP   
0 DO \ цикл по количеству всех комбинаций
DUP H. \ вывод результата, начиная с нуля
DUP massive I CELLS + ! \ сохранение в massive
MASK++ \ следующий!
LOOP ;

33 combs \ проверка

555 combs



в результате получаю на экране

Код:
Для числа 51 -- 16 комбинаций:
0000 0001 0002 0003 0010 0011 0012 0013 0020 0021 0022 0023 0030 0031 0032 0033
Для числа 1365 -- 64 комбинаций:
0000 0001 0004 0005 0010 0011 0014 0015 0040 0041 0044 0045 0050 0051 0054 0055
0100 0101 0104 0105 0110 0111 0114 0115 0140 0141 0144 0145 0150 0151 0154 0155
0400 0401 0404 0405 0410 0411 0414 0415 0440 0441 0444 0445 0450 0451 0454 0455
0500 0501 0504 0505 0510 0511 0514 0515 0540 0541 0544 0545 0550 0551 0554 0555


плюс все эти значения записанны в массив massive

p.s. Адаптация под SPF формально не должна вызвать сложностей
но я уже клюю носом, и сейчас этим заниматься уже нет сил..

_________________
С уважением, WingLion
Forth-CPU . RuF09WE
Мой Форт
Отсутствие бана это не заслуга юзера, а недоработка модератора (с)


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

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 5062
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 23 раз.
Поблагодарили: 63 раз.
мое решение.
Для запуска нужен СПФ4.18
Код:
\ 12-12-200 ~mOleg
\ Copyright [C] 2007 mOleg mininoleg@yahoo.com
\ задачка с конкурса на форуме: http://fforum.winglion.ru/viewtopic.php?t=1068

REQUIRE TILL devel\~moleg\lib\util\for-next.f

\ вернуть количество бит в стандартной ячейке
: bits/cell ( --> u ) 0 -1 BEGIN TUCK WHILE 1+ SWAP 2* REPEAT NIP ;

        0 VALUE buffer \ адрес места, где хранится результирующий массив

\ выделение памяти под массив и его инициализация
bits/cell 4 / 1 SWAP LSHIFT CELLS CELL + ALLOCATE THROW DUP TO buffer 0!

\
: aCount ( addr --> addr # ) DUP CELL + SWAP @ ;

\ отправить значение в буфер
: ->buf ( u --> )
        buffer aCount + !
        CELL buffer +! ;

\ перевести значение счетчика u в следующую позицию, согласно маске um
: increment ( um u --> um u++ ) OVER INVERT OR 1 + OVER AND ;

\ найти все возможные комбинации бит внутри маски um
\ вернуть адрес и длину получившегося массива
: combs ( um --> addr # )
        0 buffer !
        0 BEGIN DUP ->buf      \ сохранить результат в буфер
                2DUP <> WHILE  \ пока не достигнут предел счета
                increment      \ увеличить значение счетчика
          REPEAT 2DROP
        buffer aCount ;

\EOF
: ~combs buffer DUP @ CELL / FOR CELL + DUP @ . SPACE TILL DROP ;

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


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

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 5062
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 23 раз.
Поблагодарили: 63 раз.
пока что результаты следующие:
Calls      Ticks        AverageTicks     Name
mOleg 100 | 679,500 | 6,795 | sample
profit 100 | 1,296,518,256 | 12,965,182 | sample


тестировалось с помощью следующего testspd.f
Код:
\ 28-10-2007 ~mOleg
\ тестируем скорость работы алгоритма

REQUIRE FOR  devel\~mOleg\lib\util\for-next.f
REQUIRE own  devel\~moleg\lib\util\priority.f

                                   DECIMAL

\ для замера скорости
REQUIRE ResetProfiles  devel\~pinka\lib\Tools\profiler.f

\ проверит скорость работы выбраного алгоритма
: sample ( --> ) 0x88888888 combs 2DROP ;

realtime own 0= THROW \ не могу установить приоритет

: test ( --> )
       ResetProfiles
         100 FOR sample TILL
       CR .AllStatistic ;

normal own DROP


и заклинания в test.bat spf4.exe %1 testspd.f test BYE

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


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

Зарегистрирован: Пт май 05, 2006 06:19
Сообщения: 192
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Код:

  1024 ALLOCATE THROW VALUE adr
: combs ( u -- adr u )
   0 adr >R
   BEGIN
   2DUP SWAP 1 + U<
   WHILE
   2DUP SWAP INVERT AND 0=
   IF DUP R@ ! R> 4 + >R  THEN
   1 +
   REPEAT
   2DROP adr R> OVER -
;

S" ok" CR TYPE

решение за 5 минут :)
PS +5 минут на исправление - привдение потребованиям оформления
PPS +10 минут на отладку

_________________
SPF


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Чт дек 13, 2007 18:14 
Не в сети

Зарегистрирован: Ср май 03, 2006 11:27
Сообщения: 1394
Откуда: St.Petersburg
Благодарил (а): 2 раз.
Поблагодарили: 11 раз.
Код:
: MINBIT
  DUP
  INVERT 1+
  XOR
INVERT 1+ 1 RSHIFT
;

0  VALUE  TEMPLATE
0  VALUE ITEMPLATE
0  VALUE NTEMPLATE

: TEMPLATE.
TO TEMPLATE
TEMPLATE INVERT TO ITEMPLATE
TEMPLATE MINBIT TO NTEMPLATE
0
BEGIN
ITEMPLATE OR
NTEMPLATE +
TEMPLATE AND DUP CR H.
DUP 0=
UNTIL DROP

;

0x1081100 TEMPLATE.



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

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 5062
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 23 раз.
Поблагодарили: 63 раз.
Mihail писал(а):
Код:

Спасибо, Михаил!
только, померять скорость опять не получается 8(

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


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт дек 14, 2007 15:39 
Не в сети

Зарегистрирован: Ср май 03, 2006 11:27
Сообщения: 1394
Откуда: St.Petersburg
Благодарил (а): 2 раз.
Поблагодарили: 11 раз.
Код:

REQUIRE { devel\~mak\locals4.f


\ вернуть количество бит в стандартной ячейке
: bits/cell ( --> u ) 0 -1 BEGIN TUCK WHILE 1+ SWAP 2* REPEAT NIP ;

        0 VALUE buffer \ адрес места, где хранится результирующий массив

\ выделение памяти под массив и его инициализация
1 bits/cell 4 / LSHIFT CELLS CELL + ALLOCATE THROW DUP TO buffer 0!

\
: aCount ( addr --> addr # ) DUP CELL + SWAP @ ;

\ отправить значение в буфер
: ->buf ( u --> )
        buffer aCount + !
        CELL buffer +! ;


: MINBIT
  DUP
  INVERT 1+
  XOR
INVERT 1+ 1 RSHIFT
;

: TEMPLATE! { tmpl \ it nt -- }
tmpl INVERT TO it
tmpl MINBIT TO nt
0
BEGIN
it OR
nt +
tmpl AND DUP ->buf
DUP 0=
UNTIL DROP

;

0x1081100 TEMPLATE!


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

Зарегистрирован: Ср май 03, 2006 11:27
Сообщения: 1394
Откуда: St.Petersburg
Благодарил (а): 2 раз.
Поблагодарили: 11 раз.
: combs ( um --> addr # ) 0 buffer ! TEMPLATE! buffer aCount ;


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

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

тестировалось на "Compaq evo n610c" P4M 2GHz
Calls      Ticks        AverageTicks 
mrak - конца теста не дождался 8(
mOleg 100 | 679,500 | 6,795
profit 100 | 1,296,518,256 | 12,965,182
mak4444 100 | 558,264 | 5,582

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


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

Зарегистрирован: Чт июл 20, 2006 11:31
Сообщения: 2168
Откуда: Екб
Благодарил (а): 0 раз.
Поблагодарили: 41 раз.
REQUIRE { \LIB\EXT\LOCALS.F

CREATE BUFF 256 CELLS ALLOT

: combs \ MSK -- A u

DUP DUP INVERT { SMS MSK MSK_ \ STB } 1 TO STB

32 0 DO SMS 1 AND IF STB 2* TO STB THEN SMS 2/ TO SMS LOOP

0 STB CELLS BUFF + BUFF DO DUP I ! MSK_ OR 1+ MSK AND 4 +LOOP DROP

BUFF STB CELLS ;



\EOF

0x88888888 combs DUMP

Оптимизированный вариант алгоритма Wingliona.
Работает быстрее программы Михаила (раза в 4).

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


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

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 5062
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 23 раз.
Поблагодарили: 63 раз.
chess писал(а):
Оптимизированный вариант алгоритма Wingliona.
Работает быстрее программы Михаила (раза в 4).


тестировалось на "Compaq evo n610c" P4M 2GHz
????????????????????????????????????????????????
?Автор ?Calls? Ticks ? AverageTicks ?
????????????????????????????????????????????????
?profit 100 ? 1,296,518,256 ? 12,965,182 ?
?mOleg 100 ? 679,500 ? 6,795 ?
?mak4444 100 ? 558,264 | 5,582 ?
?chess 100 | 2,022,172 | 20,221 |

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


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

Зарегистрирован: Чт июл 20, 2006 11:31
Сообщения: 2168
Откуда: Екб
Благодарил (а): 0 раз.
Поблагодарили: 41 раз.
mOleg писал(а):
тестировалось на "Compaq evo n610c" P4M 2GHz

mOleg, проверь пожалуйста время выполнения по следующей методике:
После программы вставь следующий текст.
Код:
REQUIRE ASSEMBLER lib\ext\spf-asm.f

CODE timer@
MOV -4 [EBP], EAX
RDTSC
LEA EBP, -4 [EBP]
RET
END-CODE

: test 100 0 DO 0x88888888 combs 2DROP LOOP ;

: tics.
timer@ test timer@ -
timer@      timer@ - - ABS
100 / CR . ." tics" ;

tics.

Твоя методика замера времени выполнения вызывает у меня сомнения в ее корректности.

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


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

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


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

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


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

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