I want to create a polynomial ring which has float Coefficients like this. I can create with integers but, Floats does not work.
using Oscar
S, (a,b,c,d) = PolynomialRing(QQ,["a","b","c","d"])
RR = AbstractAlgebra.RealField
s1 = S( 8*a - RR(0.51234)*a*(1+RR(1/2)*a+RR(1/3)*b+RR(1/4)*c) - 8)
s2 = S( 8*b - RR(0.51234)*b*(1+RR(2/3)*a+RR(2/4)*b+RR(2/5)*c) - 8)
s3 = S( 8*c - RR(0.51234)*c*(1+RR(3/4)*a+RR(3/5)*b+RR(3/6)*c) - 8)
s4 = S( 8*d - RR(0.51234)*d*(1+RR(4/5)*a+RR(4/6)*b+RR(4/7)*c) - 8)
It gives me this error. How can I create polynomials like this.
ERROR: LoadError: MethodError: no method matching (::FmpqMPolyRing)(::BigFloat)
Closest candidates are:
(::FmpqMPolyRing)() at ~/.julia/packages/Nemo/5CDLD/src/flint/fmpq_mpoly.jl:1063
(::AbstractAlgebra.Ring)(::Singular.n_RingElem{Singular.RingElemWrapper{S, T}}) where {S, T} at ~/.julia/packages/Singular/uG7uo/src/number/n_unknown.jl:358
(::AbstractAlgebra.Ring)(::Union{Singular.n_FieldElem{T}, Singular.n_RingElem{T}} where T) at ~/.julia/packages/Oscar/iRpOQ/src/Rings/mpoly.jl:736
...
Stacktrace:
[1] *(x::BigFloat, y::fmpq_mpoly)
# AbstractAlgebra ~/.julia/packages/AbstractAlgebra/mQIYL/src/Rings.jl:84
[2] top-level scope
# /mnt/c/Users/yusuf/Desktop/7.Semester/bitirme/Repo_Resultant_System/resultant-system/chandra4.jl:7
in expression starting at /mnt/c/Users/yusuf/Desktop/7.Semester/bitirme/Repo_Resultant_System/resultant-system/chandra4.jl:7
While I do not have previous experience with this particular (from appearances, rather sophisticated) package Oscar.jl, parsing this error message tells me that the function you are trying to call is being given a BigFloat as input, but simply does not have a method for that type.
At first this was a bit surprising given that there are no BigFloats in your input, but after a bit of investigation, it appears that the culprit is the following
julia> RR = AbstractAlgebra.RealField
Floats
julia> RR(1/3)
0.333333333333333314829616256247390992939472198486328125
julia> typeof(ans)
BigFloat
However, changing these inputs from BigFloat to a more standard Float64 does not fix the problem; S has no method for those either. It does, however, have methods for Rationals such as 1//3. Consequently, a simple apparent fix would be to write
using Oscar
S, (a,b,c,d) = PolynomialRing(QQ,["a","b","c","d"])
RR = AbstractAlgebra.Rational # Note the change here!
s1 = S( 8*a - RR(0.51234)*a*(1+RR(1/2)*a+RR(1/3)*b+RR(1/4)*c) - 8)
s2 = S( 8*b - RR(0.51234)*b*(1+RR(2/3)*a+RR(2/4)*b+RR(2/5)*c) - 8)
s3 = S( 8*c - RR(0.51234)*c*(1+RR(3/4)*a+RR(3/5)*b+RR(3/6)*c) - 8)
s4 = S( 8*d - RR(0.51234)*d*(1+RR(4/5)*a+RR(4/6)*b+RR(4/7)*c) - 8)
which runs without error.
Or perhaps a bit more cleanly, by directly inputting your coefficients as rationals from the start:
S, (a,b,c,d) = PolynomialRing(QQ,["a","b","c","d"])
RR = AbstractAlgebra.Rational
s1 = S( 8*a - RR(51234//100000)*a*(1+RR(1//2)*a+RR(1//3)*b+RR(1//4)*c) - 8)
s2 = S( 8*b - RR(51234//100000)*b*(1+RR(2//3)*a+RR(2//4)*b+RR(2//5)*c) - 8)
s3 = S( 8*c - RR(51234//100000)*c*(1+RR(3//4)*a+RR(3//5)*b+RR(3//6)*c) - 8)
s4 = S( 8*d - RR(51234//100000)*d*(1+RR(4//5)*a+RR(4//6)*b+RR(4//7)*c) - 8)
which yields
julia> s1 = S( 8*a - RR(51234//100000)*a*(1+RR(1//2)*a+RR(1//3)*b+RR(1//4)*c) - 8)
-25617//100000*a^2 - 8539//50000*a*b - 25617//200000*a*c + 374383//50000*a - 8
julia> s2 = S( 8*b - RR(51234//100000)*b*(1+RR(2//3)*a+RR(2//4)*b+RR(2//5)*c) - 8)
-8539//25000*a*b - 25617//100000*b^2 - 25617//125000*b*c + 374383//50000*b - 8
julia> s3 = S( 8*c - RR(51234//100000)*c*(1+RR(3//4)*a+RR(3//5)*b+RR(3//6)*c) - 8)
-76851//200000*a*c - 76851//250000*b*c - 25617//100000*c^2 + 374383//50000*c - 8
julia> s4 = S( 8*d - RR(51234//100000)*d*(1+RR(4//5)*a+RR(4//6)*b+RR(4//7)*c) - 8)
-25617//62500*a*d - 8539//25000*b*d - 25617//87500*c*d + 374383//50000*d - 8
In this latter case, the RR wrapper does not appear to be necessary, as it does not change the type of the inputs, but I suppose it doesn't hurt.
Related
I am trying to practice fitting with the Lsq-Fit-function in Julia.
The derivative of a Cauchy-distribution with parameters \gamma and x_0.
Following this manual I tried
f(x, x_0, γ) = -2*(x - x_0)*(π * γ^3 * (1 + ((x - x_0)/γ)^2)^2)^(-1)
x_0 = 3350
γ = 50
xarr = range(3000, length = 5000, stop = 4000)
yarr = [f(x, x_0, γ) for x in xarr]
using LsqFit
# p ≡ [x_0, γ]
model(x, p) = -2*(x - p[1])*(π * (p[2])^3 * (1 + ((x - p[1])/p[2])^2)^2)^(-1)
p0 = [3349, 49]
curve_fit(model, xarr, yarr, p0)
param = fit.param
... and it does not work, giving a MethodError: no method matching -(::StepRangeLen[...], leaving me confused.
Can please somebody tell me what I am doing wrong?
There are a few issues with what you've written:
the model function is meant to be called with its first argument (x) being the full vector of independent variables, not just one value. This is where the error you mention comes from:
julia> model(x, p) = -2*(x - p[1])*(π * (p[2])^3 * (1 + ((x - p[1])/p[2])^2)^2)^(-1);
julia> p0 = [3349, 49];
julia> model(xarr, p0);
ERROR: MethodError: no method matching -(::StepRangeLen{Float64,Base.TwicePrecision{Float64},Base.TwicePrecision{Float64}}, ::Float64)
One way to fix this is to use the dot notation to broadcast all operators so that they work elementwise:
julia> model(x, p) = -2*(x .- p[1]) ./ (π * (p[2])^3 * (1 .+ ((x .- p[1])/p[2]).^2).^2);
julia> model(xarr, p0); # => No error
but if this is too tedious you can let the #. macro do the work for you:
# just put #. in front of the expression to transform every
# occurrence of a-b into a.-b (and likewise for all operators)
# which means to compute the operation elementwise
julia> model(x, p) = #. -2*(x - p[1])*(π * (p[2])^3 * (1 + ((x - p[1])/p[2])^2)^2)^(-1);
julia> model(xarr, p0); # => No error
Another issue is that the parameters you're looking for are meant to be floating-point values. But your initial guess p0 is initialized with integers, which confuses curve_fit. There are two ways of fixing this. Either put floating-point values in p0:
julia> p0 = [3349.0, 49.0]
2-element Array{Float64,1}:
3349.0
49.0
or use a typed array initializer to specify explicitly the element type:
julia> p0 = Float64[3349, 49]
2-element Array{Float64,1}:
3349.0
49.0
This is not really an error, but I would find it more intuitive to compute a/b instead of a*b^(-1). Also, yarr can be computed with a simple broadcast using dot notation instead of a comprehension.
Wrapping all this together:
f(x, x_0, γ) = -2*(x - x_0)*(π * γ^3 * (1 + ((x - x_0)/γ)^2)^2)^(-1)
(x_0, γ) = (3350, 50)
xarr = range(3000, length = 5000, stop = 4000);
# use dot-notation to "broadcast" f and map it
# elementwise to elements of xarr
yarr = f.(xarr, x_0, γ);
using LsqFit
model(x, p) = #. -2*(x - p[1]) / (π * (p[2])^3 * (1 + ((x - p[1])/p[2])^2)^2)
p0 = Float64[3300, 10]
fit = curve_fit(model, xarr, yarr, p0)
yields:
julia> fit.param
2-element Array{Float64,1}:
3349.999986535933
49.99999203625603
Recently, I got started with Julia's (v1.0.3) DifferentialEquations.jl package. I tried solving a simple ODE system, with the same structure as my real model, but much smaller.
Depending on the solver which I use, the example either solves or throws an error. Consider this MWE, a Chemical Engineering model of a consecutive / parallel reaction in a CSTR:
using DifferentialEquations
using Plots
# Modeling a consecutive / parallel reaction in a CSTR
# A --> 2B --> C, C --> 2B, B --> D
# PETERSEN-Matrix
# No. A B C D Rate
# 1 -1 2 k1*A
# 2 -2 1 k2*B*B
# 3 2 -1 k3*C
# 4 -1 1 k4*B
function fpr(dx, x, params, t)
k_1, k_2, k_3, k_4, q_in, V_liq, A_in, B_in, C_in, D_in = params
# Rate equations
rate = Array{Float64}(undef, 4)
rate[1] = k_1*x[1]
rate[2] = k_2*x[2]*x[2]
rate[3] = k_3*x[3]
rate[4] = k_4*x[2]
dx[1] = -rate[1] + q_in/V_liq*(A_in - x[1])
dx[2] = 2*rate[1] - 2*rate[2] + 2*rate[3] - rate[4] + q_in/V_liq*(B_in - x[2])
dx[3] = rate[2] - rate[3] + q_in/V_liq*(C_in - x[3])
dx[4] = rate[4] + q_in/V_liq*(D_in - x[4])
end
u0 = [1.5, 0.1, 0, 0]
params = [1.0, 1.5, 0.75, 0.15, 3, 15, 0.5, 0, 0, 0]
tspan = (0.0, 15.0)
prob = ODEProblem(fpr, u0, tspan, params)
sol = solve(prob)
plot(sol)
This works perfectly.
However, if a choose a different solver, say Rosenbrock23() or Rodas4(), the ODE is not solved and I get the following error:
ERROR: LoadError: TypeError: in setindex!, in typeassert, expected Float64,
got ForwardDiff.Dual{Nothing,Float64,4}
I won't paste the whole stacktrace here, since it is very long, but you can easily reproduce this by changing sol = solve(prob) into sol = solve(prob, Rosenbrock23()). It seems to me that the error occurs when the solver tries to derive Jacobians, but I have no clue why. And why does the default solver work, but others don't?
Please, could anyone tell me why this error occurs and how it can be fixed?
Automatic differentiation works by passing Dual types through your function, instead of the floats you would normally use it with. So the problem arises because you fix the internal value rate to be of type Vector{Float64} (see the third point here, and this advice). Fortunately, that's easy to fix (and even better looking, IMHO):
julia> function fpr(dx, x, params, t)
k_1, k_2, k_3, k_4, q_in, V_liq, A_in, B_in, C_in, D_in = params
# Rate equations
# should actually be rate = [k_1*x[1], k_2*x[2]*x[2], k_3*x[3], k_4*x[2]], as per #LutzL's comment
rate = [k_1*x[1], k_2*x[2], k_3*x[3], k_4*x[2]]
dx[1] = -rate[1] + q_in/V_liq*(A_in - x[1])
dx[2] = 2*rate[1] - 2*rate[2] + 2*rate[3] - rate[4] + q_in/V_liq*(B_in - x[2])
dx[3] = rate[2] - rate[3] + q_in/V_liq*(C_in - x[3])
dx[4] = rate[4] + q_in/V_liq*(D_in - x[4])
end
That works with both Rosenbrock23 and Rodas4.
Alternatively, you can turn off AD with Rosenbrock23(autodiff=false) (which, I think, will use finite differences instead), or supply a Jacobian.
I was wondering how I can convert this code from Matlab to R code. It seems this is the code for midpoint method. Any help would be highly appreciated.
% Usage: [y t] = midpoint(f,a,b,ya,n) or y = midpoint(f,a,b,ya,n)
% Midpoint method for initial value problems
%
% Input:
% f - Matlab inline function f(t,y)
% a,b - interval
% ya - initial condition
% n - number of subintervals (panels)
%
% Output:
% y - computed solution
% t - time steps
%
% Examples:
% [y t]=midpoint(#myfunc,0,1,1,10); here 'myfunc' is a user-defined function in M-file
% y=midpoint(inline('sin(y*t)','t','y'),0,1,1,10);
% f=inline('sin(y(1))-cos(y(2))','t','y');
% y=midpoint(f,0,1,1,10);
function [y t] = midpoint(f,a,b,ya,n)
h = (b - a) / n;
halfh = h / 2;
y(1,:) = ya;
t(1) = a;
for i = 1 : n
t(i+1) = t(i) + h;
z = y(i,:) + halfh * f(t(i),y(i,:));
y(i+1,:) = y(i,:) + h * f(t(i)+halfh,z);
end;
I have the R code for Euler method which is
euler <- function(f, h = 1e-7, x0, y0, xfinal) {
N = (xfinal - x0) / h
x = y = numeric(N + 1)
x[1] = x0; y[1] = y0
i = 1
while (i <= N) {
x[i + 1] = x[i] + h
y[i + 1] = y[i] + h * f(x[i], y[i])
i = i + 1
}
return (data.frame(X = x, Y = y))
}
so based on the matlab code, do I need to change h in euler method (R code) to (b - a) / n to modify Euler code to midpoint method?
Note
Broadly speaking, I agree with the expressed comments; however, I decided to vote up this question. (now deleted) This is due to the existence of matconv that facilitates this process.
Answer
Given your code, we could use matconv in the following manner:
pacman::p_load(matconv)
out <- mat2r(inMat = "input.m")
The created out object will attempt to translate Matlab code into R, however, the job is far from finished. If you inspect the out object you will see that it requires further work. Simple statements are usually translated correctly with Matlab comments % replaced with # and so forth but more complex statements may require a more detailed investigation. You could then inspect respective line and attempt to evaluate them to see where further work may be required, example:
eval(parse(text=out$rCode[1]))
NULL
(first line is a comment so the output is NULL)
My first Fortran lesson is to plot the probability density function of the radial Sturmian functions. In case you are interested, the radial Sturmian functions are used to graph the momentum space eigenfunctions for the hydrogen atom.
In order to produce these radial functions, one needs to first produce some polynomials called the Gegenbauer polynomials, denoted
Cba(x),
where a and b should be stacked atop each other. One needs these polynomials because the Sturmians (let's call them R_n,l) are defined like so,
R_n,l(p) = N pl⁄(p2 + k2)l+2 Cn - l - 1l + 1(p2 - k2⁄p2 + k2),
where N is a normalisation constant, p is the momentum, n is the principle quantum number, l is the angular momentum and k is a constant. The normalisation constant is there so that when I come to square this function, it will produce a probability distribution for the momentum of the electron in a hydrogen atom.
Gegenbauer polynomials are generated using the following recurrence relation:
Cnl(x) = 1⁄n[2(l + n - 1) x Cn - 1l(x) - (2l + n - 2)Cn - 2l(x)],
with C0l(x) = 1 and C1l(x) = 2lx, as you may have noticed, l is fixed but n is not. At the start of my program, I will specify both l and n and work out the Gegenbauer polynomial I need for the radial function I wish to plot.
The problems I am having with my code at the moment are all in my subroutine for working out the value of the Gegenbauer polynomial Cn-l-1l+1(p2 - k2⁄p2 + k2) for incremental values of p between 0 and 3. I keep getting the error
Unclassified statement at (1)
but I cannot see what the issue is.
program Radial_Plot
implicit none
real, parameter :: pi = 4*atan(1.0)
integer, parameter :: top = 1000, l = 50, n = 100
real, dimension(1:top) :: x, y
real increment
real :: a=0.0, b = 2.5, k = 0.3
integer :: i
real, dimension(1:top) :: C
increment = (b-a)/(real(top)-1)
x(1) = 0.0
do i = 2, top
x(i) = x(i-1) + increment
end do
Call Gegenbauer(top, n, l, k, C)
y = x*C
! y is the function that I shall be plotting between values a and b.
end program Radial_Plot
Subroutine Gegenbauer(top1, n1, l1, k1, CSub)
! This subroutine is my attempt to calculate the Gegenbauer polynomials evaluated at a certain number of values between c and d.
implicit none
integer :: top1, i, j, n1, l1
real :: k1, increment1, c, d
real, dimension(1:top1) :: x1
real, dimension(1:n1 - l1, 1:top1) :: C1
real, dimension(1:n1 - l1) :: CSub
c = 0.0
d = 3.0
k1 = 0.3
n1 = 50
l1 = 25
top1 = 1000
increment1 = (d - c)/(real(top1) - 1)
x1(1) = 0.0
do i = 2, top1
x1(i) = x1(i-1) + increment1
end do
do j = 1, top1
C1(1,j) = 1
C1(2,j) = 2(l1 + 1)(x1(i)^2 - k1^2)/(x1(i)^2 + k1^2)
! All the errors occurring here are all due to, and I quote, 'Unclassifiable statement at (1)', I can't see what the heck I have done wrong.
do i = 3, n1 - l1
C1(i,j) = 2(((l1 + 1)/n1) + 1)(x1(i)^2 - k1^2)/(x1(i)^2 + k1^2)C1(i,j-1) - ((2(l1+1)/n1) + 1)C1(i,j-2)
end do
CSub(j) = Cn(n1 - l1,j)^2
end do
return
end Subroutine Gegenbauer
As francesalus correctly pointed out, the problem is because you use ^ instead of ** for exponentiation. Additionally, you do not put * between the terms you are multiplying.
C1(1,j) = 1
C1(2,j) = 2*(l1 + 1)*(x1(i)**2 - k1**2)/(x1(i)**2 + k1**2)
do i = 3, n1 - l1
C1(i,j) = 2 * (((l1 + 1)/n1) + 1) * (x1(i)**2 - k1**2) / &
(x1(i)**2 + k1**2)*C1(i,j-1) - ((2(l1+1)/n1) + 1) * &
C1(i,j-2)
end do
CSub(j) = Cn(n1 - l1,j)**2
Since you are beginning I have some advice. Learn to put all subroutines and functions to modules (unless they are internal). There is no reason for the return statement at the and of the subroutine, similarly as a stop statement isn't necessary at the and of the program.
To address the question we start with the following toy model problem being here just a case study:
Given two circles on a plane (its centers (c1 and c2) and radii (r1 and r2)) as well as a positive number r3, find all circles with radii = r3 (i.e all points c3 being centers of circles with radii = r3) tangent (externally and internally) to given two circles.
In general, depending on Circle[c1,r1], Circle[c2,r2] and r3 there are 0,1,2,...8 possible solutions. A typical case with 8 solutions :
I slightly modified a neat Mathematica implementation by Jaime Rangel-Mondragon on Wolfram Demonstration Project, but its core is similar:
Manipulate[{c1, a, c2, b} = pts;
{r1, r2} = Map[Norm, {a - c1, b - c2}];
w = Table[
Solve[{radius[{x, y} - c1]^2 == (r + k r1)^2,
radius[{x, y} - c2]^2 == (r + l r2)^2}
] // Quiet,
{k, -1, 1, 2}, {l, -1, 1, 2}
];
w = Select[
Cases[Flatten[{{x, y}, r} /. w, 2],
{{_Real, _Real}, _Real}
],
Last[#] > 0 &
];
Graphics[
{{Opacity[0.35], EdgeForm[Thin], Gray,
Disk[c1, r1], Disk[c2, r2]},
{EdgeForm[Thick], Darker[Blue,.5],
Circle[First[#], Last[#]]& /# w}
},
PlotRange -> 8, ImageSize -> {915, 915}
],
"None" -> {{pts, {{-3, 0}, {1, 0}, {3, 0}, {7, 0}}},
{-8, -8}, {8, 8}, Locator},
{{r, 0.3, "r3"}, 0, 8},
TrackedSymbols -> True,
Initialization :> (radius[z_] := Sqrt[z.z])
]
We can easily conclude that in a generic case we have an even number of solutions 0,2,4,6,8 while cases with an odd number of solutions 1,3,5,7 are exceptional - they are of zero measure in terms of control ranges. Thus changing in Manipulate c1, r1, c2, r2, r3 one can observe that it is much more difficult to track cases with an odd number of circles.
One could modify on a basic level the above approach : solving purely symbolically equations for c3 as well as redesignig Manipulate structure with an emphasis on changing number of solutions. If I'm not wrong Solve can work only numerically with Locator in Manipulate, however here Locator seems to be crucial for simplicity of controlling c1, r1, c2, r2 as well as for the whole implementation.
Let's state the questions, :
1. How can we force Manipulate to track seamlessly cases with an odd number of solutions (circles) ?
2. Is there any way to make Solve to find exact solutions of the underlying equations?
( I find the answer by Daniel Lichtblau to be the best approach to the question 2, but it seems in this instance there is still an essential need for sketching of a general technique of emphasizing measure zero sets of solutions while working with Manipulate )
These considerations are of less importance while dealing with exact solutions
For example Solve[x^2 - 3 == 0, x] yields {{x -> -Sqrt[3]}, {x -> Sqrt[3]}}
while in case from the above of slightly more difficult equations extracted from Manipulate setting the following arguments :
c1 = {-Sqrt[3], 0}; a = {1, 0}; c2 = {6 - Sqrt[3], 0}; b = {7, 0};
{r1, r2} = Map[ Norm, {a - c1, b - c2 }];
r = 2.0 - Sqrt[3];
to :
w = Table[Solve[{radius[{x, y} - {x1, y1}]^2 == (r + k r1)^2,
radius[{x, y} - {x2, y2}]^2 == (r + l r2)^2}],
{k, -1, 1, 2}, {l, -1, 1, 2}];
w = Select[ Cases[ Flatten[ {{x, y}, r} /. w, 2], {{_Real, _Real}, _Real}],
Last[#] > 0 &]
we get two solutions :
{{{1.26795, -3.38871*10^-8}, 0.267949}, {{1.26795, 3.38871*10^-8}, 0.267949}}
similarly under the same arguments and equations, putting :
r = 2 - Sqrt[3];
we get no solutions : {}
but in fact there is exactly one solution which we would like to emphasize:
{ {3 - Sqrt[3], 0 }, 2 - Sqrt[3] }
In fact, passing to Graphics such a small difference between two different solutions and the uniqe one is indistinguishable, however working with Manipulate we cannot track carefully with a desired accuracy merging of two circles and usually the last observed configuration when lowering r3 before vanishing all solutions (reminding so-called structural instability) looks like this :
Manipulate is rather a powerful tool, not only a toy, and its mastering could be very useful. The considered issues when appearing in a serious research are frequently critical, for example: in studying solutions of nonlinear differential equations, occurence of singularities in its solutions, qualitative behavior of dynamical systems, bifurcations, phenomena in Catastrophe theory and so on.
As this is a measure zero set, tools that require some granularity will generally have trouble with the concept. Perhaps better is to look for the singularity locus explicitly, where solutions have multiplicity or in other ways depart from the nearby solution behavior(s). It will be a part of the discriminant variety. In particular, you can grab the relevant part by setting your defining polynomials to zero and simultaneously making the Jacobian determinant zero.
Here is your example. I will eventually (wlog) put one center at the origin and the other at (1,0).
centers = Array[c, {2, 2}];
radii = Array[r, 3];
circ[cen_, rad_, x_, y_] := ({x, y} - cen).({x, y} - cen) - rad^2
I'll use your 'k' for both polynomials. Your formulation has pairs (k,l) where each is +-1. We can just use k, arrange by squaring to get a polynomial in k^2, and replace that with 1.
polys =
Table[Expand[
circ[centers[[j]], radii[[3]] + k*radii[[j]], x, y]], {j, 2}]
Out[18]= {x^2 + y^2 - 2 x c[1, 1] + c[1, 1]^2 - 2 y c[1, 2] +
c[1, 2]^2 - k^2 r[1]^2 - 2 k r[1] r[3] - r[3]^2,
x^2 + y^2 - 2 x c[2, 1] + c[2, 1]^2 - 2 y c[2, 2] + c[2, 2]^2 -
k^2 r[2]^2 - 2 k r[2] r[3] - r[3]^2}
We'll remove the part that is linear in k, square the rest, square that removed part, and equate the two. We also then replace k with unity.
p2 = polys - k*Coefficient[polys, k];
polys2 = Expand[p2^2 - (k*Coefficient[polys, k])^2] /. k -> 1;
We now get the determinant of the Jacobian and add that to the brew.
discrim = Det[D[polys2, #] & /# {x, y}];
allrelations = Join[polys2, {discrim}];
Now set the centers as noted earlier (could have done this from the beginning, one would suppose).
ar2 =
allrelations /. {c[1, 1] -> 0, c[1, 2] -> 0, c[2, 1] -> 0,
c[2, 2] -> 0}
Out[38]= {x^4 + 2 x^2 y^2 + y^4 - 2 x^2 r[1]^2 - 2 y^2 r[1]^2 +
r[1]^4 - 2 x^2 r[3]^2 - 2 y^2 r[3]^2 - 2 r[1]^2 r[3]^2 + r[3]^4,
x^4 + 2 x^2 y^2 + y^4 - 2 x^2 r[2]^2 - 2 y^2 r[2]^2 + r[2]^4 -
2 x^2 r[3]^2 - 2 y^2 r[3]^2 - 2 r[2]^2 r[3]^2 + r[3]^4, 0}
We now eliminate x and y to get the locus in r[1],r[2],r[3] parameter space that determines where we'll have multiplicity in our solutions.
gb = GroebnerBasis[ar2, radii, {x, y},
MonomialOrder -> EliminationOrder]
{r[1]^6 - 3 r[1]^4 r[2]^2 + 3 r[1]^2 r[2]^4 - r[2]^6 -
8 r[1]^4 r[3]^2 + 8 r[2]^4 r[3]^2 + 16 r[1]^2 r[3]^4 -
16 r[2]^2 r[3]^4}
If I did this all correctly, then we now have the polynomial defining the locus in parameter space where solution sets can get silly. Off this set they should never have multiplicity, and real counts should always be even. The intersection of this set with real space will be a 2d surface in the 3d space of the radii parameters. It will separate regions that have 0, 2, 4, 6, or 8 real solutions from one another.
Last, I'll point out that in this example the variety in question reduces nicely into a product of planes. I guess from a geometric view this is not too surprising.
Factor[gb[[1]]]
Out[43]= (r[1] - r[2]) (r[1] + r[2]) (r[1] - r[2] - 2 r[3]) (r[1] +
r[2] - 2 r[3]) (r[1] - r[2] + 2 r[3]) (r[1] + r[2] + 2 r[3])