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

...
Google Search
Forth-FAQ Spy Grafic

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




Начать новую тему Ответить на тему  [ Сообщений: 6 ] 
Автор Сообщение
 Заголовок сообщения: *задача подсчета островов
СообщениеДобавлено: Сб май 05, 2007 22:08 
Ну, кто не успел, тот не успел.

Теперь от меня задачка (вспомнил, что в школе читал её описание, тогда - не решил):

Есть матрица (таблица, двумерный массив) s. Размер матрицы W*H. Саму её задавать в текстовом виде. Пример:

Код:
0X00XX
0XX00X
0XXXX0
0XX000


Те ячейки матрицы s[i,j] в которых стоит крестик будут помеченными. Будем называть связанными такие две ячейки которые обе помечены и находятся в прямом соседстве с друг другом в одном из четырёх направлений: "вверх", "вниз", "вправо", "влево" (то есть соприкосновение только углами, диагональные не учитываются).

Задача: по заданному текстовому представлению матрицы выдать кол-во изолированных областей связанных помеченных точек ("островов", в показанном примере их два).

Стековая нотация:
Код:
: islands ( addr u -- x )
...
;


1) одиночно стоящие крестики тоже считаются островами
2) Матрица считается плоской - то есть крайние значения строк
не соприкасаются друг с другом ( не на торе и не на шаре).

3) "вложенные" острова тоже считаются:
Код:
OOXXXX0
0XXOOXX
OXOXXOX
0XX00XX
OOXXXOO

Приведенная выше матрица должна выдать два острова.

Пояснение для тех кто не знает упорно не понимает что такое есть "addr u" во входных параметрах:

На входе: строка в виде addr u. Строка может браться из файла или описываться в тексте непосредтсвенно -- это неважно.
На выходе: кол-во островов в матрице.

Пример "строки" для матрицы:
Код:
XO
OX


Строка выглядит побайтово так:
1-й байт: код "O"
2-й байт: код "Х"
3-й байт: перевод строки (любого вида, неважно)
4-й или 5-й байт: код "Х"
5-й или 6-й байт: код "O"

Ограничений никаких на внутреннее предствление массива нет. Как хотите так и делайте -- хоть горшком, хоть списком, хоть деревом называйте.


Последний раз редактировалось profiT Пт май 11, 2007 01:42, всего редактировалось 3 раз(а).

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

Зарегистрирован: Пт май 05, 2006 06:19
Сообщения: 192
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
задачка острова
<pre> \ задача острова
lib\ext\locals.f

0 VALUE матрица
0 VALUE остров
0 VALUE есть
0 VALUE вокруг
0 VALUE шм
0 VALUE вм

: мт ( -- adr u x y ) \ 0-48 X-88
S" 0X00XX0XX00X0XXXX00XX000" 6 4 ;
мт TO вм TO шм ALLOCATE THROW TO матрица матрица вм шм * MOVE

\ матрица вм шм * TYPE \ тест
4 ALLOCATE THROW TO есть 4 есть !
4 ALLOCATE THROW TO вокруг 4 вокруг !

\ добавить точку номер I в конец списка
: add.point ( I adr -- adr1 )
{ i adr }
adr DUP @ CELL + RESIZE THROW -> adr
adr @ CELL + adr !
i adr DUP @ + 4 - !
adr
; \ : t1 вокруг add.point TO вокруг вокруг 16 DUMP ; 7 t1 \EOF

\ уничтожить точку острова
: X>0 ( i -- )
матрица + 48 SWAP C!
;

\ получить линейные координаты точек окружающих точку i
: l4 ( i -- w e s n ) \ западная восточная северная и южная
>R
R@ шм MOD IF R@ 1- ELSE -1 THEN \ слева
R@ 1+ шм MOD IF R@ 1+ ELSE -1 THEN \ справа
R@ шм - \ сврху
R> шм + \ снизу

; \ 7 l4 \EOF

\ пополнить список "вокург" точками вокруг точки i
: get.list1 ( i -- )
l4
4 0
DO
DUP 0 < 0= >R DUP шм вм * > 0= R> * \ точка в матрице ?
IF
DUP матрица + C@ 88 = \ точка суша
IF вокруг add.point TO вокруг ELSE DROP THEN
ELSE DROP THEN
LOOP
; \ 7 вокруг get.list1 вокруг 32 DUMP \EOF

\ пройти по списку "есть" и получить список точек "вокруг"
: get.list ( -- )
есть C@ CELL / 1 - 0
DO
есть CELL + I CELLS + C@ get.list1
LOOP
; \ 7 есть add.point TO есть get.list \EOF

: утопить_есть
есть @ CELL / 1- 0
?DO
есть CELL + I CELLS + @ X>0
LOOP
; \ матрица шм вм * CR TYPE 7 есть add.point TO есть 8 есть add.point TO есть утопить_есть матрица шм вм * CR TYPE \EOF

: очистить_вокруг
CELL ALLOCATE THROW TO вокруг 4 вокруг !
;
\ произвести последовательное уничтожение територии острова
: утопить_остров ( I -- )
есть add.point TO есть
BEGIN
get.list
утопить_есть
вокруг @ 4 <>
WHILE
есть FREE THROW
вокруг TO есть
очистить_вокруг
REPEAT
очистить_вокруг
; \ матрица шм вм * CR TYPE 1 утопить_остров матрица шм вм * CR TYPE \EOF

: считать_острова
шм вм * 0
DO
матрица I + C@ 88 =
IF
остров 1+ TO остров
I утопить_остров
THEN
LOOP
; считать_острова остров . \EOF</pre>

уж не обессуте если кривовато, я человек неискушенный,
стековой нотации islands ( addr u -- x ) не соответствует, но веть и adr u не совсем корректно отражает сущность матрицы :)

_________________
SPF


Последний раз редактировалось mrack Вс май 06, 2007 23:39, всего редактировалось 3 раз(а).

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

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
проверялось? Работает?
На разных матрицах?
Не пользовался SPF и не всё понял... Зачем топить острова, если их нужно считать, кроме того, кажется, в условии было, что матрица вводится построчно? (текст)

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


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

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
такую задачу я решал на С,
на форте не могу сообразить. Вот описал АЛГОРИТМ, но никак не отформатирую текст ...

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


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

Зарегистрирован: Пт май 05, 2006 06:19
Сообщения: 192
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
работает :) ... топить острова это художественный изыск алгоритма, есть вода и берег как только встречаем первый край острова значит остров остров есть, и чтоб он не мешался далее надо его убрать (потопить остров)... ну вцелом не особо изыскано но зато влет (сел, решил), на матрицах других не проверял. есть в алгоритме недостаток, пака пил пиво понял это, в целом работе он не мешает а где не скажу.

_________________
SPF


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

Зарегистрирован: Чт май 04, 2006 18:18
Сообщения: 456
Благодарил (а): 0 раз.
Поблагодарили: 1 раз.
<pre>
REQUIRE %[ ~ygrek/lib/list/all.f
REQUIRE split ~profit/lib/bac4th-str.f
REQUIRE BOUNDS ~ygrek/lib/string.f

: xy ( x y m -- elem ) nth car nth ;
: xy@ ( x y m -- val ) xy car ;
: xy! ( val x y m -- ) xy setcar ;
: xy. LAMBDA{ LAMBDA{ . } CR SWAP mapcar } SWAP mapcar ;

: input ( a u -- m )
%[
START{ byRows split notEmpty %[ DUP STR@ BOUNDS ?DO I C@ % LOOP ]%l }EMERGE
]% ;

: validate ( m -- )
DUP car length SWAP LAMBDA{ length OVER <> ABORT" Not a matrix" } SWAP mapcar DROP ;

: island? ( c -- ? ) 1 = ;

\ начальное заполнение всей суши цветом 1
: initialize LAMBDA{ LAMBDA{ [CHAR] X = IF 1 ELSE 0 THEN } SWAP mapcar! } SWAP mapcar ;

\ распостранится в ячейку elem цветом color если можно
: maybe-mark? ( elem color -- ) OVER car island? IF SWAP setcar TRUE ELSE 2DROP FALSE THEN ;

\ распостранить цвет color
: one-scan { m color | f xn yn -- ? }
m length 1- -> yn
m car length 1- -> xn
FALSE -> f
yn 1+ 0 DO
xn 1+ 0 DO
I J m xy@ color = IF
I J 1+ yn MIN m xy color maybe-mark? f OR -> f
I J 1- 0 MAX m xy color maybe-mark? f OR -> f
I 1+ xn MIN J m xy color maybe-mark? f OR -> f
I 1- 0 MAX J m xy color maybe-mark? f OR -> f
THEN
LOOP
LOOP f ;

\ поставить на первый неокрашенный участок суши цвет color
: mark-one { m color -- ? }
LAMBDA{ ['] island? SWAP list-scan } m list-scan IF DROP color SWAP setcar TRUE ELSE FALSE THEN ;

: process { m | color -- }
2 -> color
BEGIN
m color mark-one
WHILE
BEGIN
m color one-scan 0=
UNTIL
color 1+ -> color
REPEAT
color 2 - ;

: islands
DUP 0= IF 2DROP 0 EXIT THEN
input
DUP validate
DUP initialize
DUP process
SWAP FREE-LIST ;
</pre>

Описание алгоритма - красим острова разными цветами по одному цвету за проход простым расползанием от каждой окрашенной точки - сколько цветов потратим - столько островов и есть. Так как эффективность в критериях конкурса не указана (так как никаких критериев не указано вообще) то я имею наглость предложить самую неэффективную реализацию : матрица это список списков.
ЗЫ работает на cvs-ном devel только :-( (как и решение 1-ой задачки впрочем)
ЗЫЫ А будут ли представлены reference implementation-ы от составителей и проверка правильности всех приведённых решений (ими же)...

_________________
http://forth.org.ru/~ygrek


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

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


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

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


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

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