Creating a notebook that has cells of a certain style password protected

Question

I am teaching students how to use Mathematica. I want to create a problem set that has cells with a certain style (probably Input or some new style that is a variant of Input) locked down so that the students can not see them at all or just see an unevaluatable placeholder instead. But I also want a cell within the notebook that permits someone with a password (like me) to make these hidden cells visible and evaluatable.

Extra credit: it would be cool if I could relock these cells so that they reverted to their hidden form.

Concession: Maybe the unlocking cell does not have to be in the notebook but could be a function in an external notebook that worked on the problem set notebook.

Right now I accomplish the basic idea by having two notebooks, one with the answers and one without them. But this is ugly and leads to synchronization errors as I change my mind.

Ideas welcome. Obviously, simpler is better.

Answer 1

Here's an idea following up on the master-notebook model.

The master notebook has two additional cell styles: AnswerInput and AnswerOutput. You can write the questions as you like, using ItemNumbered, Text, or whatever style except those two new styles. You put your answer code in an AnswerInput cell, and evaluate it. Set the output cell to style AnswerOutput.

The master notebook has a button at the top, which you can copy for each assignment, that generates the question document. You distribute that notebook to the students, but only ever have to edit the master. Consequently the question notebook is automatically synchronized to the master notebook.

The question notebook does not contain the Button, and your answers are replaced with a placeholder Input cell.

I'm inclined to do it this way because

1. I don't have to remember and protect an additional password.
2. Since there is no password prompt, students will not be distracted trying to guess the password.
3. The notebook itself is not subject to attack for purposes of cheating, since the answers are not in the notebook.

Here is the code for the button. Evaluate it at the top of a new notebook, and double-click on the button cell frame at the right to hide the code. Note: you need to add "ButtonCode" to the CellTags option on this cell (from the Cell menu) to ensure the button is not included in the question notebook.

(* Click this button to generate a notebook without answers *)
Button["Create question notebook", 
 Module[{copy, cursorposition = NotebookSelection[]},
  (* Copy the current notebook, inheriting the stylesheet *)
  copy = CreateDocument[{}, 
    NotebookFileName -> 
     FileNameJoin[{NotebookDirectory[], "Questions.nb"}], 
    StyleDefinitions -> CurrentValue[EvaluationNotebook[], 
      StyleDefinitions]];
  NotebookWrite[copy, 
   (SelectionMove[EvaluationNotebook[], All, Notebook, 
     AutoScroll -> False]; NotebookRead[EvaluationNotebook[]])];
  (* Return cursor to its initial position *)
  SelectionMove[cursorposition, After, Cell];
  (* Remove all "AnswerOutput"-Style cells *)
  NotebookFind[copy, "AnswerOutput", All, CellStyle];
  NotebookDelete[copy];
  (* Replace all "AnswerInput"-Style cells with a placeholder Input cell, framed with a Gray border *)
  NotebookFind[copy, "AnswerInput", All, CellStyle];
  Scan[
   NotebookWrite[#, Cell[BoxData["(* Your solution *)\n"], 
      "Input", CellFrame -> {{1, 1}, {1, 1}}, 
      CellFrameColor -> Gray]] &, SelectedCells[copy]];
  (* Remove the button code *)
  NotebookFind[copy, "ButtonCode", All, CellTags];
  NotebookDelete[copy];
  (* Return cursor to its initial position *)
  SelectionMove[cursorposition, After, Cell];
 ], ImageSize -> All]

Add these two styles to the notebook's stylesheet:

Cell[StyleData["AnswerInput", StyleDefinitions -> StyleData["Input"]], GeneratedCellStyles->{"Output"->"AnswerOutput"}, MenuSortingValue->10000]

and

Cell[StyleData["AnswerOutput", StyleDefinitions -> StyleData["Output"]], MenuSortingValue->10000]

The question notebook will keep a copy of any Output cells from your master, so you can include Output in the questions themselves. When you evaluate AnswerInput cells, however, the outputs are styled AnswerOutput, and those are removed from the question notebook.

Answer 2

I don't claim this will do everything you want, but this presentation by Jason Harris on Advanced Typesetting includes a program that will Encrypt code and allow it to be unlocked with a short and simple password.

Apparently it was used live during a workshop presentation to encourage those in attendance to attempt the problem(s) at hand without first seeing the solution(s). (Did anyone on here attend??)

Note: You may have to dismiss a message box when launching the notebook. Everything works fine for me on v9.

Answer 3

This is a start that could be turned into a style and a package, and improved, etc.

First, some function to encrypt a string with a key. I'm not good at this, I only knew how to do it with Encode

encode[expr_, password_String] :=
 With[{fnameSource = FileNameJoin[{$TemporaryDirectory, "encrSource"}],
       fnameDest = FileNameJoin[{$TemporaryDirectory, "encrDest"}]},
  Block[{buff},
   Put[Unevaluated[buff = expr], fnameSource];
   Encode[fnameSource, fnameDest, password];
   With[{res = StringJoin@Import[fnameDest, {"Binary", "Character8"}]},
    Scan[DeleteFile, {fnameSource, fnameDest}];
    res
    ]
   ]]

To decode

decode[expr_String, password_String] := 
 With[{fname = FileNameJoin[{$TemporaryDirectory, "decr"}]},
      Export[fname, Characters@expr, {"Binary", "Character8"}];
      Block[{buff},
       Quiet@Check[Get[fname, password], buff = $Failed];
   With[{res = buff},
    DeleteFile@fname;
    res]
   ]]

The idea is simple: to provide a button in a CellFrameLabel, that encrypts or decrypts the cell's content

Let's overload our previous functions, letting them take a cell object

encode[co_CellObject] := 
 With[{pass = InputString["Please, enter the password"]},
  CurrentValue[co, {TaggingRules, "encoded"}] = True;
  NotebookWrite[co,
   Replace[NotebookRead[co], 
    Cell[data_, opts___] :> 
     Cell[BoxData@
       ToBoxes@Interpretation["Hidden cell", 
         Evaluate@encode[data, pass]], opts]]];
  SelectionMove[EvaluationNotebook[], After, Cell];
  ]

decode[co_CellObject] := 
 With[{pass = InputString["Please, enter the password"]},
  With[{newCell = Replace[
      NotebookRead[co],
      Cell[BoxData[int_], opts___] :> 
       Cell[decode[ToExpression@int, pass], opts]]},
   (CurrentValue[co, {TaggingRules, "encoded"}] = False;
   NotebookWrite[co, newCell];
   SelectionMove[EvaluationNotebook[], After, Cell]) /; 
    MatchQ[newCell, Cell[Except[$Failed], ___]]]
  ]

decode::fail = "Failed to decode cell";
decode[_CellObject] := (Message[decode::fail]; $Failed /; False)

These are the options an "encryptable cell" should have. Just a tagging rule with the state (encrypted or not encrypted), and the cell frame label specifications.

opts = Sequence[
  CellFrameLabels -> {{None, None}, {None, ToBoxes@Dynamic[
       CurrentValue[{TaggingRules, "encoded"}] /. {
          False :> {"Encode", encode},
          True :> {"Decode", decode}} /. {butName_, fun_} :>
         Button[butName, 
          fun[SelectionMove[EvaluationNotebook[], All, 
            EvaluationCell]; First@SelectedCells[]], 
          Method -> "Queued"]]}}, 
  TaggingRules -> {"encoded" -> False}];

So, for example, try

CellPrint@ExpressionCell[28 f[9], "Output", opts]

or

CellPrint@TextCell["The answer is 8", "Text", opts]

You can put this into a stylesheet, and the functions into a package.