Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Здравствуйте, эксперты! есть процедура генерации случайных вопросов (номеров) я внутри использую рекурсию ... немогли бы помочь исправить мою процедуру для выборки случайных чисел и чтобы они не повторялись только не рекурсивно ...ниже привел процедуру :

Вопрос задал: Motor (статус: Посетитель) Вопрос отправлен: 20 апреля 2009, 03:08 Состояние вопроса: открыт, ответов: 1.

Ответ #1. Отвечает эксперт: min@y™

Для зарядки мозгов я взялся накропать тебе примерчик. Итак, берём массив целых чисел и заполняем его последовательно числами от 0 до (размер массива минус 1). Затем просто несколько (тысяч) раз переставляем пары случайных элементов внутри массива местами. Это даёт гарантию того, что все числа будут уникальные. Повторяющимся числам просто взяться неоткуда. После такой перетасовки можно брать из массива числа последовательно, они будут случайными и неповторяющмися.

Вот исходник с камментами:

program p2664;
 
{$APPTYPE CONSOLE}
 
const
  N = 300; // 1000 // Кол-во элементов
 
type
  TQMass = array[0..N - 1] of Integer;
 
// Перестановка местами двух целых чисел с использованием дополнительной переменной
{procedure Exchange(const P1, P2: PInteger);
var
  Temp: Integer;
begin
  Temp:= P1^;
  P1^:= P2^;
  P2^:= Temp;
end;}
 
// Перестановка местами двух целых чисел без использования дополнительной переменной.
// Работает в разы быстрее предыдущей.
procedure Exchange(const P1, P2: PInteger); assembler;
asm
  push [P1]
  push [P2]
  pop  [P1]
  pop  [P2]
end;
 
// Заполнение массива последовательными числами от 0 до N - 1
procedure FillQMass(var QMass: TQMass);
var
  Index: Integer;
begin
  for Index:= Low(TQMass) to High(TQMass) do
    QMass[Index]:= Index;
end;
 
// Тасование "колоды". Changes - кол-во перестановок
procedure RandomQMass(var QMass: TQMass; const Changes: Integer);
var
  Index, Index1, Index2: Integer;
begin
  for Index:= 0 to Changes - 1 do
    begin
      Index1:= Random(N);
      Index2:= Random(N);
      Exchange(@QMass[Index1], @QMass[Index2]);
    end;
end;
 
// Вывод массива на экран
procedure WriteQMass(const QMass: TQMass);
var
  Index: Integer;
begin
  for Index:= Low(TQMass) to High(TQMass) do
    Write(' ', QMass[Index]);
 
  WriteLn(#13#10);
end;
 
var
  QMass: TQMass;
 
begin
  Randomize();
  FillQMass(QMass); // Заполнение массива последовательными числами от 0 до N - 1
  WriteLn('  Source array: '); 
  WriteQMass(QMass); // Вывод массива на экран
 
  RandomQMass(QMass, 10000);
  WriteLn('  Changed array: ');
  WriteQMass(QMass); // Вывод массива на экран
 
  Write('  Press "ENTER" to exit... ');
  ReadLn;
end.

Ответ отправил: min@y™ (статус: Доктор наук) Время отправки: 20 апреля 2009, 08:59 Оценка за ответ: 5 Комментарий к оценке:

Мини-форум вопроса

min@y™ (статус: Доктор наук), 20 апреля 2009, 08:24 [#1]: Как же тяжко с утра в понедельник после Пасхи ковыряться в чужих исходниках!... Лучше скажи прямо, что тебе нужно, а? Предположу: есть числа от 1 до 1000. Их надо ПЕРЕТАСОВАТЬ, как колоду карт? Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!

Motor (статус: Посетитель), 20 апреля 2009, 14:07 [#2]: Нужно генерировать случайное число (номер вопроса) от 1 до N , где N - количество вопросов в тесте (оно задается произвольно зависит от выбранного теста) .... необходимо чтобы числа генерировались случайным образом и без повторений и либо как функция возвращала результат либо во внешнюю переменную этот номер вопроса сохранялся ...далее он будет передан другой процедуре в качестве параметра которая будет искать его сверяя во БД и двигая курсор к нужному номеру производя при этом выборку данных. ....вся фишка в том что все работает и с моей прошлой (рекурсивной процедурой) просто не учитывается последний шаг .... т.е. отрабатывает все вопросы выводит а последний нет ....может я просто счетчик который учитывает найденные вопросы не там поставил ? ниже скинул исходник всего модуля.

Motor (статус: Посетитель), 20 апреля 2009, 14:10 [#3]: var IDUser: integer; // ID пользователя IDTest: integer; // ID теста IDQuest: integer; // ID вопроса QCOUNT: integer; // Кол-во вопросов в тесте TestTimeOut: boolean; // признак завершения теста QMass : array [1..1000] of integer; // Массив вопросов qsum:integer; // Сумма найденныйх (FND) вопросов {$R *.dfm} //============= Открытие HTML Файла из БД ===================================== procedure TTestForm.DBOpenHTMLFile(var Q_N:integer; WB: TWebBrowser); var Flags: OLEVariant; FileName:string; i,CurRow,RCount:integer; begin Flags := 0; TestData.ADOQuery2.SQL.Text := 'Select QFileName,QTheme from Quest WHERE Quest.QTheme = '+ IntToStr(IDTest) +' GROUP BY QFileName,QTheme'; TestData.ADOQuery2.Open; CurRow:=TestData.ADOQuery2.RecNo; // Номер записи (положение курсора) RCount:=TestData.ADOQuery2.RecordCount; // Всего записей i:=1; while i<=RCount do begin // showmessage('КУРСОР ВОПРОСА : ' + IntToStr(CurRow)); if Q_N = CurRow then begin // showmessage ('Nashli'); TestData.ADOQuery2.Fields[0].AsString; FileName:=TestData.ADOQuery2.Fields[0].Value; WebBrowser1.Navigate(WideString(FileName), Flags, Flags, Flags, Flags); TestData.ADOQuery2.CursorPosChanged; end else // showmessage ('NE Nashli'); inc(i); inc(CurRow); TestData.ADOQuery2.RecNo:=CurRow; end; end; //============ Подсчет количества вопросов в теме ========================= function TTestForm.QThemeCount:integer; var count:integer; // переменная для подсчета кол-ва вопросов begin // ---------- Кол-во вопросов по теме --------------------- TestData.ADOQuery1.SQL.Text := 'Select count(*),QTheme from Quest WHERE Quest.QTheme ='+ IntToStr(IDTest) +' GROUP BY QTheme'; TestData.ADOQuery1.Open; count:= TestData.ADOQuery1.Fields[0].AsInteger; // открываем запрос "Вопросов" QThemeCount:=count; TestData.ADOQuery1.Close; //--------------------------------------------------------- end; //===================== Обнуление массива QMass вопросов ===================== procedure TTestForm.ClearQMass; var i:integer; begin for i:=1 to 1000 do begin QMass[i]:=-1; // очищаем массив под выборку end; end; //===================== Генерация вопроса случайным образом ================== procedure TTestForm.QuestGen(N:integer); var i,qnum : integer; fnd:boolean; begin fnd:=FALSE; qnum:=Random(N)+1; // выбираем случайным образом вопрос IDQuest:=qnum; // Showmessage(InttoStr(IDQuest)); i:=1; while(i<=QCount)and not(fnd) do if (Qmass[i]=qnum) then fnd:=true else inc(i); QMass[qnum]:=qnum; if fnd then QuestGen(N); // рекурсия на Random отработку if qsum = QCount then TestForm.Close; end; //==================== Закрытие формы ========================================= procedure TTestForm.SpeedButton2Click(Sender: TObject); begin TestForm.Close; end; //===================== При появлении формы теста задаем параметры ============ procedure TTestForm.FormShow(Sender: TObject); begin qsum:=0; // Обнуление суммы выданных вопросов IDUser:=TestData.ADODataSet4id.Value; // Определяем ID пользователя IDTest:=TestData.ADODataSet5id.Value; // Определяем ID темы теста QCOUNT:=QThemeCount; // Кол-во вопросов в тесте ClearQMass; // Обнуления массива вопросов //DBOpenHTMLFile(IDQuest, WebBrowser1); end; //===================== При закрытии формы теста задаем параметры ============ procedure TTestForm.FormDestroy(Sender: TObject); begin TestData.ADOQuery1.Close; // Закрываем запрос Вопросов IDUser:=0; // ID пользователя IDTest:=0; // ID теста QCOUNT:=0; // Кол-во вопросов в тесте qsum:=0; // Обнуление суммы выданных вопросов ClearQMass; // Обнуления массива вопросов end; //====================== Обработчик кнопки ОТВЕТИТЬ ========================== procedure TTestForm.SpeedButton1Click(Sender: TObject); begin QuestGen(QCount); // ShowMessage('ВОПРОС № : ' + IntToStr(IDQuest)) DBOpenHTMLFile(IDQuest, WebBrowser1); end; procedure TTestForm.FormCreate(Sender: TObject); begin Randomize; end; // if qsum = QCount then TestForm.Close; -срабатывает раньше времени т.е. закрывает окно формы а потом выводит уже в него вопрос ...и никак от этого не могу избавиться

min@y™ (статус: Доктор наук), 20 апреля 2009, 14:22 [#4]: Я не буду ковыряться в твоих исходниках. Воспользуйся моим примером и не мучайся. Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!

Motor (статус: Посетитель), 20 апреля 2009, 14:34 [#5]: пасиба буду разбираться

min@y™ (статус: Доктор наук), 20 апреля 2009, 14:40 [#6]: А чо там разбираться-то? Всё просто, как веник. Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.