logarithmic_root_complex.pl 2.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778
  1. #!/usr/bin/perl
  2. # Daniel "Trizen" Șuteu
  3. # License: GPLv3
  4. # Date: 17 September 2016
  5. # Website: https://github.com/trizen
  6. # Logarithmic root of n.
  7. # Solves c = x^x, where "c" is known.
  8. # (based on Newton's method for nth-root)
  9. # Example: 100 = x^x
  10. # x = lgrt(100)
  11. # x =~ 3.59728502354042
  12. # The function is defined in complex numbers for any value != 0.
  13. use 5.010;
  14. use strict;
  15. use warnings;
  16. use Math::MPC;
  17. use Math::MPFR;
  18. my $PREC = 128; # can be tweaked
  19. my $ROUND = Math::MPC::MPC_RNDNN();
  20. sub lgrt {
  21. my ($c) = @_;
  22. if (ref($c) ne 'Math::MPC') {
  23. my $n = Math::MPC::Rmpc_init2($PREC);
  24. Math::MPC::Rmpc_set_str($n, "$c", 10, $ROUND);
  25. $c = $n;
  26. }
  27. my $p = Math::MPFR::Rmpfr_init2($PREC);
  28. Math::MPFR::Rmpfr_ui_pow_ui($p, 10, $PREC >> 2, $ROUND);
  29. Math::MPFR::Rmpfr_ui_div($p, 1, $p, $ROUND);
  30. my $d = Math::MPC::Rmpc_init2($PREC);
  31. Math::MPC::Rmpc_log($d, $c, $ROUND);
  32. my $x = Math::MPC::Rmpc_init2($PREC);
  33. Math::MPC::Rmpc_set($x, $c, $ROUND);
  34. Math::MPC::Rmpc_sqrt($x, $x, $ROUND);
  35. Math::MPC::Rmpc_add_ui($x, $x, 1, $ROUND);
  36. Math::MPC::Rmpc_log($x, $x, $ROUND);
  37. my $y = Math::MPC::Rmpc_init2($PREC);
  38. Math::MPC::Rmpc_set_ui($y, 0, $ROUND);
  39. my $tmp = Math::MPC::Rmpc_init2($PREC);
  40. my $abs = Math::MPFR::Rmpfr_init2($PREC);
  41. my $count = 0;
  42. while (1) {
  43. Math::MPC::Rmpc_sub($tmp, $x, $y, $ROUND);
  44. Math::MPC::Rmpc_abs($abs, $tmp, $ROUND);
  45. Math::MPFR::Rmpfr_cmp($abs, $p) <= 0 and last;
  46. Math::MPC::Rmpc_set($y, $x, $ROUND);
  47. Math::MPC::Rmpc_log($tmp, $x, $ROUND);
  48. Math::MPC::Rmpc_add_ui($tmp, $tmp, 1, $ROUND);
  49. Math::MPC::Rmpc_add($x, $x, $d, $ROUND);
  50. Math::MPC::Rmpc_div($x, $x, $tmp, $ROUND);
  51. last if ++$count > $PREC;
  52. }
  53. $x;
  54. }
  55. say lgrt(100); # (3.597285023540417505497652251782286069146 0)
  56. say lgrt(-100); # (3.702029366602145942901939629527371028025 1.34823128471151901327831464969872480416)
  57. say lgrt(-1); # (1.690386757163589211290419139332364873691 1.869907964026775775222799239924290781916)