下面的算法可能麻烦了一些，但是总算实现了要求的功能...
{
名称: OnDraw.pas
功能: 实现无向图的“N笔画”
作者: creation_zy
时间: 2002-6-5
}
unit OneDraw;
interface
uses
Classes, SysUtils;
type
TOneDraw=class
private
FVertexList:TStringList;
FLineCount:Word;
FLines:array of array [0..1] of Word;
function IndexOfEx(const Vertex:String):Integer;
function GetVertexCount: Word;
function GetOddCount: Word;
public
property VertexCount:Word read GetVertexCount;
property LineCount:Word read FLineCount;
property OddCount:Word read GetOddCount;
function VertexLineCount(const VertexIndex:Integer):Integer;
overload;
function VertexName(const index:Integer):String;
procedure Clear;
procedure ReadData(const Data:String);
procedure Append(const VertexA,VertexB:String);
function Solve(out Count:Integer):String;
constructor Create;
destructor Destroy;
override;
end;
implementation
{ TOneDraw }
procedure TOneDraw.Append(const VertexA, VertexB: String);
begin
if FLineCount>High(FLines) then
exit;
FLines[FLineCount][0]:=IndexOfEx(VertexA);;
FLines[FLineCount][1]:=IndexOfEx(VertexB);
Inc(FLineCount);
end;
procedure TOneDraw.Clear;
begin
FVertexList.Clear;
FLineCount:=0;
SetLength(FLines,0);
end;
constructor TOneDraw.Create;
begin
FVertexList:=TStringList.Create;
FLineCount:=0;
end;
destructor TOneDraw.Destroy;
begin
FVertexList.Free;
SetLength(FLines,0);
inherited;
end;
function TOneDraw.GetVertexCount: Word;
begin
Result:=FVertexList.Count;
end;
function TOneDraw.VertexLineCount(const VertexIndex: Integer): Integer;
begin
Result:=Integer(FVertexList.Objects[VertexIndex]);
end;
function TOneDraw.IndexOfEx(const Vertex: String): Integer;
begin
Result:=FVertexList.IndexOf(Vertex);
if Result<0 then
Result:=FVertexList.Add(Vertex);
FVertexList.Objects[Result]:=TObject(Integer(FVertexList.Objects[Result])+1);
end;
//读入数据
//格式:
//输入数据为多行文本，
//每行存放一条线段的信息，线段两个端点的名称用逗号格开，
//形如： 端点名1,端点名2
//eg: A,B
procedure TOneDraw.ReadData(const Data: String);
var
SL:TStringList;
mstr:String;
i,p:Integer;
begin
if Data='' then
exit;
SL:=TStringList.Create;
SL.Text:=Data;
SetLength(FLines,SL.Count);
//预先分配空间
for i:=0 to SL.Count-1do
begin
mstr:=SL;
p:=Pos(',',mstr);
if p>0 then
Append(Copy(mstr,1,p-1),Copy(mstr,p+1,Length(mstr)));
end;
SL.Free;
end;
function TOneDraw.VertexName(const index: Integer): String;
begin
Result:=FVertexList[index];
end;
function TOneDraw.GetOddCount: Word;
var
i:Integer;
begin
Result:=0;
with FVertexListdo
for i:=0 to Count-1do
if Integer(Objects) mod 2>0 then
Inc(Result);
end;
function TOneDraw.Solve(out Count: Integer): String;
var
Map,VertexLineCount:array of Integer;
MapLineCount:Integer;
UsedLine:array of array of Integer;
LevelUsedCount:array of Integer;
function GetEntrance:Integer;
//寻找度数为奇数的顶点作为切入口v
var
i:Integer;
begin
for i:=0 to MapLineCount-1do
if VertexLineCount[FLines[Map][0]] mod 2>0 then
begin
Result:=FLines[Map][0];
exit;
end
else
if VertexLineCount[FLines[Map][1]] mod 2>0 then
begin
Result:=FLines[Map][1];
exit;
end;
Result:=FLines[Map[0]][0];
//如果没有找到奇度数顶点...
end;
procedure UseLine(const Level, MapIndex:Integer);
var
i:Integer;
begin
i:=Map[MapIndex];
//
UsedLine[Level][LevelUsedCount[Level]]:=i;
Inc(LevelUsedCount[Level]);
//减小与之相连的顶点度数
Dec(VertexLineCount[FLines[0]]);
Dec(VertexLineCount[FLines[1]]);
//已经用过的和尚未使用的交换位置
Dec(MapLineCount);
i:=Map[MapIndex];
Map[MapIndex]:=Map[MapLineCount];
Map[MapLineCount]:=i;
end;
procedure UnuseLine(const Level, MapIndex:Integer);
var
i:Integer;
begin
i:=Map[MapIndex];
//
Dec(LevelUsedCount[Level]);
//恢复顶点度数
Inc(VertexLineCount[FLines[0]]);
Inc(VertexLineCount[FLines[1]]);
//将位置换回
i:=Map[MapIndex];
Map[MapIndex]:=Map[MapLineCount];
Map[MapLineCount]:=i;
Inc(MapLineCount);
end;
procedure Search(LeftCount:Integer);
procedure Connect(vmi:Integer);
var
i,m,n1,n2:Integer;
found:Boolean;
begin
i:=0;
found:=false;
while i<MapLineCountdo
begin
m:=Map;
n1:=FLines[m][0];
n2:=FLines[m][1];
if (n1=vmi) or (n2=vmi) then
begin
if n1=vmi then
n1:=n2;
found:=true;
UseLine(LeftCount,i);
Connect(n1);
UnuseLine(LeftCount,i);
end;
Inc(i);
end;
if not found then
Search(LeftCount);
end;
begin
if MapLineCount=0 then
Abort;
//利用哑异常跳出递归
if LeftCount<=0 then
exit;
Dec(LeftCount);
Connect(GetEntrance);
end;
var
i,j,oc,MinCount:Integer;
begin
SetLength(VertexLineCount,FVertexList.Count);
MapLineCount:=FLineCount;
SetLength(Map,MapLineCount);
//计算最少需要几笔
oc:=GetOddCount;
MinCount:=oc div 2;
if MinCount=0 then
//如果没有奇度数顶点，一笔就够了
MinCount:=1;
Count:=MinCount;
Result:='';
while Count<oc+1do
//笔画数上限
begin
//将顶点度数信息写入VertexLineCount数组
for i:=0 to FVertexList.Count-1do
VertexLineCount:=Integer(FVertexList.Objects);
//初始化连线映射表
for i:=0 to MapLineCount-1do
Map:=i;
//分配结果数组空间
SetLength(UsedLine,Count);
for i:=0 to Count-1do
SetLength(UsedLine,MapLineCount);
SetLength(LevelUsedCount,Count);
try
Search(MinCount);
except
end;
if MapLineCount=0 then
//成功完成
begin
for i:=Count-1do
wnto 0do
begin
for j:=0 to LevelUsedCount-1do
Result:=Result+FVertexList[FLines[UsedLine[j]][0]]+','+
FVertexList[FLines[UsedLine[j]][1]]+' ';
Result:=Result+#13#10;
end;
exit;
end;
Inc(Count);
//增加笔划数
end;
Count:=-1;
//失败... ——不可能的
end;
end.
使用例子：
uses
OneDraw;
var
OD:TOneDraw;
procedure TForm1.FormCreate(Sender: TObject);
begin
OD:=TOneDraw.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
OD.Free;
end;
procedure TForm1.btnAnalyzeClick(Sender: TObject);
var
i:Integer;
begin
OD.Clear;
OD.ReadData(Memo1.Text);
with Memo2.Linesdo
begin
Clear;
Add('顶点数: '+IntToStr(OD.VertexCount));
Add('线条数: '+IntToStr(OD.LineCount));
Add('各顶点连线数: ');
for i:=0 to OD.VertexCount-1do
Add(Format('%6s: %d',[OD.VertexName(i),OD.VertexLineCount(i)]));
Add('度数为奇数的顶点数: '+IntToStr(OD.OddCount));
end;
btnAnalyze.Enabled:=false;
end;
procedure TForm1.Memo1Change(Sender: TObject);
begin
btnAnalyze.Enabled:=true;
end;
procedure TForm1.btnCalClick(Sender: TObject);
var
N:Integer;
begin
if btnAnalyze.Enabled then
btnAnalyze.Click;
with Memo2.Linesdo
begin
Add('搜索结果:');
Add(OD.Solve(N));
Add('需要 '+IntToStr(N)+' 笔。')
end;
end;
注:
对于上面的问题，Memo1的文本为：
A,B
A,C
A,E
B,D
B,F
C,D
C,G
D,H
E,F
E,G
F,H
G,H
相应的结果为：
顶点数: 8
线条数: 12
各顶点连线数:
A: 3
B: 3
C: 3
E: 3
D: 3
F: 3
G: 3
H: 3
度数为奇数的顶点数: 8
搜索结果:
A,B B,D C,D A,C A,E E,F F,H G,H C,G
B,F
D,H
E,G
需要 4 笔。
