原题链接

首先如果不考虑数据范围，珂以想到一个贪心：每一次询问的\(u,v\)，设它们的最近公共祖先为\(lca\)，若当前的\(u,v\)有一条\(u\rightarrow v\)的路径，就直接按这个路径跑；否则尽量往\(lca\)上跑。如果跑不动了，而且也没有\(u\rightarrow v\)的路径，就不能到达。正确性显然。

但是数据范围是\(2\times 10^5\)啊，刚才那样不星啊！

我们珂以用倍增来快速让\(u,v\)向上跑，具体就是维护\(g_{u,i}\)表示从\(u\)向上跑\(2^i\)步最浅能到哪儿。然后就珂以通过二分的方法找出\(u,v\)能到达的离\(lca\)最近的点，且在\(lca\)以下。接着只要查询是否有\(u'\rightarrow v'\)的直接路径。

关键是咋找呢？珂能这个路径的起点在子树\(u'\)内，终点在子树\(v'\)内。

先对原树做一遍\(dfs\)序，设\(u\)子树所代表的区间为\([beg_u,ed_u]\)。设一个路径表示成\((x,y)\)，则\(u'\rightarrow v'\)的路径一定在集合\(\{(x,y)|x\in [beg_{u'},ed_{u'}],y\in [beg_{v'},ed_{v'}]\}\)。于是，这时候珂以将原问题转化成一个二位数点的问题：将\((x,y)\)表示成平面直角坐标系上的一个点，\(\{(x,y)|x\in[beg_{u'},ed_{u'}],y\in [beg_{v'},ed_{v'}]\}\)表示成平面直角坐标系上的矩形。刚才的查询路径即珂转化为查询一个矩形内是否有点。二位数点的板子题。

代码(窝为什么要写毒瘤的pascal啊)：

uses math;

const
  Maxn = 200005;
  LOG = 20;

var
  i, j, swap_tmp: longint;
  n, m, q: longint;
  tot_edge, tot, dfn_time, lca: longint;
  u, v: longint;
  head: array [0 .. Maxn] of longint;
  toV, nxt: array [0 .. Maxn * 2] of longint;
  par: array [0 .. Maxn, 0 .. LOG] of longint;
  dep: array [0 .. Maxn] of longint;
  beg, ed: array [0 .. Maxn] of longint;
  g: array [0 .. Maxn, 0 .. LOG] of longint;
  res, Ans: array [0 .. Maxn] of longint;
  b: array [0 .. Maxn * 5, 0 .. 4] of longint; // start, end, id, val
  bit: array [0 .. Maxn * 5] of longint;

procedure add_edge(u, v: longint);
begin
  inc(tot_edge);
  toV[tot_edge] := v;
  nxt[tot_edge] := head[u];
  head[u] := tot_edge;
end;

procedure dfs(u: longint);
  var i, j, v: longint;
begin
  dep[u] := dep[par[u, 0]] + 1;
  inc(dfn_time);
  beg[u] := dfn_time;
  i := head[u];
  while i <> 0 do begin
    dfs(toV[i]);
    i := nxt[i];
  end;
  ed[u] := dfn_time;
end;
function get_lca(u, v: longint): longint;
  var i, j: longint;
begin
  if (dep[u] > dep[v]) then begin
    swap_tmp := v;
    v := u;
    u := swap_tmp;
  end;
  for i := 19 downto 0 do begin
    if (((dep[v] - dep[u]) shr i) and 1) <> 0 then begin
      v := par[v, i];
    end;
  end;
  if (u = v) then begin
    exit(u);
  end;
  for i := 19 downto 0 do begin
    if (par[u, i] <> par[v, i]) then begin
      u := par[u, i];
      v := par[v, i];
    end;
  end;
  exit(par[u, 0]);
end;

procedure dfs1(u: longint);
  var i, j, v: longint;
begin
  i := head[u];
  while (i <> 0) do begin
    v := toV[i];
    dfs1(v);
    if ((g[u, 0] = 0) or ((g[v, 0] <> 0) and (dep[g[v, 0]] < dep[g[u, 0]]))) then begin
      g[u, 0] := g[v, 0];
    end;
    i := nxt[i];
  end;
end;

procedure insert_point(x, y: longint);
begin
  inc(tot); b[tot, 0] := x; b[tot, 1] := y; b[tot, 2] := 0; b[tot, 3] := 1;
end;
procedure insert_rect(x1, y1, x2, y2, id: longint);
begin
  inc(tot); b[tot, 0] := x2; b[tot, 1] := y2; b[tot, 2] := id; b[tot, 3] := 1;
  inc(tot); b[tot, 0] := x2; b[tot, 1] := y1 - 1; b[tot, 2] := id; b[tot, 3] := -1;
  inc(tot); b[tot, 0] := x1 - 1; b[tot, 1] := y2; b[tot, 2] := id; b[tot, 3] := -1;
  inc(tot); b[tot, 0] := x1 - 1; b[tot, 1] := y1 - 1; b[tot, 2] := id; b[tot, 3] := 1;
end;

procedure qsort(l, h: longint);
  var i, j, m1, m2: longint;
begin
  i := l;
  j := h;
  m1 := b[(i + j) div 2, 0];
  m2 := b[(i + j) div 2, 2];
  repeat
    while (b[i, 0] < m1) or ((b[i, 0] = m1) and (b[i, 2] < m2)) do inc(i);
    while (m1 < b[j, 0]) or ((m1 = b[j, 0]) and (m2 < b[j, 2])) do dec(j);
    if i <= j then begin
      b[0] := b[i];
      b[i] := b[j];
      b[j] := b[0];
      inc(i);
      dec(j);
    end;
  until i > j;
  if i < h then qsort(i, h);
  if j > l then qsort(l, j);
end;
procedure bit_add(x: longint);
  var i: longint;
begin
  i := x;
  while (i < Maxn * 5) do begin
    inc(bit[i], 1);
    inc(i, (i and (-i)));
  end;
end;
function bit_query(x: longint): longint;
  var i, cur: longint;
begin
  cur := 0;
  i := x;
  while (i <> 0) do begin
    inc(cur, bit[i]);
    dec(i, (i and (-i)));
  end;
  exit(cur);
end;

begin
  tot_edge := 0;
  readln(n);
  for i := 2 to n do begin
    read(par[i, 0]);
    add_edge(par[i, 0], i);
  end;
  dfn_time := 0;
  dfs(1);
  for j := 1 to 19 do begin
    for i := 1 to n do begin
      par[i, j] := par[par[i, j - 1], j - 1];
    end;
  end;
  
  tot := 0;
  readln(m);
  for i := 1 to m do begin
    readln(u, v);
    if (beg[u] > beg[v]) then begin
      swap_tmp := u;
      u := v;
      v := swap_tmp;
    end;
    lca := get_lca(u, v);
    if ((g[u, 0] = 0) or (dep[lca] < dep[g[u, 0]])) then begin
      g[u, 0] := lca;
    end;
    if ((g[v, 0] = 0) or (dep[lca] < dep[g[v, 0]])) then begin
      g[v, 0] := lca;
    end;
    insert_point(beg[u], beg[v]);
  end;
  
  dfs1(1);
  for i := 1 to n do begin
    if (g[i, 0] = i) then begin
      g[i, 0] := 0;
    end;
  end;
  for j := 1 to 19 do begin
    for i := 1 to n do begin
      g[i, j] := g[g[i, j - 1], j - 1];
    end;
  end;
  
  readln(q);
  for i := 1 to q do begin
    readln(u, v);
    if (beg[u] > beg[v]) then begin
      swap_tmp := u;
      u := v;
      v := swap_tmp;
    end;
    lca := get_lca(u, v);
    for j := 19 downto 0 do begin
      if ((g[u, j] <> 0) and (dep[g[u, j]] > dep[lca])) then begin
        u := g[u, j];
        inc(res[i], 1 shl j);
      end;
    end;
    for j := 19 downto 0 do begin
      if ((g[v, j] <> 0) and (dep[g[v, j]] > dep[lca])) then begin
        v := g[v, j];
        inc(res[i], 1 shl j);
      end;
    end;
    if (((g[u, 0] = 0) and (u <> lca)) or ((g[v, 0] = 0) and (v <> lca))) then begin
      res[i] := -1;
      continue;
    end;
    inc(res[i], 2);
    if ((u = lca) or (v = lca)) then begin
      dec(res[i]);
      continue;
    end;
    insert_rect(beg[u], beg[v], ed[u], ed[v], i);
  end;
  
  qsort(1, tot);
  fillchar(Ans, 0, sizeof(Ans));
  for i := 1 to tot do begin
    //writeln('b[', i, ']=', b[i, 0], ' ', b[i, 1], ' ', b[i, 2], ' ', b[i, 3]);
    if (b[i, 2] = 0) then begin
      bit_add(b[i, 1]);
    end
    else begin
      inc(Ans[b[i, 2]], b[i, 3] * bit_query(b[i, 1]));
    end;
  end;
  
  for i := 1 to q do begin
    if (Ans[i] > 0) then begin
      dec(res[i]);
    end;
    writeln(res[i]);
  end;
end.