decalsamples.pas

C++中的STL真的让人爱不释手,如果你使用DELPHI,现在你也有了类似于STL的标准库,还不赶快下载啊!

unit DeCALSamples;

interface

uses DeCAL;

procedure DoExamples;

implementation

uses Windows, Math, Classes, SysUtils, RandomTesting;

var
	counter : Integer = 0;

type
	TTest = class
  public
  	FName : String;
    FCount : Integer;
    FTest : Boolean;

    constructor Create;

  end;

constructor TTest.Create;
begin
	FCount := counter;
  FName := chr(65 + Random(26)) + chr(65 + Random(26)) + chr(65 + Random(26));
  FTest := Random(2) = 0;
  Inc(counter);
end;

function TestPrinter (obj : TObject) : String;
	function BToT(b : Boolean) : String;
  begin
  	if b then
    	result := 'Yes'
    else
    	result := 'No';
  end;
begin
	with obj as TTest do
  	result := format('Name: %s Count: %d Test:%s', [Fname, FCount, BTOT(FTest)]);
end;

function ComparatorTestName(ptr : Pointer; const obj1, obj2 : DObject) : Integer;
begin
	result := CompareStr(TTest(obj1.vobject).FName, TTest(obj2.vobject).Fname);
end;

function ComparatorTestCount(ptr : Pointer; const obj1, obj2 : DObject) : Integer;
begin
	result := TTest(obj1.vobject).FCount - TTest(obj2.vobject).FCount;
end;

function ComparatorTestTest(ptr : Pointer; const obj1, obj2 : DObject) : Integer;
var a,b : Boolean;
begin
	a := TTest(obj1.vobject).FTest;
  b := Ttest(obj2.vobject).Ftest;
  if a = b then
  	result := 0
  else if not a then
  	result := -1
  else
  	result := 1;
end;

procedure FreeAll(objs : array of TObject);
var i : Integer;
begin
	for i := Low(objs) to High(objs) do
  	objs[i].free;
end;

procedure PrintContainer(con : DContainer);
begin
	writeln('container: ', con.classname, ' size:', con.size);
	ForEach(con, MakeApply(ApplyPrintLN));
  writeln;
end;

procedure PrintContainers(cons : array of DContainer);
var i : Integer;
begin
	for i := Low(cons) to High(cons) do
  	PrintContainer(cons[i]);
end;

procedure PrintMap(assoc : DAssociative);
var iter : DIterator;
begin
	writeln;
	writeln('container: ', assoc.classname, ' size:', assoc.size);
  iter := assoc.start;
  while not atEnd(iter) do
  	begin
    	write('[');
      SetToKey(iter);
      ApplyPrint(nil, getRef(iter)^);
      write('][');
      SetToValue(iter);
      ApplyPrint(nil, getRef(iter)^);
      writeln(']');
      advance(iter);
    end;
end;

procedure AddExample1;
var arr : DArray;
begin
	arr := DArray.Create;
  arr.add([1]);
  arr.add([4,5,6]);
  PrintContainer(arr);
  arr.free;
end;

procedure AddExample2;
var arr : DArray;
begin
	arr := DArray.Create;
  arr.add(['this']);
  arr.add(['is', 'an', 'add', 'example']);
  PrintContainer(arr);
  arr.free;
end;

procedure AddExample3;
var list : DList;
begin
	list := DList.Create;
  list.add([chr(65)]);
  list.add([chr(66),chr(67)]);
  PrintContainer(list);
  list.free;
end;

procedure AddExample4;
var s : DSet;
begin
	s := DSet.Create;
  s.add(['here', 'we']);
  s.add(['perform', 'set', 'addition']);

  // Note that the set will be printed in sorted order!
  PrintContainer(s);

  s.free;
end;

procedure AddExample5;
var s : DHashSet;
begin
	s := DHashSet.Create;
  s.add(['here', 'we']);
  s.add(['perform', 'set', 'addition']);

  // Note that the set will be printed in random order!
  PrintContainer(s);

  s.free;
end;

procedure AddExample6;
var s : DSet;
		a : DArray;
    l : DList;
	procedure AddStringsToContainer(con : DContainer);
  begin
  	con.add(['these', 'are', 'strings', 'being', 'added']);
  end;
  procedure AddNumbersToContainer(con : DContainer);
  begin
  	con.add([1,2,3,4,5]);
  end;
begin
	s := DSet.Create;
  a := DArray.Create;
  l := DList.Create;

  AddStringsToContainer(s);
  AddStringsToContainer(a);
  AddStringsToContainer(l);

  // note that we can't add numbers to the set, 'cause all items must be the same type
  AddNumbersToContainer(a);
  AddNumbersToContainer(l);

  PrintContainers([s,a,l]);

  s.free;
  a.free;
  l.free;
end;

procedure AddExample7;
var a : DArray;
		l : DList;
	procedure AddStrings(cons : array of DContainer);
  var i : Integer;
  begin
  	for i := Low(cons) to High(cons) do cons[i].add(['just', 'another', 'string', 'addition']);
  end;
	procedure AddNumbers(cons : array of DContainer);
  var i : Integer;
  begin
  	for i := Low(cons) to High(cons) do cons[i].add([5,4,3,2,1]);
  end;
begin
	a := DArray.Create;
  l := DList.Create;
  AddStrings([a,l]);
  AddNumbers([a,l]);
  PrintContainers([a,l]);
  FreeAll([a,l]);
end;

procedure AddExample8;
var i : Integer;
		a : DArray;
begin
	a := DArray.Create;
  for i := 1 to 10 do
  	a.add([TTest.Create]);
  PrintContainer(a);
  ObjFree(a);
  a.free;
end;

procedure AddExample9;
var l : DList;
		j : Integer;
begin
	l := DList.Create;

  j := 0;
  while j < 360 do
  	begin
    	l.add([sin(DegToRad(j))]);
      Inc(j, 10);
    end;

  PrintContainer(l);

  l.free;
end;


procedure Comparator1;
var a : DArray;
		i : Integer;
begin
	a := DArray.Create;
  for i := 1 to 10 do
  	a.add([TTest.Create]);
	PrintContainer(a);
  sortWith(a, MakeComparator(ComparatorTestName));
  PrintContainer(a);
  sortWith(a, MakeComparator(ComparatorTestCount));
  PrintContainer(a);
  ObjFree(a);
  a.free;
end;

procedure Comparator2;
var a : DArray;
		i : Integer;
begin
	a := DArray.CreateWith(MakeComparator(ComparatorTestName));
  for i := 1 to 10 do
  	a.add([TTest.Create]);
	PrintContainer(a);
  sort(a);
  PrintContainer(a);
  ObjFree(a);
  a.free;
end;

procedure Comparator3;
var s1, s2 : DSet;
		i : Integer;
    t : TTest;
begin
	s1 := DSet.CreateWith(MakeComparator(ComparatorTestName));
	s2 := DSet.CreateWith(MakeComparator(ComparatorTestCount));
  for i := 1 to 10 do
  	begin
    	t := TTest.Create;
	  	s1.add([t]);
      s2.add([t]);
    end;
  PrintContainers([s1, s2]);
  ObjFree(s1);
  s1.free;
  s2.free;
end;

procedure Set1;
var s : DSet;
		h : DHashSet;
begin
	s := DSet.Create;
  h := DHashSet.Create;

  s.add(['hello', 'there', 'just', 'testing', 'this']);
  h.add(['hello', 'there', 'just', 'testing', 'this']);

  PrintContainers([s,h]);

  if s.includes(['hello']) then
  	writeln('Found hello');
  if s.includes(['borf']) then
  	writeln('Error');

  s.free;
  h.free;

end;

procedure Set2;
var s : DSet;
		i : Integer;
    t : TTest;
begin
	s := DSet.CreateWith(makeComparator(ComparatorTestName));

  t := TTest.Create;
  s.add([t]);

  for i := 1 to 9 do
  	s.add([TTest.Create]);

  if s.includes([t]) then
  	writeln('Found t');

  t := TTest.Create;
  if s.includes([t]) then
  	writeln('Error!');
  t.free;

  ObjFree(s);
  s.free;
end;

procedure Set3;
var s : DSet;
		i : Integer;
begin
	s := DSet.Create;

  for i := 1 to 3 do
  	s.add([i]);

//  s.remove([5]);

  for i := 1 to 10 do
  	s.remove([i]);

  s.free;
end;


{** Demonstrates a mapping of integers to strings. }
procedure Map1;
var m : DMap;
		iter : DIterator;
begin
	m := DMap.Create;
  m.putPair([10, 'hello']);
  m.putAt([11, 12, 13], ['zonk', 'toast', 'bravo']);

  PrintMap(m);

  write('Finding 12...');
  iter := m.locate([12]);
  if not atEnd(iter) then
  	begin
	  	write('found it: ');
      ApplyPrintLN(nil, getRef(iter)^);
    end;

  m.free;

end;

{** Demonstrates a mapping of strings to objects. }
procedure Map2;
var m : DMap;
		i : Integer;
    t : TTest;
    iter : DIterator;
begin
	m := DMap.Create;

  for i := 1 to 10 do
  	begin
    	t := TTest.Create;
      m.putPair([t.Fname, t]);
    end;

  PrintMap(m);

  iter := m.locate([t.fname]);
  if not atEnd(iter) then
  	writeln('found it');

  ObjFree(m);
  m.free;
end;

{** Demonstrates a multi-map (multiple equal keys) of strings to integers. }
procedure Map3;
var m : DMultiMap;
begin
	m := DMultiMap.Create;

  m.putPair(['hello', 1]);
  m.putPair(['there', 2]);
  m.putPair(['just', 3]);
  m.putPair(['hello', 4]);
  m.putPair(['there', 5]);

  PrintMap(m);

  m.free;
end;

{** Demonstrates a multi-map of objects to integers.  Note that the
map is keyed off the boolean field in the test object. }
procedure Map4;
var m : DMultiMap;
		t : TTest;
    i : Integer;
begin
	m := DMultiMap.CreateWith(MakeComparator(ComparatorTestTest));

  for i := 1 to 10 do
  	begin
    	t := TTest.Create;
      m.putPair([t, i]);
    end;

  PrintMap(m);

  ObjFreeKeys(m);
	m.free;
end;

{** Demonstrates an object to object mapping. }
procedure Map5;
var m : DHashMap;
		t, t2 : TTest;
    i : Integer;
begin
	m := DHashMap.Create;

  for i := 1 to 10 do
  	begin
    	t := TTest.Create;
      t2 := TTest.Create;
      m.putPair([t, t2]);
    end;

  PrintMap(m);

  ObjFree(m);
  ObjFreeKeys(m);

	m.free;
end;

procedure Map6;
var m : DMap;
		mm : DMultiMap;
begin
	m := DMap.Create;
  mm := DMultiMap.Create;

  m.putPair([10, 'ten']);
  m.putPair([15, 'fifteen']);
  m.putPair([20, 'twenty']);
  m.putPair([15, 'ouch']);

  mm.putPair([10, 'ten']);
  mm.putPair([15, 'fifteen']);
  mm.putPair([20, 'twenty']);
  mm.putPair([15, 'ouch']);

  PrintContainer(m);
  PrintContainer(mm);

  FreeAll([m,mm]);
end;

procedure Map7;
var m : DHashMap;
		mm : DMultiHashMap;
begin
	m := DHashMap.Create;
  mm := DMultiHashMap.Create;

  m.putPair([10, 'ten']);
  m.putPair([15, 'fifteen']);
  m.putPair([20, 'twenty']);
  m.putPair([15, 'ouch']);

  mm.putPair([10, 'ten']);
  mm.putPair([15, 'fifteen']);
  mm.putPair([20, 'twenty']);
  mm.putPair([15, 'ouch']);

  PrintContainer(m);
  PrintContainer(mm);

  FreeAll([m,mm]);
end;

procedure Sorting1;
var l : DList;
begin
	l := DList.Create;
	l.add([3,6,1,8,3,6,9,2,4]);
  sort(l);
  PrintContainer(l);
  l.free;
end;

{** Demonstrates sort and stableSort.  The stableSort version will retain
the ordering of the container it is sorting, while sort will lose the
ordering. }
procedure Sorting2;
var a1, a2 : DArray;
		i : Integer;
begin
	a1 := DArray.Create;
  for i := 1 to 10 do
  	a1.add([TTest.Create]);

  sortWith(a1, MakeComparator(ComparatorTestCount));

  PrintContainer(a1);

  a2 := a1.clone as DArray;


  sortWith(a1, MakeComparator(ComparatorTestTest));

  stablesortWith(a2, MakeComparator(ComparatorTestTest));

  PrintContainers([a1, a2]);


  ObjFree(a1);
  a1.free;
  a2.free;

end;

procedure Sorting3;
var a : DArray;
		i : Integer;
begin
	a := DArray.CreateWith(MakeComparator(ComparatorTestName));

  for i := 1 to 10 do
  	a.add([TTest.Create]);

  PrintContainer(a);

  sort(a);

  PrintContainer(a);

  objFree(a);
  a.free;
end;

procedure Replace1;
var a : DArray;
		i : Integer;
begin
	a := DArray.Create;

  for i := 1 to 10 do
  	a.add([i]);

  PrintContainer(a);

  Replace(a, [3, 5], [1000, 1001]);

  PrintContainer(a);

  a.free;

end;

{** Replacement restricted to a certain range. }
procedure Replace2;
var a : DArray;
		i : Integer;
begin
	a := DArray.Create;

  for i := 1 to 10 do
  	a.add([i]);

  PrintContainer(a);

  ReplaceIn(advanceByF(a.start, 4), a.finish, [3, 7], [1000, 1001]);

  PrintContainer(a);

  a.free;

end;

function t1u(ptr : Pointer; const obj : DObject) : DObject;
begin
	result := Make(['binky ' + IntToStr(asInteger(obj))]);
end;

procedure Transform1;
var a, a2 : DArray;
		l : DList;
		i : Integer;
begin
	a := DArray.Create;
  l := DList.Create;

  for i := 1 to 10 do
  	a.add([i]);

  // This will add strings equivalent to the integers into the list.
  transformUnary(a, l, MakeUnary(t1u));

  PrintContainer(l);

  // Using the same call, we can send it to an array.
  a2 := DArray.Create;
  transformUnary(a,a2, MakeUnary(t1u));

  PrintContainer(a2);

	l.free;
  a.free;
  a2.free;
end;

function t2b(ptr : Pointer; const obj1, obj2 : DObject) : DObject;
begin
	SetInteger(result, asInteger(obj1) + asInteger(obj2));
end;

procedure Transform2;
var i : Integer;
		a,b : DArray;
    l : DList;
begin
	a := DArray.Create;
  b := DArray.Create;
  l := DList.Create;
	for i := 1 to 10 do
  	begin
    	a.add([i]);
      b.add([10 * i]);
    end;
  transformBinary(a,b,l, MakeBinary(t2b));
  PrintContainer(l);
  FreeAll([a,b,l]);
end;

procedure Shuffling1;
var i : Integer;
		a : DArray;
begin
	a := DArray.Create;
  for i := 1 to 10 do
  	a.add([i]);

  randomShuffle(a);

  PrintContainer(a);

  a.free;
end;

procedure SetOps1;
var a : DArray;
		l : DList;