Cell[CellGroupData[{Cell[BoxData[
 RowBox[{
  RowBox[{"clebsch", " ", "=", 
   RowBox[{"{", "\[IndentingNewLine]", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"12", ",", "11"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"12", ",", "16"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"12", ",", "13"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"12", ",", "5"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"12", ",", "7"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"3", ",", "14"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"3", ",", "6"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"3", ",", "4"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"3", ",", "16"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"3", ",", "7"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"8", ",", "4"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"8", ",", "9"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"8", ",", "11"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"8", ",", "1"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"8", ",", "7"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"2", ",", "6"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"2", ",", "15"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"2", ",", "13"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"2", ",", "1"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"2", ",", "7"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"14", ",", "10"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"14", ",", "11"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"14", ",", "13"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"14", ",", "1"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"6", ",", "9"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"6", ",", "11"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"6", ",", "5"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"4", ",", "15"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"4", ",", "13"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"4", ",", "5"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"10", ",", "15"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"10", ",", "9"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"10", ",", "5"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"10", ",", "7"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"15", ",", "11"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"15", ",", "16"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"9", ",", "16"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"9", ",", "13"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"16", ",", "1"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"1", ",", "5"}], "}"}]}], "}"}], ",", 
     "\[IndentingNewLine]", "\[IndentingNewLine]", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"12", ",", "3"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"12", ",", "14"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"12", ",", "4"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"12", ",", "10"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"12", ",", "15"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"3", ",", "8"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"3", ",", "11"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"3", ",", "1"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"3", ",", "5"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"8", ",", "2"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"8", ",", "6"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"8", ",", "15"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"8", ",", "16"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"2", ",", "4"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"2", ",", "10"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"2", ",", "9"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"2", ",", "5"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"14", ",", "6"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"14", ",", "9"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"14", ",", "16"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"14", ",", "5"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"6", ",", "4"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"6", ",", "13"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"6", ",", "1"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"4", ",", "11"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"4", ",", "7"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"10", ",", "16"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"10", ",", "13"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"10", ",", "1"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"15", ",", "9"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"15", ",", "13"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"15", ",", "7"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"9", ",", "11"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"9", ",", "1"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"11", ",", "16"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"11", ",", "13"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"16", ",", "7"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"13", ",", "5"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"1", ",", "7"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"5", ",", "7"}], "}"}]}], "}"}], ",", 
     "\[IndentingNewLine]", "\[IndentingNewLine]", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{"12", ",", "8"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"12", ",", "2"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"12", ",", "6"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"12", ",", "9"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"12", ",", "1"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"3", ",", "2"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"3", ",", "10"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"3", ",", "15"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"3", ",", "9"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"3", ",", "13"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"8", ",", "14"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"8", ",", "10"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"8", ",", "13"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"8", ",", "5"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"2", ",", "14"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"2", ",", "11"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"2", ",", "16"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"14", ",", "4"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"14", ",", "15"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"14", ",", "7"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"6", ",", "10"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"6", ",", "15"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"6", ",", "16"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"6", ",", "7"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"4", ",", "10"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"4", ",", "9"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"4", ",", "16"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"4", ",", "1"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"10", ",", "11"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"15", ",", "1"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"15", ",", "5"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"9", ",", "5"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"9", ",", "7"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"11", ",", "1"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"11", ",", "5"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"11", ",", "7"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"16", ",", "13"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"16", ",", "5"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"13", ",", "1"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"13", ",", "7"}], "}"}]}], "}"}]}], "}"}]}], 
  ";"}]], "Input",
 CellGroupingRules->{"GroupTogetherGrouping", 10000.},
 InitializationCell->True,
 CellChangeTimes->{
  3.35696210375764*^9, {3.4101882313252387`*^9, 3.410188246087054*^9},
    3.8173258507517567`*^9},
 CellID->443559150],

Cell[BoxData[
 RowBox[{
  RowBox[{
   RowBox[{"HeilbronnCoordinates", " ", "=", " ", 
    RowBox[{"{", 
     RowBox[{
      RowBox[{"{", 
       RowBox[{"0", ",", " ", 
        RowBox[{"31", "/", "33"}]}], "}"}], ",", " ", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"8", "/", "31"}], ",", " ", "1"}], "}"}], ",", " ", 
      RowBox[{"{", 
       RowBox[{"1", ",", " ", 
        RowBox[{"23", "/", "33"}]}], "}"}], ",", " ", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"23", "/", "31"}], ",", " ", 
        RowBox[{"7", "/", "11"}]}], "}"}], ",", " ", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"2", "/", "31"}], ",", " ", 
        RowBox[{"7", "/", "11"}]}], "}"}], ",", " ", "\n", "    ", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"10", "/", "31"}], ",", " ", 
        RowBox[{"23", "/", "33"}]}], "}"}], ",", " ", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"29", "/", "31"}], ",", " ", "1"}], "}"}], ",", " ", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"21", "/", "31"}], ",", " ", 
        RowBox[{"31", "/", "33"}]}], "}"}], ",", " ", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"10", "/", "31"}], ",", " ", 
        RowBox[{"2", "/", "33"}]}], "}"}], ",", " ", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"2", "/", "31"}], ",", " ", "0"}], "}"}], ",", " ", 
      "\n", "    ", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"21", "/", "31"}], ",", " ", 
        RowBox[{"10", "/", "33"}]}], "}"}], ",", " ", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"29", "/", "31"}], ",", " ", 
        RowBox[{"4", "/", "11"}]}], "}"}], ",", " ", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"8", "/", "31"}], ",", " ", 
        RowBox[{"4", "/", "11"}]}], "}"}], ",", " ", 
      RowBox[{"{", 
       RowBox[{"0", ",", " ", 
        RowBox[{"10", "/", "33"}]}], "}"}], ",", " ", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"23", "/", "31"}], ",", " ", "0"}], "}"}], ",", " ", 
      RowBox[{"{", 
       RowBox[{"1", ",", " ", 
        RowBox[{"2", "/", "33"}]}], "}"}]}], "}"}]}], ";"}], 
  " "}]], "Input",
 CellGroupingRules->{"GroupTogetherGrouping", 10000.},
 CellChangeTimes->{
  3.35696210375764*^9, {3.410116781236971*^9, 3.41011678928887*^9}, {
   3.4101874635105524`*^9, 3.410187552702361*^9}, {
   3.410188086601364*^9, 3.410188095614684*^9}, {
   3.4102732318752637`*^9, 3.4102732455070395`*^9}, 
   3.8173258507518272`*^9},
 CellID->458834528],

Cell[BoxData[
 RowBox[{
  RowBox[{
   RowBox[{"fb", "[", 
    RowBox[{"n_", ",", " ", "b_"}], "]"}], " ", ":=", " ", 
   RowBox[{
    RowBox[{"First", " ", "/@", " ", 
     RowBox[{"Rest", "[", 
      RowBox[{"FoldList", "[", 
       RowBox[{
        RowBox[{"Function", "[", 
         RowBox[{
          RowBox[{"{", 
           RowBox[{"r", ",", " ", "f"}], "}"}], ",", " ", "\n", 
          "       ", 
          RowBox[{
           RowBox[{"(", 
            RowBox[{
             RowBox[{"{", 
              RowBox[{
               RowBox[{"Floor", "[", "#", "]"}], ",", " ", 
               RowBox[{"f", 
                RowBox[{"(", 
                 RowBox[{"#", " ", "-", " ", 
                  RowBox[{"Floor", "[", "#", "]"}]}], ")"}]}]}], 
              "}"}], " ", "&"}], " ", ")"}], "[", 
           RowBox[{
            RowBox[{"r", "[", 
             RowBox[{"[", "2", "]"}], "]"}], "/", "f"}], "]"}]}], 
         "]"}], ",", " ", 
        RowBox[{"{", 
         RowBox[{"0", ",", " ", "n"}], "}"}], ",", " ", "\n", 
        "      ", 
        RowBox[{
         RowBox[{"Range", "[", 
          RowBox[{
           RowBox[{"b", " ", "-", " ", "1"}], ",", " ", "0", ",", " ", 
           RowBox[{"-", "1"}]}], "]"}], "!"}]}], "]"}], "]"}]}], " ", 
    "/;", " ", 
    RowBox[{"n", " ", "<", " ", 
     RowBox[{"b", "!"}]}]}]}], ";"}]], "Input",
 CellGroupingRules->{"GroupTogetherGrouping", 10000.},
 GeneratedCell->False,
 CellChangeTimes->{
  3.35032403644083*^9, {3.35032412969238*^9, 3.35032413056407*^9}, {
   3.35032420250788*^9, 3.3503242082719*^9}, 3.36432387114063*^9, 
   3.817325850751882*^9},
 CellID->191202336],

Cell[BoxData[
 RowBox[{
  RowBox[{
   RowBox[{"fdp", "[", "ds_List", "]"}], " ", ":=", " ", "\n", "  ", 
   RowBox[{
    RowBox[{"Fold", "[", 
     RowBox[{
      RowBox[{
       RowBox[{"{", 
        RowBox[{
         RowBox[{"Delete", "[", 
          RowBox[{
           RowBox[{"#1", "[", 
            RowBox[{"[", "1", "]"}], "]"}], ",", " ", "#2"}], "]"}], 
         ",", " ", 
         RowBox[{"Append", "[", 
          RowBox[{
           RowBox[{"#1", "[", 
            RowBox[{"[", "2", "]"}], "]"}], ",", " ", 
           RowBox[{"#1", "[", 
            RowBox[{"[", 
             RowBox[{"1", ",", "#2"}], "]"}], "]"}]}], "]"}]}], "}"}],
        " ", "&"}], " ", ",", " ", "\n", "    ", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"Range", "[", 
         RowBox[{"Length", "[", "ds", "]"}], "]"}], ",", " ", 
        RowBox[{"{", "}"}]}], "}"}], ",", " ", 
      RowBox[{"ds", " ", "+", " ", "1"}]}], "]"}], "[", 
    RowBox[{"[", "2", "]"}], "]"}]}], ";"}]], "Input",
 CellGroupingRules->{"GroupTogetherGrouping", 10000.},
 GeneratedCell->False,
 CellChangeTimes->{{3.35032411724346*^9, 3.35032412204241*^9}, {
   3.35032418733598*^9, 3.35032421720179*^9}, {3.35032507560296*^9, 
   3.35032508140169*^9}, 3.36432386926563*^9, 3.817325850751935*^9},
 CellID->337919576],

Cell[BoxData[
 RowBox[{
  RowBox[{
   RowBox[{"nthPermutation", "[", 
    RowBox[{"l_List", ",", " ", 
     RowBox[{"n_Integer", "?", "Positive"}]}], "]"}], " ", ":=", " ", 
   "\n", "  ", 
   RowBox[{
    RowBox[{"l", "[", 
     RowBox[{"[", 
      RowBox[{"fdp", "[", 
       RowBox[{"fb", "[", 
        RowBox[{
         RowBox[{"n", " ", "-", " ", "1"}], ",", " ", 
         RowBox[{"Length", "[", "l", "]"}]}], "]"}], "]"}], "]"}], 
     "]"}], " ", "/;", " ", 
    RowBox[{"n", " ", "<=", " ", 
     RowBox[{"(", 
      RowBox[{
       RowBox[{"Length", "[", "l", "]"}], "!"}], ")"}]}]}]}], 
  ";"}]], "Input",
 CellGroupingRules->{"GroupTogetherGrouping", 10000.},
 GeneratedCell->False,
 CellChangeTimes->{{3.35032403302762*^9, 3.35032403332524*^9}, {
   3.3503241247516*^9, 3.3503241269975*^9}, {3.35032419671435*^9, 
   3.35032419920456*^9}, 3.35032425703889*^9, {3.35032490431506*^9, 
   3.35032490637451*^9}, 3.36432386842188*^9, 3.817325850751989*^9},
 CellID->169356758],

Cell[BoxData[
 RowBox[{"Manipulate", "[", 
  RowBox[{
   RowBox[{"With", "[", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"coord", " ", "=", 
       RowBox[{
        RowBox[{
         RowBox[{"HeilbronnCoordinates", "[", 
          RowBox[{"[", "#", "]"}], "]"}], "&"}], "/@", 
        RowBox[{"nthPermutation", "[", 
         RowBox[{
          RowBox[{"Range", "[", "16", "]"}], ",", 
          RowBox[{"Round", "[", 
           RowBox[{
            RowBox[{"16", "!"}], " ", "perm"}], "]"}]}], "]"}]}]}], 
      "}"}], ",", "\[IndentingNewLine]", 
     RowBox[{"Grid", "[", 
      RowBox[{"{", "\[IndentingNewLine]", 
       RowBox[{"{", 
        RowBox[{
         RowBox[{"Graphics", "[", 
          RowBox[{
           RowBox[{"{", 
            RowBox[{"Red", ",", "\[IndentingNewLine]", 
             RowBox[{
              RowBox[{
               RowBox[{"Line", "[", 
                RowBox[{"{", 
                 RowBox[{
                  RowBox[{"coord", "[", 
                   RowBox[{"[", 
                    RowBox[{"#", "[", 
                    RowBox[{"[", "1", "]"}], "]"}], "]"}], "]"}], ",", 
                  RowBox[{"coord", "[", 
                   RowBox[{"[", 
                    RowBox[{"#", "[", 
                    RowBox[{"[", "2", "]"}], "]"}], "]"}], "]"}]}], 
                 "}"}], "]"}], "&"}], "/@", 
              RowBox[{"(", 
               RowBox[{"clebsch", "[", 
                RowBox[{"[", "1", "]"}], "]"}], ")"}]}], ",", 
             "\[IndentingNewLine]", "Black", ",", 
             RowBox[{"EdgeForm", "[", "Thin", "]"}], ",", "White", 
             ",", 
             RowBox[{
              RowBox[{
               RowBox[{"Disk", "[", 
                RowBox[{"#", ",", ".02"}], "]"}], "&"}], "/@", 
              "coord"}]}], "}"}], ",", 
           RowBox[{"ImageSize", "\[Rule]", "190"}]}], "]"}], ",", 
         "\[IndentingNewLine]", 
         RowBox[{"Graphics", "[", 
          RowBox[{
           RowBox[{"{", 
            RowBox[{"Green", ",", "\[IndentingNewLine]", 
             RowBox[{
              RowBox[{
               RowBox[{"Line", "[", 
                RowBox[{"{", 
                 RowBox[{
                  RowBox[{"coord", "[", 
                   RowBox[{"[", 
                    RowBox[{"#", "[", 
                    RowBox[{"[", "1", "]"}], "]"}], "]"}], "]"}], ",", 
                  RowBox[{"coord", "[", 
                   RowBox[{"[", 
                    RowBox[{"#", "[", 
                    RowBox[{"[", "2", "]"}], "]"}], "]"}], "]"}]}], 
                 "}"}], "]"}], "&"}], "/@", 
              RowBox[{"(", 
               RowBox[{"clebsch", "[", 
                RowBox[{"[", "2", "]"}], "]"}], ")"}]}], ",", 
             "\[IndentingNewLine]", "Black", ",", 
             RowBox[{"EdgeForm", "[", "Thin", "]"}], ",", "White", 
             ",", 
             RowBox[{
              RowBox[{
               RowBox[{"Disk", "[", 
                RowBox[{"#", ",", ".02"}], "]"}], "&"}], "/@", 
              "coord"}]}], "}"}], ",", 
           RowBox[{"ImageSize", "\[Rule]", "190"}]}], "]"}], ",", 
         "\[IndentingNewLine]", 
         RowBox[{"Graphics", "[", 
          RowBox[{
           RowBox[{"{", 
            RowBox[{"Blue", ",", "\[IndentingNewLine]", 
             RowBox[{
              RowBox[{
               RowBox[{"Line", "[", 
                RowBox[{"{", 
                 RowBox[{
                  RowBox[{"coord", "[", 
                   RowBox[{"[", 
                    RowBox[{"#", "[", 
                    RowBox[{"[", "1", "]"}], "]"}], "]"}], "]"}], ",", 
                  RowBox[{"coord", "[", 
                   RowBox[{"[", 
                    RowBox[{"#", "[", 
                    RowBox[{"[", "2", "]"}], "]"}], "]"}], "]"}]}], 
                 "}"}], "]"}], "&"}], "/@", 
              RowBox[{"(", 
               RowBox[{"clebsch", "[", 
                RowBox[{"[", "3", "]"}], "]"}], ")"}]}], ",", 
             "\[IndentingNewLine]", "Black", ",", 
             RowBox[{"EdgeForm", "[", "Thin", "]"}], ",", "White", 
             ",", 
             RowBox[{
              RowBox[{
               RowBox[{"Disk", "[", 
                RowBox[{"#", ",", ".02"}], "]"}], "&"}], "/@", 
              "coord"}]}], "}"}], ",", 
           RowBox[{"ImageSize", "\[Rule]", "190"}]}], "]"}]}], "}"}], 
       "}"}], "]"}]}], "]"}], ",", "\[IndentingNewLine]", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"perm", ",", "1", ",", "\"\<permute the vertices\>\""}],
       "}"}], ",", "0.000001", ",", "1"}], "}"}], ",", 
   RowBox[{"SaveDefinitions", "\[Rule]", " ", "True"}]}], 
  "]"}]], "Input",
 CellGroupingRules->{"GroupTogetherGrouping", 10000.},
 CellChangeTimes->{
  3.35696210375764*^9, {3.4101168401540394`*^9, 
   3.4101169295875425`*^9}, {3.4101175786988797`*^9, 
   3.4101177679942846`*^9}, {3.4101178424164925`*^9, 
   3.410117861465213*^9}, {3.4101872367754803`*^9, 
   3.4101872938498254`*^9}, {3.410187365075083*^9, 
   3.4101874039525366`*^9}, {3.4101877265092154`*^9, 
   3.410187735973201*^9}, {3.4101879412565713`*^9, 
   3.4101879659530683`*^9}, {3.410188257634118*^9, 
   3.4101882657761507`*^9}, {3.4102732519072638`*^9, 
   3.410273405292288*^9}, 3.4102735377238398`*^9, {
   3.4102735758747835`*^9, 3.410273635640256*^9}, {
   3.4102862703799934`*^9, 3.4102863327822123`*^9}, {
   3.410286466680088*^9, 3.410286474501647*^9}, {
   3.4106342092705584`*^9, 3.4106342488955584`*^9}, {
   3.4106343118018084`*^9, 3.4106343255518084`*^9}, 
   3.81732585074732*^9},
 CellID->249027806],

Cell[BoxData[
 TagBox[
  StyleBox[
   DynamicModuleBox[{$CellContext`perm$$ = 1, Typeset`show$$ = True, 
    Typeset`bookmarkList$$ = {}, Typeset`bookmarkMode$$ = "Menu", 
    Typeset`animator$$, Typeset`animvar$$ = 1, Typeset`name$$ = 
    "\"untitled\"", Typeset`specs$$ = {{{
       Hold[$CellContext`perm$$], 1, "permute the vertices"}, 1.*^-6, 
      1}}, Typeset`size$$ = {
    588., {92.134033203125, 97.865966796875}}, Typeset`update$$ = 0, 
    Typeset`initDone$$, Typeset`skipInitDone$$ = 
    False, $CellContext`perm$380911$$ = 0}, 
    DynamicBox[Manipulate`ManipulateBoxes[
     1, StandardForm, "Variables" :> {$CellContext`perm$$ = 1}, 
      "ControllerVariables" :> {
        Hold[$CellContext`perm$$, $CellContext`perm$380911$$, 0]}, 
      "OtherVariables" :> {
       Typeset`show$$, Typeset`bookmarkList$$, Typeset`bookmarkMode$$,
         Typeset`animator$$, Typeset`animvar$$, Typeset`name$$, 
        Typeset`specs$$, Typeset`size$$, Typeset`update$$, 
        Typeset`initDone$$, Typeset`skipInitDone$$}, "Body" :> 
      With[{$CellContext`coord = 
         Map[Part[$CellContext`HeilbronnCoordinates, #]& , 
           $CellContext`nthPermutation[
            Range[16], 
            Round[Factorial[16] $CellContext`perm$$]]]}, 
        Grid[{{
           Graphics[{Red, 
             Map[Line[{
                Part[$CellContext`coord, 
                 Part[#, 1]], 
                Part[$CellContext`coord, 
                 Part[#, 2]]}]& , 
              Part[$CellContext`clebsch, 1]], Black, 
             EdgeForm[Thin], White, 
             Map[Disk[#, 0.02]& , $CellContext`coord]}, ImageSize -> 
            190], 
           Graphics[{Green, 
             Map[Line[{
                Part[$CellContext`coord, 
                 Part[#, 1]], 
                Part[$CellContext`coord, 
                 Part[#, 2]]}]& , 
              Part[$CellContext`clebsch, 2]], Black, 
             EdgeForm[Thin], White, 
             Map[Disk[#, 0.02]& , $CellContext`coord]}, ImageSize -> 
            190], 
           Graphics[{Blue, 
             Map[Line[{
                Part[$CellContext`coord, 
                 Part[#, 1]], 
                Part[$CellContext`coord, 
                 Part[#, 2]]}]& , 
              Part[$CellContext`clebsch, 3]], Black, 
             EdgeForm[Thin], White, 
             Map[Disk[#, 0.02]& , $CellContext`coord]}, ImageSize -> 
            190]}}]], 
      "Specifications" :> {{{$CellContext`perm$$, 1, 
          "permute the vertices"}, 1.*^-6, 1}}, "Options" :> {}, 
      "DefaultOptions" :> {ControllerLinking -> True}],
     ImageSizeCache->{633., {138., 144.}},
     SingleEvaluation->True],
    Deinitialization:>None,
    DynamicModuleValues:>{},
    Initialization:>({$CellContext`HeilbronnCoordinates = {{
         0, 31/33}, {8/31, 1}, {1, 23/33}, {23/31, 7/11}, {
         2/31, 7/11}, {10/31, 23/33}, {29/31, 1}, {21/31, 31/33}, {
         10/31, 2/33}, {2/31, 0}, {21/31, 10/33}, {29/31, 4/11}, {
         8/31, 4/11}, {0, 10/33}, {23/31, 0}, {
         1, 2/33}}, $CellContext`nthPermutation[
         Pattern[$CellContext`l, 
          Blank[List]], 
         PatternTest[
          Pattern[$CellContext`n, 
           Blank[Integer]], Positive]] := Condition[
         Part[$CellContext`l, 
          $CellContext`fdp[
           $CellContext`fb[$CellContext`n - 1, 
            Length[$CellContext`l]]]], $CellContext`n <= Factorial[
           Length[$CellContext`l]]], $CellContext`fdp[
         Pattern[$CellContext`ds, 
          Blank[List]]] := Part[
         Fold[{
           Delete[
            Part[#, 1], #2], 
           Append[
            Part[#, 2], 
            Part[#, 1, #2]]}& , {
           Range[
            Length[$CellContext`ds]], {}}, $CellContext`ds + 1], 
         2], $CellContext`fb[
         Pattern[$CellContext`n, 
          Blank[]], 
         Pattern[$CellContext`b, 
          Blank[]]] := Condition[
         Map[First, 
          Rest[
           FoldList[
            Function[{$CellContext`r, $CellContext`f}, 
             ({
              Floor[#], $CellContext`f (# - Floor[#])}& )[
             Part[$CellContext`r, 2]/$CellContext`f]], {
            0, $CellContext`n}, 
            Factorial[
             Range[$CellContext`b - 1, 0, -1]]]]], $CellContext`n < 
         Factorial[$CellContext`b]], $CellContext`clebsch = {{{12, 
        11}, {12, 16}, {12, 13}, {12, 5}, {12, 7}, {3, 14}, {3, 6}, {
        3, 4}, {3, 16}, {3, 7}, {8, 4}, {8, 9}, {8, 11}, {8, 1}, {8, 
        7}, {2, 6}, {2, 15}, {2, 13}, {2, 1}, {2, 7}, {14, 10}, {14, 
        11}, {14, 13}, {14, 1}, {6, 9}, {6, 11}, {6, 5}, {4, 15}, {4, 
        13}, {4, 5}, {10, 15}, {10, 9}, {10, 5}, {10, 7}, {15, 11}, {
        15, 16}, {9, 16}, {9, 13}, {16, 1}, {1, 5}}, {{12, 3}, {12, 
        14}, {12, 4}, {12, 10}, {12, 15}, {3, 8}, {3, 11}, {3, 1}, {3,
         5}, {8, 2}, {8, 6}, {8, 15}, {8, 16}, {2, 4}, {2, 10}, {2, 
        9}, {2, 5}, {14, 6}, {14, 9}, {14, 16}, {14, 5}, {6, 4}, {6, 
        13}, {6, 1}, {4, 11}, {4, 7}, {10, 16}, {10, 13}, {10, 1}, {
        15, 9}, {15, 13}, {15, 7}, {9, 11}, {9, 1}, {11, 16}, {11, 
        13}, {16, 7}, {13, 5}, {1, 7}, {5, 7}}, {{12, 8}, {12, 2}, {
        12, 6}, {12, 9}, {12, 1}, {3, 2}, {3, 10}, {3, 15}, {3, 9}, {
        3, 13}, {8, 14}, {8, 10}, {8, 13}, {8, 5}, {2, 14}, {2, 11}, {
        2, 16}, {14, 4}, {14, 15}, {14, 7}, {6, 10}, {6, 15}, {6, 
        16}, {6, 7}, {4, 10}, {4, 9}, {4, 16}, {4, 1}, {10, 11}, {15, 
        1}, {15, 5}, {9, 5}, {9, 7}, {11, 1}, {11, 5}, {11, 7}, {16, 
        13}, {16, 5}, {13, 1}, {13, 7}}}}; Typeset`initDone$$ = True),
    
    SynchronousInitialization->True,
    UnsavedVariables:>{Typeset`initDone$$},
    UntrackedVariables:>{Typeset`size$$}], "Manipulate",
   Deployed->True,
   StripOnInput->False],
  Manipulate`InterpretManipulate[1]]], "Output",
 CellGroupingRules->{"GroupTogetherGrouping", 10000.},
 CellChangeTimes->{3.817325850747541*^9},
 CellID->41790133]
}, {7}]]