my ac solution!!!!
var s,ss:string;
k:char;
p1,p2,i,j:longint;
v:array[1..10000] of boolean;
Tin:boolean;
procedure Tout(ans:string); begin write(ans); halt; end;
begin
s:='';
while not EOF do
begin
read(k);
if (k<>#13) and (k<>#10) then s:=s+k;
end;
Tin:=false; p1:=1;
fillchar(v,sizeof(v),true);
for i:=1 to length(s)-1 do
begin
if not Tin then
if (s[i]='(') and (s[i+1]='*') then
begin
Tin:=true;
p1:=i;
end;
if Tin then
if (i<>p1+1) and (s[i]='*') and (s[i+1]=')') then
begin
Tin:=false;
for j:=p1 to i+1 do
v[j]:=false;
end;
end;
if TIn then TOut('NO');
ss:='';
for i:=1 to length(s) do
if v[i] then ss:=ss+s[i];
j:=0;s:=ss;
fillchar(v,sizeof(v),true);
for i:=1 to length(s) do
if j<0 then Tout('NO') else
if s[i]='(' then inc(j) else
if s[i]=')' then dec(j) else
if j=0 then v[i]:=false;
if j<>0 then Tout('NO');
ss:='';
for i:=1 to length(s) do
if v[i] then ss:=ss+s[i];
s:=ss;
while pos('(',s)>0 do
begin
for i:=1 to length(s) do
if s[i]='(' then p1:=i;
for i:=p1 to length(s) do
if s[i]=')' then
begin
p2:=i;
break;
end;
for i:=p1 to p2 do
if not (s[i] in ['=','+','-','*','/','0','1','2','3','4','5','6','7','8','9',')','(']) then Tout('NO');
delete(s,p1,p2-p1+1);
end;
write('YES');
end.