mirror of
https://github.com/KevinMidboe/linguist.git
synced 2025-10-29 17:50:22 +00:00
Merge pull request #1110 from github/samples_checking
Towards testing for presence of sample files
This commit is contained in:
@@ -426,6 +426,11 @@ module Linguist
|
||||
#
|
||||
# Returns the extensions Array
|
||||
attr_reader :filenames
|
||||
|
||||
# Public: Return all possible extensions for language
|
||||
def all_extensions
|
||||
(extensions + [primary_extension]).uniq
|
||||
end
|
||||
|
||||
# Public: Get URL escaped name.
|
||||
#
|
||||
|
||||
@@ -332,8 +332,6 @@ Cirru:
|
||||
# ace_mode: cirru
|
||||
# lexer: Cirru
|
||||
lexer: Text only
|
||||
extensions:
|
||||
- .cr
|
||||
|
||||
Clean:
|
||||
type: programming
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
82
samples/Common Lisp/macros-advanced.cl
Normal file
82
samples/Common Lisp/macros-advanced.cl
Normal file
@@ -0,0 +1,82 @@
|
||||
;; @file macros-advanced.cl
|
||||
;;
|
||||
;; @breif Advanced macro practices - defining your own macros
|
||||
;;
|
||||
;; Macro definition skeleton:
|
||||
;; (defmacro name (parameter*)
|
||||
;; "Optional documentation string"
|
||||
;; body-form*)
|
||||
;;
|
||||
;; Note that backquote expression is most often used in the `body-form`
|
||||
;;
|
||||
|
||||
; `primep` test a number for prime
|
||||
(defun primep (n)
|
||||
"test a number for prime"
|
||||
(if (< n 2) (return-from primep))
|
||||
(do ((i 2 (1+ i)) (p t (not (zerop (mod n i)))))
|
||||
((> i (sqrt n)) p)
|
||||
(when (not p) (return))))
|
||||
; `next-prime` return the next prime bigger than the specified number
|
||||
(defun next-prime (n)
|
||||
"return the next prime bigger than the speicified number"
|
||||
(do ((i (1+ n) (1+ i)))
|
||||
((primep i) i)))
|
||||
;
|
||||
; The recommended procedures to writting a new macro are as follows:
|
||||
; 1. Write a sample call to the macro and the code it should expand into
|
||||
(do-primes (p 0 19)
|
||||
(format t "~d " p))
|
||||
; Expected expanded codes
|
||||
(do ((p (next-prime (- 0 1)) (next-prime p)))
|
||||
((> p 19))
|
||||
(format t "~d " p))
|
||||
; 2. Write code that generate the hardwritten expansion from the arguments in
|
||||
; the sample call
|
||||
(defmacro do-primes (var-and-range &rest body)
|
||||
(let ((var (first var-and-range))
|
||||
(start (second var-and-range))
|
||||
(end (third var-and-range)))
|
||||
`(do ((,var (next-prime (- ,start 1)) (next-prime ,var)))
|
||||
((> ,var ,end))
|
||||
,@body)))
|
||||
; 2-1. More concise implementations with the 'parameter list destructuring' and
|
||||
; '&body' synonym, it also emits more friendly messages on incorrent input.
|
||||
(defmacro do-primes ((var start end) &body body)
|
||||
`(do ((,var (next-prime (- ,start 1)) (next-prime ,var)))
|
||||
((> ,var ,end))
|
||||
,@body))
|
||||
; 2-2. Test the result of macro expansion with the `macroexpand-1` function
|
||||
(macroexpand-1 '(do-primes (p 0 19) (format t "~d " p)))
|
||||
; 3. Make sure the macro abstraction does not "leak"
|
||||
(defmacro do-primes ((var start end) &body body)
|
||||
(let ((end-value-name (gensym)))
|
||||
`(do ((,var (next-prime (- ,start 1)) (next-prime ,var))
|
||||
(,end-value-name ,end))
|
||||
((> ,var ,end-value-name))
|
||||
,@body)))
|
||||
; 3-1. Rules to observe to avoid common and possible leaks
|
||||
; a. include any subforms in the expansion in positions that will be evaluated
|
||||
; in the same order as the subforms appear in the macro call
|
||||
; b. make sure subforms are evaluated only once by creating a variable in the
|
||||
; expansion to hold the value of evaluating the argument form, and then
|
||||
; using that variable anywhere else the value is needed in the expansion
|
||||
; c. use `gensym` at macro expansion time to create variable names used in the
|
||||
; expansion
|
||||
;
|
||||
; Appendix I. Macro-writting macros, 'with-gensyms', to guranttee that rule c
|
||||
; gets observed.
|
||||
; Example usage of `with-gensyms`
|
||||
(defmacro do-primes-a ((var start end) &body body)
|
||||
"do-primes implementation with macro-writting macro 'with-gensyms'"
|
||||
(with-gensyms (end-value-name)
|
||||
`(do ((,var (next-prime (- ,start 1)) (next-prime ,var))
|
||||
(,end-value-name ,end))
|
||||
((> ,var ,end-value-name))
|
||||
,@body)))
|
||||
; Define the macro, note how comma is used to interpolate the value of the loop
|
||||
; expression
|
||||
(defmacro with-gensyms ((&rest names) &body body)
|
||||
`(let ,(loop for n in names collect `(,n (gensym)))
|
||||
,@body)
|
||||
)
|
||||
475
samples/Common Lisp/motor-inferencia.cl
Normal file
475
samples/Common Lisp/motor-inferencia.cl
Normal file
@@ -0,0 +1,475 @@
|
||||
#|
|
||||
ESCUELA POLITECNICA SUPERIOR - UNIVERSIDAD AUTONOMA DE MADRID
|
||||
INTELIGENCIA ARTIFICIAL
|
||||
|
||||
Motor de inferencia
|
||||
Basado en parte en "Paradigms of AI Programming: Case Studies
|
||||
in Common Lisp", de Peter Norvig, 1992
|
||||
|#
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;; Global variables
|
||||
;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
(defvar *hypothesis-list*)
|
||||
(defvar *rule-list*)
|
||||
(defvar *fact-list*)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;; Constants
|
||||
;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defconstant +fail+ nil "Indicates unification failure")
|
||||
|
||||
(defconstant +no-bindings+ '((nil))
|
||||
"Indicates unification success, with no variables.")
|
||||
|
||||
(defconstant *mundo-abierto* nil)
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;; Functions for the user
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
;; Resets *fact-list* to NIL
|
||||
(defun erase-facts () (setq *fact-list* nil))
|
||||
|
||||
(defun set-hypothesis-list (h) (setq *hypothesis-list* h))
|
||||
|
||||
|
||||
;; Returns a list of solutions, each one satisfying all the hypothesis contained
|
||||
;; in *hypothesis-list*
|
||||
(defun motor-inferencia ()
|
||||
(consulta *hypothesis-list*))
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;; Auxiliary functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
#|____________________________________________________________________________
|
||||
FUNCTION: CONSULTA
|
||||
|
||||
COMMENTS:
|
||||
CONSULTA receives a list of hypothesis (variable <hypotheses>), and returns
|
||||
a list of binding lists (each binding list being a solution).
|
||||
|
||||
EXAMPLES:
|
||||
hypotheses is:
|
||||
((brothers ?x ?y) (neighbours juan ?x)).
|
||||
|
||||
That is, we are searching the brothers of the possible neighbors of Juan.
|
||||
|
||||
The function can return in this case:
|
||||
|
||||
(((?x . sergio) (?y . javier)) ((?x . julian) (?y . mario)) ((?x . julian) (?y . pedro))).
|
||||
That is, the neighbors of Juan (Sergio and Julian) have 3 brothers in total(Javier, Mario, Pedro)
|
||||
____________________________________________________________________________|#
|
||||
|
||||
(defun consulta (hypotheses)
|
||||
(if (null hypotheses) (list +no-bindings+)
|
||||
(mapcan #'(lambda (b)
|
||||
(mapcar #'(lambda (x) (une-bindings-con-bindings b x))
|
||||
(consulta (subst-bindings b (rest hypotheses)))))
|
||||
(find-hypothesis-value (first hypotheses)))))
|
||||
|
||||
|
||||
|
||||
#|____________________________________________________________________________
|
||||
FUNCTION: FIND-HYPOTHESIS-VALUE
|
||||
|
||||
COMMENTS:
|
||||
This function manages the query a single query (only one hypothesis) given a binding list.
|
||||
It tries (in the following order) to:
|
||||
- Answer the query from *fact-list*
|
||||
- Answer the query from the rules in *rule-list*
|
||||
- Ask the user
|
||||
|
||||
The function returns a list of solutions (list of binding lists).
|
||||
|
||||
EXAMPLES:
|
||||
If hypothesis is (brothers ?x ?y)
|
||||
and the function returns:
|
||||
(((?x . sergio) (?y . javier)) ((?x . julian) (?y . maria)) ((?x . alberto) (?y . pedro))).
|
||||
|
||||
Means that Sergio and Javier and brothers, Julian and Mario are brothers, and Alberto and Pedro are brothers.
|
||||
____________________________________________________________________________|#
|
||||
|
||||
(defun find-hypothesis-value (hypothesis)
|
||||
(let (rules)
|
||||
(cond
|
||||
((equality? hypothesis)
|
||||
(value-from-equality hypothesis))
|
||||
((value-from-facts hypothesis))
|
||||
((setq good-rules (find-rules hypothesis))
|
||||
(value-from-rules hypothesis good-rules))
|
||||
(t (ask-user hypothesis)))))
|
||||
|
||||
|
||||
|
||||
; une-bindings-con-bindings takes two binding lists and returns a binding list
|
||||
; Assumes that b1 and b2 are not +fail+
|
||||
(defun une-bindings-con-bindings (b1 b2)
|
||||
(cond
|
||||
((equal b1 +no-bindings+) b2)
|
||||
((equal b2 +no-bindings+) b1)
|
||||
(T (append b1 b2))))
|
||||
|
||||
|
||||
|
||||
#|____________________________________________________________________________
|
||||
FUNCTION: VALUE-FROM-FACTS
|
||||
|
||||
COMMENTS:
|
||||
Returns all the solutions of <hypothesis> obtained directly from *fact-list*
|
||||
|
||||
EXAMPLES:
|
||||
> (setf *fact-list* '((man luis) (man pedro)(woman mart)(man daniel)(woman laura)))
|
||||
|
||||
> (value-from-facts '(man ?x))
|
||||
returns:
|
||||
|
||||
(((?X . LUIS)) ((?X . PEDRO)) ((?X . DANIEL)))
|
||||
____________________________________________________________________________|#
|
||||
|
||||
(defun value-from-facts (hypothesis)
|
||||
(mapcan #'(lambda(x) (let ((aux (unify hypothesis x)))
|
||||
(when aux (list aux)))) *fact-list*))
|
||||
|
||||
|
||||
|
||||
|
||||
#|____________________________________________________________________________
|
||||
FUNCTION: FIND-RULES
|
||||
|
||||
COMMENTS:
|
||||
Returns the rules in *rule-list* whose THENs unify with the term given in <hypothesis>
|
||||
The variables in the rules that satisfy this requirement are renamed.
|
||||
|
||||
EXAMPLES:
|
||||
> (setq *rule-list*
|
||||
'((R1 (pertenece ?E (?E . ?_)))
|
||||
(R2 (pertenece ?E (?_ . ?Xs)) :- ((pertenece ?E ?Xs)))))
|
||||
|
||||
Then:
|
||||
> (FIND-RULES (PERTENECE 1 (2 5)))
|
||||
returns:
|
||||
((R2 (PERTENECE ?E.1 (?_ . ?XS.2)) :- ((PERTENECE ?E.1 ?XS.2))))
|
||||
That is, only the THEN of rule R2 unify with <hypothesis>
|
||||
|
||||
However,
|
||||
> (FIND-RULES (PERTENECE 1 (1 6 7)))
|
||||
|
||||
returns:
|
||||
((R1 (PERTENECE ?E.6 (?E.6 . ?_)))
|
||||
(R2 (PERTENECE ?E.7 (?_ . ?XS.8)) :- ((PERTENECE ?E.7 ?XS.8))))
|
||||
So the THEN of both rules unify with <hypothesis>
|
||||
____________________________________________________________________________|#
|
||||
|
||||
(defun find-rules (hypothesis)
|
||||
(mapcan #'(lambda(b) (let ((renamed-rule (rename-variables b)))
|
||||
(when (in-then? hypothesis renamed-rule)
|
||||
(list renamed-rule)))) *rule-list*))
|
||||
|
||||
(defun in-then? (hypothesis rule)
|
||||
(unless (null (rule-then rule))
|
||||
(not (equal +fail+ (unify hypothesis (rule-then rule))))))
|
||||
|
||||
|
||||
|
||||
#|____________________________________________________________________________
|
||||
FUNCTION: VALUE-FROM-RULES
|
||||
|
||||
COMMENTS:
|
||||
Returns all the solutions to <hypothesis> found using all the rules given in
|
||||
the list <rules>. Note that a single rule can have multiple solutions.
|
||||
____________________________________________________________________________|#
|
||||
(defun value-from-rules (hypothesis rules)
|
||||
(mapcan #'(lambda (r) (eval-rule hypothesis r)) rules))
|
||||
|
||||
(defun limpia-vinculos (termino bindings)
|
||||
(unify termino (subst-bindings bindings termino)))
|
||||
|
||||
|
||||
#|____________________________________________________________________________
|
||||
FUNCTION: EVAL-RULE
|
||||
|
||||
COMMENTS:
|
||||
Returns all the solutions found using the rule given as input argument.
|
||||
|
||||
EXAMPLES:
|
||||
> (setq *rule-list*
|
||||
'((R1 (pertenece ?E (?E . ?_)))
|
||||
(R2 (pertenece ?E (?_ . ?Xs)) :- ((pertenece ?E ?Xs)))))
|
||||
Then:
|
||||
> (EVAL-RULE
|
||||
(PERTENECE 1 (1 6 7))
|
||||
(R1 (PERTENECE ?E.42 (?E.42 . ?_))))
|
||||
returns:
|
||||
(((NIL)))
|
||||
That is, the query (PERTENECE 1 (1 6 7)) can be proven from the given rule, and
|
||||
no binding in the variables in the query is necessary (in fact, the query has no variables).
|
||||
On the other hand:
|
||||
> (EVAL-RULE
|
||||
(PERTENECE 1 (7))
|
||||
(R2 (PERTENECE ?E.49 (?_ . ?XS.50)) :- ((PERTENECE ?E.49 ?XS.50))))
|
||||
returns:
|
||||
NIL
|
||||
That is, the query can not be proven from the rule R2.
|
||||
____________________________________________________________________________|#
|
||||
|
||||
(defun eval-rule (hypothesis rule)
|
||||
(let ((bindings-then
|
||||
(unify (rule-then rule) hypothesis)))
|
||||
(unless (equal +fail+ bindings-then)
|
||||
(if (rule-ifs rule)
|
||||
(mapcar #'(lambda(b) (limpia-vinculos hypothesis (append bindings-then b)))
|
||||
(consulta (subst-bindings bindings-then (rule-ifs rule))))
|
||||
(list (limpia-vinculos hypothesis bindings-then))))))
|
||||
|
||||
|
||||
(defun ask-user (hypothesis)
|
||||
(let ((question hypothesis))
|
||||
(cond
|
||||
((variables-in question) +fail+)
|
||||
((not-in-fact-list? question) +fail+)
|
||||
(*mundo-abierto*
|
||||
(format t "~%Es cierto el hecho ~S? (T/nil)" question)
|
||||
(cond
|
||||
((read) (add-fact question) +no-bindings+)
|
||||
(T (add-fact (list 'NOT question)) +fail+)))
|
||||
(T +fail+))))
|
||||
|
||||
|
||||
; value-from-equality:
|
||||
(defun value-from-equality (hypothesis)
|
||||
(let ((new-bindings (unify (second hypothesis) (third hypothesis))))
|
||||
(if (not (equal +fail+ new-bindings))
|
||||
(list new-bindings))))
|
||||
|
||||
|
||||
|
||||
#|____________________________________________________________________________
|
||||
FUNCTION: UNIFY
|
||||
|
||||
COMMENTS:
|
||||
Finds the most general unifier of two input expressions, taking into account the
|
||||
bindings specified in the input <bingings>
|
||||
In case the two expressions can unify, the function returns the total bindings necessary
|
||||
for that unification. Otherwise, returns +fail+
|
||||
|
||||
EXAMPLES:
|
||||
> (unify '1 '1)
|
||||
((NIL)) ;; which is the constant +no-bindings+
|
||||
> (unify 1 '2)
|
||||
nil ;; which is the constant +fail+
|
||||
> (unify '?x 1)
|
||||
((?x . 1))
|
||||
> (unify '(1 1) ?x)
|
||||
((? x 1 1))
|
||||
> (unify '?_ '?x)
|
||||
((NIL))
|
||||
> (unify '(p ?x 1 2) '(p ?y ?_ ?_))
|
||||
((?x . ?y))
|
||||
> (unify '(?a . ?_) '(1 2 3))
|
||||
((?a . 1))
|
||||
> (unify '(?_ ?_) '(1 2))
|
||||
((nil))
|
||||
> (unify '(?a . ?b) '(1 2 3))
|
||||
((?b 2 3) (?a . 1))
|
||||
> (unify '(?a . ?b) '(?v . ?d))
|
||||
((?b . ?d) (?a . ?v))
|
||||
> (unify '(?eval (+ 1 1)) '1)
|
||||
nil
|
||||
> (unify '(?eval (+ 1 1)) '2)
|
||||
(nil))
|
||||
____________________________________________________________________________|#
|
||||
|
||||
(defun unify (x y &optional (bindings +no-bindings+))
|
||||
"See if x and y match with given bindings. If they do,
|
||||
return a binding list that would make them equal [p 303]."
|
||||
(cond ((eq bindings +fail+) +fail+)
|
||||
((eql x y) bindings)
|
||||
((eval? x) (unify-eval x y bindings))
|
||||
((eval? y) (unify-eval y x bindings))
|
||||
((variable? x) (unify-var x y bindings))
|
||||
((variable? y) (unify-var y x bindings))
|
||||
((and (consp x) (consp y))
|
||||
(unify (rest x) (rest y)
|
||||
(unify (first x) (first y) bindings)))
|
||||
(t +fail+)))
|
||||
|
||||
|
||||
;; rename-variables: renombra ?X por ?X.1, ?Y por ?Y.2 etc. salvo ?_ que no se renombra
|
||||
(defun rename-variables (x)
|
||||
"Replace all variables in x with new ones. Excepto ?_"
|
||||
(sublis (mapcar #'(lambda (var)
|
||||
(if (anonymous-var? var)
|
||||
(make-binding var var)
|
||||
(make-binding var (new-variable var))))
|
||||
(variables-in x))
|
||||
x))
|
||||
|
||||
|
||||
|
||||
;;;; Auxiliary Functions
|
||||
|
||||
(defun unify-var (var x bindings)
|
||||
"Unify var with x, using (and maybe extending) bindings [p 303]."
|
||||
(cond ((or (anonymous-var? var)(anonymous-var? x)) bindings)
|
||||
((get-binding var bindings)
|
||||
(unify (lookup var bindings) x bindings))
|
||||
((and (variable? x) (get-binding x bindings))
|
||||
(unify var (lookup x bindings) bindings))
|
||||
((occurs-in? var x bindings)
|
||||
+fail+)
|
||||
(t (extend-bindings var x bindings))))
|
||||
|
||||
(defun variable? (x)
|
||||
"Is x a variable (a symbol starting with ?)?"
|
||||
(and (symbolp x) (eql (char (symbol-name x) 0) #\?)))
|
||||
|
||||
(defun get-binding (var bindings)
|
||||
"Find a (variable . value) pair in a binding list."
|
||||
(assoc var bindings))
|
||||
|
||||
(defun binding-var (binding)
|
||||
"Get the variable part of a single binding."
|
||||
(car binding))
|
||||
|
||||
(defun binding-val (binding)
|
||||
"Get the value part of a single binding."
|
||||
(cdr binding))
|
||||
|
||||
(defun make-binding (var val) (cons var val))
|
||||
|
||||
(defun lookup (var bindings)
|
||||
"Get the value part (for var) from a binding list."
|
||||
(binding-val (get-binding var bindings)))
|
||||
|
||||
(defun extend-bindings (var val bindings)
|
||||
"Add a (var . value) pair to a binding list."
|
||||
(append
|
||||
(unless (eq bindings +no-bindings+) bindings)
|
||||
(list (make-binding var val))))
|
||||
|
||||
(defun occurs-in? (var x bindings)
|
||||
"Does var occur anywhere inside x?"
|
||||
(cond ((eq var x) t)
|
||||
((and (variable? x) (get-binding x bindings))
|
||||
(occurs-in? var (lookup x bindings) bindings))
|
||||
((consp x) (or (occurs-in? var (first x) bindings)
|
||||
(occurs-in? var (rest x) bindings)))
|
||||
(t nil)))
|
||||
|
||||
(defun subst-bindings (bindings x)
|
||||
"Substitute the value of variables in bindings into x,
|
||||
taking recursively bound variables into account."
|
||||
(cond ((eq bindings +fail+) +fail+)
|
||||
((eq bindings +no-bindings+) x)
|
||||
((and (listp x) (eq '?eval (car x)))
|
||||
(subst-bindings-quote bindings x))
|
||||
((and (variable? x) (get-binding x bindings))
|
||||
(subst-bindings bindings (lookup x bindings)))
|
||||
((atom x) x)
|
||||
(t (cons (subst-bindings bindings (car x)) ;; s/reuse-cons/cons
|
||||
(subst-bindings bindings (cdr x))))))
|
||||
|
||||
(defun unifier (x y)
|
||||
"Return something that unifies with both x and y (or fail)."
|
||||
(subst-bindings (unify x y) x))
|
||||
|
||||
(defun variables-in (exp)
|
||||
"Return a list of all the variables in EXP."
|
||||
(unique-find-anywhere-if #'variable? exp))
|
||||
|
||||
(defun unique-find-anywhere-if (predicate tree &optional found-so-far)
|
||||
"Return a list of leaves of tree satisfying predicate,
|
||||
with duplicates removed."
|
||||
(if (atom tree)
|
||||
(if (funcall predicate tree)
|
||||
(pushnew tree found-so-far)
|
||||
found-so-far)
|
||||
(unique-find-anywhere-if
|
||||
predicate
|
||||
(first tree)
|
||||
(unique-find-anywhere-if predicate (rest tree)
|
||||
found-so-far))))
|
||||
|
||||
(defun find-anywhere-if (predicate tree)
|
||||
"Does predicate apply to any atom in the tree?"
|
||||
(if (atom tree)
|
||||
(funcall predicate tree)
|
||||
(or (find-anywhere-if predicate (first tree))
|
||||
(find-anywhere-if predicate (rest tree)))))
|
||||
|
||||
(defun new-variable (var)
|
||||
"Create a new variable. Assumes user never types variables of form ?X.9"
|
||||
(gentemp (format nil "~S." var)))
|
||||
; (gentemp "?") )
|
||||
;;;
|
||||
|
||||
(defun anonymous-var? (x)
|
||||
(eq x '?_))
|
||||
|
||||
(defun subst-bindings-quote (bindings x)
|
||||
"Substitute the value of variables in bindings into x,
|
||||
taking recursively bound variables into account."
|
||||
(cond ((eq bindings +fail+) +fail+)
|
||||
((eq bindings +no-bindings+) x)
|
||||
((and (variable? x) (get-binding x bindings))
|
||||
(if (variable? (lookup x bindings))
|
||||
(subst-bindings-quote bindings (lookup x bindings))
|
||||
(subst-bindings-quote bindings (list 'quote (lookup x bindings)))
|
||||
)
|
||||
)
|
||||
((atom x) x)
|
||||
(t (cons (subst-bindings-quote bindings (car x)) ;; s/reuse-cons/cons
|
||||
(subst-bindings-quote bindings (cdr x))))))
|
||||
|
||||
(defun eval? (x)
|
||||
(and (consp x) (eq (first x) '?eval)))
|
||||
|
||||
(defun unify-eval (x y bindings)
|
||||
(let ((exp (subst-bindings-quote bindings (second x))))
|
||||
(if (variables-in exp)
|
||||
+fail+
|
||||
(unify (eval exp) y bindings))))
|
||||
|
||||
|
||||
|
||||
(defun rule-ifs (rule) (fourth rule))
|
||||
(defun rule-then (rule) (second rule))
|
||||
|
||||
|
||||
(defun equality? (term)
|
||||
(and (consp term) (eql (first term) '?=)))
|
||||
|
||||
|
||||
(defun in-fact-list? (expresion)
|
||||
(some #'(lambda(x) (equal x expresion)) *fact-list*))
|
||||
|
||||
(defun not-in-fact-list? (expresion)
|
||||
(if (eq (car expresion) 'NOT)
|
||||
(in-fact-list? (second expresion))
|
||||
(in-fact-list? (list 'NOT expresion))))
|
||||
|
||||
|
||||
;; add-fact:
|
||||
|
||||
(defun add-fact (fact)
|
||||
(setq *fact-list* (cons fact *fact-list*)))
|
||||
|
||||
|
||||
(defun variable? (x)
|
||||
"Is x a variable (a symbol starting with ?) except ?eval and ?="
|
||||
(and (not (equal x '?eval)) (not (equal x '?=))
|
||||
(symbolp x) (eql (char (symbol-name x) 0) #\?)))
|
||||
|
||||
|
||||
;; EOF
|
||||
111
samples/Perl/PSGI.pod
Normal file
111
samples/Perl/PSGI.pod
Normal file
@@ -0,0 +1,111 @@
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Catalyst::PSGI - How Catalyst and PSGI work together
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
The L<PSGI> specification defines an interface between web servers and
|
||||
Perl-based web applications and frameworks. It supports the writing of
|
||||
portable applications that can be run using various methods (as a
|
||||
standalone server, or using mod_perl, FastCGI, etc.). L<Plack> is an
|
||||
implementation of the PSGI specification for running Perl applications.
|
||||
|
||||
Catalyst used to contain an entire set of C<< Catalyst::Engine::XXXX >>
|
||||
classes to handle various web servers and environments (e.g. CGI,
|
||||
FastCGI, mod_perl) etc.
|
||||
|
||||
This has been changed in Catalyst 5.9 so that all of that work is done
|
||||
by Catalyst implementing the L<PSGI> specification, using L<Plack>'s
|
||||
adaptors to implement that functionality.
|
||||
|
||||
This means that we can share common code, and share fixes for specific
|
||||
web servers.
|
||||
|
||||
=head1 I already have an application
|
||||
|
||||
If you already have a Catalyst application, then you should be able to
|
||||
upgrade to the latest release with little or no trouble (see the notes
|
||||
in L<Catalyst::Upgrading> for specifics about your web server
|
||||
deployment).
|
||||
|
||||
=head1 Writing your own PSGI file.
|
||||
|
||||
=head2 What is a .psgi file?
|
||||
|
||||
A C<< .psgi >> file lets you control how your application code reference
|
||||
is built. Catalyst will automatically handle this for you, but it's
|
||||
possible to do it manually by creating a C<myapp.psgi> file in the root
|
||||
of your application.
|
||||
|
||||
=head2 Why would I want to write my own .psgi file?
|
||||
|
||||
Writing your own .psgi file allows you to use the alternate L<plackup> command
|
||||
to start your application, and allows you to add classes and extensions
|
||||
that implement L<Plack::Middleware>, such as L<Plack::Middleware::ErrorDocument>
|
||||
or L<Plack::Middleware::AccessLog>.
|
||||
|
||||
The simplest C<.psgi> file for an application called C<TestApp> would be:
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use TestApp;
|
||||
|
||||
my $app = TestApp->psgi_app(@_);
|
||||
|
||||
Note that Catalyst will apply a number of middleware components for you
|
||||
automatically, and these B<will not> be applied if you manually create a
|
||||
psgi file yourself. Details of these components can be found below.
|
||||
|
||||
Additional information about psgi files can be found at:
|
||||
L<http://search.cpan.org/dist/Plack/lib/Plack.pm#.psgi_files>
|
||||
|
||||
=head2 What is in the .psgi file Catalyst generates by default?
|
||||
|
||||
Catalyst generates an application which, if the C<using_frontend_proxy>
|
||||
setting is on, is wrapped in L<Plack::Middleware::ReverseProxy>, and
|
||||
contains some engine-specific fixes for uniform behaviour, as contained
|
||||
in:
|
||||
|
||||
=over
|
||||
|
||||
=item L<Plack::Middleware::LighttpdScriptNameFix>
|
||||
|
||||
=item L<Plack::Middleware::IIS6ScriptNameFix>
|
||||
|
||||
=back
|
||||
|
||||
If you override the default by providing your own C<< .psgi >> file,
|
||||
then none of these things will be done automatically for you by the PSGI
|
||||
application returned when you call C<< MyApp->psgi_app >>. Thus, if you
|
||||
need any of this functionality, you'll need to implement this in your
|
||||
C<< .psgi >> file yourself.
|
||||
|
||||
An apply_default_middlewares method is supplied to wrap your application
|
||||
in the default middlewares if you want this behaviour and you are providing
|
||||
your own .psgi file.
|
||||
|
||||
This means that the auto-generated (no .psgi file) code looks something
|
||||
like this:
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use TestApp;
|
||||
|
||||
my $app = TestApp->apply_default_middlewares(TestApp->psgi_app(@_));
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Catalyst::Upgrading>, L<Plack>, L<PSGI::FAQ>, L<PSGI>.
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
Catalyst Contributors, see Catalyst.pm
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
This library is free software. You can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
29
samples/R/df.residual.r
Normal file
29
samples/R/df.residual.r
Normal file
@@ -0,0 +1,29 @@
|
||||
|
||||
df.residual.mira <- function(object, ...) {
|
||||
fit <- object$analyses[[1]]
|
||||
return(df.residual(fit))
|
||||
}
|
||||
|
||||
df.residual.lme <- function(object, ...) {
|
||||
return(object$fixDF[["X"]][1])
|
||||
}
|
||||
|
||||
df.residual.mer <- function(object, ...) {
|
||||
return(sum(object@dims[2:4] * c(1, -1, -1)) + 1)
|
||||
}
|
||||
|
||||
df.residual.default <- function(object, q = 1.3, ...) {
|
||||
df <- object$df.residual
|
||||
if (!is.null(df))
|
||||
return(df)
|
||||
|
||||
mk <- try(c <- coef(object), silent = TRUE)
|
||||
mn <- try(f <- fitted(object), silent = TRUE)
|
||||
if (inherits(mk, "try-error") | inherits(mn, "try-error"))
|
||||
return(NULL)
|
||||
n <- ifelse(is.data.frame(f) | is.matrix(f), nrow(f), length(f))
|
||||
k <- length(c)
|
||||
if (k == 0 | n == 0)
|
||||
return(NULL)
|
||||
return(max(1, n - q * k))
|
||||
}
|
||||
13
samples/XML/XmlIO.pluginspec
Normal file
13
samples/XML/XmlIO.pluginspec
Normal file
@@ -0,0 +1,13 @@
|
||||
<plugin name="XmlIO" version="0.0.1" compatVersion="0.0.1">
|
||||
<vendor>FreeMedForms</vendor>
|
||||
<copyright>(C) 2008-2012 by Eric MAEKER, MD</copyright>
|
||||
<license>GPLv3</license>
|
||||
<category>Patient data</category>
|
||||
<description>The XML form loader/saver for FreeMedForms.</description>
|
||||
<url>http://www.freemedforms.com/</url>
|
||||
<dependencyList>
|
||||
<dependency name="Core" version="0.0.1"/>
|
||||
<dependency name="FormManager" version="0.0.1"/>
|
||||
<dependency name="Category" version="0.0.1"/>
|
||||
</dependencyList>
|
||||
</plugin>
|
||||
@@ -1,7 +1,7 @@
|
||||
require 'linguist/samples'
|
||||
require 'linguist/language'
|
||||
require 'tempfile'
|
||||
require 'yajl'
|
||||
|
||||
require 'test/unit'
|
||||
|
||||
class TestSamples < Test::Unit::TestCase
|
||||
@@ -35,4 +35,22 @@ class TestSamples < Test::Unit::TestCase
|
||||
assert_equal data['tokens_total'], data['language_tokens'].inject(0) { |n, (_, c)| n += c }
|
||||
assert_equal data['tokens_total'], data['tokens'].inject(0) { |n, (_, ts)| n += ts.inject(0) { |m, (_, c)| m += c } }
|
||||
end
|
||||
|
||||
# If a language extension isn't globally unique then make sure there are samples
|
||||
def test_presence
|
||||
Linguist::Language.all.each do |language|
|
||||
language.all_extensions.each do |extension|
|
||||
language_matches = Language.find_by_filename("foo#{extension}")
|
||||
|
||||
# If there is more than one language match for a given extension
|
||||
# then check that there are examples for that language with the extension
|
||||
if language_matches.length > 1
|
||||
language_matches.each do |language|
|
||||
assert File.directory?("samples/#{language.name}"), "#{language.name} is missing a samples directory"
|
||||
assert Dir.glob("samples/#{language.name}/*#{extension}").any?, "#{language.name} is missing samples for extension #{extension}"
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
Reference in New Issue
Block a user