скачала несколько юнитов для работы с мышью, но при запуске программы требует файл типа TPU , а все юниты просто с расширение PAS. что в этих ситуациях обычно делают?
Обычно - просто компилируют PAS файл модуля, и компилятор создает TPU файл...
Или загружают в Паскаль основную программу (НЕ модуль), и в меню выбирают Compile -> Build, тогда Паскаль сам откомпилирует все необходимые PAS файлы в TPU (желательно, чтобы PAS файлы модулей при этом находились в той же папке, что и основная программа)...
а еще хотела спросить в вашем юните в МИККИ что обозначается, первый раз встречаю это слово...
Там же написано:
пытаюсь реализовать такой алгоритм :
1) есть сетка с координатами
2) если в каком-то окне щелкнуть мышью, то подсветить эту клетку
3) если щелкнуть повторно , то снять выделение
не получается применить прцедуры, а так же в графическом режиме сделать отдельное выделение, типа процедуры window(x1,y1,x2,y2) в crt . Подскажите, как применять процедуры юнита mouse
Вот примитивная заготовка, чтобы понять основные моменты.
program test;
uses graph, crt, mouse;
var d,m: integer;
c: char;
mx,my: word;
begin
d:=vga;
m:=vgahi;
initgraph(d,m,''); // не забудьте скопировать EGAVGA.BGI в папку с программой
if not initmouse then
begin
restorecrtmode;
halt;
end;
showmouse;
repeat
if mousepressed then
begin
getmousexy(mx,my);
hidemouse;
lineto(mx,my);
showmouse;
end;
until keypressed;
while keypressed do c:=readkey;
hidemouse;
restorecrtmode;
end.
а нет процедуры. которая определяет, в каком месте экрана находится курсор?
Чем
Procedure GetMouseXY(VAR KoordX,KoordY:Word );не устраивает? Она же возвращает координаты мыши...
все.... перепутала просто один юнит с другим все устраивает, а , кстати, для вывода графики обязательно мышь выключать надо? а еще все таки не могу вычертить окно , даже по этой процедуре... толи setviewport то ли window ?
Если не хочешь получать после вывода графики и движения мышкой разные "артефакты" на экране - лучше отключать, тогда курсор мыши не мешает нормальному выводу графики.
А насчет окна - Window не получится однозначно - у тебя графический режим, а не текстовый. SetViewPort только устанавливает ViewPort, но никак не отчерчивает ничего... Объясни подробнее, что именно ты хочешь нарисовать и что выделять?
Может, тебе подойдет простой Rectangle и функция MouseIn ?
у меня есть сетка (line(x1,y1,x2,y2)) которые делят экран на сетку , мне надо чтобы после щелчка мышью по полю, ячейка выделялась другим цветом, а после второго щелчка снималось выделение.. подскажите, как хоть выделение организовать.. да. там еще проблема будет с определением координат выделения, потому что на сколько делить экран задает пользователь )))) то есть , при 10*10 нужно будет определить , сколько заливать , какой размер )))
Пишу прямо здесь, так что могут быть мелкие помарки... Идея такая:
const
size_x = 10;
size_y = 10;
var
selected: array[1 .. size_y, 1 .. size_x] of boolean;
{ изначально присвоить все элементы False }
...
len_x := getmaxx div size_x; { это если поле должно быть на весь экран }
len_y := getmaxy div size_y;
{ Отрисовываем начальную сетку... }
setcolor(white);
for i := 1 to size_y do
for j := 1 to size_x do begin
rectangle((j - 1)*len_x, (i - 1)*len_y, j*len_x, i*len_y);
selected[i, j] := false;
end;
{ после нажатия на кнопку мыши проверяем: }
for i := 1 to size_y do
for j := 1 to size_x do
if mouseIn((j - 1)*len_x, (i - 1)*len_y, j*len_x, i*len_y) then begin
selected[i, j] := not selected[i, j];
if selected[i, j] then setfillstyle(solidfill, lightgray)
else setfillstyle(solidfill, getbkcolor);
bar((j - 1)*len_x, (i - 1)*len_y, j*len_x, i*len_y);
setcolor(white);
rectangle((j - 1)*len_x, (i - 1)*len_y, j*len_x, i*len_y);
{ в принципе, все - из For-ов можно выходить... }
end;
...
Немного доработала.Теперь в процессе создаю матрицу, в которой если клетка выделена, то будет единица, если нет, то ноль.Вроде работает.Для кроссворда теперь нужно чтобы не было отдельно стоящих единиц, чтобы все были связаны между собой .Предложили алгоритм "киселя". Разливать, как кисель ))
Смысл такой : берем первую единицу, которая встречается, если у нее есть соседние по горизонтали и вертикали, то добавляем к ним по единице, дальше проверяем соседей у соседей (может рекурсия пройдет, не знаю ), и опять по единице добавляем. К концу прохода должна остаться всего одна единица. то есть если кроссворд был такой
0100
0100
1111
0100
то после прохода должно получиться что-то типа этого
0100
0200
4345
0400
и проверяем, есть ли еще единицы, если есть, то нужно вернуться и опять заполнять кроссворд, пока все не будет на месте. Пробовала через цикл, но что-то не то получается...
вчера вечером посидела, вот что получилось
program IncMassive;
type
setArray = array[1..10, 1..10] of integer;
var
a,b:setarray;
i,j:integer;
n:integer;
procedure print(const a: setarray);
var i, j: integer;
begin
writeln;
for i := 1 to n do begin
for j := 1 to n do write(a[i,j]:3);
writeln;
end;
end;
procedure increm(i_start, j_start: integer;
n: integer; value: integer; var a: setarray);
begin
a[i_start, j_start] := value;
if (i_start > 1) and (a[i_start - 1, j_start] > value)
then increm(i_start - 1, j_start, n, value + 1, a);
if (i_start < n) and (a[i_start + 1, j_start] > value)
then increm(i_start + 1, j_start, n, value + 1, a);
if (j_start > 1) and (a[i_start, j_start - 1] > value)
then increm(i_start, j_start - 1, n, value + 1, a);
if (j_start < n) and (a[i_start, j_start + 1] > value)
then increm(i_start, j_start + 1, n, value + 1, a);
end;
begin
randomize;
write('input N:'); readln(n);
for i := 1 to n do
for j := 1 to n do a[i, j] := random(2);
print(a);
b := a;
for i := 1 to n do
for j := 1 to n do
if b[i, j] = 1 then inc(b[i, j], n*n);
for i := 1 to n do
for j := 1 to n do
if b[i, j] = n*n + 1 then Increm(i, j, n, 2, b);
for i := 1 to n do
for j := 1 to n do
if b[i, j] <> 0 then dec(b[i, j]);
print(b);
readln;
end.
в данном случае мне нужно, что б он проверил матрицу кроссворда. можно ли из заданной пользователем сетки составить кроссворд , нет ли там отдельно стоящих ячеек или не связанных между собой. Так удобне. то есть если есть более одной единицы в сетке , значит составить нельзя . А это тестовая прога была, посмотреть как работает.
все, работает классно, подпрыгиваю и пританцовываю... так может скоро запостю здесь программу полностью, для составления кроссвордов, интересная задача, кстати, странно, что никто до этого этим не занимался.А как название тему поменять, чтоб в поиске находил, как про кроссворд?
скачала словарь существительных, теперь его пытаюсь отсортировать по количеству буквБ самые маленькие слова вверху и чтоб оставил сортировку по алфавиту внутри.Должно вроде работать правильно, хотя не уверенаю Хотелось бы узнать, правильно она будет работать или нет?
Прикрепленные файлы
data.txt ( 591.61 килобайт )
Кол-во скачиваний: 1963
FILE_SOR.PAS ( 580 байт )
Кол-во скачиваний: 290
Словарь скачивать пока влом, поэтому маленький вопрос. Файл словаря это действительно файл из записей с фиксированной длиной 26 байт? Это именно file of slova? А не простой текстовый?
И второе: может быть, стоило бы все же явно задать условие сортировки по алфавиту? Так, на всякий случай...
да, я его специально переделывала из текстового в файл записей, вручную так сказать ))) только вот по времени он мне обещает сортировать всю базу примерно дней 5 , на моей машине... так что даже проверить не могу, ка кэто будет работать ..
ладно, уговорили. Скачаю Ваш словарь, отсортирую, выложу отсортированный. Короткие в начало, одинаковые - по алфавиту. Но в виде простого текстового файла.
так это и надо было, просто для того чтобы это сделать пришлось вот так вот извратиться.. переделать в файл записей, потом отсортировать.А идея у меня была вначале такая - создать еще массив в котором будет храниться такая информация
1 поле - количество букв
2 поле - номер с какого по порядку начинаются слова с заданным количеством букв(1 поле )
3 поле - номер, на каком заканчиваются слова с таким количеством букв.
все это для того чтобы было удобнее перемещаться по файлу, посмотрел сколько букв, перешел на нужное количество шагов и начинай подбирать подходит слово , не подходит.
только вот абсолютно пока не представляю, как там будет рекурсия работать.Нам что-то сказали, типа вставляешь слова, вставляешь, потом когда доходишь до того места , когда боьлше ни одно слово не подходит, вернуться на шаг назад, поменять какое-то другое слово, и опять вставлять, только вот как это делать, никто толкьом объяснить не может...
Это типа словарь
Прикрепленные файлы
Slovar.zip ( 256.56 килобайт )
Кол-во скачиваний: 4536
пасибки )) то что нужно и даже больше ))
я где-то здесь на форуме находила, вы решали уже задачу про кроссворд, только там его решить надо было и проверить , а мне составить, но там наверно тоже нужно было его составлять.ТОлько вот с делфи мы еще не работали, может посоветуете с чего хоть начинать слова забивать в кроссворд ?
Ох...
Это очень сильно зависит от того, какой будет окончательная схема работы.
Если бы я стал это делать, я делал бы так:
1. Строим сетку кроссворда и проверяем ее на правильность.
2. По имеющейся сетке строим список "гнезд" с указанием начальных координат слов, их длины и направления. Нужен для организации рекурсии.
3. Желательно отсортировать этот список по убыванию длины слова. Мне кажется, что вначале нужно впихивать самые длинные слова.
4. Далее:
- берем очередное "гнездо" и ищем такое слово, которое туда подойдет;
- если нашли, вписываем его в сетку и рекурсивно переходим к следующему "гнезду";
- если не нашли, возвращаемся на предыдущий шаг рекурсии и ищем для этого шага другое слово.
Если следовать этой схеме, то нужно начинать со списка гнезд. То есть нужно на готовой сетке найти все клетки, у которых есть либо только сосед справа, либо только сосед снизу. Это точки начала слов. Для каждой такой точки определить направление слова и его длину. И занести все это в массив. Круче было бы использовать динамический список... но зачем? И так возни хватит.
Удачи!
смысл понятен, только как проверять подходит слово или нет, я не совсем уловила структуру "гнезда" , это массив или что-то еще? допустим. нашли слово, 5 букв, вертикально , на пересечении буква е, как дальше впихивать с учетом этой самой буквы е?
Структура самого гнезда очень простая - координаты начала, длина слова и направление.
Нечто вроде
type
TGnezdo = record
x,y: byte;
len: byte;
horizontal: boolean;
end;
var
Gnezdo: array[1..100] od TGnezdo;
ok := true;
i:=0;
while (ok) and (i<Gnezdo[1].len) do
begin
if (Setka[Gnezdo[1].x][Gnezdo[1].y+i] <> ' ') and (Setka[Gnezdo[1].x][Gnezdo[1].y+i] <> Slovo[i+1])
then ok := false
else inc(i);
end;
for i=0 to Gnezdo[1].len-1 do
begin
Setka[Gnezdo[1].x][Gnezdo[1].y+i] := Slovo[i+1];
end;
Setka[Gnezdo[1].x][Gnezdo[1].y+i] := Slovo[i+1];
тут сначала координаты сетки [x][y] , а потом что? Slovo{i+1} ?
Slovo - это слово из словаря, которое мы сейчас проверяем. Это строка. А Slovo[i+1] - это его очередной проверяемый символ. i+1 - потому что i отсчитывается от нуля, а символы в строке нумеруются с 1.
понятно, теперь сижу втыкаюсь ... вот еще косяк объявился. не хочет repeat заботать ...
они по моему все не работают, один общий, то есть выполнять все, пока не выход, то есть c:=5;
второй на case работает, то есть пока c<>5, выполнять по case и третий ждет пока клавишу не нажмут , а потом работать начать .Вроде должно работать, но после одного прохода. как только я заканчиваю сетку рисовать , он меня тихонько выкидывает....Там файл, модуль ваш, с мышкой
Прикрепленные файлы
123.PAS ( 4.49 килобайт )
Кол-во скачиваний: 202
Вот что у меня получилось . структура данных
if horizontal thenВ этом фрагменте
begin
okgor:=true;
i:=0;
while okgor and ( i <len) do
begin
if (bukv[x,y+i]=' ') then
begin
okgor:=true;
ok:=true;
inc(i);
end
else if (bukv[x,y+i]<>s[i])
then
begin
okgor:=false
end
else inc(i);
end;
if (bukv[x,y+i]=' ') thenЛишнее, потому что okgor перед входом в цикл уже true, а как только оно станет не трю, цикл завершается, поэтому внутри цикла делать его трю не имеет смысла.
begin
okgor:=true; { ВОТ ЭТО ЛИШНЕЕ }
ok:=true;
inc(i);
end
function NewWord(dlina: integer): string;
begin
{возвращает слово заданной длины.
при этом надо как-то учитывать те слова,
что уже были выбраны ранее.}
end;
function GoodWord(s: string; i: integer): boolean;
begin
{возвращает true, если слово, заданное строкой s,
можно вписать в гнездо с номером i}
end;
function CheckNext(i: integer): boolean;
var s: string;
begin
if i > числа_гнезд then {все гнезда проверены}
begin
CheckNext := true; {шабаш}
exit;
end;
repeat
s := NewWord(Gnezdo[i].len); {выбираем слово из словаря}
if GoodWord(s,i) {слово хорошее}
then
begin
if CheckNext(i+1) then {вызываем рекурсию}
begin
CheckNext := true;
exit;
end;
end;
until больше_нет_слов_такой_длины;
CheckNext := false; {заполнить гнездо так и не удалось}
end;
конечно, интересно мне все.С мышью я тоже мучалась ))) а с циклами что делать тогда? Больше надеяться не на кого , потому что все только открывают рот удивленно " И это на первом курсе??". Тем более проблемы будут с проверкой это точно... Можно словарь разбить на файлы по длине слов...еще есть такие идеи:
Для очередного слова в сетке (желательно начинать с длинных)
фаза Do
* определяешь маску (какие буквы уже определены)
* получаешь курсор выборки из словаря по данной маске и запоминаешь его значение
* если обломились производишь откат к предыдущему слову
* вставляешь выбранное из словаря слово и переходишь к следующему
фаза Redo (когда был откат)
* переводишь курсор вперед
* если обломились (или вернулись на первое запомненное значение) производишь откат к предыдущему слову
* вставляешь выбранное из словаря слово и переходишь к следующему
Для случаев, когда в маске зафиксирован префикс (первые несколько букв) диапазон поиска можно сократить.
Также можно ввести проверку для каждой позиции буквы в слове собрать множество доступных букв и фильтровать запросы к словарю на основе этих данных.
Например, буква Ъ не встречается в начале слова так что незачем сканировать словарь.
Я позволил себе
1) сделать так, чтобы клетки меняли состояние не просто, когда мышь нажата, а именно по факту нажатия (т.е. не было нажато - стало нажато);
2) заменить операторы типа
if a < 1 then f:=false else f:=trueна эквивалентные им
f:=(a>=1);
циклы должны работать так
1) New- создать новую сетку , то етсь совсем новую , пустую, нажал - заполнил
2) Make - составить кроссворд , рекурсивно заполнить словами (здесь буду работать, что получится сегодня, покажу )
3) Exit _ когда пользователь нажмет на эту "кнопку" - выход из программы
тоесть нажал на new - новую сетку сделал , нажал потом на make - заполнил кроссворд, дальше еще подумаю , над сохранением ... но это если основную часть выполню и останется время. ТО есть пользователь может составить несколько кроссвордов , переходя по кнопкам.ПОка не нажмется Exit . Задумка была такая.
Уважаемый Бродяжник , посидели вчера , покумекали, вот что получили , осталось забить это в код....
Вот данная рекурсивная процедура . Будем использовать как мне их обозвали «дырки», то есть места выхода из процедуры, через которые будет проскакивать рекурсия не выполняя никаких функций.
Выглядит это так (должно по крайней мере)
«гнезда» - упорядоченный массив записей содержащий вот такую структуру
Tgnezdo=record
x,y:integer; - координаты ячейки, где начинается слово
len:byte; -длина слова
horizontal:boolean; - горизонтально или вертикально расположено слово
вот данная процедура
Уважаемая Love (можно без 133?),
я тем временем немного поправил циклы, так что меню уже почти работает. Единственное, что накладываются друг на друга сообщения, так что их надо как-то очищать, когда они уже не нужны. Я обвел кнопки рамочками по размеру области для MouseIn, чтобы четко видеть, где отлавливается щелчок.
И я уже почти закончил рекурсивную модельку, которая по заданной сетке подбирает гнезда и заполняет их, следя за пересечениями. Думаю, что сегодня и закончу. Она с массой ограничений, но схема там работает.
А уже завтра гляну на Ваш материал.
Прикрепленные файлы
1.pas ( 5.39 килобайт )
Кол-во скачиваний: 214
Хотя бы в какой-то степени оно работает!
(Я составил 4 простеньких кроссворда. Дальше тестить поленился).
Читайте ридми.
Воть.
Прикрепленные файлы
Recurs.zip ( 32.7 килобайт )
Кол-во скачиваний: 148
Вчера посидела с реализацией своей рекурсивной модели (см.выше) , вроде все должно работать , но есть какие-то непонятки, не могу найти где. В файле несколько процедур добавлено, основная ARBEIT , должна возвращать истину, елси все так и все работает, а так же текстовое поле , в котором все должно быть расставлено по местам , но почему-то этого не происходит.... может как-нибудь подправить можно. А в вашем кроссворде я так поняла можно модель рекурсивную взять, и вставить в прогу основную)). Может к вечеру что-то прояснится ....
в 11.30 началось переполнение стека.... (*паника и старх*)
Прикрепленные файлы
PEREDELI.PAS ( 9.56 килобайт )
Кол-во скачиваний: 245
Когда сдавать-то?
сдавать демо-версию завтра, а у меня кроме веселого меню и пары кнопок ничего нет )))) даже левого какого вывода слов на экран ...
Сочувствую...
В том файле, который Вы прикрепили последним, я нашел пару ошибок.
1) это то, что я ведь в своей проге не случайно сделал функцию IsLetter. Вот представьте себе, что Вы пытаетесь узнать, есть ли сосед слева у самой левой клетки? Или сосед сверху у самой верхней? Что будет? Range Check Error, вот что.
2) Когда Вы первый раз вызываете функцию ARBEIT, Вы передаете ей переменную Ng, которая не определена. Перед первым вызовом надо поставить Ng := 1.
Больше я ничего не смог выяснить, из-за отсутствия файла словаря. Мой-то словарь не подходит!
Сегодня буду в сети еще часов до 4 по Москве, а дальше все... каникулы до среды.
а так , если пользоваться вашей программой. как е в мой интерфейс загнать? а в принципе , будет работать такая рекурсия или надо все в принципе переделывать? а словарь вот....
Прикрепленные файлы
DATA_.rar ( 198.94 килобайт )
Кол-во скачиваний: 156
ща посмотрим...
Правка:
Жаль, но чтобы привести это все в чувство, нужно больше времени.
И словарь кстати не тот совсем... ведь это простой текстовый файл, а в программе у Вас стоит FSTR=file of string, что вовсе не то же самое.
К сожалению, в ближайших несколько дней я уже не смогу быть Вам полезным...
Удачи!
завтра как-нибудь еще отверчусь, скажу, что все в процессе, постараюсь отладить, может чего и получится...Огромное спасибо за неоценимую помощь )))
вот... только теперь выясняется, что память в паскале не резиновая и словарь в 50000 слов обработать трудновато, даже не знаю, что тут можно сделать ... может подскажете, потому что замучала ошибка выхода за диапазон, и словарь пришлось урезать , теперь слова длинне 5 букв использовать нельзя. В файле словарь и код.МОжет можно как-нибудь решить проблему нехватки памятики и выхода за диапазоны?
Прикрепленные файлы
123.rar ( 18.11 килобайт )
Кол-во скачиваний: 148
Привет!
В последнем выложенном файле есть как минимум следующие ошибки:
1. Еще раз возвращаюсь к разнице между text и file of string. Ваш словарь - это text, а не file of string. Поэтому к нему нельзя обращаться, как к file of string. В частности, нельзя использовать процедуру seek. Сделайте следующую вещь: напишите маленькую программу такого вида:
program test;А потом сравните файлы f1.txt и f2.txt. И найдите 10 отличий.
var f1: text;
f2: file of string;
p,m: string;
begin
p := 'Preved';
m := 'Medved';
assign(f1,'f1.txt');
rewrite(f1);
assign(f2,'f2.txt');
rewrite(f2);
writeln(f1,p);
writeln(f1,m);
write(f2,p);
write(f2,m);
close(f1);
close(f2);
end;
with gnezdo doЕсли if horizontal, то почему увеличивается игрек? Ведь это вертикальная координата?
begin
i:=0;
if horizontal then
begin
while i<len do
begin
inc(i);
str:=str +text[x,y];
inc(y);
end;
end
for i:=1 to n do
for j:=1 to n do
begin
if (a[i,j]=1) and (a[i-1,j]<>1 )and (a[i+1,j]=1 )then
ng := 1;
if a[i,j]=1 then bukv[i,j]:=' ' else bukv[i,j]:='0';
Get_gnezda(a, gnezdo,n, q);
ng := 1;
if ARBEIT( bukv,Ng) then ok:=true ;
if ARBEIT( bukv,1) then ok:=true ;
Доброго времени суток ))
все координально переделала, вроде работает... теперь начались косяки с интерфейсом
1) не могу повторно задать сетку и создать кроссворд, то есть когда ошибочно введена сетка, повторное нажатие на NEW вызывает сетку, но кроссворд на MAKE уже не получается
2) как быть с выводом готового кроссворда на экран ? в графическом режиме не отображаются русские буквы (((, выключать графику?
3) можно конечно попробовать в транслите. но тогда начинаются проблемы с перекодированием - в русском 33 буквы, в английском всего 26 )))
тут демо-версия, выводит кроссворд в графическом режиме...
Прикрепленные файлы
coursovik1.rar ( 68.04 килобайт )
Кол-во скачиваний: 138
Вот, сыскал в сети... русские фонты для BGI.
Прикрепленные файлы
Rus_chr.rar ( 111.17 килобайт )
Кол-во скачиваний: 154
И еще есть замечания по рекурсии.
Во-первых, что делает переменная flag? Ведь на участке между
flag := falseи
if not flNoWord and not flag thenзначение flag не меняется. Поэтому фактически это условие сводится к
if not flNoWord. Во-вторых, как должна работать рекурсия? У нас должна быть возможность вернуться назад на любое число шагов. Например, первые 5 гнезд заполнились нормально. А шестое мы так и не смогли заполнить. Мы возвращаемся назад на один шаг. Это значит, что последнее вписанное слово нужно вычеркнуть из сетки. То есть либо необходим специальный алгоритм вычеркивания, либо нужно сохранить предыдущую копию. Допустим, у нас есть копия. Но вот беда - оказывается, что другого варианта заполнения пятого гнезда нет. Это значит, что надо вернуться еще на шаг назад и вычеркнуть из сетки еще и четвертое слово. То есть нужна еще одна копия - и не одна, а весь набор промежуточных копий для всех шагов. Если мощь компьютера позволяет, можно и так. А если нет? Тогда нужно изобретать специальный алгоритм вычеркивания. Почему специальный? Потому что он должен учитывать то, что буква в сетке может принадлежать не одному, а сразу двум словам. И вычеркивать ее нужно с оглядкой.
после многочисленных тестов пришла к выводу что рекурсия плохая и не работает ))) (*тихонько сходит с ума*). Работает только в одну сторону с перебором словаря и просто проверкой , подходит , не подходит...
но ничего путного придумать не могу, потому как не хватате глубоко понимания сущности рекурсии...
если хранить маску слов на всех этапах, то не хватит никакой памяти... Однокурсник использует деревья и списки, остался последний день, не думаю, что успею переделать все ))
Я уже почти заставил его работать, хотя тут, конечно, всплыли новые приколы. Например, может случиться так, что есть четыре первых гнезда. При этом первые три не пересекаются друг с другом, а четвертое пересекается с первым и со вторым. Мы заполнили три первых, перешли к четветрому, а с ним не стряслось. И происходит что: мы возвращаемся к третьему, меняем в нем слово - и это никак не влияет на ситуацию с четвертым гнездом. Мы прокручиваем все варианты для третьего гнезда, и только потом переходим ко второму и что-то в нем меняем. И это может продолжаться весьма долго...
но зато у меня уже заполнился вот такой кроссворд:
.О.В.
АДАЗА
.Ё.В.
АЖГОН
.А.Д.
Оно работает!
Это еще актуально?
Конечно актуально ))) допуск до экзамена )) тут не только такие приколы выплыли.. почти половина моей работы напрасна, при чем так что выть хочется... Сделала мышь, чтоб удобнее было, теперь надо клавиатуру подключать, интерфейс плохой. проверка неправильная.Теперь надо не только проверить можно ли составить кроссворд, но и пользователю показать , что так делать нельзя, то есть если он уже забил слово, то сделать так , чтоб ы восседние клеточки и кликнуть-то нельзя было, то есть показать, куда можно кликать а куда нет, вообщем полный провал ... сколько глюков будет, я уже чувствую...
Ладно, кладу то, что пока есть.
Те несколько кроссвордов, которые я пробовал, заполнились.
Единственное, что:
- я так и понял, что с проверкой что-то неладно, поэтому я ее просто отключил;
- процесс рекурсии может быть длительным. При этом желательно брать такую сетку, чтобы в ней был минимум горизонтальных слов. Например, кроссворд в виде буквы Ш строится на ура, а вот в виде Е не так быстро. Если хотите порадоваться, задайте сетку в виде квадрата
*****
*...*
*...*
*...*
*****
пасибо вам огроменно , не знаю, что б я делала ))) все работает на ура, и даже если где-то выяснится что не на ура, то наверно не расстроюсь, теперь остался интерфейс. но тут как-нибудь постараюсь справиться... теперь вот придется думать над проверками, где можно клутку ставить , а где нет ... начинаю трассировать программу. так графика подвисает после очередного прерывания и ничего сделать не могу. потому как мышь пропадает, поэтому и проверить сложно , где что не работает.
Хорошо!
С интерфейсом Вы справитесь, Вы жутко способная.
А я пойду почивать на лаврах.
Удачи!
Вчера докрутила, перестала мышь работать... не работает на весь экран в программе, то есть на полэкрана работает, а на вторую половину никак.Самое интересное. что запускаешь оригинал, на работает, запускаешь похожую программу, с теми же процедурами - работает . И если оригинал запустить после копии, то он тоже начинает работать, а ошибку найти не могу, ничего вроде не меняла.Может подскажете, где косяк?
Прикрепленные файлы
coursovik.rar ( 59.62 килобайт )
Кол-во скачиваний: 120
У мя все работает... и причин ему не работать не видно...
А вообще ничего, ничего, проект развивается!
(А заставка, кстати, была неплохая...)
надеюсь - это окончательный вариант... Только есть еще несколько вопросов по процедурам в программе. Если можно, прокомментируйте несколько процедур, как именно они работают, файл Komment.pas . У меня обнаружилось несколько непоняток в связи с неполадками в работе )))
1) словарь просматривается от начала до конца только один раз? или по кругу?
2) в случае ситуации, когда нельзя составить кроссворд в принципе, что будет в этом случае, зависнет?
3) пару раз выводил на экран кроссворд, в котором одно и тоже слово встречалось 3 раза )))
и еще.. проверку на правильность ввода при самом вводе сетки мне милостиво разрешили не делать, но заставили выводить где именно ошибся пользователь.Так как у меня процедура SELECTED заполнения идет через repeat , то там очень сложно что-то поменять так , что б и смысл соранился и что-то можно было вывести... я думала о полной перерисовке экрана, то есть если есть 4 клетки вместе, то выделить их все , елси есть одна стоящая одиноко. выделить и ее, а потом спросить перерисовать сетку или нет.
это конечно все мелочи, меня волнуют больше всего комментарии , отчет писать надо будет )
Прикрепленные файлы
________.rar ( 209.69 килобайт )
Кол-во скачиваний: 157
KOMMENT.PAS ( 3.31 килобайт )
Кол-во скачиваний: 207
Read this.
Прикрепленные файлы
comment.txt ( 8.09 килобайт )
Кол-во скачиваний: 261
Volvo , очень прошу вас прокомментировать код... потому как самой не осилить ну никак, как не старалась.Так как писала не я и процедура рекурсивная то и трассировать очень сложно, не все понимаю , как работает.А спрашивать будут...
program IncMassive;
type
setArray = array[1..10, 1..10] of integer;
var
a,b:setarray;
i,j:integer;
n:integer;
procedure print(const a: setarray);
var i, j: integer;
begin
writeln;
for i := 1 to n do begin
for j := 1 to n do write(a[i,j]:3);
writeln;
end;
end;
procedure increm(i_start, j_start: integer;
n: integer; value: integer; var a: setarray);
begin
a[i_start, j_start] := value;
if (i_start > 1) and (a[i_start - 1, j_start] > value)
then increm(i_start - 1, j_start, n, value + 1, a);
if (i_start < n) and (a[i_start + 1, j_start] > value)
then increm(i_start + 1, j_start, n, value + 1, a);
if (j_start > 1) and (a[i_start, j_start - 1] > value)
then increm(i_start, j_start - 1, n, value + 1, a);
if (j_start < n) and (a[i_start, j_start + 1] > value)
then increm(i_start, j_start + 1, n, value + 1, a);
end;
begin
randomize;
write('input N:'); readln(n);
for i := 1 to n do
for j := 1 to n do a[i, j] := random(2);
print(a);
b := a;
for i := 1 to n do
for j := 1 to n do
if b[i, j] = 1 then inc(b[i, j], n*n);
for i := 1 to n do
for j := 1 to n do
if b[i, j] = n*n + 1 then Increm(i, j, n, 2, b);
for i := 1 to n do
for j := 1 to n do
if b[i, j] <> 0 then dec(b[i, j]);
print(b);
readln;
end.
Извините, что вмешиваюсь.
Просто Вы затронули интересную тему - составление кроссворда.
Я тоже бился над этой задачей, лет несколько тому назад.
Если интересно, то с удовольствием поделюсь опытом.
Очень мне словарь Ваш понравился. Я свой создавал сам, ещё до того как смог впервые выйти в интернет.
Пришлось написать спец. утилитку - "выдиратель" слов из текста, причем тех, в которых нет ничего, кроме букв русского алфавита (в Вашем словаре есть слова с дефисами это слово ведь не годится для кроссворда)
Потом возникла проблема отделения имён существительных в ед.числе им.падеже от всех остальных, тогда пришлось написать ещё одну программку, которая по окончанию определяла нужное это слово или нет. Набор неверных окончаний хранился в отдельном файле.
Сетку для кроссворда "рисовал" в текстовом редакторе, из звёздочек и пробелов. Мыши на моём компьютере по моему не было тогда, или я просто не решался её подключать.
И полным перебором всех слов сетка заполнялась. Правда не все сетки ей были по зубам, на этом я собственно и остановился.
Ещё пару слов про словарь. Слова были разбиты по длине, и хранились в отдельных файлах. 02, 03 ... 24
Длиннее 24 букв слов в орфографическом словаре нет, да и вряд ли его придётся использовать.
При такой системе хранения, отпадала проблема отбрасывания "коротких" или "длинных" слов. Файл делался короче, примерно, в 10 раз и работать с ним было намного легче. По крайней мере отбрасывалась как минимум одна проверка на совпадение длины.
Я с удовольчствием рассмотрю все предложения ))) Когда я бралась за эту задачу. я не думала, что все будет настолько сложно и запутанно. Утром доделала заполнение сетки, теперь начались проблемы с рекурсией.
Дело в том , что в программе используется массив USED - использованные ранее подошедшие и не подошедшие слова. То есть , если словарь хотя бы 4000 слов, то на каком-то шаге рекурсии , его весь нужно загнать в этот массви, джля того чтобы определить подходит слово или его надо удалить на этом шаге, но в паскале это возможно только с помощью динамической памяти... вот тут я и села. ТО есть программа до ходит да максимального размера массива использованных слов, а дальше проверка , было слово или нет просто станвовится бесполезной. ведь массив кончился и ничего туда больше не записывается. тут образуется зацикливание, вроде до конца файла еще не дошли, и слова уже все подряд подходят и рекурсия дальше не идет .... что тут делать?
Прикрепленные файлы
________.rar ( 182.91 килобайт )
Кол-во скачиваний: 168
Love133
Если потерпите, завтра выложу версию с продвинутым словарем, поддерживающим запоминание до 32000 слов и ускоренный поиск слова заданной длины.
pascal65536
Привет соратникам!
тут вот какая мысль возникла... а ведь большинство слов в получившемся кроссворде нвчинаются на первые 3-4 буквы алфавита...
а потому словарь отсортирован по алфавиту и длине слов. в начале самые длинные, и гнезда сортируются так же, то есть берем первое подходящее слово ( а оно в начале алфавита ) и идем дальше и так до упора. Если не прокатило, берем второе подходящее слово - все из того же словаря , значит отличаться они будут максимумна 2-3 буквы )))) Попробовала работать с динамической памятью... Косяков немеряно, память толком выгрузить не могу.... но работает вернее...
Конечно потерплю )) деваться все равно некуда, сдавать-то надо....
GoodWind
Это поначалу так, что слова начинаются на одинаковые буквы, потом, когда кроссворд достроится до конца, окажется, что буквы-то разные. Первое слово берётся из алфавитного списка, а все оставльные подбираются по маске.
Paskal , как там насчет наработок ? мне было бы интересно посмотреть на ваш вариант обработки словаря и перебор, потому как дымаю полным перебором все это дело решилось бы быстрее раза в 3 )))
LOVE133
Думаете, быстрее? Нифига подобного. СтОит подумать над другим алгоритмом, отличным от полного перебора.
А исходник выложу у себя на сайте, сюда линк выложу. Думаю, администраторы не обидятся.
Oops...
Зашился я с работой, так что не до кроссвордов. Видимо, я выбываю из игры...
В общем, идея была такая - хранить в массиве использованных слов не сами слова, а номера соответствующих записей в файле словаря. Тогда имеем всего два байта на слово, за счет чего размер массива можно существенно растянуть. Для этого, правда, пришлось сконвертировать словарь из текстового в типизированный файл. Начерно я это реализовал, оно даже работает, хотя одну не очень большую сетку ковыряло с полчаса. (А все из-за того, что слова на i-том и i+1-м уровне рекурсии оказались не связанными друг с другом). Но к "передаче в эксплуатацию" не готово.
давайте хоть черновик )))как-нибудь доковыряю, смысл в принципе понятный, а до ума доведу как-нибудь, потому что в том виде, что у меня сейчас точно не примут )) просто на каком-то месте зацикливается и дальше не строит и сообщение о том что построить нельзя не выводит, поэтому и не принимают ... а косяки подправлю ))
Выкладываю исходник, для общего ознакомления.
Только, пожалуйста, не надо его массово распространять.
Дата создания многих файлов - август 1999 года, так что прошу не судить строго, за корявый местами код.
http://www.pascal.hop.ru/temp/findword.zip Ссылка будет актуальна до июня.
В архиве есть всё, о чем я писал. Сетка кроссворда в файле setka.txt
Вот.
Читайте ReadMe.txt
Может, стоит подумать над тем, чтобы как-то отображать на экране процесс поиска, чтобы пользователь не скучал, и не думал, что все повисло? Хотя в графическом режиме это будет давать лишние тормоза...
Прикрепленные файлы
New_voc.zip ( 143.99 килобайт )
Кол-во скачиваний: 175
Пасибки огромное ))) потихоньку разбераюсь, все равно торопиться уже некуда , только сдать осталось . Может , все таки доделаю, как положено )))
Удачи!