генерация чисел

Deman1986 · #1 08.02.2015, 15:33

Уважаемы программисты помогите с решением задачи
генерацию набора цифр от нуля до девяти (количество объектов в наборе должно изменяться от одного до девяти, одинаковые цифры в наборе не допускаются);
вывод набора цифр пользователю в одной из определённых в индивидуальном задании графических форм в течение фиксированного промежутка времени;
вывод пользователю всех цифр (в заданной графической форме) для того, чтобы он мог указать, какие из них входили в набор;
индикация ошибок пользователя (при их наличии).
Графическая форма:
Римские цифры, словесная форма, цвет шрифта
реализовал вот так

Код:

unit main;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Timer1: TTimer;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;


implementation

{$R *.dfm}

function DecToRoman(Decimal: LongInt): string;
const
Romans: array[1..9] of string =
('I', 'II', 'III', 'IV', 'V', 'VI', 'VII', 'VIII', 'IX');
  Arabics: array[1..9] of Integer =
  (1, 2, 3, 4, 5, 6, 7, 8, 9);
var
  i: Integer;
  scratch: string;
begin
  scratch := '';
  for i := 9 downto 1 do
    while (Decimal >= Arabics[i]) do
    begin
      Decimal := Decimal - Arabics[i];
      scratch := scratch + Romans[i];
    end;
  Result := scratch;
  end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
// числа от 1 до 9 включительно будут отображаться последовательно
Label1.Caption:=Label1.Caption +' ' + IntToStr(Random(8)+1);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//надо обязательно иницилизировать генератор
Randomize;
  Timer1.Interval := 5000; // 5 секунд
    Timer1.Enabled := false;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Timer1.Enabled:=True;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled := false;
end;

end.

Помогите пожалуйста дальше не получается. Спасибо

M.A.D.M.A.N. · #2 08.02.2015, 15:50

Ну как вариант — использовать метод распределения, иначе в дельфи можно только получить псевдослучайные числа.

Deman1986 · #3 09.02.2015, 10:40

Подскажите пожалуйста как реализоваьь я новичек в дельфи. Спасибо.

lmikle · #4 09.02.2015, 20:59

Делал подобную задачу - перемешивание колоды карт.
Собственно, проблема данной задачи в том, что при прямой генерации для исключения повторения сгенерированного значения необходимо заного его генерировать. Такой алгоритм приводит к практически бесконечной генерации в конце списка.
Примененное решение заключалось в том, что производится не генерация самих значений (их список известен и конечен), а генерация их места в итоговом списке. Если позиция уже занята, то происходит просто поиск следующей свободной позиции (сдвиг).

Вот пример генерации:

Код:

procedure GetNumbers(var A : Array of Integer);
var
  I, Idx : Integer;
  B : Array [0..8] Of Integer;
begin
  If (Length(A) > 9) Or (Length(A) < 1)
    Then Raise Exception.Create('Input array should have length 1 to 9. ');

  // Init temp arrray
  For I := 0 to 8 Do B[i] := 0;

  // Generate list
  For I := 1 to 9 Do
    Begin
      Idx := Random(9);
      While B[Idx] <> 0 Do
        If Idx = 8 Then Idx := 0 Else Inc(Idx);
      B[Idx] := I;
    End;

  // Copy result to output array
  For I := Low(A) To High(A) Do A[i] := B[i];
end;

Пример использования. Пусть будут римские цифры:

Код:

// Return rome 1..9
function IntToRome(Value : Integer) : String;
const
  Romes : Array [1..9] Of String =
    ('I','II','III','IV','V','VI','VII','VIII','IX');
begin
  If Not (Value In [1..9]) 
    Then Raise Exception.Create('Value should be in range 1..9.');
  Result := Romes[Value];
end;

procedure Form1.Button1Click(Sender : TObject);
var
  N, I : Integer;
  A : Array Of Integer;
  S : String;
begin
  Randomize;
  N := Random(9)+1; // Random number of digits 1..9
  SetLength(A,N); // prepare the array
  GetNumbers(A); // Get values

  // Prepare and show result
  S := '';
  For I := Low(A) To High(A) Do
    Begin
      S := S + IntToRome(A[i]);
      If I < High(A) Then S := S + ', ';
    End;
  ShowMessage(S);
end;

Alegun · #5 09.02.2015, 22:44

А можно и так ещё, в лоб

Код:

...
type
 rdm = array [{1} 0..9] of string;

procedure rds(var ds: rdm);
var
 i, p, b: integer;
 s, r: string;
begin
 i:= {1} 0;
 while i <= 9 do
  begin
   p:= Random(10);
   b:= Random(10);
   s:= ds[p];
   r:= ds[b];
   ds[p]:= r;
   ds[b]:= s;
   inc(i);
  end;
end;

пример использования

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
 i: integer;
 m: rdm;
begin
 Randomize;
 for i:= {1} 0 to 9 do m[i]:=  IntToStr(i); { IntToRome(i);}
 Edit1.Text:='';
 rds(m);
 for i:= {1} 0 to 9 {Random(8)+2} do Edit1.Text:= Edit1.Text + m[i];
end;

в фигурных скобочках - вариант с ромой и переменной длинной наборчика

lmikle · #6 10.02.2015, 02:35

Да, можно прямым перемешиванием, хотя, при особом невезении, можно получить неперемешанный массив. Да, инициализацию массива забыл. И еще одна проблема в твоем коде - в моем варианте я всегда генерирую любое число от 1 до 9 не зависимо от длинны переданного массива. Именно поэтому используется временный массив, из которого потом производится копирование. Это не очень хорошо, если надо сгенерировать РЕАЛЬНО большую последоватиельность (например, если надо генерировать числа от 1 до, допустим, 1 млрд), памяти дополнительной много сожрет. С другой стороны, в твоем варианте все равно есть проблема, если надо сгенерировать любые 5 чисел из диапазона 1..9, как мне кажется, хотя очень внимательно не смотрел.

Alegun · #7 10.02.2015, 07:04

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

Deman1986 · #8 10.02.2015, 13:16

Оригинально конечно получилось. Протестил спасибо большое. Вот так набрал в дельфи.

Код:

unit main;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;


implementation

{$R *.dfm}

function IntToRome(Value : Integer) : String;
const
  Romes : Array [1..9] Of String =
    ('I','II','III','IV','V','VI','VII','VIII','IX');
begin
  If Not (Value In [1..9])
    Then Raise Exception.Create('значение должно быть в диапазоне 1..9.');
  Result := Romes[Value];
end;

procedure GetNumbers(var A : Array of Integer);
var
  I, Idx : Integer;
  B : Array [0..8] Of Integer;
begin
  If (Length(A) > 9) Or (Length(A) < 1)
    Then Raise Exception.Create('входной массив дорлжен иметь длину 1 to 9. ');

  // инициализация временного массива
  For I := 0 to 8 Do B[i] := 0;
 
  // генерация листа
  For I := 1 to 9 Do
    Begin
      Idx := Random(9);
      While B[Idx] <> 0 Do
        If Idx = 8 Then Idx := 0 Else Inc(Idx);
      B[Idx] := I;
    End;
 
  // копирование результатат в выходной массив
  For I := Low(A) To High(A) Do A[i] := B[i];
end;

procedure TForm1.Button1Click(Sender: TObject);
var
N, I : Integer;
  A : Array Of Integer;
    S : String;
begin
Randomize;
  N := Random(9)+1; // Random числа 1..9
    SetLength(A,N); // выделение памяти массиву
      GetNumbers(A);
// Отображение результата
S := '';
  For I := Low(A) To High(A) Do
    Begin
      S := S + IntToRome(A[i]);
      If I < High(A) Then S := S + ', ';
    End;
  ShowMessage(S);
end;

end.

А как сделать словестную форму и цвет?

Alegun · #9 10.02.2015, 13:29

Если словесная - это 'Один','Два','Три','итд.', то аналогично заменой содержимого текстового массива, а если звуком, то тогда туда нужно поместить имена звуковых файлов и воспроизводить их медиаплеером. Цветом (если это не 'Красный','Жёлтый','Зелёный','итд.') почти тоже самое, только вместо строк использовать в массиве тип TColor, напр. clRed

lmikle · #10 11.02.2015, 01:51

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

Пусть у нас есть RadioGroup c 2 вариантами - Римские цифры (0) и Слова (1).
тогда:

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
N, I : Integer;
  A : Array Of Integer;
    S : String;
begin
Randomize;
  N := Random(9)+1; // Random числа 1..9
    SetLength(A,N); // выделение памяти массиву
      GetNumbers(A);
// Отображение результата
S := '';
  For I := Low(A) To High(A) Do
    Begin
      Case RadioGroup1.ItemIndex Of // не помню как точно св-во нвзывается
        0 : S := S + IntToRome(A[i]);
        1 : S := S + IntToWord(A[i]);
        Else Raise Exception.Create('Unknown transformation.');
      End;
      If I < High(A) Then S := S + ', ';
    End;
  ShowMessage(S);
end;

Функцию IntToWord сам напишешь по аналогии...

Deman1986 · #11 12.02.2015, 14:31

Я сделал немного по хитрому добавил вторую кнопку с названием "Словестная форма"

Код:

unit main;

interface

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

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

var
  Form1: TForm1;


implementation

{$R *.dfm}

function IntToRome(Value : Integer) : String;
const
  Romes : Array [1..9] Of String =
    ('I','II','III','IV','V','VI','VII','VIII','IX');
begin
  If Not (Value In [1..9])
    Then Raise Exception.Create('значение должно быть в диапазоне 1..9.');
  Result := Romes[Value];
end;

function IntToWord(Value : Integer) : String;
const
  Wordes : Array [1..9] of String =
    ('Один','Два','Три','Четыре','Пять','Шесть','Семь','Восемь','Девять');
begin
  If not (Value In [1..9])
    Then Raise Exception.Create('значение должно быть в диапазоне Один..Девять.');
  Result := Wordes[Value];
end;

procedure GetNumbers(var A : Array of Integer);
var
  I, Idx : Integer;
  B : Array [0..8] Of Integer;
begin
  If (Length(A) > 9) Or (Length(A) < 1)
    Then Raise Exception.Create('входной массив дорлжен иметь длину 1 to 9. ');

  // инициализация временного массива
  For I := 0 to 8 Do B[i] := 0;
 
  // генерация листа
  For I := 1 to 9 Do
    Begin
      Idx := Random(9);
      While B[Idx] <> 0 Do
        If Idx = 8 Then Idx := 0 Else Inc(Idx);
      B[Idx] := I;
    End;
 
  // копирование результатат в выходной массив
  For I := Low(A) To High(A) Do A[i] := B[i];
end;

procedure TForm1.Button1Click(Sender: TObject);
var
N, I : Integer;
  A : Array Of Integer;
    S : String;
begin
Randomize;
  N := Random(9)+1; // Random числа 1..9
    SetLength(A,N); // выделение памяти массиву
      GetNumbers(A);
// Отображение результата
S := '';
  For I := Low(A) To High(A) Do
    Begin
        S := S + IntToRome(A[i]);
      If I < High(A) Then S := S + ', ';
    End;
  ShowMessage(S);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
N, I : Integer;
  A : Array Of Integer;
    S : String;
begin
Randomize;
  N := Random(9)+1; // Random слова Один..Девять
    SetLength(A,N); // выделение памяти массиву
      GetNumbers(A);
// Отображение результата
S := '';
  For I := Low(A) To High(A) Do
    Begin
        S := S + IntToWord(A[i]);
      If I < High(A) Then S := S + ', ';
    End;
  ShowMessage(S);
end;

end.

вот так получилось

Deman1986 · #12 12.02.2015, 14:34

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

M.A.D.M.A.N. · #13 12.02.2015, 15:43

Сам то как думаешь?

Deman1986 · #14 13.02.2015, 11:16

все спасибо всем огромное разобрался.

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты

Этот пользователь сказал Спасибо M.A.D.M.A.N. за это полезное сообщение:
Deman1986 (13.02.2015)

Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
Deman1986 (13.02.2015)