                        CHAPTER  16

                      The LISP Editor

   16.1.  The Editors

      It is quite possible to use VI, Emacs or  other  stan-
      dard editors to edit your lisp programs, and many peo-
      ple do just that.  However there is a  lisp  structure
      editor  which  is particularly good for the editing of
      lisp programs, and  operates  in  a  rather  different
      fashion,  namely  within a lisp environment.  applica-
      tion.  It is handy to know how to use  it  for  fixing
      problems  without  exiting  from the lisp system (e.g.
      from the debugger  so  you  can  continue  to  execute
      rather  than having to start over.)  The editor is not
      quite like the top-level  and  debugger,  in  that  it
      expects  you  to  type editor commands to it.  It will
      not evaluate whatever you happen to type.   (There  is
      an editor command to evaluate things, though.)

      The editor is available (assuming your system  is  set
      up  correctly  with  a  lisp  library) by typing (load
      'cmufncs) and (load 'cmuedit).

      The  most  frequent  use of the editor  is  to  change
      function  definitions  by starting the editor with one
      of the  commands  described  in  section  16.14.  (see
      _e_d_i_t_f),   values   (_e_d_i_t_v),  properties  (_e_d_i_t_p),  and
      expressions  (_e_d_i_t_e).  The  beginner   is  advised  to
      start  with  the  following (very basic) commands: _o_k,
      _u_n_d_o, _p, #, under which are  explained  two  different
      basic commands which  start with numbers, and f.

      This documentation, and the editor, were imported from
      PDP-10  CMULisp by Don Cohen.  PDP-10 CMULisp is based
      on UCILisp, and the editor itself was derived from  an
      early  version of Interlisp.  Lars Ericson, the author
      of this section, has provided this very  concise  sum-
      mary.   Tutorial  examples  and implementation details
      may be found in the Interlisp Reference Manual,  where
      a similar editor is described.

9

9The LISP Editor                                         16-1

The LISP Editor                                         16-2

   16.2.  Scope of Attention

      Attention-changing commands allow you  to  look  at  a
      different  part  of a Lisp expression you are editing.
      The sub-structure upon which the editor's attention is
      centered  is called "the current expression".   Chang-
      ing the current expression  means  shifting  attention
      and not actually modifying any structure.

____________________________________________________________

_S_C_O_P_E _O_F _A_T_T_E_N_T_I_O_N _C_O_M_M_A_N_D _S_U_M_M_A_R_Y

_n (_n>_0) . Makes the nth element of the current expression be
the new current expression.

-_n (_n>_0). Makes the nth element from the end of the  current
expression be the new current expression.

_0. Makes the  next  higher expression  be  the  new  correct
expression.   If  the  intention  is  to go back to the next
higher left parenthesis, use the command !0.

_u_p .  If a p command would cause  the  editor  to  type  ...
before  typing  the current expression, (the current expres-
sion is a tail of the next higher expression)  then  has  no
effect;  else, up makes the old current expression the first
element in the new current expression.

!_0 . Goes back to the next higher left parenthesis.

^ .  Makes the top level expression be the  current  expres-
sion.

_n_x .  Makes the current expression be the next expression.

(_n_x _n) equivalent to n nx commands.

!_n_x .  Makes current expression be the next expression at  a
higher  level.  Goes through any number of right parentheses
to get to the next expression.

 _b_k .  Makes the current expression be the previous  expres-
sion in the next higher expression.

(_n_t_h _n) _n>_0 .  Makes the list starting with the nth  element
of the current expression be the current expression.

(_n_t_h $) - _g_e_n_e_r_a_l_i_z_e_d _n_t_h _c_o_m_m_a_n_d. nth locates $,  and  then
backs up to the current level, where the new current expres-
sion is the tail whose first element contains, however  dee-
ply,  the  expression  that was the terminus of the location
operation.

                                      Printed: July 21, 1983

The LISP Editor                                         16-3

:: .  (pattern ::  .  $)  e.g., (cond :: return).   finds  a
cond that contains a return, at any depth.

(_b_e_l_o_w _c_o_m _x) .  The below command is useful for locating  a
substructure  by  specifying something  it contains.  (below
cond) will cause the cond  clause  containing   the  current
expression  to  become  the new current expression.  Suppose
you are editing a list of lists, and want to find a  sublist
that  contains a foo (at any depth).  Then simply executes f
foo (below ).

(_n_e_x _x) .  same as (_b_e_l_o_w _x) followed by nx.   For  example,
if  you are deep inside of a selectq clause, you can advance
to the next clause with (_n_e_x _s_e_l_e_c_t_q).

_n_e_x.  The  atomic  form  of  _n_e_x is useful if  you  will  be
performing  repeated   executions   of  (_n_e_x  _x).  By simply
marking  the  chain corresponding to x,  you can use _n_e_x  to
step through the sublists.
____________________________________________________________

   16.3.  Pattern Matching Commands

      Many editor commands that  search  take  patterns.   A
      pattern _p_a_t matches with x if:

____________________________________________________________

_P_A_T_T_E_R_N _S_P_E_C_I_F_I_C_A_T_I_O_N _S_U_M_M_A_R_Y

- _p_a_t is _e_q to x.

- _p_a_t is &.

- _p_a_t is a number and equal to x.

- if (car _p_a_t) is the atom *any*, (cdr _p_a_t)  is  a  list  of
patterns,  and  _p_a_t matches x if and only if one of the pat-
terns on (cdr _p_a_t) matches x.

- if _p_a_t is a literal atom or string, and (nthchar  _p_a_t  -1)
is @, then _p_a_t matches with any literal atom or string which
has the same initial characters as _p_a_t, e.g.   ver@  matches
with verylongatom, as well as "verylongstring".

- if (car _p_a_t) is the atom --, _p_a_t matches  x  if  (a)  (cdr
_p_a_t)=nil,  i.e.   _p_a_t=(--), e.g., (a --) matches (a) (a b c)
and (a .  b) in other words, -- can  match  any  tail  of  a
list.   (b)  (cdr _p_a_t) matches with some tail of x, e.g.  (a

                                      Printed: July 21, 1983

The LISP Editor                                         16-4

-- (&)) will match with (a b c (d)), but not (a b c  d),  or
(a  b c (d) e).  however, note that (a -- (&) --) will match
with (a b c (d) e).  in other words, -- will match any inte-
rior segment of a list.

- if (car _p_a_t) is the atom ==, _p_a_t matches x if and only  if
(cdr  _p_a_t) is _e_q to x.  (this pattern is for use by programs
that call the editor as a subroutine, since  any  non-atomic
expression  in a command typed in by the user obviously can-
not be _e_q to existing structure.) -  otherwise  if  x  is  a
list,  _p_a_t  matches x if (car _p_a_t) matches (car x), and (cdr
_p_a_t) matches (cdr x).

- when searching, the pattern  matching  routine  is  called
only  to  match  with  elements in the structure, unless the
pattern begins with :::, in which case cdr of the pattern is
matched  against tails in the structure.  (in this case, the
tail does not have to be a proper tail, e.g.   (:::   a  --)
will  match  with the element (a b c) as well as with cdr of
(x a b c), since (a b c) is a tail of (a b c).)
____________________________________________________________

      16.3.1.  Commands That Search

____________________________________________________________

_S_E_A_R_C_H _C_O_M_M_A_N_D _S_U_M_M_A_R_Y

_f _p_a_t_t_e_r_n .  f informs the editor that the next  command  is
to  be  interpreted as a pattern.  If no pattern is given on
the same line as the f then the last  pattern  is  used.   f
pattern means find the next instance of pattern.

(_f _p_a_t_t_e_r_n _n).  Finds the next instance of pattern.

(_f _p_a_t_t_e_r_n _t).  similar to f pattern, except,  for  example,
if the current expression is (cond ..), f cond will look for
the next cond, but (f cond t) will 'stay here'.

(_f _p_a_t_t_e_r_n  _n)  _n>_0.   Finds  the  nth  place  that  pattern
matches.   If the current expression is (foo1 foo2 foo3), (f
f00@ 3) will find foo3.

(_f _p_a_t_t_e_r_n) _o_r (_f _p_a_t_t_e_r_n _n_i_l).  only matches with  elements
at  the top level of the current expression.  If the current
expression is (_p_r_o_g _n_i_l (_s_e_t_q _x (_c_o_n_d & &)) (_c_o_n_d &) ...)  f
(cond  --)  will  find  the cond inside the setq, whereas (f
(cond --)) will find the top level cond,  i.e.,  the  second
one.

                                      Printed: July 21, 1983

The LISP Editor                                         16-5

(_s_e_c_o_n_d . $) .  same as (lc .  $) followed by another (lc  .
$)  except  that  if the first succeeds and second fails, no
change is made to the edit chain.

(_t_h_i_r_d . $) .  Similar to second.

(_f_s _p_a_t_t_e_r_n_1 ... _p_a_t_t_e_r_n_n) .  equivalent to f pattern1  fol-
lowed by f pattern2 ...  followed by f pattern n, so that if
f pattern m fails, edit chain is left at place  pattern  m-1
matched.

(_f= _e_x_p_r_e_s_s_i_o_n _x) .  Searches for a structure eq to  expres-
sion.

(_o_r_f _p_a_t_t_e_r_n_1 ... _p_a_t_t_e_r_n_n) .  Searches  for  an  expression
that is matched by either pattern1 or ...  patternn.

_b_f _p_a_t_t_e_r_n .  backwards find.   If the current expression is
(_p_r_o_g _n_i_l (_s_e_t_q _x (_s_e_t_q _y (_l_i_s_t _z))) (_c_o_n_d ((_s_e_t_q _w --) --))
--) f list followed  by  bf  setq  will  leave  the  current
expression  as (setq y (list z)), as will f cond followed by
bf setq

(_b_f _p_a_t_t_e_r_n _t).  backwards  find.   Search  always  includes
current  expression,  i.e., starts at end of current expres-
sion and works backward, then ascends and backs up, etc.
____________________________________________________________

         16.3.1.1.   Location Specifications    Many  editor
            commands  use  a  method  of specifying position
            called  a  location  specification.   The  meta-
            symbol $ is used to denote a location specifica-
            tion.   $ is a list of commands  interpreted  as
            described above.  $ can also be atomic, in which
            case it is interpreted as (list $).  a  location
            specification  is  a  list of edit commands that
            are executed in  the  normal  fashion  with  two
            exceptions.   first, all commands not recognized
            by the editor are interpreted as though they had
            been  preceded  by f. The location specification
            (cond 2 3) specifies  the  3rd  element  in  the
            first clause of the next cond.

            the if command and the ## function provide a way
            of  using  in  location specifications arbitrary
            predicates applied to elements  in  the  current
            expression.

            In insert, delete, replace and change, if  $  is

                                      Printed: July 21, 1983

The LISP Editor                                         16-6

            nil (empty), the corresponding operation is per-
            formed on the current edit chain, i.e.  (replace
            with  (car x)) is equivalent to (:(car x)).  for
            added readability, here is also permitted, e.g.,
            (insert  (print  x)  before  here)  will  insert
            (print x) before the current expression (but not
            change  the  edit chain).  It is perfectly legal
            to ascend to insert, replace,  or  delete.   for
            example  (insert  (_r_e_t_u_r_n) after ^ prog -1) will
            go to the top, find the first prog, and insert a
            (_r_e_t_u_r_n)  at its end, and not change the current
            edit chain.

            The a, b,  and  :   commands  all  make  special
            checks in e1 thru em for expressions of the form
            (## . coms).  In this case, the expression  used
            for  inserting  or  replacing  is  a copy of the
            current expression after executing coms, a  list
            of  edit  commands.    (insert (## f cond -1 -1)
            after3)  will make a copy of the  last  form  in
            the  last clause of the next cond, and insert it
            after the third element of the  current  expres-
            sion.

            $.  In descriptions of  the  editor,  the  meta-
            symbol $ is used to denote a location specifica-
            tion.   $ is a list of commands  interpreted  as
            described above.  $ can also be atomic.

____________________________________________________________

_L_O_C_A_T_I_O_N _C_O_M_M_A_N_D _S_U_M_M_A_R_Y

(_l_c . $) .  Provides a way of explicitly invoking the  loca-
tion operation.  (lc cond 2 3) will perform search.

(_l_c_l . $) .  Same as lc except search is confined to current
expression.   To  find a cond containing a _r_e_t_u_r_n, one might
use the location specification (cond (lcl  _r_e_t_u_r_n)  )  where
the   would reverse the effects of the lcl command, and make
the final current expression be the cond.
____________________________________________________________

      16.3.2.  The Edit Chain   The edit-chain is a list  of
         which  the first element is the the one you are now
         editing ("current expression"), the next element is
         what  would  become  the  current expression if you
         were to do a 0, etc., until the last element  which
         is the expression that was passed to the editor.

                                      Printed: July 21, 1983

The LISP Editor                                         16-7

____________________________________________________________

_E_D_I_T _C_H_A_I_N _C_O_M_M_A_N_D _S_U_M_M_A_R_Y

_m_a_r_k .  Adds the current edit chain to the front of the list
marklst.

_ .  Makes the new edit chain be (car marklst).

(_ _p_a_t_t_e_r_n) .  Ascends the edit chain  looking  for  a  link
which matches pattern.  for example:

__ .  Similar to _ but also erases the mark.

\ . Makes the edit chain be the value of unfind.  unfind  is
set  to  the current edit chain by each command that makes a
"big jump", i.e., a command that usually performs more  than
a  single  ascent or descent, namely ^, _, __, !nx, all com-
mands that involve a search, e.g., f, lc, ::, below,  et  al
and                      and                     themselves.
if the user types f cond, and then f car,   would  take  him
back  to the cond.  another  would take him back to the car,
etc.

\_p .  Restores the edit chain to its state as  of  the  last
print  operation.   If  the edit chain has not changed since
the last printing, \p restores it to its  state  as  of  the
printing before that one.  If the user types p followed by 3
2 1 p, \p will  return  to  the  first  p,  i.e.,  would  be
equivalent to 0 0 0.  Another \p would then take him back to
the second p.
____________________________________________________________

   16.4.  Printing Commands

____________________________________________________________

_P_R_I_N_T_I_N_G _C_O_M_M_A_N_D _S_U_M_M_A_R_Y

_p  Prints current expression in  abbreviated  form.   (p  m)
prints  mth  element  of  current  expression in abbreviated
form.  (p m n) prints mth element of current  expression  as
though  printlev  were  given  a depth of n.  (p 0 n) prints
current expression as though printlev were given a depth  of
n.  (p cond 3) will work.

?  .  prints the current expression as though printlev  were
given a depth of 100.
9

9                                      Printed: July 21, 1983

The LISP Editor                                         16-8

_p_p .  pretty-prints the current expression.

_p_p*.  is like pp, but forces comments to be shown.
____________________________________________________________

   16.5.  Structure Modification Commands

      All structure modification commands are undoable.  See
      _u_n_d_o.

____________________________________________________________

_S_T_R_U_C_T_U_R_E _M_O_D_I_F_I_C_A_T_I_O_N _C_O_M_M_A_N_D _S_U_M_M_A_R_Y

# [_e_d_i_t_o_r _c_o_m_m_a_n_d_s] (n)  n>1 deletes the corresponding  ele-
ment from the current expression.

(_n _e_1 ...  _e_m) _n,_m>_1 replaces the nth element in the current
expression with e1 ...  em.

(-_n _e_1 ...  _e_m) _n,_m>_1 inserts e1 ...  em before the  n  ele-
ment in the current expression.

(_n _e_1 ...  _e_m) (the letter "n" for "next" or "nconc", not  a
number)  m>1  attaches  e1 ...  em at the end of the current
expression.

(_a _e_1 ... _e_m) .   inserts  e1  ...   em  after  the  current
expression (or after its first element if it is a tail).

(_b _e_1 ... _e_m) .  inserts  e1  ...   em  before  the  current
expression.   to  insert  foo before the last element in the
current expression, perform -1 and then (b foo).

(: _e_1 ... _e_m) .  replaces the current expression by  e1  ...
em.     If the current expression is a tail then replace its
first element.

_d_e_l_e_t_e _o_r (:)  .  deletes the current expression, or if  the
current expression is a tail, deletes its first element.

(_d_e_l_e_t_e . $).  does a (lc .  $) followed by delete.  current
edit chain is not changed.

(_i_n_s_e_r_t _e_1 ... _e_m _b_e_f_o_r_e . $) .  similar to  (lc.   $)  fol-
lowed by (b e1 ... em).

(_i_n_s_e_r_t _e_1 ...  _e_m _a_f_t_e_r .  $).  similar  to  insert  before

                                      Printed: July 21, 1983

The LISP Editor                                         16-9

except uses a instead of b.

(_i_n_s_e_r_t _e_1 ...  _e_m _f_o_r .   $).   similar  to  insert  before
except uses :  for b.

(_r_e_p_l_a_c_e $ _w_i_t_h _e_1 ... _e_m) .  here $ is the segment  of  the
command between replace and with.

(_c_h_a_n_g_e $ _t_o _e_1 ... _e_m) .  same as replace with.
____________________________________________________________

   16.6.  Extraction and Embedding Commands

____________________________________________________________

_E_X_T_R_A_C_T_I_O_N _A_N_D _E_M_B_E_D_D_I_N_G _C_O_M_M_A_N_D _S_U_M_M_A_R_Y

(_x_t_r . $) .  replaces the original current  expression  with
the expression that is current after performing (lcl . $).

(_m_b_d _x) .  x is a list, substitutes the  current  expression
for  all  instances  of  the  atom  * in x, and replaces the
current expression with the  result  of  that  substitution.
(mbd x) :  x atomic, same as (mbd (x *)).

(_e_x_t_r_a_c_t $_1 _f_r_o_m $_2) .  extract is an editor  command  which
replaces  the  current expression with one of its subexpres-
sions (from any depth).  ($1 is the segment between  extract
and  from.)    example:  if the current expression is (print
(cond ((null x) y) (t z))) then following  (extract  y  from
cond), the current expression will be (print y).  (extract 2
-1 from cond), (extract y from 2), (extract  2  -1  from  2)
will all produce the same result.

(_e_m_b_e_d $ _i_n . _x) .  embed replaces  the  current  expression
with  a new expression which contains it as a subexpression.
($ is the segment between embed and in.)   example:   (embed
print  in setq x), (embed 3 2 in _r_e_t_u_r_n), (embed cond 3 1 in
(or * (null x))).
____________________________________________________________

   16.7.  Move and Copy Commands

9

9                                      Printed: July 21, 1983

The LISP Editor                                        16-10

____________________________________________________________

_M_O_V_E _A_N_D _C_O_P_Y _C_O_M_M_A_N_D _S_U_M_M_A_R_Y

(_m_o_v_e $_1 _t_o _c_o_m . $_2) .  ($1 is the segment between move and
to.)  where com is before, after, or the name of a list com-
mand, e.g., :, n, etc.  If $2 is nil, or (here), the current
position specifies where the operation is to take place.  If
$1 is nil, the move command allows the user to specify  some
place  the  current  expression  is to be moved to.   if the
current expression is (a b d c), (move 2 to  after  4)  will
make the new current expression be (a c d b).

(_m_v _c_o_m . $) .  is the same as (move here to com . $).

(_c_o_p_y $_1 _t_o _c_o_m . $_2)  is like move except that  the  source
expression is not deleted.

(_c_p _c_o_m . $).  is like mv except that the source  expression
is not deleted.
____________________________________________________________

   16.8.    Parentheses Moving Commands      The    commands
      presented  in  this section permit modification of the
      list structure itself, as opposed  to  modifying  com-
      ponents  thereof.   their  effect  can be described as
      inserting  or  removing  a  single   left   or   right
      parenthesis, or pair of left and right parentheses.

____________________________________________________________

_P_A_R_E_N_T_H_E_S_E_S _M_O_V_I_N_G _C_O_M_M_A_N_D _S_U_M_M_A_R_Y

(_b_i _n _m) .  both in.  inserts  parentheses  before  the  nth
element and after the mth element in the current expression.
example:  if the current expression is (a b (c d  e)  f  g),
then (bi 2 4) will modify it to be (a (b (c d e) f) g).  (bi
n) :  same as (bi n n).  example:  if the current expression
is (a b (c d e) f g), then (bi -2) will modify it to be (a b
(c d e) (f) g).

(_b_o _n) .  both out.  removes both parentheses from  the  nth
element.   example:   if the current expression is (a b (c d
e) f g), then (bo d) will modify it to be (a b c d e f g).

(_l_i _n) .  left in.  inserts a left  parenthesis  before  the
nth  element (and a matching right parenthesis at the end of
the current expression).  example:  if the  current  expres-
sion  is (a b (c d e) f g), then (li 2) will modify it to be

                                      Printed: July 21, 1983

The LISP Editor                                        16-11

(a (b (c d e) f g)).

(_l_o _n) .  left  out.  removes  a  left parenthesis  from the
nth  element.  all  elements  following  the nth element are
deleted.  example: if the current expression is (a b (c d e)
f g), then  (lo  3) will modify it to be (a b c d e).

(_r_i _n _m) .  right  in.  move  the  right parenthesis at  the
end of the nth element in to after the mth element.  inserts
a  right parenthesis  after  the mth element of the nth ele-
ment.   The  rest  of  the  nth element is brought up to the
level of the  current expression.   example: if the  current
expression  is (a (b c d e) f g), (ri 2 2) will modify it to
be (a (b c) d e f g).

(_r_o _n) .  right  out.  move the right parenthesis at the end
of  the  nth  element out to the  end of the current expres-
sion.  removes the right parenthesis from the  nth  element,
moving it to the end of the current expression. all elements
following the nth  element  are moved  inside of   the   nth
element.  example: if the current expression is (a b (c d e)
f  g),  (ro  3) will modify  it to be (a b (c d e f g)).

(_r _x _y)  replaces  all  instances  of x by y in the  current
expression,  e.g.,  (r  caadr  cadar).   x  can  be  the  s-
expression (or atom) to be substituted for, or can be a pat-
tern which specifies that s-expression (or atom).

(_s_w _n _m)  switches the nth and mth elements of  the  current
expression.  for example, if the current expression is (list
(cons (car x) (car y)) (cons (cdr y))),   (sw   2  3)   will
modify  it  to be (list (cons (cdr x) (cdr y)) (cons (car x)
(car y))).   (sw car  cdr) would produce the same result.
____________________________________________________________

      16.8.1.  Using to and thru

         to, thru, extract, embed, delete, replace, and move
         can  be  made to operate on several contiguous ele-
         ments, i.e., a segment of a list, by using  the  to
         or   thru  command  in  their  respective  location
         specifications.  thru and to  are  intended  to  be
         used   in  conjunction with extract, embed, delete,
         replace, and move.    to and thru can also be  used
         directly  with  xtr  (which  takes after a location
         specification), as in (xtr (2 thru  4))  (from  the
         current expression).

9

9                                      Printed: July 21, 1983

The LISP Editor                                        16-12

____________________________________________________________

_T_O _A_N_D _T_H_R_U _C_O_M_M_A_N_D _S_U_M_M_A_R_Y

($_1 _t_o $_2)    .   same  as  thru  except  last  element  not
included.

($_1 _t_o).  same as ($1 thru -1)

($_1 _t_h_r_u $_2)  .  If the current expression is (a  (b  (c  d)
(e)  (f  g  h)  i)  j  k), following (c thru g), the current
expression will be ((c d) (e) (f g h)).  If both $1  and  $2
are  numbers, and $2 is greater than $1, then $2 counts from
the beginning of the current expression, the same as $1.  in
other  words,  if the current expression is (a b c d e f g),
(3 thru 4) means (c thru d), not (c thru f).  in this  case,
the corresponding bi command is (bi 1 $2-$1+1).

($_1 _t_h_r_u). same as ($_1 _t_h_r_u -_1).
____________________________________________________________

   16.9.  Undoing Commands   each command that causes struc-
      ture  modification  automatically adds an entry to the
      front of undolst containing the  information  required
      to  restore all pointers that were changed by the com-
      mand.  The undo command undoes the  last,  i.e.,  most
      recent such command.

____________________________________________________________

_U_N_D_O _C_O_M_M_A_N_D _S_U_M_M_A_R_Y

_u_n_d_o .  the  undo  command  undoes  most  recent,  structure
modification  command  that  has  not  yet  been undone, and
prints the name of that command, e.g., mbd undone.  The edit
chain  is  then exactly what it was before the 'undone' com-
mand had been performed.

!_u_n_d_o .  undoes  all  modifications  performed  during  this
editing session, i.e., this call to the editor.

_u_n_b_l_o_c_k .  removes  an  undo-block. If executed  at  a  non-
blocked  state,  i.e., if undo or !undo could operate, types
not blocked.

_t_e_s_t .  adds an undo-block at the front  of  undolst.   note
that  test   together   with  !undo  provide  a  'tentative'
mode  for editing, i.e., the user can perform  a  number  of
changes,  and  then  undo  all  of  them with a single !undo

                                      Printed: July 21, 1983

The LISP Editor                                        16-13

command.

_u_n_d_o_l_s_t [_v_a_l_u_e].  each editor command that causes  structure
modification  automatically  adds  an  entry to the front of
undolst containing the information required to  restore  all
pointers that were changed by the command.

??   prints the entries on undolst.  The entries are  listed
most recent entry first.
____________________________________________________________

   16.10.  Commands that Evaluate

____________________________________________________________

_E_V_A_L_U_A_T_I_O_N _C_O_M_M_A_N_D _S_U_M_M_A_R_Y

_e .  only when typed in, (i.e., (insert  d  before  e)  will
treat  e  as  a  pattern) causes  the  editor  to  call  the
lisp interpreter giving it the next input as argument.

(_e  _x)  evaluates  x, and prints the result.  (e x  t)  same
as (e x) but does not print.

(_i _c _x_1 ... _x_n)  same as (c y1 ...  yn) where yi=(eval  xi).
example:   (i  3  (cdr foo)) will replace the 3rd element of
the current expression with the cdr of the value of foo.  (i
n foo (car fie)) will attach the value of foo and car of the
value of fie to the end of the current  expression.   (i  f=
foo t) will search for an expression eq to the value of foo.
If c is not an atom, it is evaluated as well.

(_c_o_m_s _x_1 ... _x_n) .  each  xi  is  evaluated  and  its  value
executed as a command.  The i command is not very convenient
for computing an entire edit command for  execution,   since
it  computes  the command name and its arguments separately.
also, the i command cannot be used  to  compute  an   atomic
command.   The  coms  and comsq  commands provide more  gen-
eral ways of computing commands.  (coms  (cond  (x  (list  1
x))))  will replace the first element of the current expres-
sion with the value of x if non-nil, otherwise  do  nothing.
(nil as a command is a nop.)

(_c_o_m_s_q _c_o_m_1 ... _c_o_m_n) .  executes com1 ... comn.   comsq  is
mainly  useful in conjunction with the  coms command.    for
example,  suppose the user wishes to compute an entire  list
of  commands  for  evaluation,  as opposed to computing each
command one at a time  as does  the coms command.  he  would
then  write  (coms  (cons (quote comsq) x)) where x computed

                                      Printed: July 21, 1983

The LISP Editor                                        16-14

the list of commands, e.g.,   (coms   (cons   (quote  comsq)
(get  foo (quote commands))))
____________________________________________________________

   16.11.  Commands that Test

____________________________________________________________

_T_E_S_T_I_N_G _C_O_M_M_A_N_D _S_U_M_M_A_R_Y

(_i_f _x)  generates an error unless the value of (eval  x)  is
non-nil,  i.e., if (eval x) causes an error or (eval x)=nil,
if will cause an error.  (if x coms1 coms2) if (eval  x)  is
non-nil,  execute  coms1;  if (eval x) causes an error or is
equal to nil, execute coms2.  (if x coms1)   if   (eval   x)
is  non-nil,  execute  coms1; otherwise generate  an  error.

(_l_p . _c_o_m_s) .  repeatedly executes coms, a list of commands,
until  an   error   occurs.      (lp  f  print (n  t))  will
attach  a t  at the end of every  print  expression.  (lp  f
print  (if  (##  3) nil ((n t)))) will attach a t at the end
of each print expression  which  does  not  already  have  a
second  argument.   (i.e.   the  form   (## 3) will cause an
error if the edit command 3 causes an error, thereby select-
ing  ((n t)) as the list of commands to be executed.  The if
could also  be written  as  (if  (cddr (##)) nil ((n t))).).

(_l_p_q . _c_o_m_s)  same as lp but does not print n occurrences.

(_o_r_r _c_o_m_s_1 ... _c_o_m_s_n) .  orr begins by  executing  coms1,  a
list  of  commands.   If  no  error occurs, orr is finished.
otherwise, orr restores the edit  chain  to   its   original
value,   and  continues by executing coms2, etc.  If none of
the command lists execute without  errors,   i.e.,  the  orr
"drops off the end", orr generates an error.  otherwise, the
edit chain is left as of the completion of the first command
list  which executes  without error.
____________________________________________________________

   16.12.  Editor Macros

      Many of the more sophisticated branching  commands  in
      the  editor, such as orr, if,  etc.,  are  most  often
      used  in  conjunction with  edit  macros.   The  macro
      feature  permits  the  user to define new commands and

                                      Printed: July 21, 1983

The LISP Editor                                        16-15

      thereby  expand  the  editor's  repertoire.  (however,
      built in commands always  take  precedence  over  mac-
      ros, i.e.,  the  editor's repertoire can be  expanded,
      but  not  modified.) macros are defined by using the m
      command.

      (_m _c . _c_o_m_s)  for c an atom, m defines c as an  atomic
      command.   (if a macro  is  redefined, its new defini-
      tion replaces its old.) executing c is then  the  same
      as  executing  the  list of  commands  coms.    macros
      can  also define list commands,  i.e.,  commands  that
      take  arguments.  (m (c) (arg[1] ... arg[n]) . coms) c
      an atom.  m defines c as a list command.  executing (c
      e1  ...   en)  is then  performed  by substituting  e1
      for  arg[1],  ...    en  for arg[n]  throughout  coms,
      and  then  executing  coms.   a  list  command  can be
      defined via a macro  so  as  to   take   a  fixed   or
      indefinite   number  of  'arguments'.   The form given
      above specified a macro with a fixed number  of  argu-
      ments,  as indicated by its argument list.   if the of
      arguments.  (m (c) args . coms) c,  args  both  atoms,
      defines  c as  a  list command.  executing  (c  e1 ...
      en) is performed by substituting (e1 ...   en),  i.e.,
      cdr of the command, for args throughout coms, and then
      executing coms.

      (m bp bk up p) will define bp as  an  atomic   command
      which   does three things,  a bk, an up, and a p. note
      that macros can use commands defined by macros as well
      as  built  in  commands  in  their definitions.    for
      example, suppose  z  is  defined by (m z -1 (if  (null
      (##))  nil  (p))),  i.e.  z does a -1, and then if the
      current expression is not nil, a p. now we can  define
      zz  by  (m zz  -1 z), and zzz by (m zzz -1 -1 z) or (m
      zzz -1 zz).  we could define a more general bp  by  (m
      (bp)  (n) (bk n) up p).    (bp 3)  would  perform  (bk
      3), followed  by  an  up,  followed  by a p.  The com-
      mand  second  can  be defined as a macro by (m (2nd) x
      (orr ((lc .  x) (lc .  x)))).

      Note  that  for  all editor commands, 'built in'  com-
      mands  as  well  as commands defined by macros, atomic
      definitions  and  list  definitions   are   completely
      independent.   in  other  words,  the  existence of an
      atomic definition for c in no way  affects  the treat-
      ment  of  c  when it appears as car of a list command,
      and the existence of a list definition for c in no way
      affects  the  treatment  of   c  when it appears as an
      atom.  in particular, c can be used  as  the  name  of
      either  an atomic command, or a list command, or both.
      in the latter case, two  entirely  different   defini-
      tions   can   be   used.    note  also  that once c is
      defined as an atomic command via a  macro  definition,

                                      Printed: July 21, 1983

The LISP Editor                                        16-16

      it  will  not  be searched for when used in a location
      specification, unless c is preceded by an f.   (insert
      --   before  bp)  would not search for bp, but instead
      perform a bk, an up, and a p, and then do  the  inser-
      tion.  The corresponding also holds true for list com-
      mands.

      (_b_i_n_d . _c_o_m_s)  bind  is  an  edit   command  which  is
      useful  mainly  in macros.  it binds three dummy vari-
      ables #1, #2, #3, (initialized to nil), and then  exe-
      cutes   the   edit  commands   coms.   note that these
      bindings are only in effect  while  the  commands  are
      being executed, and that bind can be used recursively;
      it will  rebind #1, #2,   and   #3  each  time  it  is
      invoked.

      _u_s_e_r_m_a_c_r_o_s  [_v_a_l_u_e].   this   variable   contains  the
      users editing macros .   if you want to save your mac-
      ros then you  should  save  usermacros.   you   should
      probably  also  save editcomsl.

      _e_d_i_t_c_o_m_s_l [_v_a_l_u_e].  editcomsl  is  the  list of  "list
      commands"  recognized  by  the editor.  (these are the
      ones of the form (command arg1 arg2 ...).)

   16.13.  Miscellaneous Editor Commands

____________________________________________________________

_M_I_S_C_E_L_L_A_N_E_O_U_S _E_D_I_T_O_R _C_O_M_M_A_N_D _S_U_M_M_A_R_Y

_o_k .  Exits from the editor.

_n_i_l .  Unless preceded by f or bf, is always a  null  opera-
tion.

_t_t_y:  .  Calls  the  editor  recursively.  The user can then
type in commands, and have them executed.  The tty:  command
is completed when  the  user exits  from  the lower   editor
(with   ok   or  stop).  the tty:  command is extremely use-
ful. it enables the user to  set  up a  complex   operation,
and   perform   interactive attention-changing commands part
way through it. for example the command  (move  3  to  after
cond  3  p  tty:)  allows  the user to interact, in  effect,
within  the move  command.      he can  verify  for  himself
that  the  correct  location has been found, or complete the
specification "by hand". in effect, tty: says "I'll tell you
what you should do when you get there."

_s_t_o_p .  exits from the editor with an error.  mainly for use

                                      Printed: July 21, 1983

The LISP Editor                                        16-17

in  conjunction  with  tty:  commands that the user wants to
abort.  since all of the commands in the editor are   errset
protected, the user must exit from the editor via a command.
stop provides a way of distinguishing between  a  successful
and unsuccessful  (from the user's  standpoint) editing ses-
sion.

_t_l .  tl  calls (top-level).  to return to the  editor  just
use the _r_e_t_u_r_n top-level command.

_r_e_p_a_c_k .  permits the 'editing' of an atom or string.

(_r_e_p_a_c_k $) does (lc . $) followed by  repack,  e.g.  (repack
this@).

(_m_a_k_e_f_n _f_o_r_m _a_r_g_s _n _m) .  makes (car form) an expr with  the
nth  through mth  elements  of  the  current expression with
each occurrence  of  an element of (cdr  form)  replaced  by
the  corresponding  element  of  args.   The nth through mth
elements  are replaced  by form.

(_m_a_k_e_f_n _f_o_r_m _a_r_g_s _n).  same as (makefn form args n n).

(_s _v_a_r . $) .  sets var (using setq) to the current  expres-
sion  after  performing  (lc .    $).    (s  foo)  will  set
foo to the current expression, (s foo -1 1) will set foo  to
the first element in the last element of the current expres-
sion.
____________________________________________________________

   16.14.  Editor Functions

(editf s_x1 ...)

     SIDE EFFECT: edits a function. s_x1 is the name of  the
                  function,  any additional arguments are an
                  optional list of commands.

     RETURNS: s_x1.

     NOTE: if s_x1 is not an editable function,  editf  gen-
           erates an fn not editable error.

9

9                                      Printed: July 21, 1983

The LISP Editor                                        16-18

(edite l_expr l_coms s_atm))
edits an expression.  its  value  is  the  last  element  of
(editl (list l_expr) l_coms s_atm nil nil).

(editracefn s_com)
is available to help the user debug complex edit macros,  or
subroutine  calls  to   the   editor.  editracefn  is  to be
defined by the user.  whenever the value of  editracefn   is
non-nil,   the   editor   calls  the   function   editracefn
before executing  each command (at  any  level),  giving  it
that command as its argument.  editracefn is initially equal
to nil, and undefined.

(editv s_var [ g_com1 ... ])

     SIDE EFFECT: similar  to  editf,  for  editing  values.
                  editv  sets  the  variable  to  the  value
                  returned.

     RETURNS: the name  of  the  variable  whose  value  was
              edited.

(editp s_x)

     SIDE EFFECT: similar  to  editf  for  editing  property
                  lists. used if x is nil.

     RETURNS: the atom whose property list was edited.

(editl coms atm marklst mess)

     SIDE EFFECT: editl is the editor.  its  first  argument
                  is  the  edit  chain,  and its value is an
                  edit chain, namely the value of l  at  the
                  time  editl  is  exited.   (l is a special
                  variable, and so can be examined or set by
                  edit  commands.    ^  is  equivalent to (e
                  (setq l(last l)) t).)  coms is an optional
                  list  of  commands.  for interactive edit-
                  ing, coms is nil.   in  this  case,  editl
                  types  edit  and then waits for input from
                  the teletype.  (if mess is not  nil  editl
                  types  it  instead  of edit.  for example,
                  the tty:  command is essentially  (setq  l
                  (editl  l  nil  nil  nil  (quote tty:))).)
                  exit occurs only via an ok, stop, or  save
                  command.   If  coms is not nil, no message
                  is typed,  and  each  member  of  coms  is
                  treated  as a command and executed.  If an

                                      Printed: July 21, 1983

The LISP Editor                                        16-19

                  error occurs in the execution  of  one  of
                  the  commands, no error message is printed
                  , the rest of the  commands  are  ignored,
                  and  editl  exits with an error, i.e., the
                  effect is the same as though a  stop  com-
                  mand  had  been executed.  If all commands
                  execute successfully,  editl  returns  the
                  current  value  of l.  marklst is the list
                  of marks.  on calls from editf, atm is the
                  name  of  the  function  being  edited; on
                  calls from editv, the name  of  the  vari-
                  able,  and  calls  from editp, the atom of
                  which some property of its  property  list
                  is being edited.  The property list of atm
                  is used by the save command for saving the
                  state  of  the  edit.   save will not save
                  anything if  atm=nil  i.e.,  when  editing
                  arbitrary  expressions  via edite or editl
                  directly.

(editfns s_x [ g_coms1 ... ])
fsubr function, used to perform the same editing  operations
on  several  functions.  editfns maps down the list of func-
tions, prints the name of each function, and calls the  edi-
tor (via editf) on that function.

     EXAMPLE: editfns foofns (r fie fum)) will change  every
              fie   to   fum   in  each  of the functions on
              foofns.

     NOTE: the  call  to  the  editor is  errset  protected,
           so  that if the editing of one function causes an
           error, editfns will proceed to  the  next   func-
           tion.     in  the  above  example,  if one of the
           functions did not contain a fie,  the  r  command
           would   cause   an  error, but editing would con-
           tinue with  the  next  function.   The  value  of
           editfns is nil.

(edit4e pat y)

     SIDE EFFECT: is the pattern match routine.

     RETURNS: t if pat matches y. see edit-match for defini-
              tion of 'match'.

     NOTE: before  each  search  operation  in  the   editor
           begins,  the   entire   pattern  is  scanned  for
           atoms  or strings that end  in  at-signs.   These
           are  replaced  by  patterns  of  the  form  (cons
           (quote  /@)  (explodec   atom)).       from   the

                                      Printed: July 21, 1983

The LISP Editor                                        16-20

           standpoint   of  edit4e, pattern type 5, atoms or
           strings  ending  in  at-signs,  is   really   "if
           car[pat]  is the atom @ (at-sign), pat will match
           with  any  literal atom  or  string  whose   ini-
           tial   character codes (up to the @) are the same
           as those in cdr[pat]." if  the  user  wishes   to
           call  edit4e  directly, he must therefore convert
           any patterns which contain   atoms   or   strings
           ending  in  at-signs  to  the  form recognized by
           edit4e.   this  can  be  done  via  the  function
           editfpat.

(editfpat pat flg)
makes a copy of pat with all patterns of type 5  (see  edit-
match)  converted to the form expected by edit4e. flg should
be passed as nil (flg=t is for internal use by the editor).

(editfindp x pat flg)

     NOTE: Allows a program to use the edit find command  as
           a  pure  predicate from outside the editor.  x is
           an expression, pat a pattern.  The value of edit-
           findp  is  t  if the command f pat would succeed,
           nil otherwise.  editfindp calls editfpat to  con-
           vert  pat  to the form expected by edit4e, unless
           flg=t.    if the program is applying editfindp to
           several different expressions using the same pat-
           tern, it will be more efficient to call  editfpat
           once,  and then call editfindp with the converted
           pattern and flg=t.

(## g_com1 ...)

     RETURNS: what the current  expression  would  be  after
              executing the edit commands com1 ...  starting
              from the present  edit  chain.   generates  an
              error  if  any  of  comi  cause  errors.   The
              current edit chain is never changed.  example:
              (i  r  (quote x) (## (cons ..z))) replaces all
              x's in the current  expression  by  the  first
              cons containing a z.

9

9                                      Printed: July 21, 1983


# Day 14: Extended Polymerization

get_day14_input_path <- function() {
    paste(getwd(), "/2021/Day 14/Day14_input.txt", sep = "")
}

chars <- matrix(ncol = 2)[-1, ]

part1 <- function(num_steps = 10) {
    readings <- readLines(get_day14_input_path())

    polymer <- readings[1]
    rules <- parse_rules(readings[3:length(readings)])

    for (i in 1:num_steps) {
        polymer <- polymerize(polymer, rules)
    }

    polymer_arr <- unlist(strsplit(polymer, ""))
    uniq_elements <- unique(polymer_arr)

    highest_count <- 0
    lowest_count <- 2147483647

    for (e in seq_len(length(uniq_elements))) {
        sum_of_letter <- sum(polymer_arr == uniq_elements[e])

        if (e == 1) {
            highest_count <- sum_of_letter
            lowest_count <- sum_of_letter
        } else {
            if (sum_of_letter > highest_count) {
                highest_count <- sum_of_letter
            }
            if (sum_of_letter < lowest_count) {
                lowest_count <- sum_of_letter
            }
        }
    }

    print(toString(highest_count - lowest_count))
}

part2 <- function(num_steps = 40) {
    readings <- readLines(get_day14_input_path())

    polymer <- readings[1]
    last_char <- rev(unlist(strsplit(polymer, "")))[1]
    rules <- parse_rules(readings[3:length(readings)])

    pairs <- optimize_pairs(polymer)

    for (i in 1:num_steps) {
        pairs <- polymerize_arr(pairs, rules, i == num_steps)
    }

    chars <<- merge_set(chars, last_char, 1)
    char_sums <- sort(as.numeric(chars[, 2]), decreasing = TRUE)

    print(chars)
    print(toString(char_sums[1] - char_sums[length(char_sums)]))
}

parse_rules <- function(readings) {
    templates <- strsplit(readings, " -> ")
    rules <- list()

    for (i in seq_len(length(templates))) {
        template <- unlist(templates[i])
        rules[[template[1]]] <- append(rules[[template[1]]], template[2])
    }
    rules
}

polymerize <- function(polymer, rules) {
    polymer_arr <- unlist(strsplit(polymer, ""))
    elements_to_insert <- c()

    for (i in seq_len(length(polymer_arr) - 1)) {
        template <- paste(polymer_arr[i], polymer_arr[i + 1], sep = "")
        elements_to_insert <- append(elements_to_insert, rules[[template]])
    }

    new_polymer_arr <- c()

    for (e in seq_len(length(elements_to_insert))) {
        new_polymer_arr <- append(new_polymer_arr, polymer_arr[e])
        new_polymer_arr <- append(new_polymer_arr, elements_to_insert[e])
    }

    new_polymer_arr <- append(new_polymer_arr, polymer_arr[length(polymer_arr)])
    paste(new_polymer_arr, collapse = "")
}

optimize_pairs <- function(polymer) {
    pairs <- matrix(ncol = 2)[-1, ]
    polymer_arr <- unlist(strsplit(polymer, ""))

    for (i in seq_len(length(polymer_arr) - 1)) {
        template <- paste(polymer_arr[i], polymer_arr[i + 1], sep = "")
        pairs <- merge_set(pairs, template, 1)
    }
    pairs
}

polymerize_arr <- function(pairs, rules, calc_chars) {
    new_pairs <- matrix(ncol = 2)[-1, ]

    for (i in seq_len(nrow(pairs))) {
        element_to_insert <- rules[[pairs[i, 1]]]

        char_arr <- unlist(strsplit(pairs[i, 1], ""))
        pair_arr <- char_arr
        pair_arr[1] <- paste(pair_arr[1], element_to_insert, sep = "")
        pair_arr[2] <- paste(element_to_insert, pair_arr[2], sep = "")

        for (p in seq_len(length(pair_arr))) {
            new_pairs <- merge_set(new_pairs, pair_arr[p], pairs[i, 2])
        }

        if (calc_chars) {
            chars <<- merge_set(chars, char_arr[1], pairs[i, 2])
            chars <<- merge_set(chars, element_to_insert, pairs[i, 2])
        }
    }
    new_pairs
}

merge_set <- function(set, element, num_to_add) {
    match <- which(set[, 1] == element, arr.ind = TRUE)

        if (length(match) == 0) {
            set <- rbind(set, c(element, num_to_add))
        } else {
            set[match, 2] <- as.numeric(set[match, 2]) +
                               as.numeric(num_to_add)
        }
    set
}

part1()
part2()


##
# spr_class.r
# Copyright (C) Jonathan Bramble 2011
#
# FBF-Optics is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# FBF-Optics is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
# See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program.  If not, see <http://www.gnu.org/licenses/>.

#' An S4 class to represent a SPR experiment for a single angle point.
#'
#'
#' @slot lambda Wavelength of light
#' @slot n_entry Refractive index of the entry medium, eg a Prism
#' @slot n_exit Refractive index of the exit medium
#' @slot angle Exterior angle in degrees
#'
SPR <- setClass("SPR",
                representation(
                  lambda="numeric",
                  n_entry="numeric",
                  n_exit="numeric",
                  angle="numeric",
                  layers="list"
                ),
                prototype(lambda=633e-9,n_entry=1.85,n_exit=1.33,angle=55)
)

#' An S4 class to represent a SPR experiment over a range of thicknesses for one layer.
#'
#'
#' @slot lambda Wavelength of light
#' @slot n_entry Refractive index of the entry medium, eg a Prism
#' @slot angle Exterior angle in degrees
#' @slot n_exit Refractive index of the exit medium
#'
SPRD <- setClass("SPRD",
                 representation(
                   points="numeric",
                   lambda="numeric",
                   n_entry="numeric",
                   n_exit="numeric",
                   angle="numeric",
                   layers="list"
                 ),
                 prototype(lambda=633e-9,n_entry=1.85,n_exit=1.33,angle=50)
)

#' An S4 class to represent a SPR experiment over a range of angles.
#' G represents an angular variation to produce the classic spr curve
#'
#' @slot points The number of data points
#' @slot lambda Wavelength of light
#' @slot n_entry Refractive index of the entry medium, eg a Prism
#' @slot n_exit Refractive index of the exit medium
#' @slot start_angle Exterior starting angle in degrees
#' @slot end_angle Exterior ending angle in degrees
#'
SPRG <- setClass("SPRG",
                 representation(
                   points="numeric",
                   lambda="numeric",
                   n_entry="numeric",
                   n_exit="numeric",
                   start_angle="numeric",
                   end_angle="numeric",
                   layers="list"
                 ),
                 prototype(points=100,lambda=633e-9,n_entry=1.78,n_exit=1.33,start_angle=45,end_angle=60)
)

#' An S4 class to represent a SPR experiment over a range of thicknesses for one layer.
#'
#'
#' @slot lambda Wavelength of light
#' @slot n_entry Refractive index of the entry medium, eg a Prism
#' @slot angle Exterior angle in degrees
#' @slot n_exit Refractive index of the exit medium
#' TODO: ADD OTHER SLOTS
SPRI <- setClass("SPRI",
                 representation(
                   points="numeric",
                   lambda="numeric",
                   n_entry="numeric",
                   n_exit="numeric",
                   angle="numeric",
                   polariser="numeric",
                   modulator="numeric",
                   analyser="numeric",
                   mod_amplitude="numeric",
                   layers="list"
                 ),
                 prototype(lambda=633e-9,n_entry=1.78,n_exit=1.33,angle=50,polariser=30,modulator=30,analyser=172,mod_amplitude=1)
)

validitySPR <- function(object){
  retval <- NULL
  if(object@angle > 90) {
    retval <- c(retval,"angle is greater than 90")
  }
  if ( is.null(retval)) return (TRUE)
  else return ( retval )
}

validitySPRG <- function(object){
  ## add real tests here - what can we check? n_entry > n_exit? end_angle > start_angle, end angle < 90
  retval <- NULL
  if(object@end_angle > 90) {
    retval <- c(retval,"end angle is greater than 90")
  }
  if ( is.null(retval)) return (TRUE)
  else return ( retval )
}

validitySPRD <- function(object){
  ## add real tests here - what can we check? n_entry > n_exit? end_angle > start_angle, end angle < 90
  retval <- NULL
  if(object@angle > 90) {
    retval <- c(retval,"end angle is greater than 90")
  }
  if ( is.null(retval)) return (TRUE)
  else return ( retval )
}

setValidity("SPR",validitySPR)
setValidity("SPRD",validitySPRD)
setValidity("SPRG",validitySPRG)
setValidity("SPRI",validitySPR)

#setters
setGeneric("points<-",function(x,value) standardGeneric("points<-"))
setGeneric("angle<-",function(x,value) standardGeneric("angle<-"))
setGeneric("n_entry<-",function(x,value) standardGeneric("n_entry<-"))
setGeneric("n_exit<-",function(x,value) standardGeneric("n_exit<-"))
setGeneric("start_angle<-",function(x,value) standardGeneric("start_angle<-"))
setGeneric("end_angle<-",function(x,value) standardGeneric("end_angle<-"))
setGeneric("lambda<-",function(x,value) standardGeneric("lambda<-"))
setGeneric("polariser<-",function(x,value) standardGeneric("polariser<-"))
setGeneric("analyser<-",function(x,value) standardGeneric("analyser<-"))
setGeneric("mod_amplitude<-",function(x,value) standardGeneric("mod_amplitude<-"))
setGeneric("modulator<-",function(x,value) standardGeneric("modulator<-"))
setGeneric("run", function(object) {standardGeneric("run")})

setReplaceMethod("points","SPR", function(x,value) {x@points <- value; validObject(x); x})
setReplaceMethod("angle","SPR", function(x,value) {x@angle <- value; validObject(x); x})
setReplaceMethod("n_entry","SPR", function(x,value) {x@n_entry <- value; validObject(x); x})
setReplaceMethod("n_exit","SPR", function(x,value) {x@n_exit <- value; validObject(x); x})
setReplaceMethod("lambda","SPR", function(x,value) {x@lambda <- value; validObject(x); x})

setReplaceMethod("points","SPRD", function(x,value) {x@points <- value; validObject(x); x})
setReplaceMethod("angle","SPRD", function(x,value) {x@angle <- value; validObject(x); x})
setReplaceMethod("n_entry","SPRD", function(x,value) {x@n_entry <- value; validObject(x); x})
setReplaceMethod("n_exit","SPRD", function(x,value) {x@n_exit <- value; validObject(x); x})
setReplaceMethod("lambda","SPRD", function(x,value) {x@lambda <- value; validObject(x); x})

setReplaceMethod("points","SPRG", function(x,value) {x@points <- value; validObject(x); x})
setReplaceMethod("start_angle","SPRG", function(x,value) {x@start_angle <- value; validObject(x); x})
setReplaceMethod("end_angle","SPRG", function(x,value) {x@end_angle <- value; validObject(x); x})
setReplaceMethod("n_entry","SPRG", function(x,value) {x@n_entry <- value; validObject(x); x})
setReplaceMethod("n_exit","SPRG", function(x,value) {x@n_exit <- value; validObject(x); x})
setReplaceMethod("lambda","SPRG", function(x,value) {x@lambda <- value; validObject(x); x})

setReplaceMethod("points","SPRI", function(x,value) {x@points <- value; validObject(x); x})
setReplaceMethod("angle","SPRI", function(x,value) {x@angle <- value; validObject(x); x})
setReplaceMethod("n_entry","SPRI", function(x,value) {x@n_entry <- value; validObject(x); x})
setReplaceMethod("n_exit","SPRI", function(x,value) {x@n_exit <- value; validObject(x); x})
setReplaceMethod("lambda","SPRI", function(x,value) {x@lambda <- value; validObject(x); x})
setReplaceMethod("polariser","SPRI", function(x,value) {x@polariser <- value; validObject(x); x})
setReplaceMethod("analyser","SPRI", function(x,value) {x@analyser <- value; validObject(x); x})
setReplaceMethod("mod_amplitude","SPRI", function(x,value) {x@mod_amplitude <- value; validObject(x); x})
setReplaceMethod("modulator","SPRI", function(x,value) {x@modulator <- value; validObject(x); x})

setGeneric("curve", function(object) {standardGeneric("curve")})
setGeneric("sprmin", function(object){standardGeneric("sprmin")})
setGeneric("rppval", function(e1,e2) {standardGeneric("rppval")})

setMethod("rppval",signature(e1="SPR",e2="numeric"),function(e1,e2){
  Rpp<-S4_SPRVAL(e1,e2)
  return(Rpp)
})

setMethod("sprmin",signature(object="SPR"),function(object){
  Rpp<-S4_SPRMIN(object)
  return(Rpp)
})

setMethod("sprmin",signature(object="SPRG"),function(object){
  Rpp<-S4_SPRMIN(object)
  return(Rpp)
})

setMethod("curve",signature(object="SPRD"),function(object){
  Rpp<-S4_SPRD(object)
  return(Rpp)
})

setMethod("curve",signature(object="SPRG"),function(object){
  Rpp<-S4_SPRG(object)
  int_angle <- seq(length=object@points,from=object@start_angle,to=object@end_angle)
  dat <- cbind(int_angle,Rpp)
  return(dat)
})

setMethod("curve",signature(object="SPRG"),function(object){
  Rpp<-S4_SPRG(object)
  int_angle <- seq(length=object@points,from=object@start_angle,to=object@end_angle)
  dat <- cbind(int_angle,Rpp)
  return(dat)
})

setMethod("run",signature(object="SPRI"),function(object){
  Rpp<-S4_SPRI(object)
  return(Rpp)
})

setMethod("show", signature(object="SPR"), function(object){
  cat(" SPR base data \n")
  cat(" Wavelength:", object@lambda , "\n")
  cat(" Angle:", object@angle , "\n")
  cat(" Entry Medium Index:", object@n_entry , "\n")
  cat(" Exit Medium Index:", object@n_exit , "\n")
})

setMethod("show", signature(object="SPRD"), function(object){
  cat(" SPRD base data \n")
  cat(" Number of data points:", object@points , "\n")
  cat(" Wavelength:", object@lambda , "\n")
  cat(" Angle:", object@angle , "\n")
  cat(" Entry Medium Index:", object@n_entry , "\n")
  cat(" Exit Medium Index:", object@n_exit , "\n")
})

setMethod("show", signature(object="SPRG"), function(object){
  cat(" SPRG base data \n")
  cat(" Number of data points:", object@points , "\n")
  cat(" Wavelength:", object@lambda , "\n")
  cat(" Starting Angle:", object@start_angle , "\n")
  cat(" Ending Angle:", object@end_angle , "\n")
  cat(" Entry Medium Index:", object@n_entry , "\n")
  cat(" Exit Medium Index:", object@n_exit , "\n")
})

setMethod("show", signature(object="SPRI"), function(object){
  cat(" SPRI base data \n")
  cat(" Number of data points:", object@points , "\n")
  cat(" Wavelength:", object@lambda , "\n")
  cat(" Angle:", object@angle , "\n")
  cat(" Entry Medium Index:", object@n_entry , "\n")
  cat(" Exit Medium Index:", object@n_exit , "\n")
})

setMethod("+", signature(e1="SPR",e2="IsoLayer"), function(e1,e2){
  e1@layers <- c(e1@layers,e2)
  structure(e1,class="SPR")
})

setMethod("+", signature(e1="SPRD",e2="IsoLayer"), function(e1,e2){
  e1@layers <- c(e1@layers,e2)
  structure(e1,class="SPRD")
})

setMethod("+", signature(e1="SPRG",e2="IsoLayer"), function(e1,e2){
  e1@layers <- c(e1@layers,e2)
  structure(e1,class="SPRG")
})

setMethod("+", signature(e1="SPRI",e2="IsoLayer"), function(e1,e2){
  e1@layers <- c(e1@layers,e2)
  structure(e1,class="SPRI")
})


## Created on Friday, January 28, 2022 at 6:08pm EDT by WeekendEditor on WeekendEditorMachine.
## Copyright (c) 2022, SomeWeekendReading.blog.  All rights reserved.  As if you care.

toolsDir <- "../../tools"                              #
source(file.path(toolsDir, "pipeline-tools.r"))        #
source(file.path(toolsDir, "graphics-tools.r"))        # Various graphics hacks

library("lubridate")                                   # For floor_date(), ceiling_date()
library("PerformanceAnalytics")                        # For chart.Correlation()
library("plyr")                                        # For ddply()

##
## Research question: Does the MWRA's metagenomic measurement of SARS-COV-2 RNA in
## wastewater predict later hospitalization or death rates or positive test rates?
##
## Hypotheses: hospitalization & death rates might work; positive test rates probably
## won't, due to changes in test availability, test type, and testing policy.
##
## Did not consider test positivity rates, since testing has changed from basically unavailable
## to somewhat available, and the reporting has been spotty enough to make the numbers useless.
##
## Should consider forcing intercept to 0 in linear models, for 0 COVID deaths when there's
## 0 SARS-CoV2 RNA present.  Might improve some of the fits, from the look of it.
##
## This time we're using US county-level data from the New York Times (updated daily?):
##   https://github.com/nytimes/covid-19-data
##   The file we want is us-counties.csv, at top level.
##
## See also the covdata package, which incorporates several data sources (now out of date):
##   https://kjhealy.github.io/covdata/
##
## CDC on wastewater surveillance:
##   https://twitter.com/CDCgov/status/1436074326437019651
##   https://www.cdc.gov/mmwr/volumes/70/wr/mm7036a2.htm?s_cid=mm7036a2_w
##   https://www.cdc.gov/mmwr/volumes/70/wr/pdfs/mm7036a2-H.pdf
##
## Biobot.io suggests:
##   https://usafacts.org/visualizations/coronavirus-covid-19-spread-map/
##
## MWRA on viral RNA levels in wastewater:
##   https://www.mwra.com/biobot/biobotdata.htm
##
## But going to biobot.io finds this repository:
##   https://github.com/biobotanalytics/covid19-wastewater-data
##
##   See: wastewater_by_county.csv and cases_by_county.csv
##
##   However, it doesn't contain data for Norfolk county MA, and has very different
##   numbers (hence the use of the word "normalized"?).  I don't understand it, so I'm
##   going to stick with the direct-from-the-MWRA data.
##
## Getting the MWRA data out of PDF hell (latest was MWRAData20220128-data.pdf):
##
## - Just pasting it into a text file or even a spreadsheet is a bit of a nightmare, where the
##   values never QUITE go where you want.
## - We used the method in https://productivityspot.com/convert-pdf-to-google-sheets/:
##   o Download the MWRA PDF file to our local machine, then upload to Google Drive.
##   o In Google Drive, open the PDF file with Google Docs (not a PDF viewer).
##   o Select the table (not the whole document, which has header lines &c).  E.g., click
##     on topmost, leftmost cell then command-click (control-click) on the bottommost, rightmost
##     cell at the bottom of the file.  Then copy.
##   o Open a new Google Sheets spreadsheet, select A1, and paste.
##   o Download it as a .tsv file, spot-check against the .pdf, then gzip compress it.
## No idea why that works whereas copying from PDF preview to any other spreadsheet just
## gives chaos.  Possibly because it's seamless Google tools from end to end?
##
## Anyway, spot-checking the result against the original confirms that it's likely right, at
## least in the 20-30 places we checked.
##

doit <- function(## Inputs
                 dataDir          = "./data",
                 ## *** NB: On 2021-01-25, the South RNA was 3772, which looks like an
                 ##     outlier, even after averaging with the North.
                 mwraDataFile     = "MWRAData20220201-data.tsv.gz",
                 covidDataFile    = "us-counties.csv.gz",
                 state            = "Massachusetts",
                 counties         = c("Suffolk", "Middlesex", "Norfolk"),

                 ## Outputs
                 resultsDir    = "./results",
                 txFile        = "mwra-covid-transcript.txt",
                 jointDataFile = "mwra-covid-joint-data.tsv",
                 nsPlotFile    = "plot-north-south.png",
                 predSetFile   = "mwra-covid-joint-data-prediction-set.tsv",
                 corrPlotFile1 = "plot-med-loads-vs-RNA-1.png",
                 corrPlotFile2 = "plot-med-loads-vs-RNA-2.png",
                 lagPlotFile   = "plot-RNA-%s-lags.png",
                 regPlotFile   = "plot-RNA-%s-regression.png",
                 regStatsFile  = "finalRegressionsTable.tsv") {

  reportStructure <- function(df) {                    # Report structure of a dataframe
    cat(sprintf("\n  - Structure:\n    o %d rows\n    o %d columns: %s\n",
                nrow(df), ncol(df), paste(colnames(df), collapse = ", ")))
    showDataframeHeadTail(df)                          # Show first few & last few rows
  }                                                    # Basically shape + column names

  isNonNegativeIntOrNA <- function(x) { is.na(x) | (is.integer(x) & x >= 0) }

  loadCOVIDData <- function(dataDir, covidDataFile, theState, counties) {
    f  <- file.path(dataDir, covidDataFile)            # Where the data lives
    cat(sprintf("* Reading US county-level COVID data from %s", f))
    covidData <- transform(subset(loadCompressedDataframe(f, sep = ",", header = TRUE, quote = ""),
                                  subset = state == theState & county %in% counties),
                           date   = as.Date(as.character(date), format = "%Y-%m-%d"),
                           county = factor(county))    # Drop unused levels
    covidData <- covidData[order(covidData$"date"), ]  # Sort by date; insist dates increment by 1
    ddply(covidData, "county", function(cdf) { stopifnot(all(diff(cdf$"date") == 1)); NULL })

    empties <- c("state", "fips", names(which(sapply(covidData, function(c) { all(is.na(c)) }))))
    cat(sprintf("\n  - Dropping %d columns for being empty or for being state & fips: %s",
                length(empties), paste(empties, collapse = ", ")))
    covidData <- subset(covidData, select = setdiff(colnames(covidData), c(empties)))

    stopifnot(colnames(covidData) == c("date", "county", "cases", "deaths"))
    colnames(covidData) <- c("Date", "County", "Cases", "Deaths")

    ## Sanity check, because not everybody is sane.  At least, not all the time
    stopifnot(all(isNonNegativeIntOrNA(covidData$"Cases")))
    stopifnot(all(isNonNegativeIntOrNA(covidData$"Deaths")))

    cat(sprintf("\n  - Differentiating cumulative cases & deaths to get daily increments"))
    covidData <- ddply(covidData, "County", function(cdf) {
      cbind(cdf,                                       # Initial value from cumulant, diff after
            data.frame(Cases.New  = c(cdf[1, "Cases"],  diff(cdf$"Cases")),
                       Deaths.New = c(cdf[1, "Deaths"], diff(cdf$"Deaths"))))
    })                                                 #

    reportStructure(covidData)                         # See what we caught
    covidData                                          # Return the data
  }                                                    #

  loadMWRAData <- function(dataDir, mwraDataFile) {    # Load the MWRA's metagenomic data
    f  <- file.path(dataDir, mwraDataFile)             # Painfully hand-extracted from a PDF
    cat(sprintf("\n* Reading MWRA wastewater RNA data from %s", f))
    mwraData <- transform(loadCompressedDataframe(f, sep = "\t", header = TRUE,
                                                  na.strings = c("ND", "")),
                          Sample.Date = as.Date(as.character(Sample.Date), format = "%m/%d/%Y"))
    colnames(mwraData)[1:11] <- c("Date", "South", "North", "South.7", "North.7",
                                  "South.LCL", "South.UCL", "North.LCL", "North.UCL",
                                  "South.Variant", "North.Variant")

    ## *** UCL & LCL columns make no sense: they don't bracket the data or its 7 day average?
    mwraData <- subset(mwraData,                       # Drop cols we don't understand & can't use
                       select = -c(South.Variant, North.Variant,
                                   South.LCL,     North.LCL,
                                   South.UCL,     North.UCL))
    stopifnot(colnames(mwraData) == c("Date", "South", "North", "South.7", "North.7"))

    mwraData <- subset(mwraData,                       # Keep only rows w/ at least 1 datum
                       subset = !is.na(South) | !is.na(North) | !is.na(South.7) | !is.na(North.7))

    ## Sanity check, because not everybody is sane.  At least, not all the time
    stopifnot(all(isNonNegativeIntOrNA(mwraData$"South")))
    stopifnot(all(isNonNegativeIntOrNA(mwraData$"North")))
    stopifnot(all(isNonNegativeIntOrNA(mwraData$"South.7")))
    stopifnot(all(isNonNegativeIntOrNA(mwraData$"North.7")))
    ## stopifnot(all(diff(mwraData$"Date") == 1))         # Missing data 2020-05-12 thru 2020-05-20

    reportStructure(mwraData)                          # See what fish we caught
    mwraData                                           # Return the data
  }                                                    #

  makeJointData <- function(mwraData, covidData, resultsDir, jointDataFile) {
    ## NB: MWRA data is copied for each county in this slightly crazy representation!
    cat("\n\n* Constructing joint dataset by inner join on dates")
    jointData <- merge(mwraData, covidData, by = "Date", all = FALSE)
    jointData <- jointData[order(jointData$"Date"), ]  # Sort it by date

    f  <- file.path(resultsDir, jointDataFile)         # Save it away for peer review
    saveDataframe(jointData, f)                        #
    cat(sprintf("\n  - Saved to %s", f))               #

    reportStructure(jointData)                         # See what we caught
    cat("\n")                                          #
    jointData                                          # Return the data
  }                                                    #

  plotNorthSouth <- function(jointData, resultsDir, nsPlotFile) {
    jointData <- unique(subset(jointData, select = c(Date, North, South)))
    jointData <- subset(jointData, subset = complete.cases(jointData))
    f <- file.path(resultsDir, nsPlotFile)             #
    withPNG(f, 850, 425, FALSE, function() {           #
      withPars(function() {                            #
        rnaCols  <- c("North" = "blue", "South" = "gray")
        matplot(x = jointData$"Date",                  # North & south RNA vs time
                y = subset(jointData, select = names(rnaCols)),
                type = "p", pch = 21, col = "black", bg = rnaCols, log = "y",
                xaxt = "n", xlab = NA, ylab = "RNA (copies/ml, log scale)",
                main = "RNA Levels vs Time")           #
        axis.Date(1,                                   #
                  at     = seq(from = floor_date(min(jointData$"Date"), "month"),
                               to   = ceiling_date(max(jointData$"Date"), "month"),
                               by   = "2 months"),     # Kind of miraculous this works at all
                  format = "%Y-%b-%d")                 #  it's really seq.Date()
        legend("topleft", bg = "antiquewhite", inset = 0.01,
               pch = 21, pt.bg = rnaCols, pt.cex = 1.5, legend = names(rnaCols))

        jointRange <- c(5, max(jointData$"North", jointData$"South", na.rm = TRUE))
        scatterplotWithDensities(xs = jointData$"South", ys = jointData$"North",
                                 bgs = "steelblue", log = "xy",
                                 regressionColor = NULL,# doesn't work on log scale
                                 xlab = "South RNA (copies/ml, log scale)",
                                 ylab = "North RNA (copies/ml, log scale)",
                                 xlim = jointRange, ylim = jointRange,
                                 main = as.expression(bquote(bold(paste(
                                     "North/South Correlation: ",
                                     bolditalic(R)^2 == .(
                                       sprintf("%.0f%%",
                                               100.0 * cor(jointData$"North",
                                                           jointData$"South")^2)))))))

        title(main = "MWRA Wastewater SARS-CoV2 RNA: North vs South", outer = TRUE)

      }, pty   = "m",                                  # Maximal plotting area
         bg    = "white",                              # Background
         mar   = c(7, 4, 2, 1),                        # Margins (e.g., to hold date labels)
         mgp   = c(3.00, 0.5, 0),                      # Axis title, label, tick
         mfrow = c(1, 2),                              # 1x2 array of plots
         oma   = c(0, 0, 1, 0),                        # Make room at top for overall title
         ps    = 16,                                   # Larget type size for file capture
         las   = 2)                                    # Labels perpendicular to axes
    })                                                 # End file capture
    cat(sprintf("* Plot of north vs south RNA to %s\n", f))
    TRUE                                               # Flag that it was done
  }                                                    #

  makePredictionSet <- function(jointData, resultsDir, predSetFile) {
    cat(sprintf("* Making prediction set:"))           # Data used in regressions (with lags)

    cat(sprintf("\n  - Averaging North and South daily mRNA measurements"))
    rnaData <- subset(transform(unique(subset(jointData, select = c(Date, South, North))),
                                RNA = ifelse(is.na(South),
                                             North,    #
                                             ifelse(is.na(North),
                                                    South,
                                                    (South + North) / 2.0))),
                      select = c(Date, RNA))           #

    cat(sprintf("\n  - For each day, summing cases and deaths over counties"))
    medData <- ddply(unique(subset(jointData, select = c(Date, County, Cases.New, Deaths.New))),
                     "Date",                           #
                     function(ddf) {                   #
                       data.frame(Cases = sum(ddf$"Cases.New"), Deaths = sum(ddf$"Deaths.New"))
                     })                                #

    cat(sprintf("\n  - Outer joining RNA data and medical data"))
    predictionSet <- merge(rnaData, medData, by = "Date", all = TRUE)
#    stopifnot(all(diff(predictionSet$"Date") == 1))    # Missing data 2021-May-12 thru 2021-May-20
    reportStructure(predictionSet)                     #

    f <- file.path(resultsDir, predSetFile)            # Save results for peer review
    saveDataframe(predictionSet, f)                    #
    cat(sprintf("\n  - Saved to %s.\n", f))            #

    predictionSet                                      # Return the prediction set
  }                                                    #

  plotCorrelations <- function(predictionSet, resultsDir, corrPlotFile1, corrPlotFile2) {

    timeFile <- file.path(resultsDir, corrPlotFile1)   #
    withPNG(timeFile, 600, 600, FALSE, function() {    #
      withPars(function() {                            #
        matplot(x = predictionSet$"Date",              #
                ## *** Z-scoring is a bit of a hack here, making the values harder to
                ## interpret.  But it DOES get them all on the same scale so we can see
                ## the structure in the plot.  If there were only 2 vars, I'd do a second
                ## y axis on the right; but as there are 5...
                y = scale(as.matrix(predictionSet[, c("RNA", "Cases", "Deaths")])),
                xaxt = "n", xlab = NA, ylab = "Z-scored RNA & med vars",
                main = "RNA & Medical Vars vs Time",  #
                pch = 21, col = "black", bg = 1 : (2 + 1))
        axis.Date(1,                                   # *** Get dates to print more regularly?
                  at     = seq(from = floor_date(min(jointData$"Date"), "month"),
                               to   = ceiling_date(max(jointData$"Date"), "month"),
                               by   = "month"),        # Kind of miraculous this works at all
                  format = "%Y-%b-%d")                 #
        legend("top", , bg = "antiquewhite", inset = 0.01,
               pch = 21, pt.bg = 1 : (2 + 1), legend = c("RNA", "Cases", "Deaths"))
      }, pty   = "m",                                  # Maximal plotting area
         bg    = "white",                              # Background
         mar   = c(7, 3, 2, 1),                        # Margins (e.g., to hold date labels)
         mgp   = c(1.75, 0.5, 0),                      # Axis title, label, tick
         ps    = 16,                                   # Larget type size for file capture
         las   = 2)                                    # Labels perpendicular to axes
    })                                                 #
    cat(sprintf("* Correlation time courses plotted to %s", timeFile))

    chartFile <- file.path(resultsDir, corrPlotFile2)  #
    withPNG(chartFile, 600, 600, FALSE, function() {   #
      chart.Correlation(subset(predictionSet, select = -Date), histogram = TRUE, pch = 19)
    })                                                 #
    cat(sprintf("\n* Correlation chart plotted to %s\n", chartFile))

    TRUE                                               # Flag that it has been done
  }                                                    #

  lagVector <- function(x, k) {                        # Put k NA's @ front, drop last k values
    if (k < 0)                                         # Don't be silly
      stop(sprintf("lagVector() can't handle negative k = %d?!", k))
    else if (k > length(x))                            # Really: don't be silly
      stop(sprintf("lagVector() can't handle k = %d, > length of vector %d?!", k, length(x)))
    else if (k == 0)                                   # Ok, this is only a LITTLE silly
      x                                                #  lag of 0 means no change
    else                                               # Otherwise reasonable lag: put k NA's on
      c(rep(NA, k), head(x, -k))                       #  the front, drop the last k elements
  }                                                    #

  lmp <- function (mdl) { anova(mdl)$"Pr(>F)"[[1]] }   # Why isn't this cached in the model?!

  laggedRegressions <- function(predictionSet, depVar, indepVar, lags) {
    ldply(lags, function(lag) {                        # For each lag, construct dataset with
      mdl <- lm(as.formula(sprintf("%s ~ %s", depVar, "indepVar.lag")),
                data = transform(predictionSet,        #  RNA lagged, extract p-value and adj R2
                                 indepVar.lag = lagVector(predictionSet[, indepVar], lag)))
      data.frame(MedVar = depVar, Lag = lag, p = lmp(mdl), Adj.R2 = summary(mdl)$"adj.r.squared")
    })                                                 # We'll use this to find the best lags
  }                                                    #  for each medical load variable

  plotLaggedRegressions <- function(waveName, regressionLags, resultsDir, lagPlotFile) {
    cat(sprintf("\n* Scatterplotting significance & strength vs RNA lag"))
    ddply(regressionLags, "MedVar", function(mvdf) {   #
      f <- file.path(resultsDir, sprintf(lagPlotFile, as.character(mvdf[1, "MedVar"])))

      withPNG(f, 400, 400, FALSE, function() {
        withPars(function() {                          # Plot -log10(p) & Adj R2 (diff y axes)
          plot(x = mvdf$"Lag", y = jitter(-log10(mvdf$"p")),
               pch = 21, col = "black", bg = "black", xlab = "Lag", ylab = "-log10(p)",
               main = sprintf("%s %s: Effect of Lag", waveName, as.character(mvdf[1, "MedVar"])))
          par(new = TRUE)                              # "as if for a new plot"... sheesh
          plot(x = mvdf$"Lag", y = mvdf$"Adj.R2",      # Other y axis (different scale)
               pch = 21, col = "blue", bg = "blue", ylim = range(mvdf$"Adj.R2"),
               xaxt = "n", yaxt = "n", xlab = NA, ylab = NA, main = NA)
          axis(4, col = "blue", col.ticks = "blue", col.axis = "blue")
          mtext("Adjusted R2", side = 4, col = "blue", line = 2)
        }, pty   = "m",                                # Maximal plotting area
           bg    = "white",                            # Background
           mar   = c(3, 3, 2, 3),                      # Margins (e.g., to hold date labels)
           mgp   = c(1.7, 0.5, 0),                     # Axis title, label, tick
           ps    = 16)                                 # Larget type size for file capture
      })

      cat(sprintf("\n  - %s", f))                      #
      NULL                                             #
    })                                                 #
    cat("\n")                                          #

    TRUE                                               #
  }                                                    #

  findOptimalLags <- function(regressionLags) {        # Find best by p-value (same as R^2)
    cat("\n* Optimal lags for each medical variable:\n")
    optimalLags <- ddply(regressionLags, "MedVar", function(df) {
      minp <- min(df$"p")                              #
      subset(df, subset = p == minp)                   #
    })                                                 #
    print(optimalLags)                                 #
    optimalLags                                        #
  }                                                    #

  finalRegressions <- function(waveName, optimalLags, predictionSet, resultsDir, regPlotFile) {
    cat("* Trying some regressions at the optimal lag for each variable:")
    ddply(optimalLags, "MedVar", function(df) {        #
      mv  <- as.character(df[1, "MedVar"])             #
      lag <- df[1, "Lag"]                              #
      cat(sprintf("\n  - Regressing %s on RNA at lag %d days:", mv, lag))

      mdl <- lm(as.formula(sprintf("%s ~ RNA", mv)),  #
                data = transform(predictionSet, RNA = lagVector(predictionSet[, "RNA"], lag)))
      mdlSum <- summary(mdl)
      mdlCI  <- confint(mdl)
      print(summary(mdl))                              #
      print(mdlCI)                                     #

      p      <- lmp(mdl)                               #
      adj.R2 <- summary(mdl)$"adj.r.squared"           #

      f <- file.path(resultsDir, sprintf(regPlotFile, mv))
      withPNG(f, 400, 400, FALSE, function() {         #
        withPars(function() {                          #
          ## Confidence intervals: 95% ci of mean at that input
          ## Prediction intervals: 95% ci of single prediction at that input
          ## PI always wider than CI, for same reason that sd is wider than se of mean by sqrt(N)
          RNARange      <- range(predictionSet$"RNA", na.rm = TRUE)
          predictFrom   <- data.frame("RNA" = seq(from = RNARange[[1]], to = RNARange[[2]],
                                                  length.out = 100))
          mdlPredictsCI <- cbind(predictFrom, predict(mdl, newdata = predictFrom,
                                                      interval = "confidence"))
          mdlPredictsPI <- cbind(predictFrom, predict(mdl, newdata = predictFrom,
                                                      interval = "prediction"))

          plot(x = lagVector(predictionSet$"RNA", lag), y = predictionSet[, mv],
               pch = 21, bg = "blue",                  #
               xlab = sprintf("RNA (copies/ml, %d days lag)", lag), ylab = mv,
               main = sprintf("%s %s vs RNA", waveName, mv))
          mtext(as.expression(bquote(                  # Report regression stats at bottom
                     paste(italic(p) %~% .(scientificExpression(p, places = 1)), ", adjusted ",
                           italic(R)^2 %~% .(sprintf("%.1f%%", 100.0 * adj.R2)))
                )), side = 1, line = 3.2)              #
          abline(reg = mdl, col = "black", lwd = 2)    #

          lightBlue   <- rgb(0, 0, 1, alpha = 0.2)     # Conf interval of mean in light color
          polygon(x = c(mdlPredictsCI[,"RNA"], rev(mdlPredictsCI[, "RNA"])),
                  y = c(mdlPredictsCI[, "lwr"], rev(mdlPredictsCI[, "upr"])),
                  col = lightBlue, border = NA)        #

          lighterBlue <- rgb(0, 0, 1, alpha = 0.1)     # Prediction interval in even lighter color
          polygon(x = c(mdlPredictsPI[,"RNA"], rev(mdlPredictsPI[, "RNA"])),
                  y = c(mdlPredictsPI[, "lwr"], rev(mdlPredictsPI[, "upr"])),
                  col = lighterBlue, border = NA)      #

        }, pty   = "m",                                # Maximal plotting area
           bg    = "white",                            # Background
           mar   = c(4, 3, 2, 1),                      # Margins (e.g., to hold date labels)
           mgp   = c(1.7, 0.5, 0),                     # Axis title, label, tick
           ps    = 16)                                 # Larger type size for file capture
      })                                               #
      cat(sprintf("\n    o Plot to %s\n", f))          #

      data.frame(MedVar      = mv,
                 Wave        = waveName,
                 Lag.Days    = lag,
                 p           = signif(p, digits = 2),
                 AdjR2Pct    = signif(100.0 * adj.R2, digits = 1),
                 Intercept   = signif(coef(mdl)[["(Intercept)"]], digits = 2),
                 InterceptCL = sprintf("%+.2f - %+.2f",
                                       mdlCI["(Intercept)", "2.5 %"], mdlCI["(Intercept)", "97.5 %"]),
                 Slope       = signif(coef(mdl)[["RNA"]], digits = 2),
                 SlopeCL     = sprintf("%+.2f - %+.2f",
                                       mdlCI["RNA", "2.5 %"], mdlCI["RNA", "97.5 %"]))
    })                                                 #
  }                                                    #

  ## Main body of script begins here
  withTranscript(dataDir, resultsDir, txFile, "MWRA COVID Analysis", function() {

    heraldPhase("Archival")                            # For peer review
    archiveAnalysisScript(resultsDir, "./mwra-covid-3.r")

    heraldPhase("Loading datasets and constructing joint dataset")
    maybeAssign("covidData", function() { loadCOVIDData(dataDir, covidDataFile, state, counties) })
    maybeAssign("mwraData",  function() { loadMWRAData(dataDir, mwraDataFile)   })
    maybeAssign("jointData", function() {              # Assemble via inner join on dates
      makeJointData(mwraData, covidData, resultsDir, jointDataFile)
    })                                                 #

    heraldPhase("Exploratory plots")                   # See the general shape of the data
    maybeAssign("nsPlotDone",  function() { plotNorthSouth(jointData, resultsDir, nsPlotFile) })

    heraldPhase("Prediction set")                      # Make dataset used by regressions: average
    maybeAssign("predictionSet", function() {          #  RNA over north/south, sum deaths/cases
      makePredictionSet(jointData, resultsDir, predSetFile)
    })                                                 #  over counties

    heraldPhase("Correlation plots")                   #
    maybeAssign("corrPlotsDone", function() {          #
      plotCorrelations(predictionSet, resultsDir, corrPlotFile1, corrPlotFile2)
    })                                                 #

    heraldPhase("Lagged regressions")                  #
    ## *** NB: The right way to do this is with an ARIMA time series model.  I'm being
    ## lazy here, examining univariate prediction from RNA, with various lags.  This is
    ## also not the right way as far as multiple hypothesis test correction (22 lags
    ## checked), and of course there's no crossvalidation since we only have 2 real waves in MA.
    maybeAssign("regressionLags", function() {         #
      cat(sprintf("* Regressing medical vars on RNA at various lags to test predictive power"))
      rbind(laggedRegressions(predictionSet, "Cases",  "RNA", 0:21),
            laggedRegressions(predictionSet, "Deaths", "RNA", 0:21))
    })                                                 #
    maybeAssign("lrPlotsDone", function() {            #
      plotLaggedRegressions("All", regressionLags, resultsDir, lagPlotFile)
    })                                                 #
    maybeAssign("optimalLags", function() { findOptimalLags(regressionLags) })

    heraldPhase("Final regressions")                   #
    maybeAssign("finalRegressionsTable", function() {  #
      finalRegressions("All", optimalLags, predictionSet, resultsDir, regPlotFile)
    })                                                 #
    print(finalRegressionsTable)

    ## Redo separately for each of the 3 waves:
    ## > plot(x = predictionSet$"Date", y = predictionSet$"RNA", log = "y", las = 3, xlab = "Time", ylab = "Cases")
    ##
    ## Wave1: 2020-03-01 to 2020-07-01
    ## Wave2: 2020-10-01 to 2021-06-01
    ## Wave2.5: 2021-06-01 to 2021-11-01 (Delta)
    ## Wave3: 2021-11-01 to 2022-02-01   (Omicron starts on top of Delta)
    predictionSetWave1   <<- subset(predictionSet,     #
                                    subset = "2020-03-01" <= Date & Date <= "2020-07-01")
    predictionSetWave2   <<- subset(predictionSet,     #
                                    subset = "2020-10-01" <= Date & Date <= "2021-06-01")
    predictionSetWave2.5 <<- subset(predictionSet,     #
                                    subset = "2021-06-01" <= Date & Date <= "2021-11-01")
    predictionSetWave3   <<- subset(predictionSet,     #
                                    subset = "2021-11-01" <= Date & Date <= "2022-02-01")

    doWave <- function(waveName, predictionSet) {      #
      print(waveName)                                  #
      resultsDir <- file.path(resultsDir, waveName)    #
      makeDirectory(resultsDir)                        #
      regressionLags <- rbind(laggedRegressions(predictionSet, "Cases",  "RNA", 0:21),
                              laggedRegressions(predictionSet, "Deaths", "RNA", 0:21))
      plotLaggedRegressions(waveName, regressionLags, resultsDir,
                            sprintf("%s-%s", waveName, lagPlotFile))
      optimalLags <- findOptimalLags(regressionLags)   #
      finalRegressionsTable <<- rbind(finalRegressionsTable,
                                     finalRegressions(waveName, optimalLags, predictionSet,
                                                      resultsDir, sprintf("%s-%s",
                                                                          waveName, regPlotFile)))
    }                                                  #

    doWave("Wave1",   predictionSetWave1)              #
    doWave("Wave2",   predictionSetWave2)              #
    doWave("Wave2.5", predictionSetWave2.5)            #
    doWave("Wave3",   predictionSetWave3)              #

    finalRegressionsTable <<- finalRegressionsTable[order(finalRegressionsTable$"MedVar",
                                                          finalRegressionsTable$"Wave"), ]
    saveDataframe(finalRegressionsTable, file.path(resultsDir, regStatsFile))
    print(finalRegressionsTable)                       # Capture to transcript

  })                                                   # End of transcript capture
}                                                      #