Nudo aleatorio en seis vértices

Question

Esta pregunta está inspirada por Joseph O'Rourke la hermosa pregunta al azar nudos. Elegir una al azar ordenó 6-tupla de puntos en la unidad de la esfera en $\mathbf{R}^3$, y la forma de un nudo mediante la conexión de los sucesivos pares de puntos en el 6-tupla por palos (ver la imagen de José de la pregunta). Por los resultados conocidos en el palo de los números, el nudo resultante será la unknot o el nudo de trébol. ¿Cuál es la probabilidad de que produzca una o la otra?

Answer 1

Me escribió un programa en Mathematica para la muestra de los nudos de esta distribución y probar qué proporción son el nudo de trébol.

Para saber si un determinado nudo es el unknot o el trébol, el programa comprueba en primer lugar el total de la curvatura del nudo y se aplica el Fary-Milnor teorema: si la curvatura es menor que $4 \pi$, entonces es el unknot. La mitad del tiempo, esta prueba identifica el unknot. Creo que debería ser posible calcular la probabilidad exacta de la curvatura de ser demasiado pequeño.

A continuación, el programa de proyectos el nudo en 100 aleatoria de los aviones. Si cualquiera de estas proyecciones tiene menos de 3 cruces, entonces estamos de nuevo teniendo en cuenta el unknot. Esta prueba elimina todos, pero ~1% de los casos.

Por último, si todavía no estamos hecho, el programa se toma la proyección con el menor número de cruces y comprueba si el resultado nudo diagrama es tricolorable. Generalmente este diagrama tiene tres cruces y esta prueba podría ser un poco de un mazazo, pero esta prueba completamente distingue a la unknot de el trébol. (Yo no uso esta prueba en primer lugar porque mi aplicación es muy lenta.)

En la ejecución de una prueba de 10.000 azar nudos, 68 nudos se determinó que el trébol. El cálculo se tomó unos 12 minutos. Aquí está uno de los conductores dispuestos en tresbolillo se encuentran:

El código de la siguiente manera. Como de costumbre, ten cuidado con los bichos.

(* Random points, projections, those sorts of things *)
randsph[] := Normalize@Table[RandomVariate@NormalDistribution[], {3}]
randknot[] := Table[randsph[], {6}]
close[x_] := Join[x, {First[x]}]
project[ x_, frame_ ] := Flatten[frame[[2 ;; 3]] . Transpose[ {x} ]]
framify[x_] := Orthogonalize@{x, randsph[], randsph[]}
rotate[{x_, y_}] := {-y, x}
halfintersecthelper[a_, b_, c_, 
  d_] := (a - c) . rotate[b - a] / ((d - c) . rotate[b - a])
halfintersect[a_, b_, c_, d_] := 
 0 <= halfintersecthelper[a, b, c, d] <= 1
intersect[a_, b_, c_, d_] := 
 halfintersect[a, b, c, d] && halfintersect[c, d, a, b]
nintshelper[cknot3_, frame_] := 
 Module[{cknot2 = (project[#1, frame] &) /@ cknot3}, 
  Table[If[Abs[i - j] > 1 && Abs[i - j] != 5 && 
     intersect[cknot2[[i]], cknot2[[i + 1]], cknot2[[j]], 
      cknot2[[j + 1]]], {i, 
     halfintersecthelper[cknot2[[j]], cknot2[[j + 1]], cknot2[[i]], 
      cknot2[[i + 1]]], 
     If[over[cknot3[[i]], cknot3[[i + 1]], cknot3[[j]], 
       cknot3[[j + 1]], frame], +1, -1], {Min[i, j], Max[i, j]}}, {0, 
     0, 0, 0}], {i, 1, 6}, {j, 1, 6}]]
nints[cknot3_, frame_] := (#1[[3 ;; 4]] &) /@ 
  Union[Select[Flatten[nintshelper[cknot3, frame], 1], #1[[3]] != 0 &]]
curvature[cknot3_] := 
 Total@Table[
   VectorAngle[cknot3[[i + 1]] - cknot3[[i]], 
    cknot3[[1 + Mod[i + 1, 6]]] - cknot3[[i + 1]]], {i, 1, 6}]
overhelper[a_, b_, c_, d_] := (b - a)\[Cross](d - c)
over[a_, b_, c_, d_, frame_] := 
 overhelper[a, b, c, d].(c - a) overhelper[a, b, c, d].frame[[1]] > 0

(* Can this knot be tricolored? *)
vars[seq_] := x /@ Range@Length@seq
domains[xs_] := And @@ (#1 == 0 || #1 == 1 || #1 == 2 &) /@ xs
nonconstant[seq_] := ! 
  And @@ Table[x[i] == x[i + 1], {i, 1, Length[seq] - 1}]
overs[seq_] := 
 And @@ Module[{n = Length[seq]}, 
   Table[If[seq[[i, 1]] == +1, x[i] == x[1 + Mod[i, n]], True], {i, 1,
      n}]]
names[seq_] := Union[(#1[[2]] &) /@ seq]
overname[seq_, n_] := 
 x@First@Flatten[Position[seq, {+1, n}, {1}, Heads -> False]]
undername1[seq_, n_] := 
 x@First@Flatten[Position[seq, {-1, n}, {1}, Heads -> False]]
undername2[seq_, n_] := 
 x[1 + Mod[First@Flatten[Position[seq, {-1, n}, {1}, Heads -> False]],
     Length[seq]]]
overunder[seq_, n_] := 
 Mod[overname[seq, n] + undername1[seq, n] + undername2[seq, n], 
   3] == 0
overunders[seq_] := And @@ (overunder[seq, #1] &) /@ names@seq
conditions[seq_] := 
 domains[vars@seq] && overs@seq && overunders@seq && nonconstant@seq
tricolor[seq_] := FindInstance[conditions@seq, vars@seq]

(* Init *)
overalltrials = 0;
overallcount = 0;

(* Random trials! *)
First@
 Timing@Module[{trials = 10000, nframes = 100, count = 0, frames, i, 
    j, k, crossings, ncrossings, pgood, projn, projj},
   frames = framify /@ Table[randsph[], {nframes}];
   For[i = 1, i <= trials, i++,
    k = close[randknot[]];
    (* Angles *)
    pgood = If[curvature[k] >= 4 Pi, 0, -1];
    (* Projections *)
    projn = 20;
    projj = 0;
    For[j = 1, j <= nframes && pgood == 0, j++,
     crossings = nints[k, frames[[j]] ];
     ncrossings = Length@crossings/2;
     If[ncrossings < 3, pgood = -1];
     If[ncrossings < projn, projn = ncrossings; projj = j];
     ];
    If[pgood == 0, crossings = nints[k, frames[[projj]]];
     pgood = If[tricolor@crossings != {}, +1, -1];];
    (* Record *)
    If[pgood == +1 && count == 0, testk = k; 
     testf = frames[[projj]]];
    If[pgood == +1, count++];
    ];
   overalltrials += trials;
   overallcount += count;
   ]
overallcount
overalltrials
overallcount / overalltrials * 100. 

(* Draw a trefoil knot found by the random trials *)
nints[testk, testf] // MatrixForm
pk = Map[project[#, testf] &, testk ]
Graphics3D[{Thickness[0.02], Opacity[1], Specularity[White, 50], 
 Line[testk, VertexColors -> {Red, Yellow, Green, Cyan, Blue, Purple, 
 Red}]}, Axes -> False, PlotRange -> All, Boxed -> False]

Answer 2

Me gusta la especificidad de esta pregunta! Sólo con la mano (no tengo esta automatizado), se generó un diez al azar ejemplos, y simplemente girar la esfera a una orientación de la que yo podría ver si el hexágono formas el unknot. Aunque las imágenes a continuación pueden no ser convincente, no es difícil para hacer esta determinación visualmente a resolución completa. El resultado de estos diez ensayos aleatorios: cero conductores dispuestos en tresbolillo, diezunknots.

Answer 3

Me cortó un pequeño metapost script que genera planas proyecciones de azar diagramas. Es lejos de ser perfecto, pero después de despedir a un par de cientos de ejemplos, yo estaría muy sorprendido si la probabilidad de conseguir un trébol es nada 0. Usted puede descargar 1000 ejemplos de http://rasmusvillemoes.dk/files/trefoil.zipjunto con la (feo) metapost código. Yo no poner un montón de esfuerzo en la lógica detrás de dibujo/desmontaje de partes de hebras cerca de las intersecciones, pero la información en el .txt archivos puede ayudar a resolver las ambigüedades. Las dos líneas "a lo Largo del segmento 1: // (-1, 0.4816) [3]" significa que aproximadamente a mitad de camino a lo largo de segmento número 1, nos encontramos con el segmento 3 y pasar por debajo de ella. (La primera parte del capítulo 0 es de color rojo; esto determina el orden de forma única.) Supongo que podes hacer ordenar estas líneas, de acuerdo con el tiempo (segundo) coordinar y, a continuación, busque la alternancia de signos, pero no sé si 6-stick diagrama de el trébol es necesariamente alterna.