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

Вниз

Как организовать нормальный "рандом"??   Найти похожие ветки 

 
VlaDD   (2004-09-30 02:58) [0]

Суть задачи такова:
На экране 8 ячеек, в каждой из них записано какое-то первоначальное значение(1..10). Нужно организовать "рандом", чтобы в случайно выбранной ячейке число наращивалось на 1. За один такт только одна ячейка. При достижении числа 10 в какой-либо ячейке, она выпадает из "рандома", а последующие такты ее не косаются. Так продолжается, пока все числа в ячейках не дойдут до 10. Обязательное условие- чтобы небыло холостых ходов, т.е. "рандом" должен выбирать только из имеющихся ячеек куда прибавить еденичку.
Вроде задача простая, суть понятна, понимаю как делать, но воплотить в жизнь не получается!!! Помогите плиззз!!! Хотя бы на словах, но конечное же лучше алгоритм


 
default ©   (2004-09-30 03:10) [1]

думай


 
VlaDD   (2004-09-30 03:17) [2]

Завтра меня подвесят за "одно" место. Вот и сижу уже полночи - ДУМАЮ!!! Ну хотябы на словах...


 
default ©   (2004-09-30 03:19) [3]

множества используй


 
VlaDD   (2004-09-30 03:26) [4]

Я использовал списки, но при удалении из него любого элемента (достигшего 10) не могу отследить его новое местоположение.
К примеру:
12345678   //изначально (Random(9))
1245678    //третья ячейка достигла 10 (Random(8))
124678     //пятая ячейка достигла 10 (Random(7))
В результате, к примеру, шестая ячейка в списке находится на четвертом месте.

Может подскажите радикально иной способ


 
default ©   (2004-09-30 03:32) [5]

var
 Mas: Array[0..7] of Byte;
 DeathSet: Set of Byte;
 IncIndex: Byte;
begin
 ...
 DeathSet := [];
 Randomize;
 repeat
   repeat
     IncIndex := Random(8);
   until not (IncIndex in DeathSet);
   Inc(Mas[IncIndex]);
   if Mas[IncIndex] = 10 then Include(DeathSet, IncIndex)
 until DeathSet = [0,1,2,3,4,5,6,7]
 ...


 
VlaDD   (2004-09-30 03:45) [6]

...
  repeat
    IncIndex := Random(8);
  until not (IncIndex in DeathSet);
  ...
На сколько я понимаю, здесь цикл вхолостую будет крутиться, пока не найдет нужное число (к примеру ячеек 100, 99 из них уже заполнены и включены во множество). Мне ни в коем случае так нельзя...


 
default ©   (2004-09-30 03:55) [7]

ты всё правильно понял
а Вы какую щас тему проходите на занятиях?
можно например при достижении 10 в какой-то ячейки закинуть в эту ячейку значение из последней и делать Random(7)
когда появится следующая десятка кидать в эту ячейку значение из предпоследней ячейки и делать Random(6) и тд
холостых не будет, НО тут мы вмешиваемся в равномерное распределение чисел в заданном интервале которое даёт Random


 
Defunct ©   (2004-09-30 03:59) [8]


A: Array[1..10] of boolean; // ячейки
deleted : integer;
index   : integer;

begin
 for i:=1 to 10 do A[i] := True; // все ячейки есть
 deleted := 0;                   // 0 ячеек удалено
 
 for i:=1 to 10 do
 begin
   index := random( 10 - deleted);
   while Not(A[index]) do
   begin
      inc(index);
      if index>10 then index := 1;
   end;
   
   A[index] := False;      // удалить ячейку.
   deleted := deleted + 1; // увеличить число удаленных ячеек
 end;
 
end;


 
default ©   (2004-09-30 04:05) [9]

Defunct ©   (30.09.04 03:59) [8]
это не то, это жульничество
кстати смысл массива A в Вашем случае вообще не понятен, вообще совсем не то и с границами напутали...


 
default ©   (2004-09-30 04:08) [10]

да и вообще ерунда какая-то(не в обиду)


 
default ©   (2004-09-30 04:18) [11]

var
Mas: Array[0..7] of Byte;
CountDelete: Byte;
IncIndex: Byte;
begin
...
CountDelete := 0;
Randomize;
repeat
  IncIndex := Random(8-CountDelete);
  Inc(Mas[IncIndex]);
  if Mas[IncIndex] = 10 then begin
    Mas[IncIndex] := Mas[7-CountDelete);
    Inc(CountDelete);
  end;
until CountDelete = 8;

вот что предлагал в [7]


 
Defunct ©   (2004-09-30 04:20) [12]

default ©   (30.09.04 04:05) [9]
[8] - пример удаления без явного удаления, просто помечаем какие ячейки удалены. текущая(удаляемая) ячейка - и есть та, которую надо увеличивать до 10 или уменьшать до 0 в общем, делать с ней все что надо.

default ©   (30.09.04 04:08) [10]
я же промолчал про [5], хотя он мне тоже показался ерундой и жульничеством с первого взгляда.


 
default ©   (2004-09-30 04:24) [13]

for i:=1 to 10 do
begin
  index := random( 10 - deleted);
  while Not(A[index]) do
  begin
     inc(index);
     if index>10 then index := 1;
  end;
 
  A[index] := False;      // удалить ячейку.
  deleted := deleted + 1; // увеличить число удаленных ячеек
end;

давайте первый шаг посмотрим
весь массив A в True
поэтому в цикл не войдём и запишем False в случайную ячейку - типа она убита так и надо?!


 
Defunct ©   (2004-09-30 04:25) [14]

Ошибка, да там есть:

//index := random( 10 - deleted);

index := random( 9 )+1;


 
Defunct ©   (2004-09-30 04:26) [15]

> поэтому в цикл не войдём и запишем False в случайную ячейку - типа она убита так и надо?!

Ну да, нам же надо удалить случайную ячейку не так ли?


 
default ©   (2004-09-30 04:32) [16]

Defunct ©   (30.09.04 04:26) [15]
может в условии что упустили?ячейка отправляется ввысь когда набирает 10 очков, у Вас они как мухи мрут, (при истинных знач-ях элементов массива)...


 
Defunct ©   (2004-09-30 04:43) [17]

я понял задание так:

1. выбрать случайную ячейку.
2. увеличить ее значение до 10
3. пока не все ячейки равны 10 - GOTO 1

перечитал задание, правлю ответ [7]

A: Array[1..8] of Integer; // ячейки
index       : integer;
TriesCount  : Integer;

begin
for i:=1 to 10 do A[i] := Random(9)+1; // начальные значения ячеек

Repeat
  index := random( 7 ) + 1;
  TriesCount := 0;
  while (A[index]>=10) and (TriesCount<8) do
  begin
     inc(index);
     if index>8 then index := 1;
  end;

  Inc(A[index])          
until TriesCount>=8;

end;


 
Defunct ©   (2004-09-30 04:45) [18]

эх..

A: Array[1..8] of Integer; // ячейки
index       : integer;
TriesCount  : Integer;

begin
 for i:=1 to 10 do A[i] := Random(9)+1; // начальные значения ячеек

 Repeat
   index := random( 7 ) + 1;
   TriesCount := 0;
   while (A[index]>=10) and (TriesCount<8) do
   begin
      inc(index);
      inc(TriesCount);
      if index>8 then index := 1;
   end;

   Inc(A[index])          
 until TriesCount>=8;

end;


 
default ©   (2004-09-30 04:45) [19]

а я понял как в [5]
посмотрите этот алгоритм он очень прост
и потом увидите что [7] совсем не глупость
а я пошёл всё-таки спать!до вечера, там посмотрю что напишите


 
default ©   (2004-09-30 04:47) [20]

да и я прозевал что в массиве могут быть сразу элементы с 10
вообщем судя по коду нам обоим надо идти спать, хех


 
Defunct ©   (2004-09-30 04:53) [21]

> вообщем судя по коду нам обоим надо идти спать, хех

это верно подмечено


 
Fedia   (2004-09-30 07:41) [22]

Это все от нежелания работать под конец рабочего дня:

unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   Edit1: TEdit;
   Edit2: TEdit;
   Edit3: TEdit;
   Edit4: TEdit;
   Edit5: TEdit;
   Edit6: TEdit;
   Edit7: TEdit;
   Edit8: TEdit;
   Button2: TButton;
   procedure Button1Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

 Tcells=record
   value: Word;
   full: Boolean;
 end;

var
 Form1: TForm1;
 cells: array [1..8] of Tcells;
 procedure Start;

implementation

{$R *.dfm}

procedure SetEditValue;
begin
 Form1.Edit1.Text:= IntToStr(cells[1].value);
 Form1.Edit2.Text:= IntToStr(cells[2].value);
 Form1.Edit3.Text:= IntToStr(cells[3].value);
 Form1.Edit4.Text:= IntToStr(cells[4].value);
 Form1.Edit5.Text:= IntToStr(cells[5].value);
 Form1.Edit6.Text:= IntToStr(cells[6].value);
 Form1.Edit7.Text:= IntToStr(cells[7].value);
 Form1.Edit8.Text:= IntToStr(cells[8].value);
end;

procedure Start;
var
 i: integer;
begin
 for i:=1 to 8 do
 begin
   cells[i].value:=random(10)+1;
   if  cells[i].value=10 then
   cells[i].full:=true else
   cells[i].full:=false;
 end;
 SetEditValue;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 NCell: integer;
 bool: Boolean;
 i, n: integer;
begin
 bool:=true;
 for i:=1 to 8 do
 if not cells[i].full then
 begin
   bool:=false;
   break;
 end;
 if bool then
 begin
   start;
   exit;
 end;

 NCell:=random(8) + 1;

 if cells[NCell].full then
 while cells[NCell].full do
 begin
   n:=random(2); //некоторый элемент случайности в изменении номера ячейки
   if n=0 then
   begin
     if NCell = 8 then
     NCell:=1 else
     inc(NCell);
   end else
   begin
     if NCell = 1 then
     NCell:=8 else
     dec(NCell);
   end;
 end;

 inc(cells[NCell].value);
 if cells[NCell].value = 10 then
 cells[NCell].full:=true;

 SetEditValue;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Start;
end;

end.


 
default ©   (2004-09-30 14:18) [23]

Defunct ©   (30.09.04 04:45) [18]
[18] вообщем пойдёт с маленькой поправкой(в цикле в начале кода 10 сменить на 8, ну это описка разумеется)
но, ИМХО, [11] поизяшней и главное в нём исключены лишние действия
например(при условии что не все ячейки откинулись), в Вашем алгоритме может быть случай что первая ячейка выпала, а в ней уже 10 есть, начинается цикл, если во второй тоже 10 есть опять цикл проходит ещё раз и тд, максимум 7 холостых проходов


 
VlaDD   (2004-10-01 02:32) [24]

Огромное Вам спасибо! Правда толком еще не разобрался(я как раз сейчас этим и занимаюсь), но главное работает!

P.S.: мне дали отсрочку с прогой еще на 2 дня


 
VlaDD   (2004-10-01 02:33) [25]

Огромное Вам спасибо! Правда толком еще не разобрался(я как раз сейчас этим и занимаюсь), но главное работает!

P.S.: мне дали отсрочку с прогой еще на 2 дня


 
VlaDD   (2004-10-10 22:45) [26]

Ну, в общем, я тут посидел и довел этот алгоритм до ума. Оцените.

unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   Memo1: TMemo;
   Memo2: TMemo;
   Memo3: TMemo;
   Memo4: TMemo;
   Memo5: TMemo;
   Memo6: TMemo;
   Memo7: TMemo;
   Memo8: TMemo;
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
   procedure FormActivate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

 TCells=record
   value:Integer;
   full:Boolean;
 end;

var
 Form1: TForm1;
 Col: integer;
 cells: array [1..8] of TCells;
 OstNom: array [1..8] of integer;
 Procedure Start;

implementation

{$R *.dfm}

Procedure SetMemoValue;
begin
 Form1.Memo1.Text:= IntToStr(cells[1].value);
 Form1.Memo2.Text:= IntToStr(cells[2].value);
 Form1.Memo3.Text:= IntToStr(cells[3].value);
 Form1.Memo4.Text:= IntToStr(cells[4].value);
 Form1.Memo5.Text:= IntToStr(cells[5].value);
 Form1.Memo6.Text:= IntToStr(cells[6].value);
 Form1.Memo7.Text:= IntToStr(cells[7].value);
 Form1.Memo8.Text:= IntToStr(cells[8].value);
end;

Procedure Start;
var i:integer;
begin
 Col:=8;
 for i:=1 to 8 do
 begin
   cells[i].value:=0;
   cells[i].full:=false;
 end;
 for i:=1 to 8 do OstNom[i]:=i;
 SetMemoValue;
end;

procedure TForm1.Button1Click(Sender: TObject);
var NCell    : integer;
   bool,bk  : Boolean;
   i,j,n    : integer;
begin
   bool:=true;     //?????????? ??? ?????????
   for i:=1 to 8 do
   if not cells[i].full then     //???? ???? ?? ???? ?????? ?? ??????  bool=false
   begin
     bool:=false;
     break;
   end;
   if bool then    //??? ???? ??????????? ??? ??????
   begin
     start;
     exit;
   end;
   Randomize;
   NCell:=OstNom[Random(Col)+1];
   inc(Cells[NCell].value);
   if Cells[Ncell].value=10 then
   begin
       Cells[Ncell].full:=true;
       bk:=false;
       i:=1;
       While bk<>true do
       begin
           if OstNom[i]=NCell then
           begin
               for j:=i to Col-1 do
                   OstNom[j]:=OstNom[j+1];
               dec(Col);
               bk:=true;
           end;
           inc(i);
       end;
   end;

   SetMemoValue;

end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  Start;
end;

end.


 
SergP.   (2004-10-10 23:04) [27]


> Я использовал списки, но при удалении из него любого элемента
> (достигшего 10) не могу отследить его новое местоположение.


А ты в списке храни не само число, а его положение.


 
Юрий Зотов ©   (2004-10-10 23:37) [28]

Ёпрст.


 
Palladin ©   (2004-10-11 00:05) [29]

я в шоке...

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

Var
Src,
Finished:TList;

Procedure SimpleIsAPriority;
Var
nIndex:Integer;
Begin
While Src.Count>0 Do
 Begin
  nIndex:=Ransom(Src.Count);
  Src[nIndex]:=Pointer(Integer(Src[nIndex])+1);
  If Integer(Src[nIndex])=10 Then
   Begin
    Finished.Add(Pointer(nIndex));
    Src.Delete(nIndex);
   End;
 End;
End;

где в принципе и Finished является лишним и лишь используется для хранения истории завершения пути ячеек...


 
Palladin ©   (2004-10-11 00:12) [30]

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


 
VlaDD   (2004-10-11 01:33) [31]

Я совершенно не понял от куда что взялось!!!
Если хотите что-либо продемонстрировать, нельзя ли поподробней?..


 
Fedia ©   (2004-10-11 01:36) [32]

To VlaDD   (10.10.04 22:45) [26]
Хотел написать, что лучше бы этот код вообще больше не всплывал, ведь можно было воспользоваться советом [7] без введения новых переменных, но посмотрел на то, что в результате этого сообщения предложил Palladin, и теперь думаю, что результат оправдал затраченные средства.



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

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

Наверх





Память: 0.54 MB
Время: 0.038 c
1-1097573243
pika
2004-10-12 13:27
2004.10.24
Помогите пожалуиста с выбором !!!


14-1096715369
roma
2004-10-02 15:09
2004.10.24
webbrowser1 &amp; skrolling


1-1097223580
TUser
2004-10-08 12:19
2004.10.24
ShareMem and C


1-1097562547
Артемий
2004-10-12 10:29
2004.10.24
Проблема с запуском Delphi 7(лицензия)


8-1091007531
Wistler
2004-07-28 13:38
2004.10.24
Как получить изображение с Web-камеры?





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский