我目前最多只能开100分的帖子，等问题解决了，再开4个100分贴，谁有本事就来拿吧。这是我们编译原理老师出的关于文法压缩的题目：《用程序实现文法自动压缩》
压缩算法如下：
第一个规则的左部必须是Z：第一、删掉左部和右部相等的规则，形如U::=U。
第二、把第一个规则（以Z为左部的规则）的右部的大写字母标记上，然后从第二个规则开始判断，对于所有以被标记过的大写字母为左部的规则，将其右部的大写字母也标记上，如此循环，直到把所有符合条件的规则都标记完。接下来，把所有左部没被标记的规则都删掉。
第三、找出形如F::=u(右部为小写字母)的规则，将其左部标记上，然后对其他的规则进行判断，凡是以小写字母为右部或以小写字母和已经被标记的大写字母为右部的规则，都保留，其余的删掉。
重复三、四步，直到不能再删掉多余规则为止。例如：现有文法G[Z]
Z::=Be A::=Ae A::=A A::=e B::=Ce B::=Af C::=Cf D::=f
请对该文法进行压缩。
解：第一步、删掉规则A::=A。
第二步、标记规则(此处用*做标记），结果如下：
Z*::=B*e B*::=C*e B*::=A*f C*::=C*f A*::=A*e A*::=e D::=f
由于D没有被标记，所以以D为左部的规则D::=f被删掉。
剩下规则：Z::=Be B::=Ce B::=Af C::=Cf A::=Ae A::=e
第三步、继续标记（此处也用*标示），结果如下：
A*::=e A*::=A*e B*::=A*f Z*::=B*e B::=Ce C::=Cf
由于B::=Ce C::=Cf不符合，删除。
剩下规则A::=e A::=Ae B::=Af Z::=Be
重复执行第三、四步，因为已经不能再删掉多余规则了，所以就此结束。最终结果为A::=e A::=Ae B::=Af Z::=Be请大家挑战难度，若能做出，不仅能得到500分，小弟还对你佩服得五体投地哦。
压缩算法如下：
第一个规则的左部必须是Z：第一、删掉左部和右部相等的规则，形如U::=U。
第二、把第一个规则（以Z为左部的规则）的右部的大写字母标记上，然后从第二个规则开始判断，对于所有以被标记过的大写字母为左部的规则，将其右部的大写字母也标记上，如此循环，直到把所有符合条件的规则都标记完。接下来，把所有左部没被标记的规则都删掉。
第三、找出形如F::=u(右部为小写字母)的规则，将其左部标记上，然后对其他的规则进行判断，凡是以小写字母为右部或以小写字母和已经被标记的大写字母为右部的规则，都保留，其余的删掉。
重复三、四步，直到不能再删掉多余规则为止。例如：现有文法G[Z]
Z::=Be A::=Ae A::=A A::=e B::=Ce B::=Af C::=Cf D::=f
请对该文法进行压缩。
解：第一步、删掉规则A::=A。
第二步、标记规则(此处用*做标记），结果如下：
Z*::=B*e B*::=C*e B*::=A*f C*::=C*f A*::=A*e A*::=e D::=f
由于D没有被标记，所以以D为左部的规则D::=f被删掉。
剩下规则：Z::=Be B::=Ce B::=Af C::=Cf A::=Ae A::=e
第三步、继续标记（此处也用*标示），结果如下：
A*::=e A*::=A*e B*::=A*f Z*::=B*e B::=Ce C::=Cf
由于B::=Ce C::=Cf不符合，删除。
剩下规则A::=e A::=Ae B::=Af Z::=Be
重复执行第三、四步，因为已经不能再删掉多余规则了，所以就此结束。最终结果为A::=e A::=Ae B::=Af Z::=Be请大家挑战难度，若能做出，不仅能得到500分，小弟还对你佩服得五体投地哦。
编译通过，而且正确实现。设计期：
你建立一个form，添加两个edit，一个按钮，不要改name。运行期：
在edit1内输入文法，点击按钮，在edit2得到压缩文法。不给分，我可真急。下面是unit1的源代码：unit Unit1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;implementationuses StrUtils;{$R *.dfm}type
// 元素（字母）
TElement = record
Charecter: String[1];
Marked: Boolean;
end; // 元素集
TElementSet = array [0..1] of TElement; // 规则
TRule = record
Left: TElement;
Right: TElementSet;
Marked: Boolean;
Deleted: Boolean;
end; // 文法
TGrammar = array of TRule;// 解析元素集
procedure StrToElements(aStr: String; var aElements: TElementSet);
var
vLen, I: Integer;
begin
vLen := Length(aStr);
for I := 0 to vLen - 1 do
begin
aElements[I].Charecter := MidStr(aStr, I + 1, 1);
end;
end;// 解析规则
procedure StrToRule(aStr: String; var aRule: TRule);
var
vSignPos: Integer;
begin
vSignPos := Pos('::=', aStr);
if vSignPos = 2 then // ::=应该在第二个字符位置
begin
aRule.Deleted := False;
aRule.Left.Charecter := LeftStr(aStr, 1);
aRule.Left.Marked := False;
StrToElements(RightStr(aStr, Length(aStr) - 4), aRule.Right);
end
else
raise Exception.Create('wrong rule string format.');
end;// 解析文法
procedure StrToGrammar(aStr: String; var aGrammar: TGrammar);
var
vDelimiterPos: Integer;
vRuleStr: String;
vRuleNum: Integer;
begin
vRuleNum := 0; vDelimiterPos := Pos(' ', aStr);
while vDelimiterPos <> 0 do
begin
Inc(vRuleNum);
SetLength(aGrammar, vRuleNum); vRuleStr := LeftStr(aStr, vDelimiterPos - 1);
StrToRule(vRuleStr, aGrammar[vRuleNum - 1]); aStr := RightStr(aStr, Length(aStr) - vDelimiterPos - 1);
vDelimiterPos := Pos(' ', aStr);
end; Inc(vRuleNum);
SetLength(aGrammar, vRuleNum);
StrToRule(aStr, aGrammar[vRuleNum - 1]);
end;// 输出元素集
function ElementsToStr(aElements: TElementSet): String;
var
I: Integer;
begin
for I := 0 to Length(aElements) - 1 do
Result := Result + aElements[I].Charecter;
end;// 输出规则
function RuleToStr(aRule: TRule): String;
begin
Result := aRule.Left.Charecter + '::=' + ElementsToStr(aRule.Right);
end;// 输出文法
function GrammarToStr(aGrammar: TGrammar): String;
var
I: Integer;
begin
for I := 0 to Length(aGrammar) - 1 do
if not aGrammar[I].Deleted then
Result := Result + RuleToStr(aGrammar[I]) + ' ';
Result := TrimRight(Result);
end;// 初始化标记
procedure InitMark(aGrammar: TGrammar);
var
I, J: Integer;
begin
for I := 0 to Length(aGrammar) - 1 do
begin
aGrammar[I].Marked := False;
aGrammar[I].Left.Marked := False;
for J := 0 to Length(aGrammar[I].Right) - 1 do
aGrammar[I].Right[J].Marked := False;
end;
end;// 步骤2的标记
// 输入：文法，标记的大写字母
procedure MarkRule2(var aGrammar: TGrammar; aChar: String);
var
I, J: Integer;
begin
for I := 0 to Length(aGrammar) - 1 do
if not aGrammar[I].Deleted
and (aGrammar[I].Left.Charecter = aChar)
and not aGrammar[I].Left.Marked then
begin
aGrammar[I].Left.Marked := True;
for J := 0 to Length(aGrammar[I].Right) - 1 do
if aGrammar[I].Right[J].Charecter = UpperCase(aGrammar[I].Right[J].Charecter) then
begin
aGrammar[I].Right[J].Marked := True;
MarkRule2(aGrammar, aGrammar[I].Right[J].Charecter);
end;
end;
end;// 步骤1
// 输入：文法
// 输出：是否有删除
function ExpressRule1(var aGrammar: TGrammar): Boolean;
var
vRuleNum, I: Integer;
begin
Result := False; vRuleNum := Length(aGrammar);
for I := 0 to vRuleNum - 1 do
with aGrammar[I] do
if (Left.Charecter = Right[0].Charecter) and (Right[1].Charecter = '') then
begin
Deleted := True;
Result := True;
end;
end;// 步骤2
// 输入：文法
// 输出：是否有删除
function ExpressRule2(var aGrammar: TGrammar): Boolean;
var
I: Integer;
begin
Result := False; // 标记
MarkRule2(aGrammar, aGrammar[0].Left.Charecter); // 删除未标记规则
for I := 0 to Length(aGrammar) - 1 do
if not aGrammar[I].Deleted and not aGrammar[I].Left.Marked then
begin
aGrammar[I].Deleted := True;
Result := True;
end;
end;// 步骤3
// 输入：文法
// 输出：是否有删除
function ExpressRule3(var aGrammar: TGrammar): Boolean;
var
I, J: Integer;
begin
Result := False; // 标记形如F::=u(右部为小写字母)的规则
for I := 0 to Length(aGrammar) - 1 do
if ((aGrammar[I].Right[0].Charecter) = LowerCase(aGrammar[I].Right[0].Charecter))
and (aGrammar[I].Right[1].Charecter = '')
and (not aGrammar[I].Deleted) then
begin
aGrammar[I].Marked := True;
aGrammar[I].Left.Marked := True;
end; // 标记小写字母和已经被标记的大写字母为右部的规则
for I := 0 to Length(aGrammar) - 1 do
if aGrammar[I].Marked and aGrammar[I].Left.Marked then
for J := 0 to Length(aGrammar) - 1 do
aGrammar[J].Marked := aGrammar[J].Marked
or ((aGrammar[J].Right[0].Charecter = aGrammar[I].Left.Charecter)
and (aGrammar[J].Right[1].Charecter = LowerCase(aGrammar[J].Right[1].Charecter))); // 删除未标记的规则
for I := 0 to Length(aGrammar) - 1 do
if not aGrammar[I].Deleted and not aGrammar[I].Marked then
begin
aGrammar[I].Deleted := True;
Result := True;
end;
end;// 压缩主流程
// 输入：原文法
// 输出：压缩文法
function ExpressGrammar(aSource: String): String;
var
vGrammar: TGrammar;
begin
// 解析文法
StrToGrammar(Trim(aSource), vGrammar); // 步骤1
ExpressRule1(vGrammar); // 步骤2和步骤3
repeat
InitMark(vGrammar);
until not ExpressRule2(vGrammar) and not ExpressRule3(vGrammar); // 输出
Result := GrammarToStr(vGrammar);
end;procedure TForm1.Button1Click(Sender: TObject);
begin
Edit2.Text := ExpressGrammar(Edit1.Text);
end;end.
对于你这样乱发烧的狗，我不想说什么。自己生得贱，跑来找抽！我不想理你，滚远点吧。ronaldli(木的)：
谢谢你的帮助，我回去试试，好了马上揭帖，500分一分都不少。
我试了一下，点了按钮之后edit2没有变化。不知道是不是我在edit1中的输入方式有误，请指点在edit1中以什么样的格式输入？
其时，我事先花了2个小时试着弄了一下的，只怪op学得太烂，只能实现第一步（删掉U::=U形），后面的打死弄不出来，而我们一起的100多个同学里面，还没有一个完全作出来的。所以才到网上寻求达人的帮助。
我当时的思路是在form1上放两个Tmemo,一个Tedit。由edit1输入文法，memo1显示最初输入的文法，memo2显示压缩后的文法。ronaldli(木的)：不知道这样能不能实现？
Z::=Be A::=Ae A::=A A::=e B::=Ce B::=Af C::=Cf D::=f
点完按钮后，Edit2显示：
A::=e A::=Ae B::=Af Z::=Be我这里没问题的
-----
这个问题更是暴难啊，1000分也不过分。我试了一下，点了按钮之后edit2没有变化
－－－－－－
ronaldli(木的)，hoho~估计他是事件没有设置。我真不明白你为什么要理会这种轻狂的年轻人？
-----
这个问题更是暴难啊，1000分也不过分。我试了一下，点了按钮之后edit2没有变化
－－－－－－
ronaldli(木的)，hoho~估计他是事件没有设置。我真不明白你为什么要理会这种轻狂的年轻人？
不好意思啊，还以为你会进一步修改一下的。不过，现在这样也很好了。如果你有时间的话，不知道能不能敢到星期天之前完善一下，谢谢。
帖子已经开了，去拿分吧。以后也请多多指教。
http://expert.csdn.net/Expert/topic/2307/2307846.xml?temp=.6872522
http://expert.csdn.net/Expert/topic/2307/2307852.xml?temp=.5715296
http://expert.csdn.net/Expert/topic/2307/2307858.xml?temp=.2689783
http://expert.csdn.net/Expert/topic/2307/2307861.xml?temp=.1334192
不好意思啊，以为你还要进一步修改的。不过现在这样子已经很好了。谢谢。当然，如果你能抽出点时间的话，希望能再帮忙完善一下。
帖子已经开了，去拿分吧。再次感谢，以后也请多多指教。
http://expert.csdn.net/Expert/topic/2307/2307846.xml?temp=7.168216E-02
http://expert.csdn.net/Expert/topic/2307/2307852.xml?temp=.6362574
http://expert.csdn.net/Expert/topic/2307/2307858.xml?temp=.616543
http://expert.csdn.net/Expert/topic/2307/2307861.xml?temp=2.572268E-02
看得出来，你的技术很好，可是做人——烂！
与其花这么多时间来嘲笑一个菜鸟，还不如用来修身养性！
我知道，你一生出来就把delphi玩得团团转，所以最好不要遇到什么问题，否则，你的问题永远是别人嘲笑的对象。
就说这么多，如果你要进来讨论技术，我会热烈欢迎；但进来嘲笑人的话，就请你不要在这个帖子里吠了。