Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2003.01.06;
Скачать: [xml.tar.bz2];

Вниз

народ, лыжы уже не едут, как это сделать???   Найти похожие ветки 

 
vilfred   (2002-12-24 14:37) [0]

понимаю, что задолбал уже, но может кто-то что-то такого типа делал... я уже офигел полностью:

W>Здравствуйте, vilfred, Вы писали:

W>Поточней сформулируй задачу - тебе надо найти последовательности ..010.. и если она на границе массива 10... или ...01 - я так понял ? (и еще вопрос массив в строку не расворачивается - я имеею ввиду что предыдущая строка ни как на последующуую не влияет?)

вот поточнее, у меня есть картинка, на картинке нарисована две какие-то кривулины, допустим кусочек эллипса и круга, или поломанная в трех местах прямая и эллепс. я считываю данные из этой картинки так:

for x:=0 to VidW-1 do for y:=11 to VidH-11 do
if (int(y)/aa=int(y/aa)) and (sqr(x-180)+sqr(y-145)<=sqr(149)) then
aaa1[y,x]:=byte(Image1.Canvas.Pixels[x,y] and $ff);

получаю массив aaa1[y,x]. Если координаты точки x,y являются точкой, которая принадлежит какой-то из двух кривых(допустим 1 - черное, 0 - белое), то в массив заносятся какие-то значения:

001000000000010
000100000000100
000010000001000
000001000001000
000001000001000
000010000001000
000010000001000
000001000001000
000000100010000
000000010001000
000000001000100
000000000100010
(видно, что значения массива это просто две какие-то линии, проведенные от балды рядом друг с другом)...

ну вобщем мне надо сделать так, чтобы первая линия слева(первые единички), была была пронумерована первой, а вторая была пронумерована второй. Т.е. захотелось мне черное поменять на белое. Т.е. мне надо сделать цикл который бы рисовал просто эти прямые, но с номерами 1,2 или 2.

Упрощенно мне нужно сделать следующее:

если я нашел первую единицу, то опускаюсь на строку вниз и ищу ближайшую к ней единицу, но строкой ниже, как только нашел ближайшую единицу, то считаю строку ближайшей к предыдущей единице и двигаюсь на эту ближайшую точку, далее стморю вторую строчку, в которой ищу ближайшую к только что найденной единице, я делаю это так, как описано в самом первоем моем постинге: т.е. чтобы найти ближайшую цифру в следующей строке массива, надо перебирать элементы вперед и назад, т.е. надо чтобы цикл шел так:

-1 1 -2 2 -3 3 -4 4

и т.д., т.е. есть элемент массива, если он равен нулю, то двигаемся сначала на шаг влево, затем на шаг вправо(ищем ближайшее неравное нулю). Если не равен нулю то становимся в эту точку(переменной h присваиваем номер элемента в массиве).

вот это не работает:

while massiv[e+h] <> 0 do begin
if massiv[e+h] <> 0 then h:=h-1;
if massiv[e-h] <> 0 then h:=h+1;
end;

Вся задача во много раз сложнее. Эти линии единичек - максимумы интерференционной картинки. есля я могу нумеровать их, то я знаю профиль поверхности зеркала в интерферометре с точностью до 20 атомных слоев.

но вот засада, на дельфях не умею писать... Вобщем надо отследить просто единички, двигаясь по массиву массивов по вертикали.

вобщем надо эти полоски отследить но как - не представляю даже...


 
vilfred   (2002-12-24 14:41) [1]

т.е. надо чтобы из этого

001000000000010
000100000000100
000010000001000
000001000001000
000001000001000
000010000001000
000010000001000
000001000001000
000000100010000
000000010001000
000000001000100
000000000100010

получилось это:

001000000000020
000100000000200
000010000002000
000001000002000
000001000002000
000010000002000
000010000002000
000001000002000
000000100020000
000000010002000
000000001000200
000000000100020

т.е. пронупмеровать линии. сказали бы сделать на perl, сделал бы, а дельфей просто не знаю вообще :(((


 
Слесарь Матерящийся   (2002-12-24 14:42) [2]

Всё честно прочитал, задача неясна.

:o)


 
vilfred   (2002-12-24 14:47) [3]

:) тебе весело, у меня диплом в жопе без этой штуки... я уж две недели бъюсь - понять не могу как это сволочь сделать...

да, согласен, сложно, я втыкал в это три месяца, но короче все свелось к тому, чтобы из верхнего массива в моем предыдущем постинге получить нижний... как массивы эти получал - это другая проблема, и её порулить всетки удалось...


вобщем вот так вот...


 
OlDemon   (2002-12-24 14:53) [4]

2 vilfred> Задача выглядит не сложно но возникают вопросы
1) размерность массива извесна?
2) кривые могут пересекаться?
3) их только 2?
4) может простым перебором массива или ресурсы жалеть надо?


 
vilfred   (2002-12-24 15:06) [5]

да, размерность массива известна

1) да, aaa1[352,288]
2) кривые пересекаться не могут, могут приближаться на расстояние максимум в 5 нулей
3) их произвольное число, но не большее чем 80 - я просто свою картинку распознать точнее не могу...
4) лучше конечно ресурсы пожалеть...
5) с меня ящик пива(живу в москве)




 
icWasya   (2002-12-24 15:31) [6]

h:=0;
while (massiv[e+h] <> 0) and (abs(h)<5) do begin
if h<0 then h:=1-h
else
if h:=-h;
end;



 
Sha   (2002-12-24 15:59) [7]

const
i1=1; i2=288;
j1=1; j2=352;
k1=0; k2=2 * 4;
h: array[k1..k2] of integer= (0,1,-1,2,-2,3,-3,4,-4);
var
aaa1: array[j1..j2,i1..i2] of byte;
i, j, k: integer;
b: byte;
begin;
b:=1; // начнем с 2, 1 уже есть
for i:=i1 to i2 do if aaa1[j1,i]=1 then begin;
inc(b);
for j:=j1 to j2 begin;
for k:=k1 to k2 do if aaa1[j,i+h[k]]=1 then begin;
aaa1[j,i+h[k]]:=b; break;
end;
end;
end;
end;





 
han_malign   (2002-12-24 16:18) [8]

- если кривые послойно непрерывны, не пересекаются и идут именно "сверху вниз", то достаточно просто проставить индексы для не нулевых точек(на всякий случай добавлю проверку на горизонтальность):
var i,j,idx,cnt: integer;
v: array[0..n-1,0..m-1];
begin
........................
for i:=0 to n-1 do begin
idx:=0;
cnt:=1;//краевое
for j:=0 to m-1 do
if(v[0,j]<>0)then begin
if(cnt>0)then inc(idx);//горизонтальный разрыв
v[0,j]:=idx;
cnt:=0;
end else inc(cnt);
end;
end;


 
Sha   (2002-12-24 16:28) [9]

2 vilfred (24.12.02 14:37)
2 han_malign © (24.12.02 16:18)

Больше трех решений в ящик не поместится! ;)




 
vilfred   (2002-12-24 16:42) [10]

в строчках
if (aaa3[j,i+h[k]]=1) then begin
aaa3[j,i+h[k]]:=b; break;

ругается на h[k] Array type required

...


 
vilfred   (2002-12-24 16:46) [11]

2han_malign © - кривые послойно не непрерывны, но это я сделаю, хотяб послойно что было хотькакннить...



 
vilfred   (2002-12-24 16:52) [12]

2han_malign © - кривые послойно не непрерывны и гуляют, на 10 нулей вправо может отличаться или на 10 нулей влево в следующей строке, но это я сделаю, хотяб послойно что было хоть какннить...

да хотябы для одной кривой чтобы отследить, все это потом.

я вообще одну кривулину такую всетки построил сам, т.е. из центральной единицы на изображении точки шел вниз, оно все работало отлично просто, рисовало. все просто зашибись...




 
Sha   (2002-12-24 16:55) [13]

2 vilfred (24.12.02 16:42)

Здесь do не хватает: for j:=j1 to j2 begin;
Надо так: for j:=j1 to j2 do begin;
Других ошибок вроде нет.
Сказать точно не могу - Delphi нет под рукой.

aaa3 надо объявить как aaa1.


 
TTCustomDelphiMaster   (2002-12-24 16:58) [14]

Примерно так это делается, но сам не проверял
const
_WidthAr = 352;
_HeightAr = 288;
var
Cv: array[1.._WidthAr, 1.._HeightAr] of integer;
procedure FillPoint(x, y, n: integer);
var
i, j: integer;
begin
Cv[x,y] := n;
for i := Max(1, x-1) to Min(_WidthAr, x+1) do
for j := Max(1, y-1) to Min(_HeightAr, y+1) do
if Cv[i,j] = 1 then
FillPoint(i, j, n);
end;

procedure Start();
var
x, y, n: integer;
begin
n := 2;
for x := 1 to _WidthAr do
for y := 1 to _HeightAr do
if Cv[x,y] = 1 then
begin
FillPoint(x, y, n);
inc(n);
end;
end;


 
Sha   (2002-12-24 20:43) [15]

Вот, наконец, добрался до дома и все-все исправил и проверил в Delphi.

const
i1=1; i2=15; //288;
j1=1; j2=12; //352;
k1=0; k2=2 * 4;
h: array[k1..k2] of integer= (0,1,-1,2,-2,3,-3,4,-4);
var
aaa3: array[j1..j2,i1..i2] of byte= (
(0,0,1,0,0,0,0,0,0,0,0,0,0,1,0),
(0,0,0,1,0,0,0,0,0,0,0,0,1,0,0),
(0,0,0,0,1,0,0,0,0,0,0,1,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0,1,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0,1,0,0,0),
(0,0,0,0,1,0,0,0,0,0,0,1,0,0,0),
(0,0,0,0,1,0,0,0,0,0,0,1,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0,1,0,0,0),
(0,0,0,0,0,0,1,0,0,0,1,0,0,0,0),
(0,0,0,0,0,0,0,1,0,0,0,1,0,0,0),
(0,0,0,0,0,0,0,0,1,0,0,0,1,0,0),
(0,0,0,0,0,0,0,0,0,1,0,0,0,1,0));

procedure TForm1.Button8Click(Sender: TObject);
var
i, j, k, ii: integer;
b: byte;
begin;
b:=1; // начнем с 2, 1 уже есть
for i:=i1 to i2 do if aaa3[j1,i]=1 then begin;
ii:=i; inc(b);
for j:=j1 to j2 do begin;
for k:=k1 to k2 do if aaa3[j,ii+h[k]]=1 then begin;
ii:=ii+h[k]; aaa3[j,ii]:=b; break;
end;
end;
end;
end;

procedure TForm1.Button9Click(Sender: TObject);
var
i, j: integer;
s: string;
begin
Memo1.Lines.Clear;
for j:=j1 to j2 do begin;
SetLength(s,i2);
for i:=i1 to i2 do s[i]:=chr(ord("0")+aaa3[j,i]);
Memo1.Lines.Add(s);
end;
end;



 
Sha   (2002-12-25 08:37) [16]

Во избежание вылета за границы массива внутренний цикл надо немного подправить:
for k:=k1 to k2 do begin;
hh:=ii+h[k];
if (hh>=i1) and (hh<=i2) and (aaa3[j,hh]=1) then begin;
ii:=hh; aaa3[j,hh]:=b; break;
end;
end;

добавив в объявления hh: integer;


 
OlDemon   (2002-12-25 08:52) [17]

если они непересекаются то почему бы просто не присваивать единичке ее порядковый номер (в смысле ) в данной строке Оч. просто ИМХО? хотя может быть я не понял задачу.

conter:=1;
for i:=1 to n do
for j:=1 to nn do
If massiv[i,j]="1" then
begin
inc(Counter);
massiv[i,j]:=IntToStr(Counter);
end;


 
Sha   (2002-12-25 09:27) [18]

2 OlDemon © (25.12.02 08:52)

Линии могут убегать за край.



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2003.01.06;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.63 MB
Время: 0.045 c
7-15325
Wizz
2002-10-28 05:09
2003.01.06
Подскажите, как эти несколько ASM команд вставить в Д6?


1-15003
CASU
2002-12-24 02:24
2003.01.06
RX - Warning


7-15323
Troll
2002-10-26 19:29
2003.01.06
АОН????


14-15314
alex134
2002-12-18 18:52
2003.01.06
ищу некую программу...


6-15185
RETAND
2002-11-05 23:34
2003.01.06
ClientSocket стучиться на ServerSocket, как реализовать??





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский