text:
9

9

                         CHAPTER  4

                     Special Functions

(and [g_arg1 ...])

     RETURNS: the value of the last argument  if  all  argu-
              ments  evaluate  to a non-nil value, otherwise
              _a_n_d returns nil.  It returns t if there are no
              arguments.

     NOTE: the arguments are evaluated  left  to  right  and
           evaluation  will cease with the first nil encoun-
           tered.

(apply 'u_func 'l_args)

     RETURNS: the result of applying function u_func to  the
              arguments in the list l_args.

     NOTE: If u_func is a lambda, then  the  (_l_e_n_g_t_h _l__a_r_g_s)
           should  equal the number of formal parameters for
           the u_func.  If u_func is  a  nlambda  or  macro,
           then l_args is bound to the single formal parame-
           ter.

9

9Special Functions                                        4-2

Special Functions                                        4-1

    ____________________________________________________

    ; _a_d_d_1 is a lambda of 1 argument
    -> (_a_p_p_l_y '_a_d_d_1 '(_3))
    4

    ; we will define _p_l_u_s_1 as a macro which will be equivalent to _a_d_d_1
    -> (_d_e_f _p_l_u_s_1 (_m_a_c_r_o (_a_r_g) (_l_i_s_t '_a_d_d_1 (_c_a_d_r _a_r_g))))
    plus1
    -> (_p_l_u_s_1 _3)
    4

    ; now if we _a_p_p_l_y a macro we obtain the form it changes to.
    -> (_a_p_p_l_y '_p_l_u_s_1 '(_p_l_u_s_1 _3))
    (add1 3)

    ; if we _f_u_n_c_a_l_l a macro however, the result of the macro is _e_v_a_led
    ; before it is returned.
    -> (_f_u_n_c_a_l_l '_p_l_u_s_1 '(_p_l_u_s_1 _3))
    4

    ; for this particular macro, the _c_a_r of the _a_r_g is not checked
    ; so that this too will work
    -> (_a_p_p_l_y '_p_l_u_s_1 '(_f_o_o _3))
    (add1 3)

    ____________________________________________________

(arg ['x_numb])

     RETURNS: if x_numb  is  specified  then  the  x_numb'_t_h
              argument  to  the enclosing lexpr If x_numb is
              not specified then this returns the number  of
              arguments to the enclosing lexpr.

     NOTE: it is an error to the interpreter  if  x_numb  is
           given and out of range.

9

9                                   Printed: January 31, 1984

Special Functions                                        4-2

(break [g_message ['g_pred]])

     WHERE:   if g_message is not given it is assumed to  be
              the null string, and if g_pred is not given it
              is assumed to be t.

     RETURNS: the value of (*_b_r_e_a_k '_g__p_r_e_d '_g__m_e_s_s_a_g_e)

(*break 'g_pred 'g_message)

     RETURNS: nil immediately if g_pred  is  nil,  else  the
              value  of  the next (return 'value) expression
              typed in at top level.

     SIDE EFFECT: If the  predicate,  g_pred,  evaluates  to
                  non-null, the lisp system stops and prints
                  out `Break '  followed  by  g_message.  It
                  then  enters a break loop which allows one
                  to interactively debug a program.  To con-
                  tinue  execution  from a break you can use
                  the _r_e_t_u_r_n  function.  to  return  to  top
                  level  or another break level, you can use
                  _r_e_t_b_r_k or _r_e_s_e_t.

(caseq 'g_key-form l_clause1 ...)

     WHERE:   l_clause_i is a list of the form  (g_comparator
              ['g_form_i  ...]).  The comparators may be sym-
              bols, small fixnums, a list of  small  fixnums
              or symbols.

     NOTE: The way caseq works is that it  evaluates  g_key-
           form, yielding a value we will call the selector.
           Each clause is examined  until  the  selector  is
           found consistent with the comparator.  For a sym-
           bol, or a fixnum, this means the two must be  _e_q.
           For  a list, this means that the selector must be
           _e_q to some element of the list.

           The comparator consisting of  the  symbol  t  has
           special  semantics: it matches anything, and con-
           sequently, should be the last comparator.

           In any case, having chosen a clause, _c_a_s_e_q evalu-
           ates each form within that clause and

     RETURNS: the value of the last form.  If no comparators
              are matched, _c_a_s_e_q returns nil.

9

9                                   Printed: January 31, 1984

Special Functions                                        4-3

    ____________________________________________________

    Here are two ways of defining the same function:
    ->(_d_e_f_u_n _f_a_t_e (_p_e_r_s_o_n_n_a)
            (_c_a_s_e_q _p_e_r_s_o_n_n_a
              (_c_o_w '(_j_u_m_p_e_d _o_v_e_r _t_h_e _m_o_o_n))
              (_c_a_t '(_p_l_a_y_e_d _n_e_r_o))
              ((_d_i_s_h _s_p_o_o_n) '(_r_a_n _a_w_a_y _w_i_t_h _e_a_c_h _o_t_h_e_r))
              (_t '(_l_i_v_e_d _h_a_p_p_i_l_y _e_v_e_r _a_f_t_e_r))))
    fate
    ->(_d_e_f_u_n _f_a_t_e (_p_e_r_s_o_n_n_a)
            (_c_o_n_d
                    ((_e_q _p_e_r_s_o_n_n_a '_c_o_w) '(_j_u_m_p_e_d _o_v_e_r _t_h_e _m_o_o_n))
                    ((_e_q _p_e_r_s_o_n_n_a '_c_a_t) '(_p_l_a_y_e_d _n_e_r_o))
                    ((_m_e_m_q _p_e_r_s_o_n_n_a '(_d_i_s_h _s_p_o_o_n)) '(_r_a_n _a_w_a_y _w_i_t_h _e_a_c_h _o_t_h_e_r))
                    (_t '(_l_i_v_e_d _h_a_p_p_i_l_y _e_v_e_r _a_f_t_e_r))))
    fate
    ____________________________________________________

(catch g_exp [ls_tag])

     WHERE:   if ls_tag is not given, it is  assumed  to  be
              nil.

     RETURNS: the result of (*_c_a_t_c_h '_l_s__t_a_g _g__e_x_p)

     NOTE: catch is defined as a macro.

(*catch 'ls_tag g_exp)

     WHERE:   ls_tag is either a symbol or a  list  of  sym-
              bols.

     RETURNS: the result of evaluating g_exp  or  the  value
              thrown during the evaluation of g_exp.

     SIDE EFFECT: this first sets up a `catch frame' on  the
                  lisp  runtime  stack.   Then  it begins to
                  evaluate g_exp.  If g_exp  evaluates  nor-
                  mally,  its  value  is returned.  If, how-
                  ever, a value is thrown during the evalua-
                  tion of g_exp then this *catch will return
                  with that value if one of these  cases  is
                  true:

     (1)  the tag thrown to is ls_tag

     (2)  ls_tag is a list and the tag thrown to is a member
          of this list

                                   Printed: January 31, 1984

Special Functions                                        4-4

     (3)  ls_tag is nil.

     NOTE: Errors are  implemented  as  a  special  kind  of
           throw.   A  catch  with  no tag will not catch an
           error but a catch whose tag  is  the  error  type
           will  catch  that  type of error.  See Chapter 10
           for more information.

(comment [g_arg ...])

     RETURNS: the symbol comment.

     NOTE: This does absolutely nothing.

(cond [l_clause1 ...])

     RETURNS: the last value evaluated in the  first  clause
              satisfied.   If  no clauses are satisfied then
              nil is returned.

     NOTE: This is  the  basic  conditional  `statement'  in
           lisp.   The  clauses  are  processed from left to
           right.   The  first  element  of  a   clause   is
           evaluated.   If  it evaluated to a non-null value
           then that clause is satisfied and  all  following
           elements  of that clause are evaluated.  The last
           value computed is returned as the  value  of  the
           cond.  If there is just one element in the clause
           then its value is returned.  If the first element
           of a clause evaluates to nil, then the other ele-
           ments of that clause are not  evaluated  and  the
           system moves to the next clause.

(cvttointlisp)

     SIDE EFFECT: The reader is modified to conform with the
                  Interlisp syntax.  The character % is made
                  the escape character and special  meanings
                  for  comma,  backquote  and  backslash are
                  removed. Also the reader is told  to  con-
                  vert upper case to lower case.

9

9                                   Printed: January 31, 1984

Special Functions                                        4-5

(cvttofranzlisp)

     SIDE EFFECT: FRANZ LISP's default syntax is reinstated.
                  One  would  run this function after having
                  run any of  the  other  _c_v_t_t_o-  functions.
                  Backslash  is  made  the escape character,
                  super-brackets work again, and the  reader
                  distinguishes   between  upper  and  lower
                  case.

(cvttomaclisp)

     SIDE EFFECT: The reader is  modified  to  conform  with
                  Maclisp  syntax.   The character / is made
                  the escape character and the special mean-
                  ings for backslash, left and right bracket
                  are removed.  The  reader  is  made  case-
                  insensitive.

(cvttoucilisp)

     SIDE EFFECT: The reader is modified to conform with UCI
                  Lisp  syntax.  The character / is made the
                  escape character, tilde is made  the  com-
                  ment character, exclamation point takes on
                  the  unquote  function  normally  held  by
                  comma,  and  backslash,  comma,  semicolon
                  become normal characters.  Here  too,  the
                  reader is made case-insensitive.

(debug s_msg)

     SIDE EFFECT: Enter  the  Fixit  package  described   in
                  Chapter  15.   This  package allows you to
                  examine the evaluation  stack  in  detail.
                  To  leave the Fixit package type 'ok'.

(debugging 'g_arg)

     SIDE EFFECT: If g_arg is non-null,  Franz  unlinks  the
                  transfer  tables, does a (*_r_s_e_t _t) to turn
                  on  evaluation  monitoring  and  sets  the
                  all-error  catcher  (ER%all)  to be _d_e_b_u_g-
                  _e_r_r-_h_a_n_d_l_e_r.  If g_arg is nil, all of  the
                  above changes are undone.

9

9                                   Printed: January 31, 1984

Special Functions                                        4-6

(declare [g_arg ...])

     RETURNS: nil

     NOTE: this is a no-op to the evaluator.  It has special
           meaning to the compiler (see Chapter 12).

(def s_name (s_type l_argl g_exp1 ...))

     WHERE:   s_type is one of  lambda,  nlambda,  macro  or
              lexpr.

     RETURNS: s_name

     SIDE EFFECT: This defines the function  s_name  to  the
                  lisp  system.   If  s_type  is  nlambda or
                  macro then the argument list  l_argl  must
                  contain exactly one non-nil symbol.

(defmacro s_name l_arg g_exp1 ...)
(defcmacro s_name l_arg g_exp1 ...)

     RETURNS: s_name

     SIDE EFFECT: This defines the  macro  s_name.  _d_e_f_m_a_c_r_o
                  makes  it  easy  to  write macros since it
                  makes the syntax just like _d_e_f_u_n.  Further
                  information   on  _d_e_f_m_a_c_r_o  is  in  8.3.2.
                  _d_e_f_c_m_a_c_r_o defines compiler-only macros, or
                  cmacros.  A  cmacro  is stored on the pro-
                  perty list of a symbol under the indicator
                  cmacro.  Thus a function can have a normal
                  definition and a cmacro  definition.   For
                  an  example of the use of cmacros, see the
                  definitions   of   nthcdr   and   nth   in
                  /usr/lib/lisp/common2.l

(defun s_name [s_mtype] ls_argl g_exp1 ... )

     WHERE:   s_mtype is one of fexpr, expr, args or macro.

     RETURNS: s_name

     SIDE EFFECT: This defines the function s_name.

     NOTE: this exists for Maclisp compatibility, it is just
           a  macro  which changes the defun form to the def
           form.   An  s_mtype  of  fexpr  is  converted  to
           nlambda  and of expr to lambda. Macro remains the
           same.  If ls_arg1 is a non-nil symbol,  then  the
           type  is  assumed  to be lexpr and ls_arg1 is the
           symbol which is bound to the number of args  when
           the function is entered.

                                   Printed: January 31, 1984

Special Functions                                        4-7

           For compatibility with  the  Lisp  Machine  Lisp,
           there are three types of optional parameters that
           can occur in ls_argl:   &_o_p_t_i_o_n_a_l  declares  that
           the  following  symbols  are optional, and may or
           may not appear in the argument list to the  func-
           tion, &_r_e_s_t _s_y_m_b_o_l declares that all forms in the
           function call that are not accounted for by  pre-
           vious  lambda bindings are to be assigned to _s_y_m_-
           _b_o_l, and &_a_u_x _f_o_r_m_1 ... _f_o_r_m_n declares  that  the
           _f_o_r_m_i  are either symbols, in which case they are
           lambda bound to nil, or lists, in which case  the
           first  element of the list is lambda bound to the
           second, evaluated element.

    ____________________________________________________

    ; _d_e_f and _d_e_f_u_n here are used to define identical functions
    ; you can decide for yourself which is easier to use.
    -> (_d_e_f _a_p_p_e_n_d_1 (_l_a_m_b_d_a (_l_i_s _e_x_t_r_a) (_a_p_p_e_n_d _l_i_s (_l_i_s_t _e_x_t_r_a))))
    append1

    -> (_d_e_f_u_n _a_p_p_e_n_d_1 (_l_i_s _e_x_t_r_a) (_a_p_p_e_n_d _l_i_s (_l_i_s_t _e_x_t_r_a)))
    append1

    ; Using the & forms...
    -> (_d_e_f_u_n _t_e_s_t (_a _b &_o_p_t_i_o_n_a_l _c &_a_u_x (_r_e_t_v_a_l _0) &_r_e_s_t _z)
            (_i_f _c _t_h_e_m (_m_s_g "_O_p_t_i_o_n_a_l _a_r_g _p_r_e_s_e_n_t" _N
                            "_c _i_s " _c _N))
            (_m_s_g "_r_e_s_t _i_s " _z _N
                 "_r_e_t_v_a_l _i_s " _r_e_t_v_a_l _N))
    test
    -> (_t_e_s_t _1 _2 _3 _4)
    Optional arg present
    c is 3
    rest is (4)
    retval is 0
    ____________________________________________________

9

9                                   Printed: January 31, 1984

Special Functions                                        4-8

(defvar s_variable ['g_init])

     RETURNS: s_variable.

     NOTE: This form is put at the top level in files,  like
           _d_e_f_u_n.

     SIDE EFFECT: This declares s_variable to be special. If
                  g_init   is   present  and  s_variable  is
                  unbound  when  the  file   is   read   in,
                  s_variable  will  be  set  to the value of
                  g_init.  An advantage  of  `(defvar  foo)'
                  over  `(declare (special foo))' is that if
                  a file containing defvars  is  loaded  (or
                  fasl'ed)  in during compilation, the vari-
                  ables mentioned in the  defvar's  will  be
                  declared  special.   The  only way to have
                  that effect with `(declare (special foo))'
                  is to _i_n_c_l_u_d_e the file.

(do l_vrbs l_test g_exp1 ...)

     RETURNS: the last form in the cdr of l_test  evaluated,
              or  a  value  explicitly  given  by  a  return
              evaluated within the do body.

     NOTE: This is the basic iteration form for FRANZ  LISP.
           l_vrbs  is a list of zero or more var-init-repeat
           forms.  A var-init-repeat form looks like:
                (s_name [g_init [g_repeat]])
           There  are  three  cases  depending  on  what  is
           present  in the form.  If just s_name is present,
           this means that when the do is entered, s_name is
           lambda-bound  to nil and is never modified by the
           system (though the program is certainly  free  to
           modify    its    value).     If   the   form   is
           (s_name 'g_init) then the only difference is that
           s_name  is  lambda-bound  to  the value of g_init
           instead of nil.  If g_repeat is also present then
           s_name is lambda-bound to g_init when the loop is
           entered and after each pass through the  do  body
           s_name is  bound to the value of g_repeat.
           l_test is either nil or has the form  of  a  cond
           clause.   If  it  is nil then the do body will be
           evaluated only once and the do will  return  nil.
           Otherwise,  before  the  do body is evaluated the
           car of l_test is evaluated and if the  result  is
           non-null,  this  signals  an  end to the looping.
           Then  the  rest  of  the  forms  in  l_test   are
           evaluated  and  the  value  of  the  last  one is
           returned as the value of the do.  If the  cdr  of
           l_test  is nil, then nil is returned -- thus this
           is not exactly like a cond clause.

                                   Printed: January 31, 1984

Special Functions                                        4-9

           g_exp1 and those forms  which  follow  constitute
           the  do  body.  A do body is like a prog body and
           thus may have labels and one may  use  the  func-
           tions go and return.
           The sequence of evaluations is this:

     (1)  the init forms are evaluated  left  to  right  and
          stored in temporary locations.

     (2)  Simultaneously all do variables are  lambda  bound
          to the value of their init forms or nil.

     (3)  If l_test is non-null, then the car  is  evaluated
          and  if  it  is non-null, the rest of the forms in
          l_test  are  evaluated  and  the  last  value   is
          returned as the value of the do.

     (4)  The forms in the do body  are  evaluated  left  to
          right.

     (5)  If l_test is nil the do function returns with  the
          value nil.

     (6)  The repeat forms are evaluated and saved  in  tem-
          porary locations.

     (7)  The variables with repeat forms are simultaneously
          bound to the values of those forms.

     (8)  Go to step 3.

     NOTE: there is an alternate form of  do  which  can  be
           used  when  there is only one do variable.  It is
           described next.

9

9                                   Printed: January 31, 1984

Special Functions                                       4-10

    ____________________________________________________

    ; this is  a simple function which numbers the elements of a list.
    ; It uses a _d_o function with two local variables.
    -> (_d_e_f_u_n _p_r_i_n_t_e_m (_l_i_s)
                 (_d_o ((_x_x _l_i_s (_c_d_r _x_x))
                      (_i _1 (_1+ _i)))
                     ((_n_u_l_l _x_x) (_p_a_t_o_m "_a_l_l _d_o_n_e") (_t_e_r_p_r))
                     (_p_r_i_n_t _i)
                     (_p_a_t_o_m ": ")
                     (_p_r_i_n_t (_c_a_r _x_x))
                     (_t_e_r_p_r)))
    printem
    -> (_p_r_i_n_t_e_m '(_a _b _c _d))
    1: a
    2: b
    3: c
    4: d
    all done
    nil
    ->
    ____________________________________________________

(do s_name g_init g_repeat g_test g_exp1 ...)

     NOTE: this is another, less general,  form of  do.   It
           is evaluated by:

     (1)  evaluating g_init

     (2)  lambda binding s_name to value of g_init

     (3)  g_test is evaluated and if it is not  nil  the  do
          function returns with nil.

     (4)  the do body is evaluated beginning at g_exp1.

     (5)  the repeat form is evaluated and stored in s_name.

     (6)  go to step 3.

     RETURNS: nil

9

9                                   Printed: January 31, 1984

Special Functions                                       4-11

(environment [l_when1 l_what1 l_when2 l_what2 ...])
(environment-maclisp [l_when1 l_what1 l_when2 l_what2 ...])
(environment-lmlisp [l_when1 l_what1 l_when2 l_what2 ...])

     WHERE:   the when's  are  a  subset  of  (eval  compile
              load),  and  the symbols have the same meaning
              as they do in 'eval-when'.

              The what's may be
                      (files file1 file2 ... fileN),
              which insure that the named files are  loaded.
              To  see  if  file_i  is  loaded, it looks for a
              'version'  property  under  file_i's   property
              list.   Thus  to prevent multiple loading, you
              should put
                      (putprop 'myfile t 'version),
              at the end of myfile.l.

              Another acceptable form for a what is
              (syntax type)
              Where type is either maclisp,  intlisp,  ucil-
              isp, franzlisp.

     SIDE EFFECT: _e_n_v_i_r_o_n_m_e_n_t-_m_a_c_l_i_s_p sets  the  environment
                  to that which `liszt -m' would generate.

                  _e_n_v_i_r_o_n_m_e_n_t-_l_m_l_i_s_p   sets  up   the   lisp
                  machine  environment. This is like maclisp
                  but it has additional macros.

                  For these specialized  environments,  only
                  the     files    clauses    are    useful.
                          (environment-maclisp      (compile
                  eval) (files foo bar))

     RETURNS: the last list of files requested.

(err ['s_value [nil]])

     RETURNS: nothing (it never returns).

     SIDE EFFECT: This causes an error and if this error  is
                  caught  by an _e_r_r_s_e_t then that _e_r_r_s_e_t will
                  return s_value instead  of  nil.   If  the
                  second  arg  is given, then it must be nil
                  (MAClisp compatibility).

9

9                                   Printed: January 31, 1984

Special Functions                                       4-12

(error ['s_message1 ['s_message2]])

     RETURNS: nothing (it never returns).

     SIDE EFFECT: s_message1 and s_message2 are  _p_a_t_o_med  if
                  they  are  given  and  then  _e_r_r is called
                  (with  no  arguments),  which  causes   an
                  error.

(errset g_expr [s_flag])

     RETURNS: a list of one  element,  which  is  the  value
              resulting from evaluating g_expr.  If an error
              occurs during the evaluation of  g_expr,  then
              the locus of control will return to the _e_r_r_s_e_t
              which will then return nil (unless  the  error
              was  caused  by a call to _e_r_r, with a non-null
              argument).

     SIDE EFFECT: S_flag  is  evaluated  before  g_expr   is
                  evaluated. If s_flag is not given, then it
                  is assumed to be t.  If  an  error  occurs
                  during   the  evaluation  of  g_expr,  and
                  s_flag evaluated to a non-null value, then
                  the  error  message  associated  with  the
                  error is printed before control returns to
                  the errset.

(eval 'g_val ['x_bind-pointer])

     RETURNS: the result of evaluating g_val.

     NOTE: The evaluator evaluates g_val in this way:
           If g_val is a symbol, then the evaluator  returns
           its  value.   If  g_val had never been assigned a
           value, then this  causes  an  `Unbound  Variable'
           error.   If  x_bind-pointer  is  given,  then the
           variable  is  evaluated  with  respect  to   that
           pointer  (see  _e_v_a_l_f_r_a_m_e  for  details  on  bind-
           pointers).

           If g_val is of type  value,  then  its  value  is
           returned.   If  g_val  is  of any other type than
           list, g_val is returned.

           If g_val is a list object then g_val is either  a
           function  call  or array reference.  Let g_car be
           the  first  element  of  g_val.   We  continually
           evaluate g_car until we end up with a symbol with
           a non-null  function  binding  or  a  non-symbol.
           Call what we end up with: g_func.

           G_func must be one of three types:  list,  binary

                                   Printed: January 31, 1984

Special Functions                                       4-13

           or array.  If it is a list then the first element
           of the list, which we shall call g_functype, must
           be  either  lambda,  nlambda, macro or lexpr.  If
           g_func is a binary, then its discipline, which we
           shall call g_functype, is either lambda, nlambda,
           macro or a string.  If g_func is  an  array  then
           this  form  is evaluated specially, see Chapter 9
           on arrays.  If g_func is a list or  binary,  then
           g_functype  will  determine  how the arguments to
           this function, the cdr of g_val,  are  processed.
           If g_functype is a string, then this is a foreign
           function call (see 8.5 for more details).

           If g_functype is lambda or lexpr,  the  arguments
           are  evaluated  (by calling _e_v_a_l recursively) and
           stacked.  If g_functype is nlambda then the argu-
           ment  list  is  stacked.   If g_functype is macro
           then the entire form, g_val is stacked.

           Next, the formal variables are lambda bound.  The
           formal  variables  are  the  cadr  of g_func.  If
           g_functype is  nlambda,  lexpr  or  macro,  there
           should  only  be one formal variable.  The values
           on the stack are lambda bound to the formal vari-
           ables  except  in  the case of a lexpr, where the
           number of actual arguments is bound to the formal
           variable.

           After  the  binding  is  done,  the  function  is
           invoked,  either by jumping to the entry point in
           the case of a binary or by evaluating the list of
           forms  beginning  at  cddr g_func.  The result of
           this function invocation is returned as the value
           of the call to eval.

(evalframe 'x_pdlpointer)

     RETURNS: an evalframe  descriptor  for  the  evaluation
              frame    just    before    x_pdlpointer.    If
              x_pdlpointer is nil, it returns the evaluation
              frame  of  the  frame  just before the current
              call to _e_v_a_l_f_r_a_m_e.

     NOTE: An evalframe descriptor describes a call to _e_v_a_l,
           _a_p_p_l_y or _f_u_n_c_a_l_l.  The form of the descriptor is
           (_t_y_p_e  _p_d_l-_p_o_i_n_t_e_r  _e_x_p_r_e_s_s_i_o_n  _b_i_n_d-_p_o_i_n_t_e_r  _n_p-
           _i_n_d_e_x _l_b_o_t-_i_n_d_e_x)
           where type is `eval' if this describes a call  to
           _e_v_a_l  or  `apply'  if  this is a call to _a_p_p_l_y or
           _f_u_n_c_a_l_l.    pdl-pointer   is   a   number   which
           describes this context. It can be passed to _e_v_a_l_-
           _f_r_a_m_e to obtain the next descriptor  and  can  be
           passed  to  _f_r_e_t_u_r_n  to  cause a return from this

                                   Printed: January 31, 1984

Special Functions                                       4-14

           context.  bind-pointer is the  size  of  variable
           binding  stack  when  this  evaluation began. The
           bind-pointer can be given as a second argument to
           _e_v_a_l  to  order to evaluate variables in the same
           context as this  evaluation. If  type  is  `eval'
           then  expression  will  have  the form (_f_u_n_c_t_i_o_n-
           _n_a_m_e _a_r_g_1 ...).  If type is `apply' then  expres-
           sion    will    have    the    form    (_f_u_n_c_t_i_o_n-
           _n_a_m_e (_a_r_g_1 ...)).  np-index  and  lbot-index  are
           pointers  into  the argument stack (also known as
           the _n_a_m_e_s_t_a_c_k array) at the time of call.   lbot-
           index  points  to  the  first  argument, np-index
           points one beyond the last argument.
           In order for there to be enough  information  for
           _e_v_a_l_f_r_a_m_e to return, you must call (*_r_s_e_t _t).

     EXAMPLE: (_p_r_o_g_n (_e_v_a_l_f_r_a_m_e _n_i_l))
              returns  (_e_v_a_l  _2_1_4_7_4_7_8_6_0_0  (_p_r_o_g_n  (_e_v_a_l_f_r_a_m_e
              _n_i_l)) _1 _8 _7)

(evalhook 'g_form 'su_evalfunc ['su_funcallfunc])

     RETURNS: the result of evaluating g_form  after  lambda
              binding  `evalhook'  to su_evalfunc and, if it
              is  given,  lambda  binding  `funcallhook'  to
              su_funcallhook.

     NOTE: As explained in 14.4, the function _e_v_a_l may  pass
           the  job  of  evaluating  a form to a user `hook'
           function when  various  switches  are  set.   The
           hook  function  normally  prints  the  form to be
           evaluated on the terminal and then  evaluates  it
           by  calling  _e_v_a_l_h_o_o_k.   _E_v_a_l_h_o_o_k does the lambda
           binding mentioned above and then  calls  _e_v_a_l  to
           evaluate  the  form  after  setting  an  internal
           switch to tell _e_v_a_l not to call the  user's  hook
           function  just  this  one  time.  This allows the
           evaluation process to advance one  step  and  yet
           insure  that  further  calls  to  _e_v_a_l will cause
           traps to the hook  function  (if  su_evalfunc  is
           non-null).
           In order for  _e_v_a_l_h_o_o_k  to  work,  (*_r_s_e_t _t)  and
           (_s_s_t_a_t_u_s _e_v_a_l_h_o_o_k _t)  must  have been done previ-
           ously.

9

9                                   Printed: January 31, 1984

Special Functions                                       4-15

(exec s_arg1 ...)

     RETURNS: the result of forking and executing  the  com-
              mand   named   by   concatenating  the  s_arg_i
              together with spaces in between.

(exece 's_fname ['l_args ['l_envir]])

     RETURNS: the error code  from  the  system  if  it  was
              unable  to  execute  the  command s_fname with
              arguments l_args and with the environment  set
              up  as specified in l_envir.  If this function
              is successful, it will not return, instead the
              lisp  system  will be overlaid by the new com-
              mand.

(freturn 'x_pdl-pointer 'g_retval)

     RETURNS: g_retval from  the  context  given  by  x_pdl-
              pointer.

     NOTE: A  pdl-pointer  denotes  a   certain   expression
           currently  being evaluated. The pdl-pointer for a
           given expression can be obtained from _e_v_a_l_f_r_a_m_e.

(frexp 'f_arg)

     RETURNS: a  list  cell  (_e_x_p_o_n_e_n_t  .  _m_a_n_t_i_s_s_a)   which
              represents the given flonum

     NOTE: The exponent will be a fixnum, the mantissa a  56
           bit bignum.  If you think of the the binary point
           occurring right  after  the  high  order  bit  of
           mantissa, then f_arg = 2[exponent] * mantissa.

(funcall 'u_func ['g_arg1 ...])

     RETURNS: the value of applying function u_func  to  the
              arguments  g_arg_i  and  then  evaluating  that
              result if u_func is a macro.

     NOTE: If u_func is a macro or nlambda then there should
           be only one g_arg.  _f_u_n_c_a_l_l is the function which
           the evaluator uses to evaluate lists.  If _f_o_o  is
           a    lambda    or    lexpr    or    array,   then
           (_f_u_n_c_a_l_l '_f_o_o '_a '_b '_c)    is    equivalent    to
           (_f_o_o '_a '_b '_c).    If   _f_o_o  is  a  nlambda  then
           (_f_u_n_c_a_l_l '_f_o_o '(_a _b _c)) is equivalent to (_f_o_o _a _b
           _c).    Finally,   if   _f_o_o   is   a   macro  then
           (_f_u_n_c_a_l_l '_f_o_o '(_f_o_o _a _b _c))  is   equivalent   to
           (_f_o_o _a _b _c).

9

9                                   Printed: January 31, 1984

Special Functions                                       4-16

(funcallhook 'l_form 'su_funcallfunc ['su_evalfunc])

     RETURNS: the result of _f_u_n_c_a_l_ling the  (_c_a_r _l__f_o_r_m)  on
              the   already   evaluated   arguments  in  the
              (_c_d_r _l__f_o_r_m)  after   lambda   binding   `fun-
              callhook'  to  su_funcallfunc  and,  if  it is
              given,   lambda    binding    `evalhook'    to
              su_evalhook.

     NOTE: This function is designed to continue the evalua-
           tion  process  with  as  little  work as possible
           after a funcallhook trap has occurred. It is  for
           this  reason  that the form of l_form is unortho-
           dox: its _c_a_r is the name of the function to  call
           and  its  _c_d_r  are  a  list of arguments to stack
           (without evaluating  again)  before  calling  the
           given function.  After stacking the arguments but
           before calling _f_u_n_c_a_l_l an internal switch is  set
           to  prevent  _f_u_n_c_a_l_l from passing the job of fun-
           calling to su_funcallfunc.  If _f_u_n_c_a_l_l is  called
           recursively   in   funcalling   l_form   and   if
           su_funcallfunc is non-null, then the arguments to
           _f_u_n_c_a_l_l  will actually be given to su_funcallfunc
           (a lexpr) to be funcalled.
           In order for  _e_v_a_l_h_o_o_k  to  work,  (*_r_s_e_t _t)  and
           (_s_s_t_a_t_u_s _e_v_a_l_h_o_o_k _t)  must  have been done previ-
           ously.  A more detailed description  of  _e_v_a_l_h_o_o_k
           and _f_u_n_c_a_l_l_h_o_o_k is given in Chapter 14.

(function u_func)

     RETURNS: the function binding of u_func  if  it  is  an
              symbol   with  a  function  binding  otherwise
              u_func is returned.

(getdisc 'y_func)

     RETURNS: the discipline of the machine  coded  function
              (either lambda, nlambda or macro).

(go g_labexp)

     WHERE:   g_labexp is either a symbol or an expression.

     SIDE EFFECT: If g_labexp is an expression, that expres-
                  sion  is  evaluated and should result in a
                  symbol.  The locus  of  control  moves  to
                  just  following the symbol g_labexp in the
                  current prog or do body.

     NOTE: this is only valid in the context of a prog or do
           body.   The  interpreter  and compiler will allow
           non-local _g_o's although the compiler won't  allow

                                   Printed: January 31, 1984

Special Functions                                       4-17

           a _g_o to leave a function body.  The compiler will
           not allow g_labexp to be an expression.

(if 'g_a 'g_b)
(if 'g_a 'g_b 'g_c ...)
(if 'g_a then  'g_b [...] [elseif 'g_c then 'g_d ...]  [else
'g_e [...])
(if 'g_a then  'g_b [...] [elseif 'g_c thenret]  [else  'g_d
[...])

     NOTE: The various forms of _i_f are intended to be a more
           readable  conditional  statement,  to  be used in
           place of _c_o_n_d.  There are two  varieties  of  _i_f,
           with  keywords,  and  without.   The keyword-less
           variety is inherited from common  Maclisp  usage.
           A  keyword-less, two argument _i_f is equivalent to
           a one-clause _c_o_n_d, i.e. (_c_o_n_d (a b)).   Any other
           keyword-less  _i_f  must  have at least three argu-
           ments.  The first two  arguments  are  the  first
           clause  of the equivalent _c_o_n_d, and all remaining
           arguments are shoved into a second clause  begin-
           ning  with  t.   Thus,  the  second form of _i_f is
           equivalent to
                   (_c_o_n_d (a b) (t c ...)).

           The keyword variety has the following grouping of
           arguments:   a   predicate,  a  then-clause,  and
           optional   else-clause.    The    predicate    is
           evaluated,  and  if  the  result  is non-nil, the
           then-clause  will  be  performed,  in  the  sense
           described  below.  Otherwise, (i.e. the result of
           the predicate evaluation was precisely nil),  the
           else-clause will be performed.

           Then-clauses will either consist entirely of  the
           single  keyword  thenret,  or will start with the
           keyword then, and be followed  by  at  least  one
           general  expression.   (These general expressions
           must not be one of the keywords.)  To  actuate  a
           thenret  means to cease further evaluation of the
           _i_f, and to return the value of the predicate just
           calculated.  The performance of the longer clause
           means to  evaluate  each  general  expression  in
           turn, and then return the last value calculated.

           The else-clause may begin with the  keyword  else
           and  be  followed by at least one general expres-
           sion.  The rendition of this clause is just  like
           that  of a then-clause.  An else-clause may begin
           alternatively with the  keyword  elseif,  and  be
           followed  (recursively)  by  a  predicate,  then-
           clause, and optional else-clause.  Evaluation  of
           this  clause,  is  just evaluation of an _i_f-form,

                                   Printed: January 31, 1984

Special Functions                                       4-18

           with the same predicate, then- and else-clauses.

(I-throw-err 'l_token)

     WHERE:   l_token is the _c_d_r of the value returned  from
              a *_c_a_t_c_h with the tag ER%unwind-protect.

     RETURNS: nothing (never returns in the current context)

     SIDE EFFECT: The error or throw denoted by  l_token  is
                  continued.

     NOTE: This function is used to implement _u_n_w_i_n_d-_p_r_o_t_e_c_t
           which allows the processing of a transfer of con-
           trol though a certain context to be  interrupted,
           a  user  function  to  be  executed  and than the
           transfer of control to  continue.   The  form  of
           l_token is either
           (_t _t_a_g _v_a_l_u_e) for a throw or
           (_n_i_l _t_y_p_e _m_e_s_s_a_g_e _v_a_l_r_e_t  _c_o_n_t_u_a_b  _u_n_i_q_u_e_i_d  [_a_r_g
           ...]) for an error.
           This function is not to be used for  implementing
           throws  or errors and is only documented here for
           completeness.

(let l_args g_exp1 ... g_exprn)

     RETURNS: the result of evaluating  g_exprn  within  the
              bindings given by l_args.

     NOTE: l_args is either nil (in which case _l_e_t  is  just
           like  _p_r_o_g_n)  or it is a list of binding objects.
           A binding object is a  list  (_s_y_m_b_o_l _e_x_p_r_e_s_s_i_o_n).
           When a _l_e_t is entered, all of the expressions are
           evaluated and then simultaneously lambda-bound to
           the  corresponding  symbols.   In  effect,  a _l_e_t
           expression  is  just  like  a  lambda  expression
           except  the  symbols and their initial values are
           next to each other, making the expression  easier
           to  understand.  There are some added features to
           the _l_e_t expression: A binding object can just  be
           a   symbol,   in   which   case   the  expression
           corresponding to that  symbol  is  `nil'.   If  a
           binding object is a list and the first element of
           that list is another  list,  then  that  list  is
           assumed  to be a binding template and _l_e_t will do
           a _d_e_s_e_t_q on it.

9

9                                   Printed: January 31, 1984

Special Functions                                       4-19

(let* l_args g_exp1 ... g_expn)

     RETURNS: the result of evaluating  g_exprn  within  the
              bindings given by l_args.

     NOTE: This is identical to _l_e_t except  the  expressions
           in  the  binding  list  l_args  are evaluated and
           bound sequentially instead of in parallel.

(lexpr-funcall 'g_function ['g_arg1 ...] 'l_argn)

     NOTE: This is a cross between funcall and  apply.   The
           last  argument,  must be a list (possibly empty).
           The element of list arg are stack  and  then  the
           function is funcalled.

     EXAMPLE: (lexpr-funcall 'list 'a '(b c d)) is the  same
              as
               (funcall 'list 'a 'b 'c 'd)

(listify 'x_count)

     RETURNS: a list of x_count  of  the  arguments  to  the
              current function (which must be a lexpr).

     NOTE: normally  arguments   1   through   x_count   are
           returned.  If x_count is negative then  a list of
           last abs(x_count) arguments are returned.

(map 'u_func 'l_arg1 ...)

     RETURNS: l_arg1

     NOTE: The function u_func is applied to successive sub-
           lists  of  the  l_arg_i.  All sublists should have
           the same length.

(mapc 'u_func 'l_arg1 ...)

     RETURNS: l_arg1.

     NOTE: The function u_func is applied to successive ele-
           ments  of  the  argument lists.  All of the lists
           should have the same length.

9

9                                   Printed: January 31, 1984

Special Functions                                       4-20

(mapcan 'u_func 'l_arg1 ...)

     RETURNS: nconc applied to the results of the functional
              evaluations.

     NOTE: The function u_func is applied to successive ele-
           ments of the argument lists.  All sublists should
           have the same length.

(mapcar 'u_func 'l_arg1 ...)

     RETURNS: a list of the values returned from  the  func-
              tional application.

     NOTE: the function u_func is applied to successive ele-
           ments of the argument lists.  All sublists should
           have the same length.

(mapcon 'u_func 'l_arg1 ...)

     RETURNS: nconc applied to the results of the functional
              evaluation.

     NOTE: the function u_func is applied to successive sub-
           lists of the argument lists.  All sublists should
           have the same length.

(maplist 'u_func 'l_arg1 ...)

     RETURNS: a  list  of  the  results  of  the  functional
              evaluations.

     NOTE: the function u_func is applied to successive sub-
           lists  of  the  arguments  lists.   All  sublists
           should have the same length.

     Readers may find the following summary table useful  in
     remembering  the  differences  between  the six mapping
     functions:

8     ________________________________________________________________
                                      Value returned is

                         l_arg1   list of results   _n_c_o_n_c of results
7       Argument to
       functional is
8    ________________________________________________________________

     elements of list    mapc        mapcar             mapcan

         sublists        map         maplist            mapcon
8    ________________________________________________________________
7   |7|7|7|7|7|7|7|7|

                     |7|7|7|7|7|7|7|7|

                                                                   |7|7|7|7|7|7|7|7|

9                                   Printed: January 31, 1984

Special Functions                                       4-21

(mfunction t_entry 's_disc)

     RETURNS: a lisp  object  of  type  binary  composed  of
              t_entry and s_disc.

     NOTE: t_entry is a pointer to the machine  code  for  a
           function,  and  s_disc  is  the  discipline (e.g.
           lambda).

(oblist)

     RETURNS: a list of all symbols on the oblist.

(or [g_arg1 ... ])

     RETURNS: the value of the first non-null  argument   or
              nil if all arguments evaluate to nil.

     NOTE: Evaluation proceeds left to right  and  stops  as
           soon  as one of the arguments evaluates to a non-
           null value.

(prog l_vrbls g_exp1 ...)

     RETURNS: the value explicitly given in a return form or
              else  nil if no return is done by the time the
              last g_exp_i is evaluated.

     NOTE: the local variables are lambda-bound to nil, then
           the  g_exp_i  are  evaluated  from  left to right.
           This is a prog body (obviously)  and  this  means
           than  any symbols seen are not evaluated, but are
           treated as labels.  This also means that return's
           and go's are allowed.

(prog1 'g_exp1 ['g_exp2 ...])

     RETURNS: g_exp1

(prog2 'g_exp1 'g_exp2 ['g_exp3 ...])

     RETURNS: g_exp2

     NOTE: the forms are evaluated from left  to  right  and
           the value of g_exp2 is returned.

9

9                                   Printed: January 31, 1984

Special Functions                                       4-22

(progn 'g_exp1 ['g_exp2 ...])

     RETURNS: the last g_exp_i.

(progv 'l_locv 'l_initv g_exp1 ...)

     WHERE:   l_locv is a list of symbols and l_initv  is  a
              list of expressions.

     RETURNS: the value of the last g_exp_i evaluated.

     NOTE: The expressions in  l_initv  are  evaluated  from
           left  to  right and then lambda-bound to the sym-
           bols in l_locv.  If there are too few expressions
           in l_initv then the missing values are assumed to
           be nil.  If there are  too  many  expressions  in
           l_initv then the extra ones are ignored (although
           they  are  evaluated).   Then  the   g_exp_i   are
           evaluated  left to right.  The body of a progv is
           like the body of a progn, it is _n_o_t a prog  body.
           (C.f. _l_e_t)

(purcopy 'g_exp)

     RETURNS: a copy of g_exp with new pure cells  allocated
              wherever possible.

     NOTE: pure space is never swept up by the garbage  col-
           lector,  so  this  should only be done on expres-
           sions which are not likely to become  garbage  in
           the  future.   In  certain cases, data objects in
           pure space become read-only after a _d_u_m_p_l_i_s_p  and
           then  an attempt to modify the object will result
           in an illegal memory reference.

(purep 'g_exp)

     RETURNS: t iff the object g_exp is in pure space.

(putd 's_name 'u_func)

     RETURNS: u_func

     SIDE EFFECT: this sets the function binding  of  symbol
                  s_name to u_func.

9

9                                   Printed: January 31, 1984

Special Functions                                       4-23

(return ['g_val])

     RETURNS: g_val (or nil if g_val is  not  present)  from
              the enclosing prog or do body.

     NOTE: this form is only valid in the context of a  prog
           or do body.

(selectq 'g_key-form [l_clause1 ...])

     NOTE: This function is just  like  _c_a_s_e_q  (see  above),
           except  that  the  symbol  otherwise has the same
           semantics as the symbol t, when used  as  a  com-
           parator.

(setarg 'x_argnum 'g_val)

     WHERE:   x_argnum is greater than zero and less than or
              equal to the number of arguments to the lexpr.

     RETURNS: g_val

     SIDE EFFECT: the lexpr's x_argnum'th argument is set to
                  g-val.

     NOTE: this can only be used within the body of a lexpr.

(throw 'g_val [s_tag])

     WHERE:   if s_tag is not given, it  is  assumed  to  be
              nil.

     RETURNS: the value of (*_t_h_r_o_w '_s__t_a_g '_g__v_a_l).

(*throw 's_tag 'g_val)

     RETURNS: g_val from the first enclosing catch with  the
              tag s_tag or with no tag at all.

     NOTE: this is used in conjunction with *_c_a_t_c_h to  cause
           a clean jump to an enclosing context.

9

9                                   Printed: January 31, 1984

Special Functions                                       4-24

(unwind-protect g_protected [g_cleanup1 ...])

     RETURNS: the result of evaluating g_protected.

     NOTE: Normally g_protected is evaluated and  its  value
           remembered, then the g_cleanup_i are evaluated and
           finally  the  saved  value  of   g_protected   is
           returned.    If   something  should  happen  when
           evaluating g_protected which  causes  control  to
           pass  through  g_protected   and thus through the
           call to the unwind-protect, then  the  g_cleanup_i
           will  still  be  evaluated.   This  is  useful if
           g_protected does  something sensitive which  must
           be  cleaned  up  whether  or not g_protected com-
           pletes.

9

9                                   Printed: January 31, 1984

max_stars_repo_name: omasanori/franz-lisp

max_issues_repo_name: omasanori/franz-lisp

max_forks_repo_name: omasanori/franz-lisp


text:
#!/usr/bin/Rscript

## this function provides a simple R interface to emeraLD

emeraLD2R <- function(path, bin){
	require(data.table)
	if(!file.exists(bin)) stop(paste0("bin = '", bin, "' file does not exist"))
	function(region, matrix.out = TRUE, info.out = TRUE){
		require(data.table)
		opts <- paste(c("--matrix", "--stdout --extra")[c(matrix.out, TRUE)], collapse = " ")
		pc <- "| tr ':' '\t'"
		chr <- strsplit(region, ":")[[1]][1]
		vcfile <- gsub("\\$chr", chr, path)
		if(!file.exists(vcfile)) stop(paste0(vcfile, " does not exist"))
		out <- suppressMessages(fread(
			input  = paste(bin, "-i", vcfile, "--region", region, opts, pc),
			header = FALSE, showProgress = FALSE
		))
		info <- NULL
		if(info.out){
			info <- out[,1:5]
			colnames(info) <- c("chr", "pos", "id", "ref", "alt")
		}
		if(matrix.out) out <- as.matrix(out[,-(1:5)]); colnames(out) <- NULL
		list("Sigma" = out, "info" = info)
	}
}

# ## use "$chr" when genotype files are separated by chromosome
# ## "$chr" is automatically replaced when a region is specified
# in_path <- "example/chr$chr.1KG.25K_m.m3vcf.gz"
#
# ## emeraLD2R creates an LD retrieval function
# getLD <- emeraLD2R(path = in_path)
#
# ## calling an LD retrieval function invokes emeraLD
# ld_data <- getLD(region = "20:83061-92955")
# ## emeraLD processes genotypes; LD output is passed to R
#
# ## check LD output
# head(ld_data$Sigma[, 1:10], 10)
# head(ld_data$info)

ext: r

max_stars_repo_name: CBIIT/nci-webtools-dceg-vQTL

max_issues_repo_name: CBIIT/nci-webtools-dceg-vQTL

max_forks_repo_name: CBIIT/nci-webtools-dceg-vQTL


text:
#source("cfg.r")
file = 'outputs/which_exp_is_biggest_comb.csv'

dat0 = read.csv(file)
rownames(dat0) = dat0[,1]
dat0 = dat0[,-1]
datm = dat0

nr = nrow(dat0)

for (i in 1:(nr/2)) for (j in 1:nr) {

    ii = i * 2 - c(1, 0)
    jj = j * 2 - c(1, 0)
    if (is.na(dat0[jj[1], i])) next
    if (i>j) {
        dat0[jj[1], i] = 100 - dat0[jj[1], i]
        dat0[ii[1], j] = 100 - dat0[jj[1], i]
        dat0[ii[2], j] = dat0[jj[2], i]
    } else if (j>i) {
        datm[ii[1], j] = 100 - datm[ii[1], j]
        datm[jj[1], i] = 100 - datm[ii[1], j]
        datm[jj[2], i] = datm[ii[2], j]
    }

}

write.csv(dat0, 'outputs/which_exp_is_biggest_TabS2.csv')
write.csv(datm, 'outputs/which_exp_is_biggest_TabS3.csv')


text:
## !/user/bin/env RStudio 1.1.423
## -*- coding: utf-8 -*-
## visualization of U.S. presidential election

library("ggplot2")
library("RColorBrewer")
library("ggthemes")
library("shiny")
library("albersusa")
library("shinydashboard")

newdata<-read.csv(
  "D:/R/File/President.csv",
  stringsAsFactors=FALSE,
  check.names=FALSE
  )

#获取处理过的标准美国地图数据源:
states <-usa_composite() %>%
  fortify(us,region="name")

#将选举数据与美国地图数据合并
American_data<-states %>%
  merge(newdata,by.x="id",by.y="STATE_NAME")

#提取各州中心经纬度数据：
midpos    <- function(AD1){mean(range(AD1,na.rm=TRUE))}
centres   <- ddply(American_data,.(STATE_ABBR),colwise(midpos,.(long,lat)))
mynewdata <-join(centres,newdata,type="full")

#1 各州选举人票分布状况：
ggplot()+
  geom_polygon(data=American_data,aes(x=long,y=lat,group=group),colour="grey",fill="white")+
  geom_point(data=mynewdata,aes(x=long,y=lat,size=Count,fill=Count),shape=21,colour="black")+
  scale_size_area(max_size=15)+
  scale_fill_gradient(low="white",high="#D73434")+
  coord_map("polyconic") +
  theme_map() %+replace%
  theme(
    legend.position ="none"
    )

#2 美国总统大选投票结果双方获胜州分布情况:

ggplot(American_data,aes(x=long,y=lat,group=group,fill=Results))+
  geom_polygon(colour="white")+
  scale_fill_manual(values=c("#19609F","#CB1C2A"),labels=c("Hillary", "Trump"))+
  coord_map("polyconic") +
  guides(fill=guide_legend(title=NULL))+
  theme_map() %+replace%
  theme(
    legend.position =c(.5,.9),
    legend.direction="horizontal"
    )

#3 民主党（希拉里）各州选票支持率统计：

qa <- quantile(na.omit(American_data$Clinton), c(0,0.2,0.4,0.6,0.8,1.0))
American_data$Clinton_q <- cut(
  American_data$Clinton,
  qa,
  labels=c("0-20%","20-40%","40-60%","60-80%", "80-100%"),
  include.lowest=TRUE
  )

ggplot(American_data,aes(long,lat,group=group,fill=Clinton_q))+
  geom_polygon(colour="white")+
  scale_fill_brewer(palette="Blues")+
  coord_map("polyconic") +
  guides(fill=guide_legend(reverse=TRUE,title=NULL))+
  theme_map() %+replace%
  theme(
    legend.position = c(0.80,0.35),
    legend.text.align=1
    )

#4 共和党（特朗普）各州选票支持率统计：

qb <- quantile(na.omit(American_data$Trump),c(0,0.2,0.4,0.6,0.8,1.0))
American_data$Trump_q <- cut(
  American_data$Trump,
  qb,
  labels=c("0-20%","20-40%","40-60%","60-80%","80-100%"),
  include.lowest = TRUE
  )

ggplot(American_data,aes(long,lat,group=group,fill=Trump_q))+
  geom_polygon(colour="white")+
  scale_fill_brewer(palette="Reds")+
  coord_map("polyconic") +
  guides(fill=guide_legend(reverse=TRUE,title=NULL))+
  theme_map() %+replace%
  theme(
    legend.position = c(0.80,0.05),
    legend.text.align=1
    )

####美国总统大选shiny仪表盘：####

# 构建UI
ui <- dashboardPage(
  dashboardHeader(title="Basic dashboard"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Electoral Vote",  tabName = "dashboard1",icon =icon("dashboard")),
      menuItem("Trump VS Clinton",tabName = "dashboard2",icon =icon("dashboard")),
      menuItem("Hillary's Vote",  tabName = "dashboard3",icon =icon("dashboard")),
      menuItem("Trump's Vote",    tabName = "dashboard4",icon =icon("dashboard")),
      menuItem("Widgets",         tabName = "widgets",  icon =icon("th"))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "dashboard1",
              fluidRow(
                box(title="Electoral Vote",plotOutput("plot1", width=1000, height=750),width =12)
              )
      ),
      tabItem(tabName = "dashboard2",
              fluidRow(
                box(title="Trump VS Clinton",plotOutput("plot2", width=1000, height=750),width =12)
              )
      ),
      tabItem(tabName = "dashboard3",
              fluidRow(
                box(title="Hillary's Vote",plotOutput("plot3", width=1000, height=750),width =12)
              )
      ),
      tabItem(tabName = "dashboard4",
              fluidRow(
                box(title="Trump's Vote",plotOutput("plot4", width=1000, height=750),width =12)
              )
      ),
      tabItem(tabName="widgets",
              fluidRow(
                box(
                  title =h2("About Detials"),
                  h3("In 2016, Donald trump won 290 votes and Hillary Clinton won 228. Donald trump finally won, becoming the 45th President of the United States"),
                  width =12
                  )
              )
      )
    )
  )
)

#2 构建服务端代码：

server <- shinyServer(function(input,output){
  output$plot1 <- renderPlot({
    ggplot()+
      geom_polygon(data=American_data,aes(x=long,y=lat,group=group),colour="grey",fill="white")+
      geom_point(data=mynewdata,aes(x=long,y=lat,size=Count,fill=Count),shape=21,colour="black")+
      scale_size_area(max_size=15)+
      scale_fill_gradient(low="white",high="#D73434")+
      coord_map("polyconic") +
      theme_map(base_size =15, base_family = "") %+replace%
      theme(legend.position ="none")
  })
  output$plot2 <- renderPlot({
    ggplot(American_data,aes(x=long,y=lat,group=group,fill=Results))+
      geom_polygon(colour="white")+
      scale_fill_manual(values=c("#19609F","#CB1C2A"),labels=c("Hillary", "Trump"))+
      coord_map("polyconic") +
      guides(fill=guide_legend(title=NULL))+
      theme_map(base_size =15, base_family = "") %+replace%
      theme(legend.position =c(.5,.9),legend.direction="horizontal")
  })
  output$plot3 <- renderPlot({
    qa<-quantile(na.omit(American_data$Clinton), c(0,0.2,0.4,0.6,0.8,1.0))
    American_data$Clinton_q<-cut(American_data$Clinton,qa,labels=c("0-20%","20-40%","40-60%","60-80%", "80-100%"),include.lowest=TRUE)
    ggplot(American_data,aes(long,lat,group=group,fill=Clinton_q))+
      geom_polygon(colour="white")+
      scale_fill_brewer(palette="Blues")+
      coord_map("polyconic") +
      guides(fill=guide_legend(reverse=TRUE,title=NULL))+
      theme_map(base_size = 15, base_family = "") %+replace%
      theme(legend.position = c(0.80,0.05),legend.text.align=1)
  })
  output$plot4 <- renderPlot({
    qb <- quantile(na.omit(American_data$Trump),c(0,0.2,0.4,0.6,0.8,1.0))
    American_data$Trump_q<-cut(American_data$Trump,qb,labels=c("0-20%","20-40%","40-60%","60-80%","80-100%"),include.lowest = TRUE)
    ggplot(American_data,aes(long,lat,group=group,fill=Trump_q))+
      geom_polygon(colour="white")+
      scale_fill_brewer(palette="Reds")+
      coord_map("polyconic") +
      guides(fill=guide_legend(reverse=TRUE,title=NULL))+
      theme_map(base_size = 15, base_family = "") %+replace%
      theme(legend.position = c(0.80,0.05),legend.text.align=1)
  })
})

#3 运行仪表盘：
shinyApp(ui, server)

max_stars_repo_name: ivitan/LearnR

max_issues_repo_name: iVitan/R

max_forks_repo_name: iVitan/R


text:
marfissci.simple.map<-function(rds,
                               agg.by = "SPECIES_CODE",
                               colour.by = "SUM_RND_WEIGHT_KGS",
                               crs.out="+proj=utm +zone=20 +datum=WGS84",
                               xlim=c(-68,-53),
                               ylim=c(40,49),
                               valid.only = T,
                               show.legend = T,
                               save.plot = T,
                               out.folder = "marfissci",
                               plot.title="",
                               name.det = NULL,
                               nclasses=5,
                               add.OCMD = c("St_Ann","Gully","Vazella_Emerald","Vazella_Sambro","Lophelia", "NE_Channel")
){
  proj.metric = '+proj=aea +lat_1=20 +lat_2=60 +lat_0=23 +lon_0=-96
                 +x_0=0 +y_0=0 +ellps=GRS80 +datum=NAD83 +units=m'
  library(classInt)
  library(rgdal)
  limits = data.frame(X = xlim, Y = ylim)
  coordinates(limits) = c("X", "Y")
  proj4string(limits) = CRS("+proj=longlat +datum=WGS84")
  boundbox = SpatialPolygons(list(Polygons(list(Polygon(cbind(
    mm= c(limits$X[2],
          seq(limits$X[2],limits$X[1],length=200),
          seq(limits$X[1],limits$X[2],length=200)),
    nn = c(limits$Y[2],
           seq(limits$Y[1],limits$Y[1],length=200),
           seq(limits$Y[2],limits$Y[2],length=200))))),
    ID = "bb")),
    proj4str = CRS("+proj=longlat +datum=WGS84"))
  boundbox.pr = spTransform(boundbox,crs.out)
  #make slightly bigger bbox to reserve space in final
  boundbox2 = SpatialPolygons(list(Polygons(list(Polygon(cbind(
    mm= c(limits$X[2]+1,
          seq(limits$X[2]+1,limits$X[1]-1,length=200),
          seq(limits$X[1]-1,limits$X[2]+1,length=200)),
    nn = c(limits$Y[2]+1,
           seq(limits$Y[1]-1,limits$Y[1]-1,length=200),
           seq(limits$Y[2]+1,limits$Y[2]+1,length=200))))),
    ID = "bb2")),
    proj4str = CRS("+proj=longlat +datum=WGS84"))
  boundbox2.pr = spTransform(boundbox2,crs.out)

  #should clip the data to desired frame here so that classIntervals only works
  #on visible data!
  #Do nrow check AFTER that
  rds.clipped = rds[boundbox,]  #clip data to bbox
  if (valid.only) rds.clipped = rds.clipped[rds.clipped@data$VALIDITY == 'VALID',]
  ncheck=length(unique(rds.clipped@data[,c(colour.by)])) #don't have enough data for requested number of classes
  if (ncheck<2) return(NULL) #can't classify on a single value
  if (nclasses>ncheck) nclasses=ncheck
  rds.clipped@data$ORD = seq.int(nrow(rds.clipped))
  classes = classIntervals(rds.clipped@data[,c(colour.by)], n=nclasses, style= "quantile", dataPrecision=0)
  colcode = findColours(classes,
  c("#c7e9b4","#41b6c4","#225ea8","#081d58")) #colorblind-friendly yellow-blue
  #c("#deebf7", "#9ecae1","#3182bd")) #colorblind-friendly blues
  #c("#fee6ce","#fdae6b","#e6550d")) #colorblind-friendly oranges
  colour.df = as.data.frame(cbind(varname=classes$var,colcode))
  names(colour.df)[names(colour.df)=="varname"] <- colour.by
  rds.clipped@data = merge( rds.clipped@data,unique(colour.df), all.x = T)
  #rds.clipped@data = rds.clipped@data[order(rds.clipped@data$ORD),]

  rds.clipped.pr = spTransform(rds.clipped, CRS(crs.out), match.ID=F)
  rds.clipped.pr@data = rds.clipped.pr@data[order(rds.clipped.pr@data$ORD),]

  if (!exists("coast.aea") ||
      !exists("coast.clipped.aea") ||
      !exists("coast.clipped.pr") ||
      !exists("the.grid") ||
      !exists("grid.pr") ||
      !exists("these.gridlines") ||
      !exists("these.gridlines.pr") )
    {

    writeLines("Building the coastline...")
    coast.aea =  as( aegis.coastline::coastline_db( project_to=proj.metric ), "Spatial" )
      library(rgeos)
      writeLines("Trimming the data to match the selected bounding box (so that data can be projected)")
      coast.clipped.aea <<- gIntersection(gBuffer(coast.aea, byid=TRUE, width=0), spTransform(boundbox,proj.metric))
      coast.clipped.pr <<- spTransform(coast.clipped.aea,crs.out)

    #'using the clipped data (pre-projection), capture information for the grid,
    #'including information about the gridlines, as well as their labels
    the.grid <<- gridat(boundbox, easts=seq(boundbox@"bbox"[1],boundbox@"bbox"[3],by=2),
                     norths=seq(boundbox@"bbox"[2],boundbox@"bbox"[4],by=2))
    grid.pr <<- spTransform(the.grid, CRS(crs.out))
    these.gridlines <<- gridlines(boundbox, easts=seq(boundbox@"bbox"[1],boundbox@"bbox"[3],by=1),
                      norths=seq(boundbox@"bbox"[2],boundbox@"bbox"[4],by=1))
    these.gridlines.pr <<- spTransform(these.gridlines, CRS(crs.out))
  }
  if (!exists("clip.100") ||
      !exists("clip.200") ||
      !exists("clip.300") ||
      !exists("clip.400") ||
      !exists("clip.500") ||
      !exists("clip.600") ||
      !exists("clip.700") ||
      !exists("clip.800") ||
      !exists("clip.900"))
  {
  #bathy data
    writeLines("Generating contours")
   p = aegis.bathymetry::bathymetry_parameters()
   p = spatial_parameters( p=p, spatial_domain="canada.east.highres" )
   depths = c(100, 200, 300, 400, 500, 600, 700, 800, 900) #, 2000, 5000 )
   plygn = as( isobath_db( p=p, DS="isobath", depths=depths ), "Spatial")
   #data must be clipped so it doesn't extend beyond the bounding box
  clip.100 <<- gIntersection(spTransform(plygn["100"], CRS(crs.out)), boundbox.pr)
  clip.200 <<- gIntersection(spTransform(plygn["200"], CRS(crs.out)), boundbox.pr)
  clip.300 <<- gIntersection(spTransform(plygn["300"], CRS(crs.out)), boundbox.pr)
  clip.400 <<- gIntersection(spTransform(plygn["400"], CRS(crs.out)), boundbox.pr)
  clip.500 <<- gIntersection(spTransform(plygn["500"], CRS(crs.out)), boundbox.pr)
  clip.600 <<- gIntersection(spTransform(plygn["600"], CRS(crs.out)), boundbox.pr)
  clip.700 <<- gIntersection(spTransform(plygn["700"], CRS(crs.out)), boundbox.pr)
  clip.800 <<- gIntersection(spTransform(plygn["800"], CRS(crs.out)), boundbox.pr)
  clip.900 <<- gIntersection(spTransform(plygn["900"], CRS(crs.out)), boundbox.pr)
  #clip.1000 <<- gIntersection(spTransform(plygn["1000"], CRS(crs.out)), boundbox.pr)
  }
  #get the desired OCMD areas
  if (length(add.OCMD)>0) OCMD.areas=get.ocmd.areas(add.OCMD)

 if (save.plot){
   if (!is.null(name.det)){
     name.detail=paste0(name.det,"_")
   }else{
     name.detail=""
   }
   if (range(rds.clipped.pr@data[agg.by])[1] == range(rds.clipped.pr@data[agg.by])[2]) {
     the.filename = range(rds.clipped.pr@data[agg.by])[1]
   }else{
     the.filename = paste(range(rds.clipped.pr@data[agg.by]),collapse = "_")
   }
#    plot.title.clean=gsub("(\\(|\\)|\\s|\\/|,)","_",plot.title)
#    plot.title.clean=gsub("__","_", plot.title.clean)
#    plot.title.clean=substr(plot.title.clean,1,15)
#    plot.title.clean=paste0(sub('_$', '', plot.title.clean),"_")

   agg.type=paste0(substr(agg.by, 1, 4),"_")

   the.filename=paste0(name.detail,agg.type,the.filename,".png")

   png(filename=paste0(project.datadirectory("aegis", "data", ,out.folder, "figures" ), the.filename),
      width = 6, height = 4, units = "in", res= 300, pointsize = 4,
      bg = "white", family = "", restoreConsole = TRUE,
      type = c("windows", "cairo", "cairo-png"))
 }
  par(mar=c(2,2,1,1),xaxs = "i",yaxs = "i",cex.axis=1.3,cex.lab=1.4)
  plot(boundbox2.pr, border="transparent", add=F, lwd=1) #add transparent boundbox first to ensure all data shown
  plot(coast.clipped.pr, col="navajowhite2", border="navajowhite4", lwd=0.5, axes=F, add=T )  #add coastline
#   lines(clip.1000, col="#666666", lwd=0.5)
  lines(clip.900, col="#717171", lwd=0.5)
  lines(clip.800, col="#7C7C7C", lwd=0.5)
  lines(clip.700, col="#888888", lwd=0.5)
  lines(clip.600, col="#939393", lwd=0.5)
  lines(clip.500, col="#9E9E9E", lwd=0.5)
  lines(clip.400, col="#AAAAAA", lwd=0.5)
  lines(clip.300, col="#B5B5B5", lwd=0.5)
  lines(clip.200, col="#C0C0C0", lwd=0.5)
  lines(clip.100, col="#CCCCCC", lwd=0.5)
  for (o in 1:length(OCMD.areas)){
    plot(spTransform(OCMD.areas[[o]], CRS(crs.out)), border="olivedrab4", lwd=0.5, add=T)
  }
  plot(these.gridlines.pr, col="grey77", lty=2, lwd=0.5, add=T)                           #gridlines
  points(rds.clipped.pr, col = rds.clipped.pr@data$colcode, pch = 15, cex = 0.5)
  text(coordinates(grid.pr), pos=grid.pr$pos, labels=parse(text=as.character(the.grid$labels)),
       offset=0.2, col="black", cex=1)
  plot(boundbox.pr, border="black", add=T, lwd=1) #add actual boundbox
  if (show.legend){
    legend(title = plot.title ,min(boundbox.pr@bbox[1,])+(0.075*(max(boundbox.pr@bbox[1,])-min(boundbox.pr@bbox[1,]))),
         min(boundbox.pr@bbox[2,])+(0.95*(max(boundbox.pr@bbox[2,])-min(boundbox.pr@bbox[2,]))),
         cex=1, y.intersp=0.8,
         legend = c(gsub(",","-",names(attr(colcode, "table"))),"no data"),
         fill = c(attr(colcode, "palette"),"white"))
  }
  if (save.plot) dev.off()
}


text:
REBOL []

;A sample server test function
;Start serving with "serve [echo]"
echo: func [ e [string!]] [return e]

; Client test function. Shows how easy it is to do a remote exec
client-test: does [ rexec [echo "Rugby is great!"] ]

max_stars_repo_name: mbk/rugby

max_issues_repo_name: mbk/rugby

max_forks_repo_name: mbk/rugby


text:
#' Write json pretty
#'
#' Re-write existing json file with pretty formatting
#'
#' @param path path to json file on disk
#' @keywords internal
#' @examples
#' \dontrun{
#' pretty_json("tests/testthat/api.coinbase.com/v2/accounts.json")
#' }
pretty_json <- function(path) {
  json <- jsonlite::read_json(path)
  jsonlite::write_json(json, path, pretty = TRUE, auto_unbox = TRUE)
}

#' Capture requests to tests directory
#'
#' Helper to build up mock fixtures for testing
#' @param expr R expresssion to execute
#' @examples
#' \dontrun{
#' capture_requests2(get_accounts())
#' }
capture_request2 <- function(expr) {
  httptest::capture_requests(expr, path = "tests/testthat")
}

max_stars_repo_name: zamorarr/gdaxr

max_issues_repo_name: zamorarr/rcoinbase

max_forks_repo_name: zamorarr/rcoinbase


text:
source("mtcars__dane.r")
source("machine_dane.r")
source("imports-85_dane.r")

#zobacz jak w SVMRegresja.r

max_stars_repo_name: PLPOLAND/Projekt-R

max_issues_repo_name: PLPOLAND/Projekt-R

max_forks_repo_name: PLPOLAND/Projekt-R