Mathematica代码:
列出所有的格点- list = Flatten[Table[{i, j}, {i, 0, 7}, {j, 0, 7}], 1]
复制代码 列出所有的共线的三点的序号组- S = {}; For[k = 1, k <= 64, k++,
- For[j = 1, j < k, j++,
- For[i = 1, i < j, i++,
- If[Cross[Append[list[[i]], 1], Append[list[[j]], 1]].Append[
- list[[k]], 1] == 0, AppendTo[S, {i, j, k}]]]]]
复制代码 列出所有的每三点不共线的四点的序号组- T = {}; For[l = 1, l <= 64, l++,
- For[k = 1, k < l, k++,
- For[j = 1, j < k, j++,
- If[Not[MemberQ[S, {j, k, l}]],
- For[i = 1, i < j, i++,
- If[Not[MemberQ[S, {i, j, k}]] && Not[MemberQ[S, {i, j, l}]] &&
- Not[MemberQ[S, {i, k, l}]], AppendTo[T, {i, j, k, l}]]]]]]]
复制代码 用f[a,b,c,d,e]判定五点a,b,c,d,e是否共抛物线
此处省略.见附件.
从j为基础找出共抛物线的点组- U = {}; For[j = 1, j < 20, j++,
- For[i = Last[T[[j]]] + 1; U1 = {}, i <= 64, i++,
- If[Not[MemberQ[T[[j]], i]] &&
- Not[MemberQ[S, Sort[Append[Delete[T[[j]], 1], i]]]] &&
- Not[MemberQ[S, Sort[Append[Delete[T[[j]], 2], i]]]] &&
- Not[MemberQ[S, Sort[Append[Delete[T[[j]], 3], i]]]] &&
- Not[MemberQ[S, Sort[Append[Delete[T[[j]], 4], i]]]] &&
- FullSimplify[f @@ (Part[list, #] & /@ Append[T[[j]], i])] == 0,
- T = Complement[T, Sort[Append[#, i]] & /@ Subsets[T[[j]], {3}]];
- AppendTo[U1, i]]]; AppendTo[U, Append[T[[j]], U1]]]
复制代码 以上的list,S,T和函数f都保存在附件中(可以用txt打开).使用时用Get函数调用即可,不必运行上面的代码.
开始搜索:- U = {}; T1 = T; For[j = 1, j < Length[T1], j++, U1 = {}; Tj = T1[[j]];
- For[i = Last[Tj] + 1, i <= 64, i++,
- If[Not[MemberQ[Tj, i]] &&
- Not[MemberQ[S, Sort[Append[Tj[[{1, 2}]], i]]]] &&
- Not[MemberQ[S, Sort[Append[Tj[[{1, 3}]], i]]]] &&
- Not[MemberQ[S, Sort[Append[Tj[[{1, 4}]], i]]]] &&
- Not[MemberQ[S, Sort[Append[Tj[[{2, 3}]], i]]]] &&
- Not[MemberQ[S, Sort[Append[Tj[[{2, 4}]], i]]]] &&
- Not[MemberQ[S, Sort[Append[Tj[[{3, 4}]], i]]]],
- If[FullSimplify[f @@ (Part[list, #] & /@ Append[Tj, i])] == 0,
- T1 = Complement[T1, Sort[Append[#, i]] & /@ Subsets[Tj, {3}]];
- AppendTo[U1, i]]]]; If[U1 != {}, AppendTo[U, Join[Tj, U1]]]]
复制代码 |