var z,h:string[8];
n,m,z1,k:longint;

Procedure fen(zl,zr,hl,hr:longint);
var w1,w2,d:longint;
begin
w1:=pos(h[hr],z); w2:=hr;
write(z[w1]);
for z1:=w1+1 to zr do
begin
d:=pos(z[z1],h);
If d<w2 then w2:=d;
end;
If (w1>zl)and(w2>hl) then fen(zl,w1-1,hl,w2-1);
If (w1<zr)and(hr>w2) then fen(w1+1,zr,w2,hr-1);
end;

begin
readln(z); readln(h);
n:=length(z); fen(1,n,1,n);
end.

var
s1,s2:string;
procedure tree(l1,r1,l2,r2:longint);
var
i:longint;
begin
if r2<l2 then exit;
if r2=l2 then
begin
write(s2[r2]);
exit;
end;
for i:=l1 to r1 do
if s1[i]=s2[r2] then break;
write(s2[r2]);
tree(l1,i-1,l2,l2+i-1-l1);
tree(i+1,r1,l2+i-l1,r2-1);
end;

begin
readln(s1);
readln(s2);
tree(1,length(s1),1,length(s2));
end.

var
m,l:string;
left_child,right_child:array[1..8] of longint;
procedure dfs(rank,l_left,l_right,m_left,m_right:longint);
var ret:longint;
begin
ret:=pos(l[l_right],m);
if ret-m_left>0 then
begin
left_child[rank]:=l_left+ret-m_left-1;
dfs(left_child[rank],l_left,left_child[rank],m_left,ret-1);
end;
if ret<m_right then
begin
right_child[rank]:=l_right-1;
dfs(right_child[rank],l_left+ret-m_left,l_right-1,ret+1,m_right);
end;
end;
procedure outputing(x:longint);
begin
write(l[x]);
if left_child[x]>0 then outputing(left_child[x]);
if right_child[x]>0 then outputing(right_child[x]);
end;
begin
readln(m);
readln(l);
fillchar(left_child,sizeof(left_child),0);
fillchar(right_child,sizeof(right_child),0);
dfs(length(l),1,length(l),1,length(m));
outputing(length(l));
writeln;
end.

一遍AC……（多少年来第一次了，还是0ms）
这种题就是没有什么极端数据，样例过了就过了，算法可以参照《数据结构与算法设计--Pascal（第2版）》第4章（这不是废话吗）
首先读入，然后进过程，最后结束
很明显，过程是本题的基础，没有过程貌似不可能解开。
过程中要做的有：
1、输出根节点
2、在中序遍历中找到后序遍历的最后一个字符，并把这个字符的前后分开（前为c，后为d）
3、在后序遍历中把所有的在c中出现过的字符按原来（在后序遍历中）的顺序计入e，同样d中的计为f
4、若c不为空，则将c为中序遍历、e为后序遍历递归执行；
若d不为空，则将d为中序遍历、f为后序遍历递归执行。

program exe;

var s1,s2:string;

procedure make(sz,sh:string);

var l,k:integer;

begin

if sh'' then

begin

l:=length(sh);

k:=pos(sh[l],sz);

write(sh[l]);

make(copy(sz,1,k-1),copy(sh,1,k-1));

make(copy(sz,k+1,l-k),copy(sh,k,l-k));

end;

end;

begin

readln(s1);

readln(s2);

make(s1,s2);

end.

虽然ac了 但是有一处不解 求解

program sanxubianli;

var s1,s2:string; pre:string;

procedure init;

begin

readln(s1);

readln(s2);

end;

procedure solve(mid,post:string);

var i:integer;

begin

if (mid='') or (post='') then exit

else

begin

i:=pos(post[length(post)],mid);

if (ord(mid[i])>=65) and (ord(mid[i])

program ex;

var

s1,s2:string;

procedure make(sz,sh:string);

var l,k:integer;

begin

if sh'' then

begin

l:=length(sh);

k:=pos(sh[l],sz);

write(sh[l]);

make(copy(sz,1,k-1),copy(sh,1,k-1));

make(copy(sz,k+1,l-k),copy(sh,k,l-k));

end;

end;

begin

readln(s1);

readln(s2);

make(s1,s2);

end.

Accepted 有效得分：100 有效耗时：0ms

var

mid,right:string;

tree:array[1..8] of record

data:char;

p,l,r:longint;

end;

where:array['A'..'H'] of record

m,r:longint;

end;

i,id:longint;

procedure maker(h,t,p:longint);

forward;

procedure makel(h,t,p:longint);

var i,j,max,now:longint;

begin

max:=0;

for i:=h to t do

if where[mid[i]].r>max then max:=where[mid[i]].r;

tree[id].data:=right[max];

tree[id].p:=p;

tree[p].l:=id;

now:=id;

inc(id);

i:=where[right[max]].m;

if i>h then makel(h,i-1,now);

if imax then max:=where[mid[i]].r;

tree[id].data:=right[max];

tree[id].p:=p;

tree[p].r:=id;

now:=id;

inc(id);

i:=where[right[max]].m;

if i>h then makel(h,i-1,now);

if i1 then makel(1,i-1,1);

if i0 then begin

write(tree[x].data);

print(tree[x].l);

print(tree[x].r);

end;

end;

begin

readln(mid);

readln(right);

for i:=1 to length(mid) do where[mid[i]].m:=i;

for i:=1 to length(right) do where[right[i]].r:=i;

make(length(right));

print(1);

end.

program v1;

var s2,s3:string;

procedure doit(s2,s3:string);

var i,j:integer;

begin

if s2='' then exit;

i:=length(s2);

j:=pos(s3[i],s2);

write(s3[i]);

doit(copy(s2,1,j-1),copy(s3,1,j-1));

doit(copy(s2,j+1,i-j),copy(s3,j,i-j));

end;

begin

readln(s2);

readln(s3);

doit(s2,s3);

readln;

readln

end.

program hxl;

type tree=^node;

node=record

data:char;

left,right:tree;

end;

var p,q,head:tree;

sm,sn:string;

k:integer;

procedure run(var p:tree;sm,sn:string);

var slm,sln,srm,srn:string;

x,y,n:integer;

d:char;

begin

if sm='' then begin p:=nil; exit;end;

n:=length(sm);

d:=sn[n];

x:=pos(d,sm);

new(p);

p^.data:=d;

p^.left:=nil;p^.right:=nil;

slm:=copy(sm,1,x-1);

srm:=copy(sm,x+1,n-x);

sln:=copy(sn,1,x-1);

srn:=copy(sn,x,n-x);

run(p^.left,slm,sln);

run(p^.right,srm,srn);

end;

procedure print(VAR p:tree);

begin

write(p^.data);

if pnil then print(p^.left);

if pnil then print(p^.right);

end;

begin

readln(sm);

readln(sn);

new(head);

head^.left:=nil;head^.right:=nil;

run(head,sm,sn);

print(head);

end.

各位帮忙看看为什么有空格 谢啦 或者发到285179318

建了个很丑的树................

---|---|---|---|---|---|---|---|---|---|

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

---|---|---|---|---|---|---|---|-

Accepted 有效得分：100 有效耗时：0ms

type

link=^point;

point=record

da:char;

l,r:link;

end;

var

q,s,t:string;i:longint;

ch:char;head,tail:link;

procedure find(ch:char;s,t:string;h:link);

var

k1,k2,k3:longint;

ch1:char;

t1,t2:string;

begin

h^.da:=ch;

if (length(s)=length(t))and(length(s)=1) then exit;

ch1:=t[length(t)];

k1:=pos(ch,s);

t1:=copy(s,1,k1-1);

t2:=copy(t,1,length(t1));

if (t1'')and(t2'') then

begin

new(h^.l);

h^.l^.l:=nil;h^.l^.r:=nil;

find(t2[length(t2)],t1,t2,h^.l);

end;

t2:=copy(t,length(t1)+1,length(s)-k1);

t1:=copy(s,k1+1,length(s)-k1);

if (t1'')and(t2'') then

begin

new(h^.r);

h^.r^.l:=nil;h^.r^.r:=nil;

find(t[length(t)-1],t1,t2,h^.r);

end;

end;

procedure print(h:link);

begin

if h=nil then exit;

write(h^.da);

print(h^.l);

print(h^.r);

end;

begin

readln(s);

readln(t);

ch:=t[length(t)];

new(head);

head^.l:=nil;head^.r:=nil;

find(ch,s,t,head);

print(head);

end.

太无语累。。。

program ex;

var i,j:longint;

s1,s2:ansistring;

procedure find(l1,r1,l2,r2:longint);

var i,j,m:longint;

begin

m:=pos(s2[r2],s1);

if (mlength(s1)) then exit;

write(s2[r2]);

if (l1

var a,g,h:string;

procedure chai(b,c:string);

var

e,f,j,k:string;

d,i:integer;

begin

a:=a+c[ord(b[0])];

d:=pos(c[ord(b[0])],b);

e:=copy(b,1,d-1);

f:=copy(b,d+1,ord(b[0])-d);

i:=ord(e[0]);

j:=copy(c,1,i);

k:=copy(c,i+1,ord(c[0])-i-1);

if e'' then chai(e,j);

if f'' then chai(f,k);

end;

begin

readln(g);

readln(h);

chai(g,h);

writeln(a);

end.

循环边界害死牛！

判断循环边界！

for(i=n-1;i>=0;i--)

{

for(j=l;j

var t,s:string;

procedure su(s,t:string);

var k,l:integer;

begin

l:=length(s);

if l=0 then exit;

write(t[l]);

k:=pos(t[l],s);

su(copy(s,1,k-1),copy(t,1,k-1));

su(copy(s,k+1,l-k),copy(t,k,l-k));

end;

begin

{readln(t);

n:=pos(' ',t);

s:=copy(t,1,n-1);

t:=copy(t,n+1,n-1);}

readln(s);

readln(t);

su(s,t);

end.

readln(t);

n:=pos(' ',t);

s:=copy(t,1,n-1);

t:=copy(t,n+1,n-1);

这题原来这么水。。

题目好熟悉!!!

这道题目和教材书上的好像,只不过是求的不一样.

多打了一个+1，交了三遍~~~~~

哈哈1次AC

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

---|---|---|---|---|---|---|---|-

Accepted 有效得分：100 有效耗时：0ms

program ex3;

var s1,s2,g:string;

procedure kan(zx,hx:string);

var t,m:integer;

begin

t:=length(zx);

if (t=0) then exit;

{g:=hx[t]; }

write(hx[t]);

m:=pos(hx[t],zx);

kan(copy(zx,1,m-1),copy(hx,1,m-1));

kan(copy(zx,m+1,t-m),copy(hx,m,t-m));

end;

begin

readln(s1);

readln(s2);

kan(s1,s2);

end.