Форум: "Потрепаться";
Текущий архив: 2004.08.22;
Скачать: [xml.tar.bz2];
Вниз
Пятничная на оптимизацию Найти похожие ветки
← →
Anatoly Podgoretsky © (2004-08-06 09:08) [0]Постановка задачи
удалить часть динамического массива
Дано
есть динамический отсортированый массив (Ar), допустим TDateTime, в находятся данные только одного года, даты могут повторяться.
Требуется</
B> удалить все записи за один месяц (переменная M)
Задача два
Тоже самое только вместо удаления, добавить уже отсортированй массив Ar2 один месяц в массив Ar1, добавляемый месяц отсутствует в Ar1, пускай он удален в задаче 1
Цель- пятничная разминка с программистким уклоном, а то надоело собак и котов прогонять через строй. Можно предоставлять как коды, так и четко описаные алгоритмы.
Оценка - оценки не будет, только флейм :-)
Практическое применение, тренировка мозгов, кому ни будь пригодится в будущем.
ЗЫ: заразился от MBo :-)
← →
Anatoly Podgoretsky © (2004-08-06 09:16) [1]Дополнение, ассемблер не использовать, только чистый Паскаль. Хотя если есть большое желание то тоже можно, но лучше не стоит, суть залания все таки оптимальные алгоритмы.
← →
TUser © (2004-08-06 09:22) [2]Не силен я пока в алгоритмах, но все же.
1. Наверное, сначала бинарным поиском (или интерпляционным) находим начало и конец удаляемого участка, затем смещаем все, что после них, назад на соотв. число, потом SetLength.
2. Опять же ищем место, куда вставить, увеличиваем размер массива, смещаем вперед, и копируем вставку.
3. Вообще, если такие задачи возникают, логичнее испозовать связные списки.
← →
Владислав © (2004-08-06 10:36) [3]> TUser © (06.08.04 09:22) [2]
"... бинарным поиском..."
Даты могут повторяться.
← →
Думкин © (2004-08-06 10:37) [4]> [3] Владислав © (06.08.04 10:36)
Ну и?
← →
Sha © (2004-08-06 10:39) [5]Anatoly Podgoretsky © (06.08.04 09:08)
Мне кажется, лучше будет в качестве задачи оставить только определение начала и конца данных за указанный интервал времени.
Удаление и вставка - это самостоятельные сравнительно легкие задачи и соответственно отдельные процедуры.
← →
Anatoly Podgoretsky © (2004-08-06 10:44) [6]Владислав © (06.08.04 10:36) [3]
Нормальный бинарный поиск должен дать первое вхождение.
Sha © (06.08.04 10:39) [5]
Конечно можно, но не интересно, интересно в комплексе. Вот вторую задачу можно и не рассматривать, поскольку она по сути первая. Просто так для полноты задачи. Суть же в первой.
← →
Думкин © (2004-08-06 10:58) [7]> [6] Anatoly Podgoretsky © (06.08.04 10:44)
В одной бинарном сразу искать 2 границы? На каком-то этапе распаралелиться?
← →
Sandman25 © (2004-08-06 11:00) [8][7] Думкин © (06.08.04 10:58)
Боюсь, что это окажется медленнее, чем 2 бинарных.
← →
Думкин © (2004-08-06 11:04) [9]> [8] Sandman25 © (06.08.04 11:00)
Из-за 2-х сравнений?
← →
Sandman25 © (2004-08-06 11:05) [10]+ из-за усложнения алгоритма.
← →
Думкин © (2004-08-06 11:05) [11]> Sandman25 © (06.08.04 11:00)
Мне каааажется, что нет. Но надо реализацию, или креститься.
← →
Sandman25 © (2004-08-06 11:10) [12][11] Думкин © (06.08.04 11:05)
Все зависит от длины периода. Если почти всегда начало будет в первой половине, а конец - во второй, то разделяться нужно будет сразу же. Обычный поиск окажется быстрее.
Если же, наоборот, разделение будет на 25 шаге, то возможно ускорение.
← →
Anatoly Podgoretsky © (2004-08-06 11:10) [13]Думкин © (06.08.04 10:58) [7]
Сам решай и приводи решение, это же задача, а не заказ работы.
← →
Думкин © (2004-08-06 11:14) [14]> [13] Anatoly Podgoretsky © (06.08.04 11:10)
Да, конечно. Но код только дома - вечером, или завтра. Потому как тут - заказ и работа. А по пути я не смогу, только трепаться. :)
← →
Sha © (2004-08-06 11:21) [15]
unit FindDateMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Grids, StdCtrls, Spin;
type
Tfrm = class(TForm)
sg: TStringGrid;
Panel1: TPanel;
se1: TSpinEdit;
se2: TSpinEdit;
bSolution: TButton;
bRandom: TButton;
bClear: TButton;
procedure FormCreate(Sender: TObject);
procedure seChange(Sender: TObject);
procedure bClearClick(Sender: TObject);
procedure bRandomClick(Sender: TObject);
procedure bSolutionClick(Sender: TObject);
procedure sgDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
State: TGridDrawState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frm: Tfrm;
implementation
{$R *.dfm}
var
d: array of integer;
c1, c2: integer;
procedure sgFill;
var
c, r, v: integer;
begin;
with frm do begin;
for r:=1 to sg.RowCount-1 do for c:=1 to sg.ColCount-1 do sg.Cells[c,r]:="";
for r:=1 to sg.RowCount-1 do sg.Cells[0,r]:=IntToStr(r);
for c:=1 to sg.ColCount-1 do sg.Cells[c,0]:=IntToStr(d[c-1]);
c1:=sg.ColCount-1; c2:=-1;
for c:=1 to sg.ColCount-1 do begin;
v:=StrToIntDef(sg.Cells[c,0],-1);
if (v>=se1.Value) and (v<=se2.Value) then begin;
if c1>c then c1:=c;
if c2<c then c2:=c;
end;
end;
//for r:=1 to sg.RowCount-1 do for c:=c1 to c2 do sg.Cells[c,r]:=".";
end;
end;
procedure dInit;
var
i, t: integer;
done: boolean;
begin;
with frm do begin;
SetLength(d,sg.ColCount-1);
for i:=0 to High(d) do d[i]:=Random(31)+1;
//Sort
repeat;
done:=true;
for i:=0 to High(d)-1 do if d[i]>d[i+1] then begin;
t:=d[i]; d[i]:=d[i+1]; d[i+1]:=t; done:=false;
end;
until done;
end;
end;
procedure Tfrm.FormCreate(Sender: TObject);
begin;
bRandomClick(Sender);
Randomize; //After - to debug
end;
procedure Tfrm.seChange(Sender: TObject);
begin;
sgFill;
end;
procedure Tfrm.bClearClick(Sender: TObject);
begin;
sgFill;
end;
procedure Tfrm.bRandomClick(Sender: TObject);
begin;
dInit;
sgFill;
end;
procedure Tfrm.bSolutionClick(Sender: TObject);
var
no: integer;
lt, rt, mt, lt2, rt2: integer;
lfound, rfound: integer;
v: integer;
begin;
sgFill;
no:=0;
lt:=-1; rt:=high(d);
lt2:=lt+1; rt2:=rt+1;
while lt<rt do begin;
mt:=(lt+rt+1) shr 1; // Round to right
inc(no);
if lt>=0 then sg.Cells[lt+1,no]:=sg.Cells[lt+1,no]+"-";
sg.Cells[rt+1,no]:=sg.Cells[rt+1,no]+"+";
sg.Cells[mt+1,no]:=sg.Cells[mt+1,no]+"?";
v:=d[mt];
if v<se1.Value
then lt:=mt
else begin;
rt:=mt-1;
if v>se2.Value
then rt2:=mt
else if lt2<mt
then lt2:=mt;
end;
end;
lfound:=lt+1;
sg.Cells[lfound+1,no]:=sg.Cells[lfound+1,no]+"L";
lt:=lt2; rt:=rt2;
while lt<rt do begin;
mt:=(lt+rt) shr 1; // Round to left
inc(no);
sg.Cells[lt+1,no]:=sg.Cells[lt+1,no]+"+";
if rt+1<sg.ColCount then sg.Cells[rt+1,no]:=sg.Cells[rt+1,no]+"-";
sg.Cells[mt+1,no]:=sg.Cells[mt+1,no]+"?";
if d[mt]>se2.Value then rt:=mt else lt:=mt+1;
end;
rfound:=rt-1;
sg.Cells[rfound+1,no]:=sg.Cells[rfound+1,no]+"R";
end;
procedure Tfrm.sgDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin;
if (Sender is TStringGrid) then with TStringGrid(Sender) do begin;
Canvas.Font:=Font;
if (Acol>=c1) and (ACol<=c2)
then Canvas.Brush.Color:=clYellow
else Canvas.Brush.Color:=clWindow;
Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2, sg.Cells[ACol, ARow]);
end;
end;
end.
object frm: Tfrm
Left = 248
Top = 164
Width = 711
Height = 485
Caption = "frm"
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = "MS Sans Serif"
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object sg: TStringGrid
Left = 0
Top = 0
Width = 703
Height = 417
Align = alClient
ColCount = 51
DefaultColWidth = 19
DefaultRowHeight = 19
DefaultDrawing = False
RowCount = 20
TabOrder = 0
OnDrawCell = sgDrawCell
end
object Panel1: TPanel
Left = 0
Top = 417
Width = 703
Height = 41
Align = alBottom
TabOrder = 1
object se1: TSpinEdit
Left = 56
Top = 8
Width = 73
Height = 24
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = "Courier New"
Font.Style = []
MaxValue = 31
MinValue = 1
ParentFont = False
TabOrder = 0
Value = 3
OnChange = seChange
end
object se2: TSpinEdit
Left = 144
Top = 8
Width = 73
Height = 24
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = "Courier New"
Font.Style = []
MaxValue = 31
MinValue = 1
ParentFont = False
TabOrder = 1
Value = 29
OnChange = seChange
end
object bSolution: TButton
Left = 504
Top = 8
Width = 75
Height = 25
Caption = "Solution"
TabOrder = 2
OnClick = bSolutionClick
end
object bRandom: TButton
Left = 368
Top = 8
Width = 75
Height = 25
Caption = "Random"
TabOrder = 3
OnClick = bRandomClick
end
object bClear: TButton
Left = 288
Top = 8
Width = 75
Height = 25
Caption = "Clear"
TabOrder = 4
OnClick = bClearClick
end
end
end
← →
default © (2004-08-06 11:45) [16]а как бинарным поиском найти сразу хоть одну границу?
такое может быть, но ведь не всегда
ведь не сказано что в массиве присут-ют даты всех дней в месяце
придётся видимо искать бинарным поиском на совп-ие элемента массива определённом месяцу в диап-не его дней с учётом года
потом двигаться влево и вправо для достижения обоих границ
[15]
а можно на словах?
уж больно лень разбирать код
← →
Sha © (2004-08-06 11:50) [17]> а как бинарным поиском найти сразу хоть одну границу?
> уж больно лень разбирать код
Там больше половины кода приходится как раз на объяснение :)
Все шаги алгоритма демонстрируются в гриде.
← →
Anatoly Podgoretsky © (2004-08-06 11:55) [18]default © (06.08.04 11:45) [16]
Даже более того, может даже не быть ни одной записи за указаный месяц, условия задачи не оговаривают эту обязательность, так же как и отсутствие промежутков, например может быть тысяца дат 23.02.2004 и никаких других. Одно оговорено явно, никаких других дат из других годов.
← →
Sha © (2004-08-06 12:03) [19]> Anatoly Podgoretsky © (06.08.04 11:55) [18]
> Даже более того, может даже не быть ни одной записи за указаный месяц
Этот случай корректно обрабатывается - в результате будет получено lfound>rfound.
← →
DeadMeat © (2004-08-06 12:15) [20]Ой... Даже *.dfm есть...
А вообще (в код правда не смотрел, мож повторюсь) я бы сделал так:
1) Найти все даты за этот месяц, записать вместо них нули (почти удалить), а вторым проходом - удалить нули. Свиду этот чуть проще, но правда может оказаться более медленно...
← →
Anatoly Podgoretsky © (2004-08-06 12:17) [21]Sha © (06.08.04 12:03) [19]
Это не к тебе, нормальный двоичный поиск даст правильный результат, надо только проверить, что границы попадают в месяц, если стартовая не попадает, то записей вообще нет, если стоповая не попадает то минус 1, если попадает то найти последнее вхождение. Твой код не анализировал, тяжел для прямого восприятия алгоритма, визуально надо смотреть и проверить отладчиком на корректность при разных условиях.
← →
Anatoly Podgoretsky © (2004-08-06 12:18) [22]DeadMeat © (06.08.04 12:15) [20]
Это не может быть оптимально, поскольку добавляется лишняя операция обнуления, для удаления не важно какие значения, удаляются нормально и с нулем и с правильным значением.
← →
Igorek © (2004-08-06 12:20) [23]1)
Поиск границ удаляемого участка стоит разделить на две фазы:
1. Поиск любого элемента, за удаляемый месяц - обычный бинарный поиск, за исключением того, что по ходу поиска храним в каком то виде две последние границы (можно явные индексы - вначале это начало и конец массива).
2. От этого элемента влево и вправо ищем первые элементы, выходящие за пределы данного месяца (может оказаться что это граница массива). Поиск ограничиваем с двух сторон используя сохраненные границы на фазе 1. Можно применить видоизмененный бинарный поиск:
- если посредине элемент не из данного месяца, то берем половинку со стороны елемента с фазы 1
- иначе берем другую половинку
- процесс повторяется, пока не останется только один элемент в диапазоне
← →
Sha © (2004-08-06 12:23) [24]> Anatoly Podgoretsky © (06.08.04 12:17) [21]
> Твой код не анализировал, тяжел для прямого восприятия алгоритма...
Весь алгоритм - порядка 20 строк:
оставляем только bSolutionClick,
затем из нее выкидвываем всю работу с гридом и подсчет количества шагов.
← →
Sha © (2004-08-06 13:30) [25]Примерно так:
type
TValue= integer;
TValueArray= array of TValue;
procedure FindInterval(const VArray: TValueArray; LValue, RValue: TValue;
var Left, Right: integer);
var
v: TValue;
lt, rt, mt, lt2, rt2: integer;
begin;
lt:=-1; rt:=High(VArray);
lt2:=lt+1; rt2:=rt+1;
while lt<rt do begin;
mt:=(lt+rt+1) shr 1; // Round to right
v:=VArray[mt];
if v<LValue
then lt:=mt
else begin;
rt:=mt-1;
if v>RValue
then rt2:=mt
else if lt2<mt
then lt2:=mt;
end;
end;
Left:=lt+1;
while lt2<rt2 do begin;
mt:=(lt2+rt2) shr 1; // Round to left
if VArray[mt]>RValue
then rt2:=mt
else lt2:=mt+1;
end;
Right:=rt2-1;
end;
Страницы: 1 вся ветка
Форум: "Потрепаться";
Текущий архив: 2004.08.22;
Скачать: [xml.tar.bz2];
Память: 0.54 MB
Время: 0.12 c