> | test_for_conic := proc(n) local m, L, C, i, poss_comb, j, f, b1, b2, b3, b4, b5, solns, g, solnsa, h, solnsb, val; |
> | m := evalf(n); |
> | L := [[trunc(m*10) mod 10, trunc(m*100) mod 10], [trunc(m*100) mod 10, trunc(m*1000) mod 10], [trunc(m*1000) mod 10, trunc(m*10000) mod 10], [trunc(m*10000) mod 10, trunc(m*100000) mod 10], [trunc(m*100000) mod 10, trunc(m*1000000) mod 10], [trunc(m*1000000) mod 10, trunc(m*10) mod 10]]; |
> | C := [c1, c2, c3, c4, c5, c6]; |
> | for i to 6 do geometry:-point(C[i], op(L[i])) end do; |
> | poss_comb := combinat:-choose(C, 3); |
> | for j to nops(poss_comb) do if geometry:-AreCollinear(op(poss_comb[j])) = true then RETURN(n, "vacuously true") end if; end do; |
> | f := (x, y) -> x^2 + 2*a1*x*y + a2*y^2 + a3*x + a4*y + a5; |
> | b1 := f(op(L[1])); |
> | b2 := f(op(L[2])); |
> | b3 := f(op(L[3])); |
> | b4 := f(op(L[4])); |
> | b5 := f(op(L[5])); |
> | solns := solve({b1, b2, b3, b4, b5}); |
> | if solns = NULL then g := (x, y) -> a0*x^2 + 2*a1*x*y + y^2 + a3*x + a4*y + a5; b1 := g(op(L[1])); b2 := g(op(L[2])); b3 := g(op(L[3])); b4 := g(op(L[4])); b5 := g(op(L[5])); solnsa := solve({b1, b2, b3, b4, b5}); if solnsa = NULL then h := (x, y) -> 2*a1*x*y + a3*x + a4*y + a5; b1 := h(op(L[1])); b2 := h(op(L[2])); b3 := h(op(L[3])); b4 := h(op(L[4])); b5 := h(op(L[5])); solnsb := solve({b1, b2, b3, b4, b5}); val := eval(h(op(L[6])), solnsb) end if; val := eval(g(op(L[6])), solnsa) end if; |
> | if solns <> NULL then val := eval(f(op(L[6])), solns) end if; |
> | if val = 0 then RETURN(n, eval(f(x, y), solns)) else RETURN(n, false) end if; |
> | end proc: |
Warning, this will take a long, long, long time to execute. I've broken the calculation into thirds as Maple had difficulty trying to display the whole thing (it would freeze). Each piece takes about 1.5 hours on my computer.
> | ans := []: for k from 0 to 333333/999999 by 1/999999 do z := test_for_conic(k); if z[2] <> false and z[2] <> "vacuously true" then ans := [op(ans), [z]] end if end do: nops(ans); |
> | for alpha to nops(ans) do ans[alpha] end do; |
> |