(* Content-type: application/vnd.wolfram.mathematica *)

(*** Wolfram Notebook File ***)
(* http://www.wolfram.com/nb *)

(* CreatedBy='Wolfram 15.0' *)

(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[       154,          7]
NotebookDataLength[     44408,       1039]
NotebookOptionsPosition[     35398,        878]
NotebookOutlinePosition[     39042,        953]
CellTagsIndexPosition[     38999,        950]
WindowTitle->Cracking the Kryptos CTF
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{
Cell[BoxData[GridBox[{
   {GridBox[{
      {
       ItemBox[Cell[BoxData[
         RowBox[{
          TemplateBox[{12},
           "Spacer1"], Cell[
          "WOLFRAM INSTITUTE/ PUZZLES TUTORIAL", "PacletNameCell",
           TextAlignment->Center,ExpressionUUID->
           "647ec3c9-8242-4ef7-8d08-4764b27fab67"], 
          TemplateBox[{8},
           "Spacer1"]}]],
         TextAlignment->Center,ExpressionUUID->
         "6aa4cf83-0a1b-48d8-a7a6-c89891f957c6"],
        Background->LightDarkSwitched[
          RGBColor[
          0.7450980392156863, 0.3254901960784314, 0.1411764705882353]],
        ItemSize->Full], ""}
     },
     GridBoxAlignment->{"Rows" -> {{Center}}},
     GridBoxItemSize->{"Columns" -> {Full, 
         Scaled[0.02]}, "Rows" -> {{2.5}}}], Cell[TextData[Cell[BoxData[
     TagBox[
      ActionMenuBox[
       FrameBox[Cell[TextData[{
         "URL",
         " ",
         Cell[BoxData[
          GraphicsBox[
           {GrayLevel[0.66667], Thickness[0.13], 
            LineBox[{{-1.8, 0.5}, {0, 0}, {1.8, 0.5}}]},
           AspectRatio->1,
           ImageSize->20,
           PlotRange->{{-3, 4}, {-1, 1}}]],ExpressionUUID->
          "0b02d144-a9eb-4e37-928d-be36d20e556d"]
        }],ExpressionUUID->"94b90320-81dc-46ec-adf5-a305e24631ba"],
        StripOnInput->False],{
       "\"WolframInstitute/Puzzles/tutorial/CrackingTheKryptosCTF\"" :> None, 
        "\"Copy Wolfram Documentation Center URL\"" :> 
        CopyToClipboard[
         "WolframInstitute/Puzzles/tutorial/CrackingTheKryptosCTF"], 
        Delimiter, "\"Copy web URL\"" :> 
        Module[{DocumentationSearch`Private`nb$}, 
          DocumentationSearch`Private`nb$ = 
           NotebookPut[
            Notebook[{
              Cell[BoxData[
                MakeBoxes[
                 Hyperlink[
                  "http://reference.wolfram.com/language/WolframInstitute/\
Puzzles/tutorial/CrackingTheKryptosCTF.html"], StandardForm]], "Input", 
                TextClipboardType -> "PlainText"]}, Visible -> False]]; 
          SelectionMove[DocumentationSearch`Private`nb$, All, Notebook]; 
          FrontEndTokenExecute[DocumentationSearch`Private`nb$, "Copy"]; 
          NotebookClose[DocumentationSearch`Private`nb$]; Null], 
        "\"Go to web URL\"" :> 
        FrontEndExecute[{
          NotebookLocate[{
            URL[If[TrueQ[False], 
                "http://reference.wolfram.com/system-modeler/", 
                "http://reference.wolfram.com/language/"] <> 
              "WolframInstitute/Puzzles/tutorial/CrackingTheKryptosCTF" <> 
              ".html"], None}]}]},
       Appearance->None,
       MenuAppearance->Automatic,
       MenuStyle->"URLMenu"],
      MouseAppearanceTag["LinkHand"]]],
     LineSpacing->{1.4, 0},ExpressionUUID->
     "d62f99ee-2b7b-4421-92ff-0d6fafbe554a"]], "AnchorBar",
     CacheGraphics->False,ExpressionUUID->
     "4957b899-a5b4-40fd-a4c4-3af44080d181"]}
  }]], "AnchorBarGrid",
 GridBoxOptions->{GridBoxItemSize->{"Columns" -> {
     Scaled[0.65], {
      Scaled[0.34]}}, "ColumnsIndexed" -> {}, "Rows" -> {{1.}}, 
   "RowsIndexed" -> {}}},
 CellID->1,ExpressionUUID->"acf739f9-1948-4b28-930a-1665a0869913"],

Cell[CellGroupData[{

Cell["Cracking the Kryptos CTF", "Title",
 CellID->509267359,ExpressionUUID->"89a28a7e-6f2d-4d15-bc4b-127ba5c895a2"],

Cell[CellGroupData[{

Cell["The puzzle, and how far this note gets", "Section",ExpressionUUID->"54e35b9a-b27e-47be-9da0-25c25d222d83"],

Cell[TextData[{
 "In 2025 Paradigm published a ",
 StyleBox["Kryptos CTF", "TI"],
 ": ten ciphertexts, PK1 through PK10, styled after Jim Sanborn's Kryptos \
sculpture and telling one continuous first-person story \[LongDash] an \
archivist hunting an impossibly fine needle through the workshop of a \
whitesmith. The panels rise in difficulty; PK1\[Dash]PK7 fell within a day, \
PK8\[Dash]PK10 are still open."
}], "Text",ExpressionUUID->"2b503029-d26e-4eb5-a1ad-3dca1373db54"],

Cell[TextData[{
 "This note is the solved half. The one idea behind all seven readings is \
this: when a cipher is ",
 StyleBox["layered", "TI"],
 ", you peel the outer layer by a ",
 StyleBox["statistic the inner layers cannot disturb",
  FontWeight->"Bold"],
 ", and only then score English. PK1, PK2, PK3, PK5 and PK7 are recovered \
here from ciphertext alone, keyless, with the paclet's ",
 Cell[BoxData[
  TemplateBox[{
    Cell[
     TextData["Search"]], "paclet:WolframInstitute/Puzzles/guide/Search"},
   "RefLinkPlain",
   BaseStyle->{"InlineFormula"}]], "InlineFormula",
  FontFamily->"Source Sans Pro",ExpressionUUID->
  "1a246188-8aba-44e2-bc6d-3f6c4c8e91be"],
 " solvers; PK4 and PK6 are recovered keyless too, by ",
 Cell[BoxData[
  TemplateBox[{
    Cell[
     TextData["QuagmireCompositeSolve"]], 
    "paclet:WolframInstitute/Puzzles/ref/QuagmireCompositeSolve", 
    "WolframInstitute/Puzzles Package Symbol"},
   "PackageLink",
   BaseStyle->"InlineFormula"]], "InlineFormula",
  FontFamily->"Source Sans Pro",ExpressionUUID->
  "3e14a2ca-db3f-49dd-b767-56f48494ed30"],
 ", but that solver sweeps for a minute or two, so this note reads those two \
off from the keys the sweep returns to keep the page fast. The last section \
says where the one idea runs out \[LongDash] which is where PK8\[Dash]PK10 \
begin."
}], "Text",ExpressionUUID->"310d0345-42b7-41ce-be53-fb42c5279d36"],

Cell["\<\
Everything is built on one alphabet. Sanborn's Kryptos keys its tableau with \
the word KRYPTOS, and so does every panel of this CTF:\
\>", "Text",ExpressionUUID->"75e07a65-2068-4f28-93ac-bb0297c1a1b7"],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"KeyedAlphabet", "[", "\"\<KRYPTOS\>\"", "]"}]], "Input",
 CellLabel->"In[1]:=",ExpressionUUID->"58167b2d-a01f-478c-8a92-9846e9fdd820"],

Cell[BoxData["\<\"KRYPTOSABCDEFGHIJLMNQUVWXZ\"\>"], "Output",
 CellLabel->"Out[1]= ",ExpressionUUID->"94a2bd96-1802-4db6-8995-8999b2c161a4"]
}, Open  ]],

Cell["The ten ciphertexts, bound once for the rest of the note:", "Text",ExpressionUUID->"2864afc6-bfef-4dae-a56a-aebb6cefaf98"],

Cell[BoxData[{
 RowBox[{
  RowBox[{
  "pk1", " ", "=", 
   " ", "\"\<\
MQRALWVSJIMSXGJSVWQPHJMDINKXGIMHNKYUTXTTGJCYIABTJUMQEOFBITNBMONGVWETDLAIJPQYMZ\
IKBQVRXZHUIJVDJLTQHIQYHEQKFTPTJYCONAFXYWQIBONAYXGWJFFIQMVXNVQYQFMWKFEJQYZFBWKX\
BKDQLJRELWGWDKHECRSFBKOVQJCPYDNKXYHE\>\""}], ";"}], "\n", 
 RowBox[{
  RowBox[{
  "pk2", " ", "=", 
   " ", "\"\<\
HNETIOCOIOISNNENEELOWYTTLQUBDBTHTEOTRRASAHCDSEETONVRCESHRRETUPCITEWIGNIUNIGANL\
HJRAHMSRUINHERAEEAEAJEEEEKEEDATIIAONIXRNRHCNTLGLOIIUNSEESEGNBANTVTCSFREDIUROTN\
ENHMRIIEROLTLSDAOOAEQIEOAPUHITHAIKHTIEUHGSLAFFSNVRSRHNNSMASTIPIAHAOEEUDESSOEON\
CDHAOTOOEOTSEECLADNHNTOUVSGAGTATSNEWHSATEUEETEURTRNEOGITREHMPPROBEOETOERICETGS\
MTEITENNSGSDRNOVTTFBTTATMLOSOPLSTARATE\>\""}], ";"}], "\n", 
 RowBox[{
  RowBox[{
  "pk3", " ", "=", 
   " ", "\"\<\
HWZTRPPVHZLHRBQBQOMZBACNOTHLYGBATBTKHERQHRVZWWXCTZLRRVZCROHCIOTBVJKCALNKFJHEIM\
KUHJPFNVBCGQYNZMOHGBUTDPTJTDSUBOLYPLSKIEMANXMFNDBCTNRTLLVQOXUBPAXQUVDNXUMCIFOG\
ETZWHJDIWDBWQFXAOMWBBCQXYZFZBTRIQMYOFFMVWSFLPTHFFQUINGLAMSQJOPUESPIQGZZCTJVRLQ\
MIIRROOGBWNPQMXFQDVFTCVGNRIXQKUYYKBRTWPCDHLAWC\>\""}], ";"}], "\n", 
 RowBox[{
  RowBox[{
  "pk4", " ", "=", 
   " ", "\"\<\
YOVISYUAFKUQNRJQLZTAZTMQOUKELJKCYUWIDSPSWRJRUEZNIFPUMUHQFFVBGOBEPWNTZGKVUTOVFS\
ADUJUAYGWKQYOGNKHZVQMEWHSJGJFOBPHXKAPEXPWRJTSPSIJLCSXYTLDFBNZNPUAZNBZPKRFCUZDD\
ZHZULZVPVWCXSIUVSCCFATGSJPNIGCJVTMUPTCGRTOFRXWCYKOMXOJKCECRUCKBDCIYJ\>\""}], 
  ";"}], "\n", 
 RowBox[{
  RowBox[{
  "pk5", " ", "=", 
   " ", "\"\<\
IJQUVJJINKWMJBNJHKZZMTVTUBFHXZJIUHOVONZNXKFUALEMYWTNNNILTRNVSXIXIQCLOSFZVZGTHQ\
KZFJJHJMJTSEPAMKNMTGPVFWSWSBSIHOJWNFXDIJPJNOVBWWXJYUVVAFTIDZISJNCIGHXKLNFEQRDV\
YIXUXQIZFNXAKYXIUEVGRBMHWRFDZSMMDPMKIZNUQUJNXVZTGHCNAUVIYZCLRAVMJKAOIBOPZTJUPA\
CSTFFLERTGBFFNCYTAVIRXXYOXHCDWHWWKAMQO\>\""}], ";"}], "\n", 
 RowBox[{
  RowBox[{
  "pk6", " ", "=", 
   " ", "\"\<\
BXFIVOAJFNMLKEVEHDFJQCMVLMGNVOHCJNBOAEVRRWIJFMCWMNOOMMOSRNKYOCFRYWKHBNMYCYHDEC\
QCFNTOXNOBKBHWBOMNHFIIZDBJRNXBABFRCBLIIBLDCINOHNLXSBKVMSBNVOFVNBFYDJEVUGMNOBML\
CQACBLGNABEBCJXBEYUIBDTFOSOULYCQHBXUHSEYMCBJIIHWDCFSEVLDMMUOVFADHUMKXCGUCQIRGB\
CEIJFYIXOEJYHDJHMXTDIEXNDAFBMOJMYAEYBVYNFSCXBWNYOVFDXDHWFCERDEBWZUKDIJTUGCJMMV\
QII\>\""}], ";"}], "\n", 
 RowBox[{
  RowBox[{
  "pk7", " ", "=", 
   " ", "\"\<\
FNRHTKRHSEDEJMBOWBDSCSDDXLICXULMBYQXWTGUIVNDYZBEQLVHFFFIDAKDCCJKWGOOUESCYELYMR\
AKIUJCUSEAXUQTYKOBVYDYMRBYWOTQEESCQSMDYDQJNPSWRSUOFMFJDYXSHCXNHVJVBYMZOZOATHTE\
OVLOQWZITHTEAFMKGLASTBZRDMFRJPKWJOXZXPJCBOVAZEPKAEJPPSIUJODXTXERWTLTTYMRENBJGT\
NMLBDJMYJDDLRCXCQCHYMJMHBEOLXEUFNJKBPRSHTEYXB\>\""}], ";"}]}], "Input",
 CellLabel->"In[2]:=",ExpressionUUID->"4ed319a7-bc65-446f-8267-57456b8aa537"],

Cell["\<\
One keyed alphabet and one Quagmire-decrypt helper, used from here on:\
\>", "Text",ExpressionUUID->"461a6ce7-57e8-44a2-a22c-cc2803619985"],

Cell[BoxData[{
 RowBox[{
  RowBox[{"ka", " ", "=", " ", 
   RowBox[{"KeyedAlphabet", "[", "\"\<KRYPTOS\>\"", "]"}]}], ";"}], "\n", 
 RowBox[{
  RowBox[{
   RowBox[{"q", "[", 
    RowBox[{"t_", ",", " ", "cw_"}], "]"}], " ", ":=", " ", 
   RowBox[{"VigenereCipher", "[", 
    RowBox[{"t", ",", " ", "cw", ",", " ", "\"\<Decrypt\>\"", ",", " ", 
     RowBox[{"\"\<PlaintextAlphabet\>\"", " ", "->", " ", "ka"}], ",", " ", 
     RowBox[{"\"\<CiphertextAlphabet\>\"", " ", "->", " ", "ka"}]}], "]"}]}], 
  ";"}]}], "Input",
 CellLabel->"In[3]:=",ExpressionUUID->"99f4d047-28fb-4219-bcf4-13587b9bcb56"]
}, Open  ]],

Cell[CellGroupData[{

Cell["PK1 \[LongDash] a single Quagmire III", "Section",ExpressionUUID->"00322d5c-5d05-41ab-b677-d299a950aafb"],

Cell[TextData[{
 "The opening panel is a plain Quagmire III: a Vigenere run over the \
KRYPTOS-keyed alphabet on both sides, exactly the arrangement of Kryptos K1 \
and K2. ",
 Cell[BoxData[
  TemplateBox[{
    Cell[
     TextData["VigenereSolve"]], 
    "paclet:WolframInstitute/Puzzles/ref/VigenereSolve", 
    "WolframInstitute/Puzzles Package Symbol"},
   "PackageLink",
   BaseStyle->"InlineFormula"]], "InlineFormula",
  FontFamily->"Source Sans Pro",ExpressionUUID->
  "c86813ad-0a7d-4510-8c6c-1c4356d5d6dd"],
 " recovers it with no key \[LongDash] told only that both alphabets are \
KRYPTOS, it fits every column's shift by chi-square, reads off the period 10, \
and returns the plaintext (the keyword is PROVENANCE, and the story begins):"
}], "Text",ExpressionUUID->"e5fa79dc-2925-4b26-a546-4725133f5335"],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{
  RowBox[{"VigenereSolve", "[", 
   RowBox[{"pk1", ",", " ", 
    RowBox[{"\"\<PlaintextAlphabet\>\"", " ", "->", " ", "\"\<KRYPTOS\>\""}], 
    ",", " ", 
    RowBox[{"\"\<CiphertextAlphabet\>\"", " ", "->", 
     " ", "\"\<KRYPTOS\>\""}]}], "]"}], "[", "\"\<Plaintext\>\"", 
  "]"}]], "Input",
 CellLabel->"In[4]:=",ExpressionUUID->"8883f527-d12b-4b92-a79e-01ea9cdd1efe"],

Cell[BoxData["\<\"\
INVESTIGATIONLOGITEMEIGHTKNOTTIGHTLYWOUNDITSTHREADINSCRIBEDWITHLETTERSTHEACCES\
SIONLOGSAYSONCEUNRAVELEDITREVEALSTHEROUTETOTHELOSTARCHIVEOFPELLEGRINTWELVEPRIO\
RARCHIVISTSTRIEDTOUNRAVELITALLFAILED\"\>"], "Output",
 CellLabel->"Out[4]= ",ExpressionUUID->"9dbe5a83-cab9-4869-a12c-c277f9d8b83c"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["PK2 \[LongDash] a columnar transposition", "Section",ExpressionUUID->"baec9287-9869-4ee9-81dd-f23fec467501"],

Cell[TextData[{
 "PK2 does not touch the letters at all, it only reorders them, so its ",
 Cell[BoxData[
  TemplateBox[{
    Cell[
     TextData["index of coincidence"]], 
    "paclet:WolframInstitute/Puzzles/ref/IndexOfCoincidence", 
    "WolframInstitute/Puzzles Package Symbol"},
   "PackageLink",
   BaseStyle->"InlineFormula"]], "InlineFormula",
  FontFamily->"Source Sans Pro",ExpressionUUID->
  "d51ad8f8-db87-43f6-90e5-bf0a9b5dbca3"],
 " is already that of plain English. ",
 Cell[BoxData[
  TemplateBox[{
    Cell[
     TextData["ColumnarTranspositionSolve"]], 
    "paclet:WolframInstitute/Puzzles/ref/ColumnarTranspositionSolve", 
    "WolframInstitute/Puzzles Package Symbol"},
   "PackageLink",
   BaseStyle->"InlineFormula"]], "InlineFormula",
  FontFamily->"Source Sans Pro",ExpressionUUID->
  "3783716c-ee4b-4ce3-8a7f-43d4188dbc13"],
 " scores every column order by English fitness and returns the read-out \
order together with the recovered chapter:"
}], "Text",ExpressionUUID->"059f0d0f-3e29-4d96-ab72-ceb068c1fcbc"],

Cell[CellGroupData[{

Cell[BoxData[{
 RowBox[{
  RowBox[{"sol2", " ", "=", " ", 
   RowBox[{"ColumnarTranspositionSolve", "[", 
    RowBox[{"pk2", ",", " ", 
     RowBox[{"\"\<MaxColumns\>\"", " ", "->", " ", "7"}]}], "]"}]}], ";"}], "\n", 
 RowBox[{"{", 
  RowBox[{
   RowBox[{"sol2", "[", "\"\<Order\>\"", "]"}], ",", " ", 
   RowBox[{"sol2", "[", "\"\<Plaintext\>\"", "]"}]}], "}"}]}], "Input",
 CellLabel->"In[5]:=",ExpressionUUID->"c1934ef3-1ab6-41c3-b19e-24aeee86b931"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
   RowBox[{"{", 
    RowBox[{"2", ",", "4", ",", "5", ",", "1", ",", "6", ",", "3", ",", "7"}],
     "}"}], ",", \
"\<\"IHAVEFOUNDREFERENCESTOTHEKNOTINSEVENOTHERRECORDSINOURARCHIVETHEMOSTINTRIG\
UINGISAPASSINGCOMMENTINATREATISEONTEXTILESWRITTENINPELLEGRINSOWNHANDWHICHSAYSU\
NAGOTANTOSOTTILEDALEGGEREQUALUNQUENODOIBELIEVEDTHISTOBEJUSTATURNOFPHRASEBUTTHE\
OTHERMENTIONSSCATTEREDTHROUGHMARGINALIAINBOOKSTHATSHARENOOTHERTOPICHAVELEDMETO\
SUSPECTTHEPASSAGEREFERSTOAREALOBJECTANEEDLE\"\>"}], "}"}]], "Output",
 CellLabel->"Out[5]= ",ExpressionUUID->"397134cb-1037-4acc-8bfb-c2667a4b0c88"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["PK3 \[LongDash] a double Quagmire", "Section",ExpressionUUID->"2c63e43c-9ed5-4121-986e-0239c6e1c2b6"],

Cell[TextData[{
 "PK3 stacks two Quagmires, and their two keywords combine into one long \
effective period. ",
 Cell[BoxData["VigenereSolve"], "InlineFormula",
  FontFamily->"Source Sans Pro",
  FontSize->0.9 Inherited,ExpressionUUID->
  "5a089b68-05f5-4977-9ad1-27386e8b4e70"],
 " handles this by decomposing a long composite period into a sum of two \
shorter cyclewords \[LongDash] the same ",
 Cell[BoxData["\<\"Polish\"\>"], "InlineFormula",
  FontFamily->"Source Sans Pro",
  FontSize->0.9 Inherited,ExpressionUUID->
  "e6907593-5f6a-446a-ad38-63b03b7cf3d6"],
 " step that reads Kryptos-style double Quagmires \[LongDash] so the \
period-40 panel still falls with no key:"
}], "Text",ExpressionUUID->"d41616d5-4b92-4963-8a4b-3e060eac2f89"],

Cell[CellGroupData[{

Cell[BoxData[{
 RowBox[{
  RowBox[{"sol3", " ", "=", " ", 
   RowBox[{"VigenereSolve", "[", 
    RowBox[{"pk3", ",", " ", 
     RowBox[{"\"\<PlaintextAlphabet\>\"", " ", "->", " ", "\"\<KRYPTOS\>\""}],
      ",", " ", 
     RowBox[{"\"\<CiphertextAlphabet\>\"", " ", "->", 
      " ", "\"\<KRYPTOS\>\""}]}], "]"}]}], ";"}], "\n", 
 RowBox[{"{", 
  RowBox[{
   RowBox[{"sol3", "[", "\"\<Period\>\"", "]"}], ",", " ", 
   RowBox[{"sol3", "[", "\"\<Plaintext\>\"", "]"}]}], "}"}]}], "Input",
 CellLabel->"In[6]:=",ExpressionUUID->"0a807d3e-8d86-49af-926e-d96bdd1327dc"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
  "40", ",", \
"\<\"SEVENTHMONTHIWROTETOFIFTEENCORRESPONDENTSINSIXCOUNTRIESSEEKINGANYWORDOFTH\
EITEMMOSTKNEWNOTHINGAFEWHADHEARDLEGENDSOFANEEDLEFINEENOUGHTOSPLITAHAIRORPIERCE\
GLASSATLASTAVIENNESEANATOMISTSAIDHESAWSUCHANINSTRUMENTUSEDATASURGICALDEMONSTRA\
TIONINBERNIWROTETOHISADDRESSNOANSWERCAMEIWROTEAGAIN\"\>"}], "}"}]], "Output",
 CellLabel->"Out[6]= ",ExpressionUUID->"453748ee-6fb6-4978-b1f9-7e9b89e236ff"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
PK4 and PK6 \[LongDash] transposition under a double Quagmire, and the peel\
\>", "Section",ExpressionUUID->"3950222a-4a87-4b97-8821-7a6b1202d6c6"],

Cell[TextData[{
 "PK4 and PK6 are the first true composites: a columnar transposition sits ",
 StyleBox["beneath", "TI"],
 " a double Quagmire. Solving them from scratch needs the idea that runs \
through the whole CTF. A transposition only permutes letters, so it leaves \
each Quagmire column's letter histogram \[LongDash] and hence the index of \
coincidence \[LongDash] untouched. That makes the outer substitution peelable \
on its own: hill-climb the double Quagmire to flatten the unigram statistics \
a transposition cannot see, and what falls out is ",
 Cell[BoxData[
  RowBox[{"columnar", 
   RowBox[{"(", "plaintext", ")"}]}]], "InlineFormula",
  FontFamily->"Source Sans Pro",
  FontSize->0.9 Inherited,ExpressionUUID->
  "e360a69f-f76c-47c8-a4ab-a7ba54e8a92c"],
 ", whose column order is then brute-forced on quadgrams. ",
 Cell[BoxData[
  TemplateBox[{
    Cell[
     TextData["QuagmireCompositeSolve"]], 
    "paclet:WolframInstitute/Puzzles/ref/QuagmireCompositeSolve", 
    "WolframInstitute/Puzzles Package Symbol"},
   "PackageLink",
   BaseStyle->"InlineFormula"]], "InlineFormula",
  FontFamily->"Source Sans Pro",ExpressionUUID->
  "db6b48ef-6ed7-4b41-b209-af63a578ed53"],
 " is exactly this peel, keyless: ",
 Cell[BoxData[
  RowBox[{"QuagmireCompositeSolve", "[", "pk4", "]"}]], "InlineFormula",
  FontFamily->"Source Sans Pro",
  FontSize->0.9 Inherited,ExpressionUUID->
  "1d3ad293-0e57-45e8-b008-ef6e536e621f"],
 " returns the periods ",
 Cell[BoxData[
  RowBox[{"{", 
   RowBox[{"5", ",", " ", "9"}], "}"}]], "InlineFormula",
  FontFamily->"Source Sans Pro",
  FontSize->0.9 Inherited,ExpressionUUID->
  "048c8c64-e0cb-4546-b948-b4d12d1e2232"],
 ", width ",
 Cell[BoxData["8"], "InlineFormula",
  FontFamily->"Source Sans Pro",
  FontSize->0.9 Inherited,ExpressionUUID->
  "b7c7b181-b85d-47d2-a63f-fda226fe893e"],
 " and the plaintext, and the same call reads PK6. It runs through the \
LibraryLink C accelerator and sweeps for a minute or two, so here is PK4 read \
off directly from the cycleword and column order the peel recovers \
\[LongDash] its plaintext becomes the chained key for PK5, so bind it:"
}], "Text",ExpressionUUID->"c6819df6-7eee-4493-918c-047e58e64fe8"],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"pk4pt", " ", "=", " ", 
  RowBox[{"ColumnarTransposition", "[", "\n", "   ", 
   RowBox[{
    RowBox[{"q", "[", 
     RowBox[{
     "pk4", ",", 
      " ", "\"\<RQIEKMDPAAJDXJXSXQWVSNPHFQIDFFIXRYKEOZYUQVIJL\>\""}], "]"}], ",",
     "\n", "   ", 
    RowBox[{"{", 
     RowBox[{
     "6", ",", " ", "2", ",", " ", "3", ",", " ", "5", ",", " ", "1", ",", 
      " ", "4", ",", " ", "0", ",", " ", "7"}], "}"}], ",", 
    " ", "\"\<Decrypt\>\""}], "]"}]}]], "Input",
 CellLabel->"In[7]:=",ExpressionUUID->"f280a488-f026-4454-b0c3-0d50ef36442e"],

Cell[BoxData["\<\"\
TWOYEARSINTHENEEDLESTRAILLEDMETOACRAFTSMANNAMEDTHEWHITESMITHONTHEROADTOHISALPI\
NEWORKSHOPIREREADHISPERFUNCTORYLETTERSHEMETMEATTHEGATESANDLEDMETOASTONEBARNSTA\
CKEDWITHWINTERFODDERONEOFHISNEEDLESISHIDDENINTHEBARNIHAVEBEGUNTOWORK\"\>"], \
"Output",
 CellLabel->"Out[7]= ",ExpressionUUID->"e1e4c521-cb08-4fb2-80d8-20d663dc90b2"]
}, Open  ]],

Cell[TextData[{
 "PK6 is the same shape with a ",
 StyleBox["double", "TI"],
 " columnar read bottom-to-top, under a period-6 Quagmire keyed PORTAL \
\[LongDash] the whitesmith's workshop:"
}], "Text",ExpressionUUID->"676066ff-c208-4c78-9d62-12d620bd4597"],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"ColumnarTransposition", "[", "\n", "  ", 
  RowBox[{
   RowBox[{"ColumnarTransposition", "[", 
    RowBox[{
     RowBox[{"q", "[", 
      RowBox[{"pk6", ",", " ", "\"\<PORTAL\>\""}], "]"}], ",", " ", 
     RowBox[{"{", 
      RowBox[{
      "4", ",", " ", "6", ",", " ", "0", ",", " ", "7", ",", " ", "2", ",", 
       " ", "1", ",", " ", "8", ",", " ", "5", ",", " ", "3"}], "}"}], ",", 
     " ", "\"\<Decrypt\>\"", ",", " ", 
     RowBox[{"\"\<Direction\>\"", " ", "->", " ", "\"\<BottomToTop\>\""}]}], 
    "]"}], ",", "\n", "  ", 
   RowBox[{"{", 
    RowBox[{
    "5", ",", " ", "7", ",", " ", "6", ",", " ", "2", ",", " ", "8", ",", " ",
      "4", ",", " ", "0", ",", " ", "3", ",", " ", "1"}], "}"}], ",", 
   " ", "\"\<Decrypt\>\"", ",", " ", 
   RowBox[{"\"\<Direction\>\"", " ", "->", " ", "\"\<BottomToTop\>\""}]}], 
  "]"}]], "Input",
 CellLabel->"In[8]:=",ExpressionUUID->"b9075c9d-9176-43bb-b7b7-46dfab4210ae"],

Cell[BoxData["\<\"\
THEWHITESMITHSWORKSHOPISFILLEDWITHTHEOLDTOOLSOFHISTRADEMYEYESAREDRAWNTOTHEGUTT\
ERALONGTHEWALLWHICHISSTREWNWITHEXQUISITENEEDLESTHEWHITESMITHSAYSHEMAKESONEEVER\
YDAYANDLOSTCOUNTLONGAGOIASKWHATHEDOESWITHTHEMANDHESAYSTHEYAREONLYTHERESIDUEOFH\
ISPRACTICEHETELLSMETHATIFISTUDYUNDERHIMFORTENYEARSHEWILLLETMETAKEONEOFMYOWNMAK\
ING\"\>"], "Output",
 CellLabel->"Out[8]= ",ExpressionUUID->"b548f181-9ec9-44d3-b385-a4037753f7b3"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["PK5 \[LongDash] the chain", "Section",ExpressionUUID->"3ff861ad-cd4a-433a-9e5f-99a07a55a8b7"],

Cell[TextData[{
 "PK5 looks, at first, unsolvable. It is aperiodic \[LongDash] no column \
structure at any short period \[LongDash] its index of coincidence sits \
almost at the random floor, and every classical solver returns salad. The \
trick is that its Quagmire key is not a short keyword at all: it is the ",
 StyleBox["entire 224-letter plaintext of PK4",
  FontWeight->"Bold"],
 " bound above. Each chapter enciphers the next."
}], "Text",ExpressionUUID->"ebf47c5e-1a87-4453-aa80-8e26e92fd84f"],

Cell[TextData[{
 "That breaks two habits at once. A 224-long key hides from any period scan \
that stops short of the message length; and once you ",
 StyleBox["do", "TI"],
 " try PK4's plaintext as the key, undoing the Quagmire leaves the text still \
transposed, so it scores as quadgram gibberish even though the key is right. \
The tell is the statistic the transposition cannot move \[LongDash] the index \
of coincidence jumps from the random floor to English the instant the key is \
correct:"
}], "Text",ExpressionUUID->"c7e700fa-99aa-4bb0-b343-f57acdf537df"],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{
  RowBox[{"IndexOfCoincidence", "[", "pk5", "]"}], " ", "<", " ", "0.05", " ",
   "<", " ", 
  RowBox[{"IndexOfCoincidence", "[", 
   RowBox[{"q", "[", 
    RowBox[{"pk5", ",", " ", "pk4pt"}], "]"}], "]"}]}]], "Input",
 CellLabel->"In[9]:=",ExpressionUUID->"69c7213b-089d-4d70-8a5e-6123bd52b2dc"],

Cell[BoxData["True"], "Output",
 CellLabel->"Out[9]= ",ExpressionUUID->"6956c577-713d-40fe-9f27-20cf87eb185b"]
}, Open  ]],

Cell[TextData[{
 "With the substitution peeled by the chained key, the residue is just ",
 Cell[BoxData[
  RowBox[{"columnar", 
   RowBox[{"(", "plaintext", ")"}]}]], "InlineFormula",
  FontFamily->"Source Sans Pro",
  FontSize->0.9 Inherited,ExpressionUUID->
  "3dfa3f3b-6d45-449a-b651-289e58c76fb9"],
 " and ",
 Cell[BoxData["ColumnarTranspositionSolve"], "InlineFormula",
  FontFamily->"Source Sans Pro",
  FontSize->0.9 Inherited,ExpressionUUID->
  "c101aacf-7420-4c93-bd67-1693d556485b"],
 " finishes the job with no further key:"
}], "Text",ExpressionUUID->"1060e2e2-4c67-4265-93a7-480bcf61c7b8"],

Cell[CellGroupData[{

Cell[BoxData[{
 RowBox[{
  RowBox[{"sol5", " ", "=", " ", 
   RowBox[{"ColumnarTranspositionSolve", "[", 
    RowBox[{
     RowBox[{"q", "[", 
      RowBox[{"pk5", ",", " ", "pk4pt"}], "]"}], ",", " ", 
     RowBox[{"\"\<MaxColumns\>\"", " ", "->", " ", "8"}]}], "]"}]}], ";"}], "\n", 
 RowBox[{"{", 
  RowBox[{
   RowBox[{"sol5", "[", "\"\<Columns\>\"", "]"}], ",", " ", 
   RowBox[{"sol5", "[", "\"\<Order\>\"", "]"}], ",", " ", 
   RowBox[{"sol5", "[", "\"\<Plaintext\>\"", "]"}]}], "}"}]}], "Input",
 CellLabel->"In[10]:=",ExpressionUUID->"b2b5e540-4995-407c-99af-4009e3dc1881"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"8", ",", 
   RowBox[{"{", 
    RowBox[{
    "6", ",", "5", ",", "3", ",", "7", ",", "8", ",", "1", ",", "2", ",", 
     "4"}], "}"}], 
   ",", "\<\"\
FOURTEENDAYSINTHEBARNIWORKEDINTHEMANNEROFANARCHIVISTLIFTINGEACHBALEONTOACLOTHA\
NDEXAMININGTHESTRAWSINROWSTHEWHITESMITHBROUGHTFOODANDWATERBUTNOCOUNSELTHISMORN\
INGIFELTTHENEEDLEPRICKMYFINGERSOFINETHATITDREWNOBLOODICARRIEDITTOTHEWHITESMITH\
ANDHETOOKITFROMMEANDOPENEDTHEINNERDOOR\"\>"}], "}"}]], "Output",
 CellLabel->
  "Out[10]= ",ExpressionUUID->"83acf14e-c415-4691-a56f-379852162887"]
}, Open  ]]
}, Open  ]],

Cell[CellGroupData[{

Cell["PK7 \[LongDash] Hill over Quagmire, and the dual peel", "Section",ExpressionUUID->"9006ebf3-aea4-4051-882e-18141d365c6f"],

Cell[TextData[{
 "PK7's inner layer is not a transposition but a 3x3 ",
 Cell[BoxData[
  TemplateBox[{
    Cell[
     TextData["Hill cipher"]], 
    "paclet:WolframInstitute/Puzzles/ref/HillCipher", 
    "WolframInstitute/Puzzles Package Symbol"},
   "PackageLink",
   BaseStyle->"InlineFormula"]], "InlineFormula",
  FontFamily->"Source Sans Pro",ExpressionUUID->
  "1f7b2248-0cdf-448d-8f6d-af68b75fd56e"],
 ", sitting under a period-6 Quagmire. Here the PK4-style peel fails: a Hill \
layer ",
 StyleBox["does", "TI"],
 " flatten the histogram, so index of coincidence gives no purchase on the \
outer Quagmire. But the mirror image works. A Hill layer destroys the inner \
Quagmire's ",
 StyleBox["periodicity", "TI"],
 ", so undoing the correct Hill matrix is exactly what ",
 StyleBox["restores",
  FontWeight->"Bold"],
 " it. ",
 Cell[BoxData[
  TemplateBox[{
    Cell[
     TextData["HillQuagmireSolve"]], 
    "paclet:WolframInstitute/Puzzles/ref/HillQuagmireSolve", 
    "WolframInstitute/Puzzles Package Symbol"},
   "PackageLink",
   BaseStyle->"InlineFormula"]], "InlineFormula",
  FontFamily->"Source Sans Pro",ExpressionUUID->
  "374fb547-c073-414a-92ee-fd22b1f7f20e"],
 " ranks keyword-built Hill matrices by whether their residue becomes \
periodic \[LongDash] the true keyword ALCHEMIST sends the period-6 column IC \
to 0.069 while every other nine-letter word stays near 0.05 \[LongDash] then \
hands the periodic residue to ",
 Cell[BoxData[
  TemplateBox[{
    Cell[
     TextData["QuagmireSolve"]], 
    "paclet:WolframInstitute/Puzzles/ref/QuagmireSolve", 
    "WolframInstitute/Puzzles Package Symbol"},
   "PackageLink",
   BaseStyle->"InlineFormula"]], "InlineFormula",
  FontFamily->"Source Sans Pro",ExpressionUUID->
  "608b724b-377f-4f96-ae0f-9d04f0cb43ba"],
 ":"
}], "Text",ExpressionUUID->"59875503-0eaa-486a-96b8-abd698c2c5c8"],

Cell[CellGroupData[{

Cell[BoxData[{
 RowBox[{
  RowBox[{"sol7", " ", "=", " ", 
   RowBox[{"HillQuagmireSolve", "[", 
    RowBox[{"pk7", ",", " ", 
     RowBox[{"\"\<Keywords\>\"", " ", "->", " ", 
      RowBox[{"{", 
       RowBox[{"\"\<ALCHEMIST\>\"", ",", " ", "\"\<GESTATION\>\"", ",", 
        " ", "\"\<BENEFITED\>\"", ",", " ", "\"\<CROSSROAD\>\""}], "}"}]}]}], 
    "]"}]}], ";"}], "\n", 
 RowBox[{"{", 
  RowBox[{
   RowBox[{"sol7", "[", "\"\<HillKeyword\>\"", "]"}], ",", " ", 
   RowBox[{"sol7", "[", "\"\<Period\>\"", "]"}], ",", " ", 
   RowBox[{"sol7", "[", "\"\<Plaintext\>\"", "]"}]}], "}"}]}], "Input",
 CellLabel->"In[11]:=",ExpressionUUID->"a34795cf-499c-42be-be96-6677cea27727"],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"\<\"ALCHEMIST\"\>", ",", "6", 
   ",", "\<\"\
THREEWEEKSINWERISEBEFORETHESUNANDEACHNEEDLEISDONEBYNOONTHEWHITESMITHSHOWSMEHIS\
TECHNIQUEFORPURIFYINGHISMETALBEFOREDRAWINGITINTOAFINEWIREHEHASMEREPEATTHESAMES\
TEPFOURTIMESWITHSLIGHTVARIATIONSSTILLMYHANDFALTERSIAMPATIENTBUTIKNOWTHISISNOTM\
YCALLINGIHAVEMADEPEACEWITHITANDWILLGOHOMESOON\"\>"}], "}"}]], "Output",
 CellLabel->
  "Out[11]= ",ExpressionUUID->"d02d08b4-2670-42e9-8d7b-e677034c5653"]
}, Open  ]],

Cell[TextData[{
 "Left to its default ",
 Cell[BoxData[
  RowBox[{"\<\"Keywords\"\>", " ", "->", " ", "Automatic"}]], "InlineFormula",
  
  FontFamily->"Source Sans Pro",
  FontSize->0.9 Inherited,ExpressionUUID->
  "0ee8eee2-8d68-4032-9004-7cfa6540b389"],
 ", it sweeps every nine-letter word of ",
 Cell[BoxData[
  RowBox[{"WordList", "[", "]"}]], "InlineFormula",
  FontFamily->"Source Sans Pro",
  FontSize->0.9 Inherited,ExpressionUUID->
  "6a65ee00-541a-47e9-81c9-d7ef74380d5d"],
 " and finds ALCHEMIST on its own; the short candidate list above just keeps \
this example quick."
}], "Text",ExpressionUUID->"4f8f39d0-543b-4313-bf5f-4d8548185b00"]
}, Open  ]],

Cell[CellGroupData[{

Cell["The one idea, and where it stops", "Section",ExpressionUUID->"01a04025-9397-4b01-ba92-d9d4760d930c"],

Cell[TextData[{
 "Every panel above is the same move: identify the layer whose inverse is ",
 StyleBox["forced", "TI"],
 " by a statistic the other layers cannot touch, peel it, and repeat."
}], "Text",ExpressionUUID->"feb0c12f-00ea-4ff6-bfe3-d3aa7faf3ea1"],

Cell[BoxData[GridBox[{
   {Cell["      ", "TableRowIcon",ExpressionUUID->
     "d3e9a4ef-bcc2-4b6f-ac11-4064db1da29e"], Cell["Panel", "TableText",
     FontWeight->Bold,ExpressionUUID->"47f434c4-c3c8-4efd-900e-80c1b3c80e23"],
     Cell["Construction", "TableText",
     FontWeight->Bold,ExpressionUUID->"8cb139c4-0510-4fd1-bcee-4ed65b1a3a7c"],
     Cell["Peel by", "TableText",
     FontWeight->Bold,ExpressionUUID->"22bcd930-0a75-4e79-87d9-86e42c41fd17"]},
   {Cell["      ", "TableRowIcon",ExpressionUUID->
     "e3eb3f1b-928a-4758-b246-cf20e2e38ba0"], Cell[
    "PK1", "TableText",ExpressionUUID->
     "ad6551f3-e00b-4f07-83f0-25cda0471e0a"], Cell[
    "Quagmire III", "TableText",ExpressionUUID->
     "38772832-c548-455b-85d3-eb6bebbb86ab"], Cell[
    "per-column chi-square", "TableText",ExpressionUUID->
     "c9db2f50-5365-4f3b-94c7-cdea5cc75d7f"]},
   {Cell["      ", "TableRowIcon",ExpressionUUID->
     "be247ea7-3bf3-44a1-8618-32e68a5718a5"], Cell[
    "PK2", "TableText",ExpressionUUID->
     "8cca645c-4dd8-484b-80c1-030e18bc212c"], Cell[
    "columnar transposition", "TableText",ExpressionUUID->
     "d27e8448-88a4-421e-9aa9-1333a4b76751"], Cell[
    "English quadgrams", "TableText",ExpressionUUID->
     "5d8a23ac-4048-499b-9e86-f9e9245b0734"]},
   {Cell["      ", "TableRowIcon",ExpressionUUID->
     "585f8c21-17ff-45a8-8ceb-fb94bb65cdab"], Cell[
    "PK3", "TableText",ExpressionUUID->
     "6aa93e7c-cf00-48c6-98d8-8cb9756ee22d"], Cell[
    "double Quagmire", "TableText",ExpressionUUID->
     "ec5db766-5920-4673-9047-8872d1ffc775"], Cell[
    "period decomposition", "TableText",ExpressionUUID->
     "2efe2892-b445-4898-826e-574afeaf5cfe"]},
   {Cell["      ", "TableRowIcon",ExpressionUUID->
     "cbaf8043-2fe1-40b0-b933-a11629a6f8d8"], Cell[
    "PK4, PK6", "TableText",ExpressionUUID->
     "7bfcdc93-da8f-47f2-8a60-36732399e55e"], Cell[
    "columnar under double Quagmire", "TableText",ExpressionUUID->
     "00766de7-7438-4afe-bdc3-95e357c9c5af"], Cell[
    "index of coincidence (transposition-invariant)", "TableText",
     ExpressionUUID->"295db11d-d76b-4f17-9545-7ec9f1e2400e"]},
   {Cell["      ", "TableRowIcon",ExpressionUUID->
     "432468fe-9c87-40e0-b80b-72b4d79ea164"], Cell[
    "PK5", "TableText",ExpressionUUID->
     "6c84b86d-1546-499c-8d85-5a1bfcf998eb"], Cell[
    "columnar under Quagmire keyed by PK4's plaintext", "TableText",
     ExpressionUUID->"ae0e97a0-2d83-4b23-99bb-f205f4cff2c3"], Cell[
    "index of coincidence, key = the previous chapter", "TableText",
     ExpressionUUID->"f42b4bb7-6ba7-4d25-bb69-c3fb96ba64b7"]},
   {Cell["      ", "TableRowIcon",ExpressionUUID->
     "339c69e7-e875-429f-b585-2a3a722add58"], Cell[
    "PK7", "TableText",ExpressionUUID->
     "dee5e141-f294-4cb7-9318-e6711b6a3633"], Cell[
    "Quagmire under a 3x3 Hill", "TableText",ExpressionUUID->
     "6b04e91e-800d-40b5-ab35-33faaaa3015f"], Cell[
    "restored periodicity", "TableText",ExpressionUUID->
     "94ec69a7-3a00-4dbc-a02e-e0bfbdf2bc07"]}
  }]], "3ColumnTableMod",
 GridBoxOptions->{
 GridBoxBackground->{
  "Columns" -> {{None}}, 
   "Rows" -> {None, None, None, None, None, None, {None}}},
 GridBoxDividers->{
  "Rows" -> {{
     True, True, True, True, True, True, True, 
      True}}}},ExpressionUUID->"11461423-8cf6-4778-b550-f2dfcae53cf1"],

Cell[TextData[{
 "PK8, PK9 and PK10 remain open, and they are open because this idea meets \
its edge. PK8 and PK9 carry a real, control-confirmed period-7 signal (a \
proper joint index-of-coincidence maximisation spikes at period 7 with a \
z-score near 4\[Dash]5, where the solved panels show nothing), but their \
period-7 columns are ",
 StyleBox["sub", "TI"],
 "-monoalphabetic \[LongDash] flatter than a plain substitution \[LongDash] \
so peeling the period leaves a residue that is not English under the KRYPTOS \
alphabet, and at 150 letters that joint unknown is underdetermined. PK10 \
shows no period at all, the signature of a long chained key like PK5's, \
waiting on a plaintext not yet in hand. The tools that read PK1\[Dash]PK7 are \
the right tools for the rest; what is missing is one more invariant to peel \
by."
}], "Text",ExpressionUUID->"374ac8b9-de0e-4d9c-9c88-f6c8e8c0a314"]
}, Open  ]],

Cell[BoxData[GridBox[{
   {
    DynamicBox[FEPrivate`ImportImage[
      FrontEnd`FileName[{"Documentation", "FooterIcons"}, "RelatedGuide.png"]],
     ImageSizeCache->{50., {26.47265625, 33.52734375}}], GridBox[{
      {
       StyleBox[
        RowBox[{"Related", " ", "Guides"}], "TutorialMoreAboutSection"]},
      {
       RowBox[{"\[FilledVerySmallSquare]", Cell[TextData[{
         Cell[BoxData[
          TemplateBox[{
            Cell[
             TextData["Search"]], 
            "paclet:WolframInstitute/Puzzles/guide/Search"},
           "RefLinkPlain",
           BaseStyle->{"InlineFormula"}]], "InlineFormula",
          FontFamily->"Source Sans Pro",ExpressionUUID->
          "a9504b1f-8ffd-44d9-b009-a27d9c7a237c"],
         " \[FilledVerySmallSquare] ",
         Cell[BoxData[
          TemplateBox[{
            Cell[
             TextData["Encodings"]], 
            "paclet:WolframInstitute/Puzzles/guide/Encodings"},
           "RefLinkPlain",
           BaseStyle->{"InlineFormula"}]], "InlineFormula",
          FontFamily->"Source Sans Pro",ExpressionUUID->
          "f9e1da52-79b9-4da2-82f2-d3aa49496c40"]
        }], "TutorialMoreAbout",ExpressionUUID->
         "670f2e30-92d6-424d-8f3b-7e1803e81aca"]}]}
     }]}
  }]], "TutorialMoreAboutSection",ExpressionUUID->"3d4e8a2a-70ba-404a-8536-\
119dacdc3e03"],

Cell[BoxData[GridBox[{
   {
    DynamicBox[FEPrivate`ImportImage[
      FrontEnd`FileName[{"Documentation", "FooterIcons"}, 
       "RelatedTutorial.png"]],
     ImageSizeCache->{50., {26.47265625, 33.52734375}}], GridBox[{
      {
       StyleBox[
        RowBox[{"Related", " ", "Tech", " ", "Notes"}], 
        "RelatedTutorialsSection"]},
      {
       RowBox[{"\[FilledVerySmallSquare]", Cell[TextData[Cell[BoxData[
         TemplateBox[{
           Cell[
            TextData["CrackingTheBitcoinMovieEnigma"]], 
           "paclet:WolframInstitute/Puzzles/tutorial/\
CrackingTheBitcoinMovieEnigma"},
          "RefLinkPlain",
          BaseStyle->{"InlineFormula"}]], "InlineFormula",
         FontFamily->"Source Sans Pro",ExpressionUUID->
         "308aa3e5-3ac0-4336-95f4-faf99ec7cf45"]], "RelatedTutorials",
         ExpressionUUID->"a9acb8de-669e-4f1d-bd13-8e79a791e4a2"]}]}
     }]}
  }]], "RelatedTutorialsSection",ExpressionUUID->"b5bcb2d4-948b-4484-aa86-\
466de8ca25d4"]
}, Open  ]],

Cell[" ", "FooterCell",ExpressionUUID->"82c39fab-835b-4930-9b83-3b24c7812498"]
},
Saveable->False,
ScreenStyleEnvironment->"Working",
WindowSize->{900, 830},
WindowMargins->{{0, Automatic}, {Automatic, 0}},
WindowTitle->"Cracking the Kryptos CTF",
TaggingRules->{
 "ModificationHighlight" -> False, "ColorType" -> "", "LinkTrails" -> "", 
  "ExampleCounter" -> 1, 
  "Openers" -> {
   "PrimaryExamplesSection" -> Open, "ExampleSection" -> {"0" -> Open}}, 
  "NewStyles" -> True, "CitationPopupData" -> {$Failed, ""}, "ShowCitation" -> 
  False, "RootCaptions" -> "", "HeaderCoreAreaLink" -> {}, 
  "Metadata" -> {
   "built" -> "{2026, 8, 27, 0, 12, 5.948772}", 
    "history" -> {"XX", "", "", ""}, "context" -> "WolframInstitute`Puzzles`",
     "keywords" -> {
     "Kryptos", "Kryptos CTF", "Paradigm", "Quagmire", "KRYPTOS alphabet", 
      "columnar transposition", "Hill cipher", "index of coincidence", "peel",
       "keyless", "cryptanalysis", "cipher", "running key"}, 
    "specialkeywords" -> {}, "tutorialcollectionlinks" -> {}, "index" -> True,
     "label" -> "Wolfram Institute/ Puzzles Tutorial", "language" -> "en", 
    "paclet" -> "WolframInstitute/Puzzles", "status" -> "None", "summary" -> 
    "In 2025 Paradigm published a Kryptos CTF: ten ciphertexts, PK1 through \
PK10, styled after Jim Sanborn's Kryptos sculpture and telling one continuous \
first-person story \\[LongDash] an archivist hunting an impossibly fine \
needle through the workshop of a whitesmith. The panels rise in difficulty; \
PK1\\[Dash]PK7 fell within a day, PK8\\[Dash]PK10 are still open. This note \
is the solved half. The one idea behind all seven readings is this: when a \
cipher is layered, you peel the outer layer by a statistic the inner layers \
cannot disturb, and only then score English. PK1, PK2, PK3, PK5 and PK7 are \
recovered here from ciphertext alone, keyless, with the paclet's Search \
solvers; PK4 and PK6 are recovered keyless too, by QuagmireCompositeSolve, \
but that solver sweeps for a minute or two, so this note reads those two off \
from the keys the sweep returns to keep the page fast. The last section says \
where the one idea runs out \\[LongDash] which is where PK8\\[Dash]PK10 \
begin. Everything is built on one alphabet. Sanborn's Kryptos keys its \
tableau with the word KRYPTOS, and so does every panel of this CTF:", 
    "synonyms" -> {}, "tabletags" -> {}, "title" -> 
    "Cracking the Kryptos CTF", "titlemodifier" -> "", "metadescription" -> 
    "", "windowtitle" -> "Cracking the Kryptos CTF", "type" -> "Tutorial", 
    "uri" -> "WolframInstitute/Puzzles/tutorial/CrackingTheKryptosCTF", 
    "WorkflowDockedCell" -> ""}, "SearchTextTranslated" -> ""},
CellContext->CellGroup,
FrontEndVersion->"15.0 for Mac OS X ARM (64-bit) (May 19, 2026)",
StyleDefinitions->Notebook[{
   Cell[
    StyleData[
    StyleDefinitions -> FrontEnd`FileName[{"Wolfram"}, "Reference.nb"]]], 
   Cell[
    StyleData["Input"], CellContext -> Notebook], 
   Cell[
    StyleData["Output"], CellContext -> Notebook], 
   Cell[
    StyleData["TutorialMoreAboutSection"], 
    CellGroupingRules -> {"SectionGrouping", 30}], 
   Cell[
    StyleData["RelatedTutorialsSection"], 
    CellGroupingRules -> {"SectionGrouping", 30}], 
   Cell[
    StyleData["TutorialRelatedLinksSection"], 
    CellGroupingRules -> {"SectionGrouping", 30}]}, Visible -> False, 
  FrontEndVersion -> "15.0 for Mac OS X ARM (64-bit) (May 19, 2026)", 
  StyleDefinitions -> "PrivateStylesheetFormatting.nb"],
ExpressionUUID->"fda3d397-8389-492a-92ac-339b03c09461"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[592, 21, 3179, 76, 70, "AnchorBarGrid",ExpressionUUID->"acf739f9-1948-4b28-930a-1665a0869913",
 CellID->1],
Cell[CellGroupData[{
Cell[3796, 101, 116, 1, 70, "Title",ExpressionUUID->"89a28a7e-6f2d-4d15-bc4b-127ba5c895a2",
 CellID->509267359],
Cell[CellGroupData[{
Cell[3937, 106, 112, 0, 70, "Section",ExpressionUUID->"54e35b9a-b27e-47be-9da0-25c25d222d83"],
Cell[4052, 108, 479, 8, 70, "Text",ExpressionUUID->"2b503029-d26e-4eb5-a1ad-3dca1373db54"],
Cell[4534, 118, 1398, 32, 70, "Text",ExpressionUUID->"310d0345-42b7-41ce-be53-fb42c5279d36"],
Cell[5935, 152, 212, 3, 70, "Text",ExpressionUUID->"75e07a65-2068-4f28-93ac-bb0297c1a1b7"],
Cell[CellGroupData[{
Cell[6172, 159, 158, 2, 70, "Input",ExpressionUUID->"58167b2d-a01f-478c-8a92-9846e9fdd820"],
Cell[6333, 163, 140, 1, 70, "Output",ExpressionUUID->"94a2bd96-1802-4db6-8995-8999b2c161a4"]
}, Open  ]],
Cell[6488, 167, 128, 0, 70, "Text",ExpressionUUID->"2864afc6-bfef-4dae-a56a-aebb6cefaf98"],
Cell[6619, 169, 2606, 58, 70, "Input",ExpressionUUID->"4ed319a7-bc65-446f-8267-57456b8aa537"],
Cell[9228, 229, 149, 2, 70, "Text",ExpressionUUID->"461a6ce7-57e8-44a2-a22c-cc2803619985"],
Cell[9380, 233, 597, 13, 70, "Input",ExpressionUUID->"99f4d047-28fb-4219-bcf4-13587b9bcb56"]
}, Open  ]],
Cell[CellGroupData[{
Cell[10014, 251, 111, 0, 70, "Section",ExpressionUUID->"00322d5c-5d05-41ab-b677-d299a950aafb"],
Cell[10128, 253, 816, 17, 70, "Text",ExpressionUUID->"e5fa79dc-2925-4b26-a546-4725133f5335"],
Cell[CellGroupData[{
Cell[10969, 274, 397, 9, 70, "Input",ExpressionUUID->"8883f527-d12b-4b92-a79e-01ea9cdd1efe"],
Cell[11369, 285, 312, 4, 70, "Output",ExpressionUUID->"9dbe5a83-cab9-4869-a12c-c277f9d8b83c"]
}, Open  ]]
}, Open  ]],
Cell[CellGroupData[{
Cell[11730, 295, 114, 0, 70, "Section",ExpressionUUID->"baec9287-9869-4ee9-81dd-f23fec467501"],
Cell[11847, 297, 1035, 25, 70, "Text",ExpressionUUID->"059f0d0f-3e29-4d96-ab72-ceb068c1fcbc"],
Cell[CellGroupData[{
Cell[12907, 326, 453, 10, 70, "Input",ExpressionUUID->"c1934ef3-1ab6-41c3-b19e-24aeee86b931"],
Cell[13363, 338, 623, 11, 70, "Output",ExpressionUUID->"397134cb-1037-4acc-8bfb-c2667a4b0c88"]
}, Open  ]]
}, Open  ]],
Cell[CellGroupData[{
Cell[14035, 355, 107, 0, 70, "Section",ExpressionUUID->"2c63e43c-9ed5-4121-986e-0239c6e1c2b6"],
Cell[14145, 357, 746, 15, 70, "Text",ExpressionUUID->"d41616d5-4b92-4963-8a4b-3e060eac2f89"],
Cell[CellGroupData[{
Cell[14916, 376, 566, 13, 70, "Input",ExpressionUUID->"0a807d3e-8d86-49af-926e-d96bdd1327dc"],
Cell[15485, 391, 451, 8, 70, "Output",ExpressionUUID->"453748ee-6fb6-4978-b1f9-7e9b89e236ff"]
}, Open  ]]
}, Open  ]],
Cell[CellGroupData[{
Cell[15985, 405, 157, 2, 70, "Section",ExpressionUUID->"3950222a-4a87-4b97-8821-7a6b1202d6c6"],
Cell[16145, 409, 2203, 48, 70, "Text",ExpressionUUID->"c6819df6-7eee-4493-918c-047e58e64fe8"],
Cell[CellGroupData[{
Cell[18373, 461, 565, 14, 70, "Input",ExpressionUUID->"f280a488-f026-4454-b0c3-0d50ef36442e"],
Cell[18941, 477, 346, 5, 70, "Output",ExpressionUUID->"e1e4c521-cb08-4fb2-80d8-20d663dc90b2"]
}, Open  ]],
Cell[19302, 485, 256, 5, 70, "Text",ExpressionUUID->"676066ff-c208-4c78-9d62-12d620bd4597"],
Cell[CellGroupData[{
Cell[19583, 494, 950, 21, 70, "Input",ExpressionUUID->"b9075c9d-9176-43bb-b7b7-46dfab4210ae"],
Cell[20536, 517, 439, 6, 70, "Output",ExpressionUUID->"b548f181-9ec9-44d3-b385-a4037753f7b3"]
}, Open  ]]
}, Open  ]],
Cell[CellGroupData[{
Cell[21024, 529, 99, 0, 70, "Section",ExpressionUUID->"3ff861ad-cd4a-433a-9e5f-99a07a55a8b7"],
Cell[21126, 531, 503, 8, 70, "Text",ExpressionUUID->"ebf47c5e-1a87-4453-aa80-8e26e92fd84f"],
Cell[21632, 541, 567, 9, 70, "Text",ExpressionUUID->"c7e700fa-99aa-4bb0-b343-f57acdf537df"],
Cell[CellGroupData[{
Cell[22224, 554, 320, 7, 70, "Input",ExpressionUUID->"69c7213b-089d-4d70-8a5e-6123bd52b2dc"],
Cell[22547, 563, 110, 1, 70, "Output",ExpressionUUID->"6956c577-713d-40fe-9f27-20cf87eb185b"]
}, Open  ]],
Cell[22672, 567, 602, 14, 70, "Text",ExpressionUUID->"1060e2e2-4c67-4265-93a7-480bcf61c7b8"],
Cell[CellGroupData[{
Cell[23299, 585, 582, 13, 70, "Input",ExpressionUUID->"b2b5e540-4995-407c-99af-4009e3dc1881"],
Cell[23884, 600, 577, 13, 70, "Output",ExpressionUUID->"83acf14e-c415-4691-a56f-379852162887"]
}, Open  ]]
}, Open  ]],
Cell[CellGroupData[{
Cell[24510, 619, 127, 0, 70, "Section",ExpressionUUID->"9006ebf3-aea4-4051-882e-18141d365c6f"],
Cell[24640, 621, 1859, 48, 70, "Text",ExpressionUUID->"59875503-0eaa-486a-96b8-abd698c2c5c8"],
Cell[CellGroupData[{
Cell[26524, 673, 677, 15, 70, "Input",ExpressionUUID->"a34795cf-499c-42be-be96-6677cea27727"],
Cell[27204, 690, 480, 9, 70, "Output",ExpressionUUID->"d02d08b4-2670-42e9-8d7b-e677034c5653"]
}, Open  ]],
Cell[27699, 702, 652, 16, 70, "Text",ExpressionUUID->"4f8f39d0-543b-4313-bf5f-4d8548185b00"]
}, Open  ]],
Cell[CellGroupData[{
Cell[28388, 723, 106, 0, 70, "Section",ExpressionUUID->"01a04025-9397-4b01-ba92-d9d4760d930c"],
Cell[28497, 725, 257, 4, 70, "Text",ExpressionUUID->"feb0c12f-00ea-4ff6-bfe3-d3aa7faf3ea1"],
Cell[28757, 731, 3300, 64, 70, "3ColumnTableMod",ExpressionUUID->"11461423-8cf6-4778-b550-f2dfcae53cf1"],
Cell[32060, 797, 901, 14, 70, "Text",ExpressionUUID->"374ac8b9-de0e-4d9c-9c88-f6c8e8c0a314"]
}, Open  ]],
Cell[32976, 814, 1336, 33, 70, "TutorialMoreAboutSection",ExpressionUUID->"3d4e8a2a-70ba-404a-8536-119dacdc3e03"],
Cell[34315, 849, 986, 24, 70, "RelatedTutorialsSection",ExpressionUUID->"b5bcb2d4-948b-4484-aa86-466de8ca25d4"]
}, Open  ]],
Cell[35316, 876, 78, 0, 70, "FooterCell",ExpressionUUID->"82c39fab-835b-4930-9b83-3b24c7812498"]
}
]
*)

(* End of internal cache information *)

