Курсовая работа - Б-деревья во внешней памяти

182 try

183 dStream.CopyFrom(sStream, 0);

184 finally

185 dStream.Free;

186 end;

187 finally

188 sStream.Free;

189 end;

190 end;

191 begin

192 UpdateFile();

193 FileCopy(FileName, DstFileName);

194 end;

195

196 function TBTree.Search(var pos, k: Integer): boolean;

197 var i: integer;

198 x: BTreeNode;

199 begin

200 x := DiskRead(pos);

201 i := 1;

202 while (i <= x.n) and (k > x.key[i]) do

203 i := i + 1;

204 if (i <= x.n) and (k = x.key[i]) then

205 begin

206 Result := true;

207 exit;

208 end;

209 if x.leaf then Result := false

210 else Result := Search(x.c[i], k);

211 end;

212

213 procedure TBTree.SplitChild(var x, y: BTreeNode; i: integer);

214 var z: BTreeNode;

215 j: integer;

216 begin

217 z := AllocateNode();

218

219 z.leaf := y.leaf;

220 z.n := t - 1;

221

222 z.pos := GetFreePos(Count + 1);

223 for j := 1 to t - 1 do

224 z.key[j] := y.key[j + t];

225 if not y.leaf then

226 for j := 1 to t do

227 z.c[j] := y.c[j + t];

228 y.n := t - 1;

229 for j := x.n + 1 downto i + 1 do

230 x.c[j + 1] := x.c[j];

231 x.c[i + 1] := z.pos;

232 for j := x.n downto i do

233 x.key[j + 1] := x.key[j];

234 x.key[i] := y.key[t];

235 x.n := x.n + 1;

236 DiskWrite(x);

237 DiskWrite(y);

238 DiskWrite(z);

239 end;

240

241 procedure TBTree.InsertNonFull(var x: BTreeNode; k: integer);

242 var i: integer;

243 y: BTreeNode;

244 begin

245 i := x.n;

24

246 if x.leaf then

247 begin

248 while (i >= 1) and (k < x.key[i]) do

249 begin

250 x.key[i + 1] := x.key[i];

251 i := i - 1;

252 end;

253 x.key[i + 1] := k;

254 x.n := x.n + 1;

255 DiskWrite(x);

256 end

257 else

258 begin

259 while (i >= 1) and (k < x.key[i]) do

260 i := i - 1;

261 i := i + 1;

262 y := DiskRead(x.c[i]);

263 if y.n = 2 * t - 1 then

264 begin

265 SplitChild(x, y, i);

266 if k > x.key[i] then

267 begin

268 i := i + 1;

269 y := DiskRead(x.c[i]);

270 end;

271 end;

272 InsertNonFull(y, k);

273 end;

274 end;

275

276 procedure TBTree.Insert(var k: integer);

277 var s, r: BTreeNode;

278 begin

279 r := DiskRead(RootPos);

280 if r.n = 2 * t - 1 then

281 begin

282 s := AllocateNode();

283 s.leaf := false;

284 s.n := 0;

285 s.pos := GetFreePos(Count);

286 s.c[1] := r.pos; // -

287 RootPos := s.pos;

288 SplitChild(s, r, 1);

289 InsertNonFull(s, k);

290 end

291 else InsertNonFull(r, k);

292 end;

293

294 function TBTree.MaxInSubTree(var pos: integer): integer;

295 var x: BTreeNode;

296 begin

297 x := DiskRead(pos);

298

299 if x.leaf then

300 Result := x.key[x.n]

301 else

302 Result := MaxInSubTree(x.c[x.n + 1]);

303 end;

304

305 function TBTree.MinInSubTree(var pos: integer): integer;

306 var x: BTreeNode;

307 begin

308 x := DiskRead(pos);

309

25

310 if x.leaf then

311 Result := x.key[1]

312 else

313 Result := MinInSubTree(x.c[1]);

314 end;

315

316 function TBTree.Remove(var x_num: integer; k: integer): boolean;

317 var i, j: integer;

318 x, y, z, cx, lbrat, pbrat: BTreeNode;

319 kprim: integer;

320 begin

321 x := DiskRead(x_num);

322 if x.leaf then

323 // п.1 Если ключ k находится в узле х и х является листом — удаляем k из х.

324 begin

325 i := 1;

326 while (k <> x.key[i]) and (i <= x.n) do i := i + 1;

327 if (k = x.key[i]) then

328 begin

329 while i <> x.n do

330 begin

331 x.key[i] := x.key[i + 1];

332 x.c[i] := x.c[i + 1];

333 i := i + 1;

334 end;

335 x.n := x.n - 1;

336 DiskWrite(x);

337 Result := true;

338 end

339 else Result := false;

340 exit;

341 end

342 else // п. 2 и 3

343 begin

416 cx := DiskRead(x.c[i]); // поддерево, которое должно содержать k

417 if (cx.n = t - 1) then // п. 3а

418 begin

419

420 if i = 1 then

421 begin

422 pbrat := DiskRead(x.c[i + 1]);

423 if (pbrat.n = t - 1) then // объединяем CX и правого соседа. тк оба по t-1

424 begin

425 cx.n := cx.n + 1;

426 cx.key[cx.n] := x.key[1];

427 j := 1;

428 while (j <= t - 1) do

429 begin

430 cx.n := cx.n + 1;

431 cx.key[cx.n] := pbrat.key[j];

432 cx.c[cx.n] := pbrat.c[j];

433 j := j + 1;

434 end;

435 cx.c[cx.n + 1] := pbrat.c[pbrat.n + 1];

436 x.n := x.n - 1;

437 if x.n <> 0 then

438 begin

439 j := 1;

440 while j <= x.n do

441 begin

442 x.key[j] := x.key[j + 1];

443 //x.c[j] := x.c[j + 1];

444 x.c[j + 1] := x.c[j + 2];

445 j := j + 1;

26

446 end;

447 DiskWrite(x);

448 end

449 else

450 begin

451 rootPos := cx.pos;

452 AddToRemMas(x.pos);

453 //SetLength(RemMas, Length(RemMas) + 1);

454 //RemMas[Length(RemMas) - 1] := x.pos;

455 end;

456 DiskWrite(cx);

457 AddToRemMas(pbrat.pos);

458 //SetLength(RemMas, Length(RemMas) + 1);

459 //RemMas[Length(RemMas) - 1] := pbrat.pos;

460 Result := Remove(cx.pos, k);

461 exit;

462 end

463 else // берем ключ из правого соседа и добавляем в x.c[i]

464 begin

465 cx.n := cx.n + 1;

466 cx.key[cx.n] := x.key[1];

467 cx.c[cx.n + 1] := pbrat.c[1];

468 x.key[1] := pbrat.key[1];

469 j := 1;

470 pbrat.n := pbrat.n - 1;

471 while (j <= pbrat.n) do

472 begin

473 pbrat.key[j] := pbrat.key[j + 1];

474 pbrat.c[j] := pbrat.c[j + 1];

475 j := j + 1;

476 end;

477 pbrat.c[j] := pbrat.c[j + 1];

478 DiskWrite(cx);

479 DiskWrite(pbrat);

480 DiskWrite(x);

481 Result := Remove(cx.pos, k);

482 exit;

483 end;

484

485 end

486 else if (i = x.n + 1) then // если рассм-ый узел - крайний справа

487 begin

488 lbrat := DiskRead(x.c[x.n]);

489 if (lbrat.n = t - 1) then // если наименьшее число ключей, объедииняем

левого соседа и CX

490 begin

491 lbrat.n := lbrat.n + 1;

492 lbrat.key[lbrat.n] := x.key[x.n];

493 j := 1;

494 while (j <= cx.n) do

495 begin

496 lbrat.n := lbrat.n + 1;

497 lbrat.key[lbrat.n] := cx.key[j];

498 lbrat.c[lbrat.n] := cx.c[j];

499 j := j + 1;

500 end;

501 lbrat.c[lbrat.n + 1] := cx.c[cx.n + 1];

502 x.n := x.n - 1;

503 if x.n = 0 then

504 begin

505 rootPos := lbrat.pos;

506 //SetLength(RemMas, Length(RemMas) + 1);

507 //RemMas[Length(RemMas) - 1] := cx.pos;

508 AddToRemMas(cx.pos);

27

509 AddToRemMas(x.pos);

510 //SetLength(RemMas, Length(RemMas) + 1);

511 //RemMas[Length(RemMas) - 1] := x.pos;

512 end

513 else

514 begin

515 AddToRemMas(cx.pos);

516 //SetLength(RemMas, Length(RemMas) + 1);

517 //RemMas[Length(RemMas) - 1] := cx.pos;

518 j := i - 1;

519 while (j <= x.n) do

520 begin

521 x.key[j] := x.key[j + 1];

522 x.c[j + 1] := x.c[j + 2];

523 j := j + 1;

524 end;

525 DiskWrite(x);

526 end;

527 DiskWrite(lbrat);

528 Result := Remove(lbrat.pos, k);

529 exit;

530 end

644 DiskWrite(cx);

645 Result := Remove(cx.pos, k);

646 exit;

647 end;

648 end;

649 end

650 else

651 Result := Remove(x.c[i], k);

652 exit;

653 end;

654 end;

655 end;

656

657 procedure TBTree.UpdateFile();

658 const

659 MaxBufSize = $F000; // 61440 байт

660 var

661 s, d: TFileStream;

662 i: integer;

663 Buffer: PChar;

664 CopySize, BufSize, N: integer;

665 begin

666 try

667 s := TFileStream.Create(FileName, fmOpenReadWrite);

668 s.Seek(0, soFromBeginning);

669 if not RemMasChange then {если страницы не удаляли или

670 число удаленных=добавленным, уходим}

671 begin

672 s.WriteBuffer(RootPos, SizeOf(integer));

673 exit;

674 end;

675 try

676 d := TFileStream.Create(FileName + 'buf', fmCreate);

677 d.Seek(0, soFromBeginning);

678

679 CopySize := s.Size - (RemCount + 2) * SizeOf(integer);

680 s.Seek((RemCount + 2) * SizeOf(integer), soFromBeginning);

681

682 d.WriteBuffer(RootPos, SizeOf(integer));

683 RemCount := Length(RemMas);

684 d.WriteBuffer(RemCount, SizeOf(integer));

685

28

686 for i := 0 to Length(RemMas) - 1 do

687 d.WriteBuffer(RemMas[i], SizeOf(integer));

688

689 // взято из TStream.CopyFrom. Копирует все записи в новый файл

690 if CopySize > MaxBufSize then BufSize := MaxBufSize else BufSize :=

CopySize;

691 GetMem(Buffer, BufSize);

692 while CopySize <> 0 do

693 begin

694 if CopySize > BufSize then N := BufSize else N := CopySize;

695 s.ReadBuffer(Buffer^, N);

696 d.WriteBuffer(Buffer^, N);

697 Dec(CopySize, N);

698 end;

699 finally

700 d.Free();

701 FreeMem(Buffer, BufSize);

702 end;

703

704 finally

705 s.Free();

706 end;

707 DeleteFile(FileName);

708 RenameFile(FileName + 'buf', FileName);

709 end;

710

711

712 end.

29

Приложение Б. Модуль класса главной формы.

1 unit uMain;

2

3 interface

4

5 uses

6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

7 Dialogs, StdCtrls, Spin, ComCtrls, XPMan, uInputDlg, ExtCtrls, commctrl,

8 BTree, uImageBTree;

9

10 type

11 TfMain = class(TForm)

12 btnGenerate: TButton;

13 btnOpen: TButton;

14 btnAdd: TButton;

15 btnDelete: TButton;

16 tvBTree1: TTreeView;

17 XPManifest1: TXPManifest;

18 OpenDialog: TOpenDialog;

19 eOpenFile: TEdit;

20 SaveDialog: TSaveDialog;

21 btnSave: TButton;

22 btnDraw: TButton;

23 btnSearch: TButton;

24 tvBTree2: TTreeView;

25 lbBefore: TLabel;

26 lbAfter: TLabel;

27 procedure ChangeTrees();

28 procedure btnGenerateClick(Sender: TObject);

29 procedure FormCreate(Sender: TObject);

30 procedure btnAddClick(Sender: TObject);

31 procedure btnDeleteClick(Sender: TObject);

32 procedure btnOpenClick(Sender: TObject);

33 procedure btnSaveClick(Sender: TObject);

34 procedure btnSearchClick(Sender: TObject);

35 procedure btnDrawClick(Sender: TObject);

36 procedure FormClose(Sender: TObject; var Action: TCloseAction);

37 procedure tvBTree1Enter(Sender: TObject);

38 private

39 { Private declarations }

40 public

41 { Public declarations }

42 end;

43

44 var

45 fMain: TfMain;

46 bt: TBTree;

47 NumOfKeys, LastAdded: integer;

48 TreeView: TTreeView;

49

50 implementation

51

52 {$R *.dfm}

53

54 // выделение элемента TreeView жирным

55 procedure SetNodeBoldState(Node: TTreeNode; Value: Boolean);

56 var

30

57 TVItem: TTVItem;

58 begin

59 if not Assigned(Node) then Exit;

60 with TVItem do

61 begin

62 mask := TVIF_STATE or TVIF_HANDLE;

63 hItem := Node.ItemId;

64 stateMask := TVIS_BOLD;

65 if Value then state := TVIS_BOLD

66 else

67 state := 0;

68 TreeView_SetItem(Node.Handle, TVItem);

69 end;

70 end;

71

72

73 procedure SelectByKey(key: integer);

74 var Node: TTreeNode;

75 Searching: boolean;

76 begin

77 if TreeView.Items.Count > 0 then

78 with TreeView do

79 begin

80 Node := Items[0];

81 Searching := true;

82

83 while (Searching) and (Node <> nil) do

84 if Node.text = inttostr(key) then

85 begin

86 Searching := False;

87 Selected := Node;

88 SetFocus;

89 end

90 else

91 Node := Node.GetNext

92 end;

93 end;

94

95 procedure TfMain.ChangeTrees();

96 var L: integer;

97 begin

98 L := tvBTree1.Left;

99 tvBTree1.Left := tvBTree2.Left;

100 tvBTree2.Left := L;

101

102 if tvBTree1.Left > tvBTree2.Left then

103 TreeView := tvBTree1

104 else

105 TreeView := tvBTree2;

106 end;

107

108 procedure BTreePrint(var pos: integer; parent: TTreeNode);

109 var g, j: integer;

110 node: TTreeNode;

111 x: BTreeNode;

112 begin

113 x := bt.DiskRead(pos);

114 if not x.leaf then

115 begin

116 for j := 1 to x.n do

117 begin

118 node := TreeView.Items.AddChild(parent, IntToStr(x.key[j]));

119 BTreePrint(x.c[j], node);

120 end;

31

121 node := TreeView.Items.AddChild(parent, '>' + IntToStr(x.key[x.n]));

122 BTreePrint(x.c[x.n + 1], node);

123 end

124 else

125 for g := 1 to x.n do

126 TreeView.Items.AddChild(parent, inttostr(x.key[g]));

127 end;

128

129 procedure PrintTree();

130 begin

131 with TreeView do

132 begin

133 Items.Clear;

134 Items.BeginUpdate;

135

136 BTreePrint(bt.RootPos, nil);

137

138 FullExpand;

139 if Items.Count > 0 then

140 Items[0].MakeVisible();

141 SetFocus();

142

143 Items.EndUpdate;

144 end;

145 end;

146

147 procedure TfMain.btnGenerateClick(Sender: TObject);

148 var a: array of integer;

149 i, j, k, n: integer;

150 begin

151 randomize();

152

153 // сохранить предыдущее??

154

155 fInput.Caption := 'Сгенерировать дерево';

156 fInput.lbQ.Caption := 'Введите количество элементов в новом дереве:';

157 fInput.eInput.Value := 15;

158

159 if fInput.ShowModal = mrOk then

160 n := fInput.eInput.Value

161 else exit;

162

163 SetLength(a, n);

164 NumOfKeys := n;

165

166 // массив со случайными числами в возрастающем порядке

167 a[0] := random(20) + 1;

168 for i := 1 to n - 1 do

169 a[i] := a[i - 1] + random(20) + 1;

170

171 // чтобы массив не был отсортирован меняем местами случайные элементы

172 for i := 0 to n - 1 do

173 begin

174 j := random(i);

175 k := a[i];

176 a[i] := a[j];

177 a[j] := k;

178 end;

179

180 bt := TBTree.Create('BTree.bts');

181 for i := 0 to n - 1 do

182 bt.Insert(a[i]);

183

184 eOpenFile.Text := bt.FileName;

32

185

186 PrintTree();

187 ChangeTrees();

188 PrintTree();

189

190 btnDraw.Enabled := true;

191 btnAdd.Enabled := true;

192 btnDelete.Enabled := true;

193 btnSave.Enabled := true;

194 btnSearch.Enabled := true;

195 end;

196

197 procedure TfMain.FormCreate(Sender: TObject);

198 begin

199 TreeView := tvBTree2;

200 end;

201

202 procedure TfMain.btnAddClick(Sender: TObject);

203 var key: integer;

204 begin

205 Randomize();

206 fInput.Caption := 'Вставить элемент';

207 fInput.lbQ.Caption := 'Введите ключ для вставки:';

208 fInput.eInput.Value := Random(200) + 1;

209

210 if fInput.ShowModal = mrOk then

211 begin

212 key := fInput.eInput.Value;

213 if not bt.Search(bt.RootPos, key) then

214 begin

215 bt.Insert(key);

216 SelectByKey(LastAdded);

217 SetNodeBoldState(TreeView.Selected, false);

218 ChangeTrees();

219 PrintTree();

220 SelectByKey(key);

221 LastAdded := key;

222 SetNodeBoldState(TreeView.Selected, true);

223 NumOfKeys := NumOfKeys + 1;

224 end

225 else MessageDlg('Ключ существует', mtInformation, [mbOK], 0);

226 end;

227 end;

228

229

230 procedure TfMain.btnDeleteClick(Sender: TObject);

231 var key, prev: integer;

232 TreeView1: TTreeView;

233 begin

234 fInput.Caption := 'Удалить элемент';

235 fInput.lbQ.Caption := 'Введите ключ, который надо удалить:';

236

237 if TreeView.Selected <> nil then

238 with TreeView.Selected do

239 begin

240 if Text[1] <> '>' then

241 fInput.eInput.Value := StrToInt(Text)

242 else fInput.eInput.Value := StrToInt(Copy(Text, 2, length(Text)));

243 end

244 else fInput.eInput.Value := Random(200) + 1;

245

246 if fInput.ShowModal = mrOk then

247 begin

248 key := fInput.eInput.Value;

33

Курсовая работа - Б-деревья во внешней памяти

Подождите немного. Документ загружается.