народ, лыжы уже не едут, как это сделать???

← →
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]

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