По-моему интересная задачка для мастеров :)

← →
Cosinus (2002-07-25 16:09) [0]

Уважаемые господа, позвольте Вам задать задачку, над которой я уже замучился думать, задам я ее в вольной форме, потому что так проще объяснить суть. Допустим, есть какой-либо количество пустых горшочков Ж:) (400, for example), расположенных, например по 100 в ряду (то бишь 4 ряда) и имеются 100 горошин, которые нужно разложить в горшочки следующим образом:
1) в горшочке может не быть горошины (что логично), но не может быть больше одной
2)в сумме четырех рядом стоящих(в ряду) горшочках не может быть двух горошин
3)конечное расположение должно полностью соответствовать слову "хаос"

← →
Skier (2002-07-25 16:11) [1]

>Cosinus
Кто-нибудь решит, а ты получишь медаль на
олимпиаде ! :)))

← →
Cosinus (2002-07-25 16:15) [2]

Какая медаль, работа такая специфическая. Помогите, будте любезны.

← →
Skier (2002-07-25 16:18) [3]

>Cosinus

> я уже замучился думать

А в чем основная проблема ?

← →
Cosinus (2002-07-25 16:20) [4]

Алгоритм - основная проблемма

← →
Skier (2002-07-25 16:22) [5]

>Cosinus
Жутко конкретный ответ ! :)

← →
MBo (2002-07-25 16:25) [6]

для небольшого заполнения работает быстро

place:array[0..399] of byte;

function possible:Boolean;
begin
row:=np mod 100;
inrow:=place[row]+place[row+100]+place[row+200]+place[row+300];
result:=(inrow<2) and (place[np]=0);
end;

randomize;
ngor:=100;
while ngor>0 do begin
np:=random(400);
if possible then begin
place[np]:=1;
dec(ngor);
end;
end;

← →
Cosinus (2002-07-25 16:31) [7]

Я не знаю, как конкретнее ответить.
Для простоты понимания могу сказать для чего это надо : есть четырехканальная анимационная машинка и 62-лампочный ряд. Лампочки подсоеденены по 15 (последовательно) - нужно создать подобие хаоса. Ну не получается написать программу, которая мне бы указала какие лампочки к какому каналу подсоединять. Вот, что я написал на скорую руку, но иногда это срабатывает, а иногда виснет на 95-98% (знаю почему, но не знаю, как исправить).
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Gauges, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
g1: TGauge;
Button3: TButton;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

type
matrix= array [0..63] of byte;
matrix1=array [0..5,0..63] of byte;
var
n,i,k,rnd:byte;
f:textfile;
matr:matrix;
matr1:matrix1;
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button2Click(Sender: TObject);
begin
form1.Close;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
for i:=0 to 63 do
begin
matr[i]:=0;
end;

for k:=1 to 4 do
begin
for i:=1 to 62 do
matr1[k,i]:=1;
end;
assignfile(f,"c:\random.txt");
rewrite(f);
randomize;
n:=0;
for k:=1 to 4 do
begin
while n<15 do
begin
rnd:=random(61)+1;
if (matr[rnd]=0) and (matr1[k,rnd-1]=1) and (matr1[k,rnd+1]=1) then
begin
matr[rnd]:=1;
write(f,rnd);
write(f," ");
inc(n);
matr1[k,rnd]:=0;
g1.progress:=g1.progress+1;
if g1.progress=98 then
begin
closefile(f);
halt(1);
end;
end;
end;
n:=0;
writeln(f," ");
end;
closefile(f);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
assignfile(f,"c:\random.txt");
append(f);
for k:=1 to 4 do
begin
for i:=1 to 62 do
begin
if matr1[k,i]=0 then
begin
write(f,"#");
end
else
begin
write(f,"0");
end;
{write(f,matr1[k,i]);}
write(f," ");
end;
writeln(f," ");
end;
closefile(f);
end;

end.

← →
Skier (2002-07-25 16:47) [8]

>Cosinus

const RowCount = 100; ColCount = 4; var N : Smallint; Peas : array[1..ColCount,1..RowCount] of Byte; function PeaCanBePlaced(const ARow : Byte) : Boolean; var ASum : Byte; begin ASum := Peas[1, ARow] + Peas[2, ARow] + Peas[3, ARow] + Peas[4, ARow]; Result := (ASum < 2) or (ASum = 0); end; //PeaCanBePlaced var ARow : Byte; ACol : Byte; begin FillChar(Peas, SizeOf(Peas), 0); N := 1; while N <= RowCount*ColCount do begin Randomize; ARow := Random(RowCount); ACol := Random(ColCount); if PeaCanBePlaced(ARow) then Peas[ACol, ARow] := 1; Inc(N); end; //while

← →
Skier (2002-07-25 16:56) [9]

>Cosinus
Ойк ! Забыл про 1)
Ещё раз :)

const RowCount = 100; ColCount = 4; var N : Smallint; Peas : array[1..ColCount,1..RowCount] of Byte; function PeaCanBePlaced(const ACol, ARow : Byte) : Boolean; var ASum : Byte; begin ASum := Peas[1, ARow] + Peas[2, ARow] + Peas[3, ARow] + Peas[4, ARow]; Result := (ASum < 2) and (Peas[ACol, ARow] = 0); end; //PeaCanBePlaced var ARow : Byte; ACol : Byte; begin FillChar(Peas, SizeOf(Peas), 0); N := 1; while N <= RowCount*ColCount do begin Randomize; ARow := Random(RowCount); ACol := Random(ColCount); if PeaCanBePlaced(ACol, ARow) then Peas[ACol, ARow] := 1; Inc(N); end; //while

← →
Cosinus (2002-07-25 16:57) [10]

>> skier >> Нет времени проверить, появилась более срочная работа, но на всякий случай, спасибо.

← →
Skier (2002-07-25 17:03) [11]

>Cosinus
А как же MBo !? (А ему спасибо !?)

← →
Cosinus (2002-07-25 17:17) [12]

>> Skier >> MBo >> Простите дедушку, склероз :) А если серьезно, то действительно забыл, что мне MBo отвечал - я подбегу к компу, быстро гляну и убегу решать совсем другие проблеммы - голова пухнет. Еще раз извините и спасибо Skier и MBo. Если что не будет получаться завтра спрошу.
С уважением, Владислав.

По-моему интересная задачка для мастеров :) Найти похожие ветки