| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
По-моему интересная задачка для мастеров :)
Cosinus © (2002-07-25 16:09:00)Уважаемые господа, позвольте Вам задать задачку, над которой я уже замучился думать, задам я ее в вольной форме, потому что так проще объяснить суть. Допустим, есть какой-либо количество пустых горшочков Ж:) (400, for example), расположенных, например по 100 в ряду (то бишь 4 ряда) и имеются 100 горошин, которые нужно разложить в горшочки следующим образом:
1) в горшочке может не быть горошины (что логично), но не может быть больше одной
2)в сумме четырех рядом стоящих(в ряду) горшочках не может быть двух горошин
3)конечное расположение должно полностью соответствовать слову "хаос"
Cosinus (2002-07-25 17:17:00) [1]>> Skier >> MBo >> Простите дедушку, склероз :) А если серьезно, то действительно забыл, что мне MBo отвечал - я подбегу к компу, быстро гляну и убегу решать совсем другие проблеммы - голова пухнет. Еще раз извините и спасибо Skier и MBo. Если что не будет получаться завтра спрошу.
С уважением, Владислав.
Skier (2002-07-25 17:03:00) [2]>Cosinus
А как же MBo !? (А ему спасибо !?)
Cosinus (2002-07-25 16:57:00) [3]>> skier >> Нет времени проверить, появилась более срочная работа, но на всякий случай, спасибо.
Skier (2002-07-25 16:56:00) [4]>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
Skier (2002-07-25 16:47:00) [5]>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
Cosinus (2002-07-25 16:31:00) [6]Я не знаю, как конкретнее ответить.
Для простоты понимания могу сказать для чего это надо : есть четырехканальная анимационная машинка и 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.
MBo (2002-07-25 16:25:00) [7]для небольшого заполнения работает быстро
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;
Skier (2002-07-25 16:22:00) [8]>Cosinus
Жутко конкретный ответ ! :)
Cosinus (2002-07-25 16:20:00) [9]Алгоритм - основная проблемма
Skier (2002-07-25 16:18:00) [10]>Cosinus
> я уже замучился думать
А в чем основная проблема ?
Cosinus (2002-07-25 16:15:00) [11]Какая медаль, работа такая специфическая. Помогите, будте любезны.
Skier (2002-07-25 16:11:00) [12]>Cosinus
Кто-нибудь решит, а ты получишь медаль на
олимпиаде ! :)))
| |
