| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Перемешать рендомно строки TStringList
WebSQLNeederr © (2008-02-18 13:05:00)Есть ли какой то простой способ перемешать в случайном порядке строки TStringList?
sniknik (2008-02-19 10:47:00) [1]> Опять таки можно придумать такой алгоритм, на котором это не проявится.
легко, вообщето первоначально хотел использовать рандомные значения сохраненные в свойстве tmp.Objects, но както "заломало" поэтому просто наименовал процедуру FoolerySort вместо RandomSort...
palva (2008-02-19 10:16:00) [2]
> sniknik © (19.02.08 01:03) [31]
Неправильно реализована функция FoolerySort. Функция обязана возвращать результат соответствующий правилам больше-меньше: рефлексивность, антисимметричность, транзитивность. Кроме того при многократном обращении к этой функции с одними и теми же параметрами результат должен быть один и тот же. Не знаю, приведет ли данный код к потере данных - это зависит от алгоритма сортировки, - но возможно сильно увеличенное время сортировки, а то и зацикливание. Алгоритм может многократно менять местами одни и те же строки, поскольку для них функция возвращает то минус, то плюс. Опять таки можно придумать такой алгоритм, на котором это не проявится.
sniknik (2008-02-19 01:03:00) [3]
function FoolerySort(List: TStringList; Index1, Index2: Integer): Integer;
begin
result:= Random(2000)-1000;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
tmp: TStringList;
begin
Randomize;
tmp:= TStringList.Create;
try
tmp.Assign(Memo1.Lines);
tmp.CustomSort(FoolerySort);
Memo1.Lines.Assign(tmp);
finally
tmp.Free;
end;
end;
KilkennyCat (2008-02-18 22:53:00) [4]> stop := false;
нафиг не надо.
> if i <= 0 then stop := true;
until stop = true;
кто вас такому учил?
и вообще, все мрак.
ща напишу.
KilkennyCat (2008-02-18 22:32:00) [5]
function rech(st : string): string;
var
s, s1 : string;
stop : bool;
i, j : integer;
tempstr, res : TStringList;
begin
stop := false;
s := st;
j := 0;
tempstr := TStringList.create;
res := TStringList.create;
repeat
i := pos('.', s);
if i <= 0 then stop := true;
s1 := copy(s, 0, i);
if length(s1) > 5 then begin
tempstr.Add(s1);
j := j+1;
end;
s := copy(s, i+2, length(s) - i);
until stop = true;
// Выше мы находили в тексте первое нахождение точки и закидывали в стринглист tempstr предложение.
for i := 1 to strtoint(Form1.counttext.text) do begin
res.Add(tempstr.Strings[Random(tempstr.Count - 1)]);
end;
// А это мы перемешали все предложения.
rech := res.text;
tempstr.Free;
res.Free;
end;
KilkennyCat (2008-02-18 22:28:00) [6]> Может можно как то оптимизировать?
Да. Хотя бы по-человечески написать. Точнее, по-паскалевски. по-венгерски.
WebSQLNeederr (2008-02-18 21:14:00) [7]Правда у меня предварительно еще разбивает текст каждой строки на предложения и заносит в СтрингЛист, а потом уже этот стринглист перемешивает.
Вот пример:
function rech(st:string):string;
var s,s1:string;stop:bool;i,j:integer;tempstr,res:TStringList;
begin
stop:=false; s:=st; j:=0;
tempstr:=TStringList.create;
res:=TStringList.create;
repeat
i:=pos('.',s); if i<=0 then stop:=true;
s1:=copy(s,0,i);
if length(s1)>5 then begin tempstr.Add(s1);j:=j+1;end;
s:=copy(s,i+2,length(s)-i);
until stop=true;
// Выше мы находили в тексте первое нахождение точки и закидывали в стринглист tempstr предложение.
for i:=1 to strtoint(Form1.counttext.text) do
begin
res.Add(tempstr.Strings[Random(tempstr.Count-1)]);
end;
// А это мы перемешали все предложения.
rech:=res.text;
tempstr.Free; res.Free;
end;
Функция выдает уже текст, где предложения перемешаны. Вот когда я эту функцию вызываю раз 10-15 то и возникает задержка в где то 40 секунд. Может можно как то оптимизировать?
WebSQLNeederr (2008-02-18 21:07:00) [8]У меня на 35-40 секунд подвисает комп ...
KilkennyCat (2008-02-18 20:46:00) [9]мда. на перемешивание 86 кбайт часики могут действительно не появиться. неуспеють...
Сергей М. (2008-02-18 16:41:00) [10]
> WebSQLNeederr (18.02.08 16:02) [23]
Да куда хочешь, туда и "пихай")
Правило одно - чем чаще вызывается ProcessMessage, тем оперативнее программа реагирует на события польз.интерфейса, но и тем больше программа отнимает у системы квантов процессорного времени.
WebSQLNeederr (2008-02-18 16:02:00) [11]ну внутри функции есть цикл, пример
function func:string;
begin
for i:=1 to 10 do
begin
СЮДА Application.Processmessages; ???
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
for i:=1 to 10 do
begin
a:=func;
ИЛИ СЮДА Application.Processmessages; ???
end;
Сергей М. (2008-02-18 15:25:00) [12]
> цикла функции
Это еще куда ?)
WebSQLNeederr (2008-02-18 15:20:00) [13]То есть в моем случае его нужно впихнуть как в тело цикла в обработчики кнопки так и в тело цикла функции, которая вызывается из обработчика кнопки.
Сергей М. (2008-02-18 15:04:00) [14]
> зачем оно вообще надо, что оно делает?
>
Как раз то что тебе нужно - что бы не подвисала
> куда его пихать?
В тело цикла, сказано же.
Если не лезет, воспользуйся смазкой)
Palladin (2008-02-18 15:04:00) [15]
> Application.Processmessages - зачем оно вообще надо, что
> оно делает?
приказывает приложению обработать все поступившие к нему, но еще не обработанные (сидящие в очереди) сообщения...
WebSQLNeederr (2008-02-18 14:59:00) [16]Есть еще два вопроса:
1. Application.Processmessages - зачем оно вообще надо, что оно делает?
2. и если надо то куда его пихать? Вот у меня есть оброботчик кнопки там есть цикл, который вызывает функцию в которой есть тоже цикл. Так вот этот процессмеседж впихивать в цикл внутри функции или в цикл обработчика кнопки?
Джо (2008-02-18 14:50:00) [17]> [15] WebSQLNeederr (18.02.08 14:40)
> Ну так а с часиками что? Как их впихнуть в процесс перемешивания?
Screen.Cursor := crHourglass;
try
// перемешиваем...
finally
Screen.Cursor := crDefault
end
Amoeba (2008-02-18 14:50:00) [18]
> Ну так а с часиками что? Как их впихнуть в процесс перемешивания?
>
>
Даю подсказку. У TScreen и TControl есть такое замечательное св-во: Cursor
WebSQLNeederr (2008-02-18 14:40:00) [19]palva, Palladin - красиво вы сделали!! По красоте! Спасибо за варианты! Ато у меня примитивный вариант перемешивания был.
Ну так а с часиками что? Как их впихнуть в процесс перемешивания?
Palladin (2008-02-18 14:34:00) [20]
Var
tmp:TStringList;
n:Integer;
Begin
tmp:=TStringList.Create;
Try
tmp.AddStrings(list);
list.Clear;
While tmp.Count>0 Do
Begin
n:=Random(tmp.Count);
list.Add(tmp[n]);
tmp.Delete(n);
End;
Finally
tmp.Free;
End;
End;
| |
Страницы: 