unit ShuiZhun;
{-------------------------------------------------
水准点平差算法单元
== ◎◎◎ 作者：陈明 ◎◎◎ ==
--------------------------------------------------}
interface
uses SysUtils,Dialogs,PerlRegEx,classes,matrice;
type SZPoint=record //水准点记录类型
isKnown:boolean; //是否为已知点
name:string; //点名
High:extended; //点的(近似)高程值
Unkown_ID:integer; //如果为未知点，则其序号
HasH:boolean; //是否已求出近似值
end;
var num_known,num_unknown,num_ce,rows:integer;
var pList: array of SZPoint;
var splitStr:string=' *'; //正则表达式的分隔符
//Q[num_Ce,num_Ce] B[num_ce,num_unknown] L[num_Ce,1]
var B,L,Q:RCOMat;
//************************************完善PList信息，初始化矩阵维数*************
procedure PointFromText(filename:string);
//************************************获取文本共有多少行************************
//function GetRows(filename:String):integer;
//************************************获取所有点的(近似)高程********************
procedure GetAllH(filename:string);
//function isAllHasH:boolean; ********是不是所有的都有高程值了
//************************************判断是不是已知的点************************
function isKnownP(pname:string):boolean;
//************************************获取未知点在所有未知点中的点序号 ，从0开始
function GetUnknownID(pname:string):integer;
//************************************获取点在所有点中的序号，从0开始***********
function GetPID(pname:string):integer;
//************************************获取矩阵B和Q******************************
procedure GetBAndQ(filename:String);
//************************************判断点是否有(近似)高程值******************
function IsPHasH(pname:string):boolean;
//************************************获取矩阵L*********************************
procedure GetL(filename:string);
{=====顺序，先PointFromText,再GetBAndQ，GetAllH，GetL等=====}
implementation
//************************************获取矩阵L*********************************
procedure GetL(filename:string);
var i,j,temp,temp1:integer;
f:textfile;
Reg:TPerlRegEx;
s:string;
List:TStrings;
begin
setlength(L,num_Ce,1);
for I := 0 to num_Ce - 1 do
for j := 0 to 0 do
L[i,j]:=0;
Reg:=TPerlRegEx.Create(nil);
List:=TStringList.Create;
temp:=0;
assignfile(f,filename);
reset(f);
while temp<>3 do //向下读三行(非空行)
begin
readln(f,s); s:=trim(s); if s<>'' then temp:=temp+1;
end; //从第四行开始读了
for temp1 := 0 to num_ce - 1 do
begin
readln(f,s); s:=trim(s);
while s='' do begin readln(f,s); s:=trim(s); end; //如果行为空则一直向下读到不为空为止
if not (s='') then //该行不为空
begin
reg.Subject:=UTF8string(s); reg.RegEx:=UTF8string(splitStr);
reg.Split(list,maxint);
L[temp1,0]:=pList[GetPID(list[1])].High-pList[GetPID(list[0])].High-strtofloat(list[2]);
end;
list.Clear;
end;
end;
//************************************判断点是否有(近似)高程值******************
function IsPHasH(pname:string):boolean;
var i:integer;
begin
result:=false;
for I := 0 to num_known+num_unknown - 1 do
if pList[i].name=pname then //是要找的点
if plist[i].HasH then
result:=true;
end;
//************************************获取点在所有点中的序号，从0开始***********
function GetPID(pname:string):integer;
var i:integer;
begin
result:=0;
for I := 0 to num_known+num_unknown - 1 do
if pList[i].name=pname then
begin result:=i; exit; end;
end;
//************************************获取所有点的(近似)高程********************
procedure GetAllH(filename:string);
var f:textfile;
Reg:TPerlRegEx;
s:string;
List:TStrings;
temp,temp1,i,j:integer;
begin
for I := 0 to 0 do //先根据已知点算一些近似高程，再算那些不能根据已知点算的那些点
begin
Reg:=TPerlRegEx.Create(nil);
List:=TStringList.Create;
temp:=0;
assignfile(f,filename);
reset(f);
while temp<>3 do //向下读三行(非空行)
begin
readln(f,s); s:=trim(s); if s<>'' then temp:=temp+1;
end; //从第四行开始读了
for temp1 := 0 to num_ce - 1 do
begin
readln(f,s); s:=trim(s);
while s='' do begin readln(f,s); s:=trim(s); end; //如果行为空则一直向下读到不为空为止
if not (s='') then //该行不为空
begin
//showmessage(s);
reg.Subject:=UTF8string(s); reg.RegEx:=UTF8string(splitStr);
reg.Split(list,maxint);
if IsKnownP(list[0]) then
begin
if (not IsKnownP(list[1])) and (not isPHasH(list[1])) then //前知后不知
begin
pList[GetPID(list[1])].High:=pList[GetPID(list[0])].High+strtofloat(list[2]);
pList[GetPID(list[1])].HasH:=true;
//showmessage('求得'+list[1]+'的高程：'+floattostr(pList[GetPID(list[1])].High));
if pList[GetPID(list[1])].HasH then
//showmessage(list[1]+'高程'+'已知');
end
end else
if IsKnownP(list[1]) then
begin
if (not IsKnownP(list[0])) and (not isPHasH(list[0])) then //后知前不知
begin
pList[GetPID(list[0])].High:=pList[GetPID(list[1])].High-strtofloat(list[2]);
pList[GetPID(list[0])].HasH:=true;
//showmessage('求得'+list[0]+'的高程：'+floattostr(pList[GetPID(list[0])].High));
end;
end;
list.Clear;
end;
end;
list.Free;
closefile(f);
end;
for I := 0 to num_unknown - 1 do
for j := 0 to num_known+num_unknown - 1 do
begin
Reg:=TPerlRegEx.Create(nil);
List:=TStringList.Create;
temp:=0;
assignfile(f,filename);
reset(f);
while temp<>3 do //向下读三行(非空行)
begin
readln(f,s); s:=trim(s); if s<>'' then temp:=temp+1;
end; //从第四行开始读了
for temp1 := 0 to num_ce - 1 do
begin
readln(f,s); s:=trim(s);
while s='' do begin readln(f,s); s:=trim(s); end; //如果行为空则一直向下读到不为空为止
if not (s='') then //该行不为空
begin
//showmessage(s);
reg.Subject:=UTF8string(s); reg.RegEx:=UTF8string(splitStr);
reg.Split(list,maxint);
if IsPHasH(list[0]) then
begin
if not IsPHasH(list[1]) then //前知后不知
begin
pList[GetPID(list[1])].High:=pList[GetPID(list[0])].High+strtofloat(list[2]);
pList[GetPID(list[1])].HasH:=true;
//showmessage('求得'+list[1]+'的高程：'+floattostr(pList[GetPID(list[1])].High));
if pList[GetPID(list[1])].HasH then
//showmessage(list[1]+'高程'+'已知');
end
end else
if IsPHasH(list[1]) then
begin
if not IsPHasH(list[0]) then //后知前不知
begin
pList[GetPID(list[0])].High:=pList[GetPID(list[1])].High-strtofloat(list[2]);
pList[GetPID(list[0])].HasH:=true;
//showmessage('求得'+list[0]+'的高程：'+floattostr(pList[GetPID(list[0])].High));
end;
end;
list.Clear;
end;
end;
list.Free;
closefile(f);
end;
end;
//************************************获取矩阵B和Q******************************
procedure GetBAndQ(filename:String);
var f:textfile;
Reg:TPerlRegEx;
s:string;
List:TStrings;
temp,temp1,i,j:integer;
begin
setlength(Q,num_Ce,num_Ce); //初始Q
for I := 0 to num_Ce - 1 do
for j := 0 to num_ce - 1 do
Q[i,j]:=0;
setlength(B,num_ce,num_unknown); //初始B
for I := 0 to num_Ce - 1 do
for j := 0 to num_unknown - 1 do
B[i,j]:=0;
Reg:=TPerlRegEx.Create(nil);
List:=TStringList.Create;
temp:=0;
assignfile(f,filename);
reset(f);
while temp<>3 do //向下读三行(非空行)
begin
readln(f,s); s:=trim(s); if s<>'' then temp:=temp+1;
end; //从第四行开始读了
for temp1 := 0 to num_Ce - 1 do
begin
readln(f,s); s:=trim(s);
//showmessage(s);
while s='' do begin readln(f,s); s:=trim(s); end; //如果行为空则一直向下读到不为空为止
if not (s='') then //该行不为空
begin
reg.Subject:=UTF8string(s); reg.RegEx:=UTF8string(splitStr);
reg.Split(list,maxint);
if not isKnownP(list[0]) then B[temp1,GetUnknownID(list[0])]:=-1;
//showmessage(list[0]+' '+inttostr(temp1)+','+inttostr(GetUnknownID(list[0])));
if not isKnownP(list[1]) then B[temp1,GetUnknownID(list[1])]:=1;
//showmessage(list[1]+' '+inttostr(temp1)+','+inttostr(GetUnknownID(list[1])));
Q[temp1,temp1]:=strtofloat(list[3]);
//showmessage(floattostr(Q[temp1,temp1]));
end;
list.Clear;
//showmessage('for');
end;
//showmessage('OK');
list.Free;
//showmessage('ListOK');
closefile(f);
end;
{=====================================是不是所有的都有高程值了
function isAllHasH:boolean;
var i:integer;
begin
result:=true;
for I := 0 to num_known+num_unknown - 1 do
if not pList[i].HasH then begin result:=false; exit;end;
end;
=================================================}
//************************************获取未知点在所有未知点中的点序号 ，从0开始
function GetUnknownID(pname:string):integer;
var j:integer;
begin
result:=0;
for j := num_known to num_known+num_unknown - 1 do
if pList[j].name=pname then
begin result:=pList[j].Unkown_ID; exit;end;
end;
function isKnownP(pname:string):boolean;
var i:integer;
begin
result:=false;
for I := 0 to num_known - 1 do
if pList[i].name=pname then
begin result:=true; exit; end;
end;
//************************************获取文本共有多少行************************
{
function GetRows(filename:String):integer;
var f:TextFile;
i:integer;
s:string;
begin
i:= 0;
assignfile(f,filename);
reset(f);
while not eof(f) do
begin
readln(f,s);
if not (trim(s)='') then //空行情况的处理
i:=i+1;
end;
closefile(f);
result:=i;
end; }
//************************************完善PList信息，初始化矩阵维数*************
procedure PointFromText(filename:string);
var f:TextFile;
Reg:TPerlRegEx;
s:string;
List:TStrings;
m:integer;
begin
Reg:=TPerlRegEx.Create(nil);
List:=TStringList.Create;
//showmessage(inttostr(rows));
assignfile(f,filename);
reset(f);
s:='';
Readln(f,s); s:=trim(s); //第一行
while s='' do begin readln(f,s); s:=trim(s); end;
if not (s='') then //空行情况的处理
begin
reg.Subject := UTF8string(s);
reg.RegEx :=UTF8string(splitStr); //以空格为分隔符（空格个数不限）
reg.Split(list,MaxInt);
num_known:=strtoint(list[0]);
num_unknown:=strtoint(list[1]);
num_ce:=strtoint(list[2]);
end;
Setlength(pList,num_known+num_unknown); //构选点记录组长度
list.Clear;
Readln(f,s); s:=trim(s); //第二行
while s='' do begin readln(f,s); s:=trim(s); end;
if not (s='') then //空行情况的处理
begin
reg.Subject := UTF8string(s);
reg.RegEx := UTF8string(splitStr); //以空格为分隔符（空格个数不限）
reg.Split(list,MaxInt);
for m := 0 to num_known - 1 do //已知点
begin
pList[m].isKnown:=true;
pList[m].name:=list[m];
pList[m].HasH:=true;
end;
for m := num_known to num_known+num_unknown - 1 do //未知点
begin
pList[m].isKnown:=false;
pList[m].name:=list[m];
pList[m].Unkown_ID:=m-num_known; //未知点的序号，从0开始
pList[m].HasH:=false;
end;
list.Clear;
Readln(f,s); s:=trim(s); //第三行
while s='' do begin readln(f,s); s:=trim(s); end;
if not (s='') then //空行情况的处理
begin
reg.Subject := UTF8string(s);
reg.RegEx := UTF8string(splitStr); //以空格为分隔符（空格个数不限）
reg.Split(list,MaxInt);
for m := 0 to num_known - 1 do
pList[m].High:=strtofloat(list[m]);
end;
list.Clear;
end;
list.Free;
closefile(f);
end;
end.
