derivlog, derivlog_shallow: logarithm derivative of x, equals x'/x

["管理员" <c2976501934@qq.com>]

/* not normalized */
NOINLINE
static GEN _ser_rebase(GEN x, long n)
{
	long i, j, l = lg(x), e = valser(x), v = varn(x), d, newl;
	GEN res;
	d = e - n; newl = l + d;
	if (newl <= 2) return zeroser(v, n);
	res = cgetg(newl, t_SER);
	res[1] = evalvalser(n) | evalvarn(v);
	j = d + 2;
	for (i = 2; i < j; i++) gel(res,i) = gen_0;
	memcpy(res + i, x + (i - d), (newl - i)*sizeof(long));
	return res;
}

/* d/dx log(f(x)) = f'(x)/f(x) */
NOINLINE
static GEN derivlog_shallow(GEN x) {
	long t = typ(x), v, e, i, l;
	GEN res = gnil, y, N, D;

	if (is_matvec_t(t)) {
		res = cgetg_copy(x, &l);
		for (i = 1; i < l; i++)
			gel(res,i) = derivlog_shallow(gel(x,i));
		return res;
	}

	if (gequal0(x)) pari_err_INV("derivlog", x);
	if (is_const_t(t)) return gen_0;

	switch(t)
	{
	case t_POL:
		v = varn(x);
		if (RgX_is_monomial(x)) {
			res = gdivsg(degpol(x), pol_x(v));
		} else {
			res = gdiv(RgX_deriv(x), x);
		}
		if (gvar(res) != v)
			res = scalarpol_shallow(res, varn(x));
		break;
	case t_SER:
		l = lg(x); y = x;
		if (l > 2 && gequal0(gel(x,2))) {
			long i = 2;
			pari_warn(warner,"normalizing a series with 0 leading term");
			y = leafcopy(x);
			do gel(y,i++) = gen_0;
			while (i < l && gequal0(gel(y,i)));
			y = normalizeser(y);
		}
		e = valser(y);
		if (e) {
			if (x == y) y = leafcopy(y);
			setvalser(y, 0);
		}
		res = gdiv(derivser(y), y);
		if (e) {
			res = _ser_rebase(res, -1);
			res[1] |= evalsigne(1);
			gel(res,2) = stoi(e);
		}
		break;
	case t_RFRAC:
		N = gel(x,1); D = gel(x,2); v = varn(D);
		if (!is_RgX(N, v)) {
			res = gneg_i(derivlog_shallow(D));
			break;
		}
		y = RgX_sub(RgX_mul(RgX_deriv(N),D),RgX_mul(N,RgX_deriv(D)));
		res = gdiv(y,gmul(N,D));
		if (gvar(res) != v)
			res = scalarpol_shallow(res, varn(x));
		break;
	default:
		res = gdiv(deriv(x,-1),x);
	}
	return res;
}

NOINLINE
GEN derivlog(GEN x) {
	pari_sp av = get_avma();
	return _gerepilecopy(av, derivlog_shallow(x));
}