Пятничная на оптимизацию

← →
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]

> а как бинарным поиском найти сразу хоть одну границу?
> уж больно лень разбирать код

Там больше половины кода приходится как раз на объяснение :)
Все шаги алгоритма демонстрируются в гриде.

default © (06.08.04 11:45) [16]
Даже более того, может даже не быть ни одной записи за указаный месяц, условия задачи не оговаривают эту обязательность, так же как и отсутствие промежутков, например может быть тысяца дат 23.02.2004 и никаких других. Одно оговорено явно, никаких других дат из других годов.

> Anatoly Podgoretsky © (06.08.04 11:55) [18]
> Даже более того, может даже не быть ни одной записи за указаный месяц

Этот случай корректно обрабатывается - в результате будет получено lfound>rfound.

Ой... Даже *.dfm есть...
А вообще (в код правда не смотрел, мож повторюсь) я бы сделал так:
1) Найти все даты за этот месяц, записать вместо них нули (почти удалить), а вторым проходом - удалить нули. Свиду этот чуть проще, но правда может оказаться более медленно...

Sha © (06.08.04 12:03) [19]
Это не к тебе, нормальный двоичный поиск даст правильный результат, надо только проверить, что границы попадают в месяц, если стартовая не попадает, то записей вообще нет, если стоповая не попадает то минус 1, если попадает то найти последнее вхождение. Твой код не анализировал, тяжел для прямого восприятия алгоритма, визуально надо смотреть и проверить отладчиком на корректность при разных условиях.

DeadMeat © (06.08.04 12:15) [20]
Это не может быть оптимально, поскольку добавляется лишняя операция обнуления, для удаления не важно какие значения, удаляются нормально и с нулем и с правильным значением.

1)
Поиск границ удаляемого участка стоит разделить на две фазы:
1. Поиск любого элемента, за удаляемый месяц - обычный бинарный поиск, за исключением того, что по ходу поиска храним в каком то виде две последние границы (можно явные индексы - вначале это начало и конец массива).
2. От этого элемента влево и вправо ищем первые элементы, выходящие за пределы данного месяца (может оказаться что это граница массива). Поиск ограничиваем с двух сторон используя сохраненные границы на фазе 1. Можно применить видоизмененный бинарный поиск:
- если посредине элемент не из данного месяца, то берем половинку со стороны елемента с фазы 1
- иначе берем другую половинку
- процесс повторяется, пока не останется только один элемент в диапазоне

> Anatoly Podgoretsky © (06.08.04 12:17) [21]
> Твой код не анализировал, тяжел для прямого восприятия алгоритма...

Весь алгоритм - порядка 20 строк:
оставляем только bSolutionClick,
затем из нее выкидвываем всю работу с гридом и подсчет количества шагов.

Примерно так:
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;

Пятничная на оптимизацию Найти похожие ветки