triangle.p

1995年ACM contest FINAL试题和源码

unit TriaMain;

interface

type
	Params = array[1..6] of real;
	ErrorState = (errOk, errInvalidInput, errUnderconstrained, errOverconstrained);

const
	eps = 0.000001;

implementation

function ErrorToStr(err : ErrorState) : string;
begin
	case err of
		errOk : ErrorToStr:='ok';
		errInvalidInput : ErrorToStr:='invalid input';
		errOverconstrained : ErrorToStr:='overconstrained';
		errUnderconstrained : ErrorToStr:='underconstrained';
	else
    	halt(99);
	end;
end;

procedure GetInput(var p : Params);
var
	i : integer;
	f : file;
begin
	assign(f, 'testin.txt');
	reset(f);
	for i:=1 to 6 do readln(p[i]);
	close(f);
end;

procedure GetInputDelphi(var p : Params);
begin
	p[1]:=StrToIntDef(MainForm.edParam1.Text, -1);
	p[2]:=StrToIntDef(MainForm.edParam2.Text, -1);
	p[3]:=StrToIntDef(MainForm.edParam3.Text, -1);
	p[4]:=StrToIntDef(MainForm.edParam4.Text, -1);
	p[5]:=StrToIntDef(MainForm.edParam5.Text, -1);
	p[6]:=StrToIntDef(MainForm.edParam6.Text, -1);
end;

procedure WriteOutput(p : Params; err : ErrorState);
var
	i : integer; f : textfile;
begin
	assignFile(f, 'testout.txt');
	reset(f);
	for i:=1 to 6 do writeln(f, p[i]);
	close(f);
end;

procedure WriteOutputDelphi(p : Params; err : ErrorState);
var
	s : string;
begin
	Str(p[1], s); MainForm.edParam1.Text:=s;
	Str(p[2], s); MainForm.edParam2.Text:=s;
	Str(p[3], s); MainForm.edParam3.Text:=s;
	Str(p[4], s); MainForm.edParam4.Text:=s;
	Str(p[5], s); MainForm.edParam5.Text:=s;
	Str(p[6], s); MainForm.edParam6.Text:=s;
	MainForm.edError.Text:=ErrorToStr(err);
end;

(*============================================================================*)

function Tan(x : real) : real;
begin
	Tan:=Sin(x)/Cos(x);
end;

function ArcSin(x : real) : real;
begin
	ArcSin:=ArcTan(x/sqrt(1-sqr(x)));
end;

function ArcCos(x : real) : real;
begin
	ArcCos:=ArcTan(sqrt(1-sqr (x))/x);
end;

(*----------------------------------------------------------------------------*)

function IsDef(x : real) : boolean;
begin
	IsDef:=(x<>-1);
end;

function CheckParam(var p : Params; i1 : integer; value : real; var err : ErrorState) : boolean;
begin
	if IsDef(p[i1]) then begin
		if (abs(p[i1]-value)<eps*p[i1]) then begin
			(*----- check ok, but no progress -----*)
			err:=errOk; CheckParam:=false;
		end else begin
			(*----- check not ok, but this is a progress -----*)
			err:=errOverconstrained; CheckParam:=true;
		end;
	end else begin
		(*----- assignment and this is a definitely progress -----*)
		p[i1]:=value; err:=errOk; CheckParam:=true;
	end;
end;

function IsState(s : string; p : Params) : boolean;
{s :   'x' = defined,   'O' = don'care (to be calculated),   '-' = don't care }
var
	i : integer; res : boolean;
begin
	i:=1; res:=true;
	while res and (i<=6) do begin
		if      copy(s, i, 1)= 'x' then res:=(p[i]<>-1)
		else if copy(s, i, 1)= 'O' then res:=true
		else if (copy(s, i, 1)= '-') then res:=true
		else halt(99);
		inc(i);
	end;
	IsState:=res;
end;

(*============================================================================*)

function Winkelsumme(var p : Params; alpha, beta, gamma : integer; var err : ErrorState) : boolean;
var
	palpha : real;
begin
	palpha:=Pi-p[beta]-p[gamma];
	if (palpha>=0) then begin
		Winkelsumme:=CheckParam(p, alpha, palpha, err);
	end else begin
		err:=errInvalidInput; Winkelsumme:=true;
	end;
end;

function DetectWinkelsumme(var p : Params; var err : ErrorState) : boolean;
var
	res : boolean;
begin
	res:=false;
	if               IsState('-O-x-x', p) then res:=Winkelsumme(p, 2, 4, 6, err);
	if (not res) and IsState('-x-O-x', p) then res:=Winkelsumme(p, 4, 2, 6, err);
	if (not res) and IsState('-x-x-O', p) then res:=Winkelsumme(p, 6, 2, 4, err);
	DetectWinkelsumme:=res;
end;

(*----------------------------------------------------------------------------*)

function Sinussatz_S(var p : Params; a, alpha, b, beta : integer; var err : ErrorState) : boolean;
var
	q, m, pa : real;
begin
	if (sin(p[beta])<>0) then begin
		q:=sin(p[alpha])/sin(p[beta]); {underflow possible}
		m:=p[b]*sin(p[alpha]); {underflow possible (-1 <= sin(p[alpha] <=1) }
		if (q<>0) then begin
			pa:=p[b]*q; Sinussatz_S:=CheckParam(p, a, pa, err);
		end else if (m<>0) then begin
			pa:=m/sin(p[beta]); Sinussatz_S:=CheckParam(p, a, pa, err);
		end else begin
			err:=errOk; Sinussatz_S:=false;
		end;
	end else begin
		err:=errInvalidInput; Sinussatz_S:=true;
	end;
end;

function Sinussatz_W(var p : Params; alpha, a, beta, b : integer; var err : ErrorState) : boolean;
var
	sinalpha, palpha : real;
begin
	if (p[b]<>0) then begin
		sinalpha:=sin(p[beta])*p[a]/p[b];
		if (abs(sinalpha)<=1) then begin
			palpha:=arcsin(sinalpha); Sinussatz_W:=CheckParam(p, alpha, palpha, err);
		end else begin
			err:=errInvalidInput; Sinussatz_W:=true;
		end;
	end else begin
		err:=errInvalidInput; Sinussatz_W:=true;
	end;
end;

function DetectSinussatz(var p : Params; var err : ErrorState) : boolean;
var
	res : boolean;
begin
	res:=false;
	if               IsState('Oxxx--', p) then res:=Sinussatz_S(p, 1, 2, 3, 4, err);
	if (not res) and IsState('xOxx--', p) then res:=Sinussatz_W(p, 2, 1, 4, 3, err);
	if (not res) and IsState('xxOx--', p) then res:=Sinussatz_S(p, 3, 4, 1, 2, err);
	if (not res) and IsState('xxxO--', p) then res:=Sinussatz_W(p, 4, 3, 2, 1, err);
	if (not res) and IsState('Ox--xx', p) then res:=Sinussatz_S(p, 1, 2, 5, 6, err);
	if (not res) and IsState('xO--xx', p) then res:=Sinussatz_W(p, 2, 1, 6, 5, err);
	if (not res) and IsState('xx--Ox', p) then res:=Sinussatz_S(p, 5, 6, 1, 2, err);
	if (not res) and IsState('xx--xO', p) then res:=Sinussatz_W(p, 6, 5, 2, 1, err);
	if (not res) and IsState('--Oxxx', p) then res:=Sinussatz_S(p, 3, 4, 5, 6, err);
	if (not res) and IsState('--xOxx', p) then res:=Sinussatz_W(p, 4, 3, 6, 5, err);
	if (not res) and IsState('--xxOx', p) then res:=Sinussatz_S(p, 5, 6, 3, 4, err);
	if (not res) and IsState('--xxxO', p) then res:=Sinussatz_W(p, 6, 5, 4, 3, err);
	DetectSinussatz:=res;
end;

(*----------------------------------------------------------------------------*)

function Cosinussatz_S(var p : Params; a, b, c, alpha : integer; var err : ErrorState) : boolean;
var
	sqra, pa : real;
begin
	sqra:=-(2*p[b]*p[c]*cos(p[alpha]))+sqr(p[b])+sqr(p[c]);  {overflow???}
	if (sqra>0) then begin
		pa:=sqrt(sqra); Cosinussatz_S:=CheckParam(p, a, pa, err);
	end else begin
		err:=errInvalidInput; Cosinussatz_S:=true;
	end;
end;

function Cosinussatz_W(var p : Params; alpha, a, b, c : integer; var err : ErrorState) : boolean;
var
	d, cosalpha, palpha : real;
begin
	d:=(2*p[b]*p[c]);
	if  (d<>0) then begin
		cosalpha:=(-sqr(p[a])+sqr(p[b])+sqr(p[c]))/d;
		if (abs(cosalpha)<=1) then begin
			palpha:=ArcCos(cosalpha); Cosinussatz_W:=CheckParam(p, alpha, palpha, err);
		end else begin
			err:=errInvalidInput; Cosinussatz_W:=true;
		end;
	end else begin
		err:=errInvalidInput; Cosinussatz_W:=true;
	end;
end;

function DetectCosinussatz(var p : Params; var err : ErrorState) : boolean;
var
	res : boolean;
begin
	res:=false;
	if               IsState('Oxx-x-', p) then res:=Cosinussatz_S(p, 1, 3, 5, 2, err);
	if (not res) and IsState('xOx-x-', p) then res:=Cosinussatz_W(p, 2, 1, 3, 5, err);
	if (not res) and IsState('x-Oxx-', p) then res:=Cosinussatz_S(p, 3, 1, 5, 4, err);
	if (not res) and IsState('x-xOx-', p) then res:=Cosinussatz_W(p, 4, 1, 3, 5, err);
	if (not res) and IsState('x-x-Ox', p) then res:=Cosinussatz_S(p, 5, 1, 3, 6, err);
	if (not res) and IsState('x-x-xO', p) then res:=Cosinussatz_W(p, 6, 1, 3, 5, err);
	DetectCosinussatz:=res;
end;

(*----------------------------------------------------------------------------*)

procedure Triangle;
var
	p : Params; err : ErrorState;
	changed : boolean;
begin
	(*---- first of all, read input -----*)
	GetInputDelphi(p); {GetInput(p);}

	(*----- now the main work begins -----*)
	changed:=false; err:=errOk;
	repeat
		changed:=DetectWinkelsumme(p, err);
		if (not changed) and (err=errOk) then changed:=DetectSinusSatz(p, err);
		if (not changed) and (err=errOk) then changed:=DetectCosinussatz(p, err);
	until (not changed) or (err<>errOk);

	(*----- check all again -----*)
	if (err=errOk) then begin
		changed:=DetectWinkelsumme(p, err);
		if (not changed) and (err=errOk) then changed:=DetectSinusSatz(p, err);
		if (not changed) and (err=errOk) then changed:=DetectCosinussatz(p, err);
	end;

	(*----- check whether output is completed -----*)
	if (err=errOk) then
		if (not IsState('xxxxxx', p)) then
        	err:=errUnderConstrained;

	(*----- now it's done, write output -----*)
	WriteOutputDelphi(p, err); {WriteOutput(p, err);}
end;

procedure TMainForm.buttDoItClick(Sender: TObject);
begin
	Triangle;
end;

end.