/***********************************
 **
 ** Integer relations package (pslq.mac)
 **
 ** Copyright: 2006, Andrej Vodopivec <andrej.vodopivec@gmail.com>
 ** Licence:   GPL
 **
 **   pslq.mac implements guess_exact_value function, which is used
 **   to identify floating point numbers as functions of known constatns.
 **
 ** For detailed description see
 **
 **  P.Borwein, K.G.Hare, A.Meichsner: Reverse symbolic computations, the
 **     identify function.
 **
 ***************************
  Examples:

  (%i2) float(%e^2+%e-1);
  (%o2) 9.107337927389695
  (%i3) guess_exact_value(%);
  (%o3) %e^2+%e-1
  (%i4) float(sin(%pi/30));
  (%o4) 0.10452846326765
  (%i5) guess_exact_value(%);
  (%o5) (sqrt(sqrt(5)-1)*sqrt(15))/(4*sqrt(2)*5^(1/4))-sqrt(5)/8-1/8
  (%i6) float(%pi*%e/2);
  (%o6) 4.269867111336783
  (%i7) guess_exact_value(%);
  (%o7) (%e*%pi)/2

 ***********************/

define_variable(identify_sum_constants,
  [%pi, %e, sqrt(2), sqrt(3), sqrt(5), log(2), log(3)], list)$
define_variable(identify_product_constants,
  [%pi, %e, sqrt(2), sqrt(3), sqrt(5), log(2), log(3)], list)$
define_variable(identify_powersum_constants,
  [%pi, %e, log(2), log(3)], list)$
define_variable(identify_extend,
  [], list)$
define_variable(identify_powersum_max_degree,
  3, fixnum)$
define_variable(identify_powersum_min_degree,
  2, fixnum)$
define_variable(identify_algebraic_degree,
  4, fixnum)$

if get(pslq_integer_relation, version)=false
  then if load_pathname # false
         then load (sconcat (pathname_directory (load_pathname), "pslq_integer_relation.lisp"))
       else load ("pslq_integer_relation.lisp");

identify_integer_relation(x, [threshold]) := block(
  [relation : pslq_integer_relation(x)],
  if length(threshold)#1 then threshold:100 else threshold:threshold[1],
  if relation=false then return(false),
  if apply("+", (map(abs, relation)))>threshold then return(false),
  relation
)$

guess_exact_value(x) :=
  if mapatom(x) then (
    if floatnump(x) or bfloatp(x) then block(
      [res],
      if equal(x, 0) or equal(x, -1) or equal(x, 1)
        then return(floor(x)),
      if errcatch (
        res : identify_as_algebraic(x)
      ) = [] then res : false,
      if res#false then return(res),
      if errcatch (
        res : identify_as_sum(x)
      ) = [] then res : false,
      if res#false then return(res),
      if errcatch (
        res : identify_as_product(x)
      ) = [] then res : false,
      if res#false then return(res),
      if errcatch (
        res : identify_as_powersum(x)
      ) = [] then res : false,
      if res#false then return(res),
      x
    )
    else x
  )
  else
    map(guess_exact_value, x)$

identify_as_sum(x) := block(
  [floats, relation, res : false, i,
  identify_sum_constants : append(identify_sum_constants, identify_extend)],
  if floatnump(x) then floats : append([x], float(identify_sum_constants))
  else (
    x : bfloat(x),
    if not(bfloatp(x)) then error("Argument to `identify_as_sum' is not a float!"),
    floats : append([x], bfloat(identify_sum_constants))
  ),
  relation : identify_integer_relation(floats),

  if relation#false then (
    res : 0,
    for i:1 thru length(identify_sum_constants) do (
      res : res + relation[i+1]*identify_sum_constants[i]
    ),
    res : -res/relation[1]
  ),

  res
)$

identify_as_algebraic(x) := block(
  [floats, relation, res : false, i, pol, %x%, dif, r, rr, ratprint:false, sol],
  if floatnump(x) then floats : makelist(x^i, i, 0, identify_algebraic_degree)
  else (
    x : bfloat(x),
    if not(bfloatp(x)) then error("Argument to `identify_as_algebraic' is not a float!"),
    floats : makelist(x^i, i, 0, identify_algebraic_degree)
  ),
  relation : identify_integer_relation(floats, 100*identify_algebraic_degree),

  if relation#false then (
    pol : makelist(%x%^i, i, 0, identify_algebraic_degree) . relation,
    sol : solve(pol, %x%),
    for r in sol do (
      r : rhs(r),
      if numberp(rectform(float(r))) then (
        if floatnump(x) then rr : float(r) else rr : bfloat(r),
        if not(floatnump(r)) and cabs(rr-x)<10^-14 then res : r
      )
    )
  ),

  res
)$

identify_as_product(x) := block(
  [floats, relation, res : false,
  identify_product_constants : append(identify_product_constants, identify_extend)],
  if floatnump(x) then floats : append([log(abs(x))], float(map(log, identify_product_constants)))
  else (
    x : bfloat(x),
    if not(bfloatp(x)) then error("Argument to `identify_as_sum' is not a float!"),
    floats : append([log(abs(x))], bfloat(map(log, identify_product_constants)))
  ),
  relation : identify_integer_relation(floats),

  if relation#false then (
    res : 1,
    for i:1 thru length(identify_product_constants) do (
      res : res * identify_product_constants[i]^relation[i+1]
      ),
    res : res^(-1/relation[1])
  )
  else return(false),
  
  if x<0 then
    -res
  else
    res
)$

identify_as_powersum(x) := block(
  [res : false, floats, relation,
  identify_powersum_constants : append(identify_powersum_constants, identify_extend),
  min_deg : identify_powersum_min_degree,
  max_deg : identify_powersum_max_degree],
  if not(floatnump(x)) then (
    x : bfloat(x),
    if not(bfloatp(x)) then error("Argument to `identify_as_powersum' is not a float!")
  ),

  res : for c in identify_powersum_constants do (
    if floatnump(x) then
      floats : makelist(float(c^i), i, -min_deg, max_deg)
    else
      floats : makelist(bfloat(c^i), i, -min_deg, max_deg),
    floats : append([x], floats),
    relation : identify_integer_relation(floats),
    if relation#false and relation[1]#0 then (
      res : makelist(-relation[i+1]/relation[1], i,
        1, min_deg + max_deg + 1),
      res : res . makelist(c^i, i, -min_deg, max_deg),
      return(res)
    )
  ),
  
  if res=done then return(false),
  res
)$
