This is the code of my program to sort people gender wise and age wise. I am getting the output but not as expected.
(deffacts initial-phase
(phase choose-gender)
(phase choose-age)
(phase choose-name))
(deffacts person (gender) (age) (name))
(deffunction ask-start-again ()
(printout t "Enter another person? (y/n) ")
(if (eq (read) y) then
(assert (phase choose-gender)
(phase choose-age)
(phase choose-name))))
(deffunction comparePerson(?pa ?pb $?comp)
(if (< ((nth$ 1 $?comp) ?pa ?pb) 0) then (return -1))
(if (> ((nth$ 1 $?comp) ?pa ?pb) 0) then (return 1))
(if (= (length$ $?comp) 1) then (return 0))
(return (comparePerson ?pa ?pb (rest$ $?comp))))
;RULES
(defrule gender-select
(phase choose-gender)
=>
(printout t "what is your gender (Male: m "
"Female: f)? ")
(assert (gender-select (read))))
(defrule good-gender-choice
?phase <- (phase choose-gender)
?choice <- (gender-select ?gender&:(or (eq ?gender m) (eq ?gender f)))
=>
(retract ?phase ?choice)
(assert (gender ?gender))
(assert (phase select-age)))
(defrule bad-gender-choice
?phase <- (phase choose-gender)
?choice <- (gender-select ?player&~m&~f)
=>
(retract ?phase ?choice)
(assert (phase choose-gender))
(printout t "Choose m or f." crlf))
(defrule age-select
(phase select-age)
=>
(printout t "What is your age? ")
(assert (age-select (read))))
(defrule good-age-choice
?phase <- (phase select-age)
?choice <- (age-select ?age&:(integerp ?age)
&:(> ?age 0))
=>
(retract ?phase ?choice)
(assert (age ?age))
(assert (phase select-name)))
(defrule bad-age-choice
?phase <- (phase select-age)
?choice <- (age-select ?age&:(or (not (integerp ?age))
(<= ?age 0)))
=>
(retract ?phase ?choice)
(assert (phase select-age))
(printout t "Choose an integer greater than zero."
crlf))
(defrule name-select
(phase select-name)
=>
(printout t "What is your name? ")
(assert (name-select (read))))
(defrule good-name-choice
?phase <- (phase select-name)
?choice <- (name-select ?name&:(or (not (integerp ?name))))
=>
(retract ?phase ?choice)
(assert (name ?name)))
(defrule bad-name-choice
?phase <- (phase select-name)
?choice <- (name-select ?name&:(integerp ?name))
=>
(retract ?phase ?choice)
(assert (phase select-name))
(printout t "Please enter a name."
crlf))
(defrule person-old-female
?gender <- (gender f)
?age <- (age ?b&:(> ?b 35))
=>
(printout t "Person is female & older. This Person must go first!" crlf)
(retract ?gender)
(retract ?age)
(ask-start-again))
(defrule person-young-female
?gender <- (gender f)
?age <- (age ?age&:(<= ?age 35))
=>
(printout t "Person is female & younger. This Person must go after older males!" crlf)
(retract ?gender)
(retract ?age)
(ask-start-again))
(defrule person-old-male
?gender <- (gender m)
?age <- (age ?a&:(> ?a 35))
=>
(printout t "Person is male & older. This Person must go after older females!" crlf)
(retract ?gender)
(retract ?age)
(ask-start-again))
(defrule person-young-male
?gender <- (gender m)
?age <- (age ?age&:(<= ?age 35))
=>
(printout t "Person is male & younger. This Person must go after younger females!" crlf)
(retract ?gender)
(retract ?age)
(ask-start-again))
(defrule print-solution
=>
(printout t "Name Age Gender" crlf)
(printout t "--------------------------------------" crlf))
(defrule print-all-persons
(declare (salience -1000))
(person (name ?name) (age ?age) (gender ?gender))
=>
(printout t ?name ?age ?gender crlf))
(defrule findFirst
?p1 <- (person)
(not (and ?p2 <- (person)
(test (< (comparePerson ?p2 ?p1) 0))))
=>
(retract ?p1))
(defrule findFirst
?phase <- (phase sort-persons)
?p1 <- (person)
(not (and ?p2 <- (person)
(test (< (comparePerson ?p2 ?p1 ?*compAge* ?*compGender*) 0))))
=>
(printout t (fact-slot-value ?p1 name) " selected" crlf)
(retract ?p1))
(defglobal ?*compAge* =
(lambda (?pa ?pb)
(- (fact-slot-value ?pb age) (fact-slot-value ?pa age) )))
(defglobal ?*compGender* =
(lambda (?pa ?pb)
(- (asc (fact-slot-value ?pa gender))
(asc (fact-slot-value ?pb gender)))))
(reset)
(run)
And this is the output It does not display the output as a list of persons. I don't know what i am missing.
Is it possible to get the output like
"male 30 a
male 40 b
female 25 c
female 50 d"
What changes do I have to make to get the output as a list and sort it? thank you.
Assert one phase at a time:
(deffacts initial-phase (phase choose-gender))
and make sure to assert the sort phase after all input:
(deffunction ask-start-again ()
(printout t "Enter another person? (y/n) ")
(if (eq (read) y) then
(assert (phase choose-gender))
else
(assert (phase sort-persons))))
Use correct syntax for defining a template:
(deftemplate person (slot gender) (slot age) (slot name))
Asserting a person ("deffacts person") doesn't make sense.
Remove the first defrule findFirst - there is another one with the same name.
You need a rule to define a person:
(defrule define-person
?gf
(retract ?gf ?af ?nf)
(assert (person (age ?age)(name ?name)(gender ?gender)))
(ask-start-again))
Rules person-old/yound-male/female aren't useful - they just retract the data collected earlier. Also, print-all-persons doesn't help with printing the sorted facts; add a similar printout function call in rule findFirst (second version).
This is my whole program for sorting people gender wise and age wise. The older should come before younger and the female should come male.
(deftemplate person (slot gender)
(slot age (type INTEGER))
(slot name))
(deffacts initial-phase
(phase choose-gender)
(phase choose-age)
(phase choose-name))
; ********
; DEFFUNCTIONS
; ********
(deffunction ask-start-again ()
(printout t "Enter another person? (y/n) ")
(if (eq (read) y) then
(assert (phase choose-gender)
(phase choose-age)
(phase choose-name))))
;RULES
(defrule gender-select
(phase choose-gender)
=>
(printout t "what is your gender (Male: m "
"Female: f)? ")
(assert (gender-select (read))))
(defrule good-gender-choice
?phase <- (phase choose-gender)
?choice <- (gender-select ?gender&:(or (eq ?gender m) (eq ?gender f)))
=>
(retract ?phase ?choice)
(assert (gender ?gender))
(assert (phase select-age)))
(defrule bad-gender-choice
?phase <- (phase choose-gender)
?choice <- (gender-select ?player&~m&~f)
=>
(retract ?phase ?choice)
(assert (phase choose-gender))
(printout t "Choose m or f." crlf))
(defrule age-select
(phase select-age)
=>
(printout t "What is your age? ")
(assert (age-select (read))))
(defrule good-age-choice
?phase <- (phase select-age)
?choice <- (age-select ?age&:(integerp ?age)
&:(> ?age 0))
=>
(retract ?phase ?choice)
(assert (age ?age))
(assert (phase select-name)))
(defrule bad-age-choice
?phase <- (phase select-age)
?choice <- (age-select ?age&:(or (not (integerp ?age))
(<= ?age 0)))
=>
(retract ?phase ?choice)
(assert (phase select-age))
(printout t "Choose an integer greater than zero."
crlf))
(defrule name-select
(phase select-name)
=>
(printout t "What is your name? ")
(assert (name-select (read))))
(defrule good-name-choice
?phase <- (phase select-name)
?choice <- (name-select ?name&:(or (not (integerp ?name))))
=>
(retract ?phase ?choice)
(assert (name ?name)))
(defrule bad-name-choice
?phase <- (phase select-name)
?choice <- (name-select ?name&:(integerp ?name))
=>
(retract ?phase ?choice)
(assert (phase select-name))
(printout t "Please enter a name."
crlf))
(defrule old-female-first
?gender <- (gender f)
?age <- (age ?b&:(> ?b 35))
=>
(printout t "Person is female & older. This Person must go first!" crlf)
(retract ?gender)
(retract ?age)
(ask-start-again))
(defrule young-female-third
?gender <- (gender f)
?age <- (age ?age&:(<= ?age 35))
=>
(printout t "Person is female & younger. This Person must go after older males!" crlf)
(retract ?gender)
(retract ?age)
(ask-start-again))
(defrule old-male-second
?gender <- (gender m)
?age <- (age ?a&:(> ?a 35))
=>
(printout t "Person is male & older. This Person must go after older females!" crlf)
(retract ?gender)
(retract ?age)
(ask-start-again))
(defrule young-male-last
?gender <- (gender m)
?age <- (age ?age&:(<= ?age 35))
=>
(printout t "Person is male & younger. This Person must go after younger females!" crlf)
(retract ?gender)
(retract ?age)
(ask-start-again))
(defrule print-all-persons
(declare (salience -1000))
(person (name ?name) (age ?age) (gender ?gender))
=>
(printout t ?name ?age ?gender crlf))
(reset)
(run)
The code is not giving any error but also not getting expected output.
Here is the code.
(deftemplate Person (slot gender) (slot name) (slot age(type INTEGER)))
(deffunction validateName (?personname)
(bind ?stringLen (str-length ?personname))
(bind ?index 1)
(while (>= ?stringLen ?index)
(bind ?currentChar (sub-string ?index ?index ?personname))
(bind ?ASCIIValue (asc ?currentChar))
(if (and (>= ?ASCIIValue 0) (<= ?ASCIIValue 64)) then (return 0))
(if (and (>= ?ASCIIValue 91) (<= ?ASCIIValue 96)) then (return 0))
(if (>= ?ASCIIValue 123) then (return 0))
(bind ?index (+ ?index 1))
)
(return 1)
)
(deffunction getGender()
(printout t "Enter Gender (M|F) : ")
(bind ?localGender (read))
(if (or (eq (upcase ?localGender) M) (eq (upcase ?localGender) F))
then
(return ?localGender)
)
(printout t "Invalid Gender... Try Again..." crlf crlf)
(return (getGender()))
)
(deffunction getName()
(printout t "Enter Name : ")
(bind ?localName (readline))
(if (eq (validateName ?localName) 1) then (return ?localName))
(printout t "Invalid Name... Try Again..." crlf crlf)
(return (getName()))
)
(deffunction getAge()
(printout t "Enter Age : ")
(bind ?localAge (read))
(if (integerp ?localAge) then (if (> ?localAge 0) then (return ?localAge)))
(printout t "Invalid Age... Try Again..." crlf crlf)
(return (getAge()))
)
(deffunction showAllPesron()
(printout t crlf"-------------------------------" crlf)
(printout t " Person List " crlf)
(printout t "-------------------------------" crlf)
(printout t "Gender | Age | Name" crlf)
(printout t "-------------------------------" crlf)
)
(deffunction getPersonDetail()
(printout t crlf)
(bind ?gender (getGender()))
(bind ?name (getName()))
(bind ?age (getAge()))
(if (eq (upcase ?gender) M) then (assert (Person (gender M) (name ?name) (age ?age))))
(if (eq (upcase ?gender) F) then (assert (Person (gender F) (name ?name) (age ?age))))
(printout t crlf)
)
(defrule show-person-order
?P <- (Person (gender ?gender1) (name ?name1) (age ?age1))
(not (Person (age ?age2&:(> ?age2 ?age1))))
=>
(printout t ?gender1" "?age1" "?name1 crlf)
(retract ?P)
)
(deffunction main()
(printout t "Add another person? (Y|N) : ")
(bind ?addAnother (read))
(if (eq (upcase ?addAnother) Y) then (getPersonDetail()) (main()))
)
(getPersonDetail())
(main())
(showAllPesron())
(run)
(reset)
Here is an answer to your question which will, perhaps, not be easy to understand. However, I'll try and add lots of comments.
The fundamental idea of this "sort" is to identify person facts in the sort order: older before younger, female before male. After finding the winner fact it is retracted, so that the rule can fire again with the second best, and so on, until all person facts have been retracted.
Here is the rule in pseudo-code:
(defrule findFirst
?p1 <- (person)
not ?p2 <- (person ranked before ?p1)
=>
(retract ?p1))
Since the ranking involves more than one slot it is best written as a function which can be called with ?p1 and ?p2 as arguments. The compare
function can be written to return -1, 0 or +1, just like Java's compare methods.
(defrule findFirst
?p1 <- (person)
(not (and ?p2 <- (person)
(test (< (comparePerson ?p2 ?p1) 0))))
=>
(retract ?p1))
It would be nice if we could write the compare function in a flexible way so that another sort order wouldn't require a complete new function. This can be done by using lambdas - anonymous deffunctions - each of which compares just one slot. Here are the ones for age and gender, assigned to globals so that they are accessible from a rule's LHS:
(defglobal ?*compAge* =
(lambda (?pa ?pb)
(- (fact-slot-value ?pb age) (fact-slot-value ?pa age) )))
(defglobal ?*compGender* =
(lambda (?pa ?pb)
(- (asc (fact-slot-value ?pa gender))
(asc (fact-slot-value ?pb gender)))))
(Note the reversal of ?pa and ?pb to get descending age order.) We can now write the comparePerson function, which receives two person facts (?pa, ?pb) and a list of lambdas ($?comp).
(deffunction comparePerson(?pa ?pb $?comp)
;; if a comparison with the first function yields a decision, return it
(if (< ((nth$ 1 $?comp) ?pa ?pb) 0) then (return -1))
(if (> ((nth$ 1 $?comp) ?pa ?pb) 0) then (return 1))
;; if this is the last function we have two equal persons: return 0
(if (= (length$ $?comp) 1) then (return 0))
;; otherwise call the compare function with the remaining functions
(return (comparePerson ?pa ?pb (rest$ $?comp))))
And now the rule, triggered with another value for the phase fact:
(defrule findFirst
?phase <- (phase sort-persons)
?p1 <- (person)
(not (and ?p2 <- (person)
(test (< (comparePerson ?p2 ?p1 ?*compAge* ?*compGender*) 0))))
=>
(printout t (fact-slot-value ?p1 name) " selected" crlf)
(retract ?p1))
Note: person facts are best assembled as soon as a correct name has been entered. There's no need to create and insert the name fact.
Is there way to change - (minus) function to + (plus) function?
My homework is to implement sin calculation on Macluaurin series
sin(x) = x-(x^3/3!)+(x^5/5!) -(x^7/7!)+(x^9/9!)-...
Each article has different sign. This is my Lisp code
(defun sinMac (x series n plusminus)
(cond ((= series 0) 0)
(t (funcall plusminus
(/ (power x n) (factorial n))
(sinMac x (- series 1) (+ n 2) plusminus)))))
Is it possible to change plusminus to exchange sign? if I get '+ function send '- to next recursive call. From that call (got '-) I call '+ and so on...
You could do it with a circular list. Like so:
(defun sin-mac (x series n plus-minus)
(cond ((zerop series) 0)
(t (funcall (car plus-minus)
(/ (power x n) (factorial n))
(sin-mac x (1- series) (+ n 2) (cdr plus-minus))))))
(sin-mac x series 1 '#0=(+ - . #0#))
Or even better, wrap up the initial arguments using labels:
(defun sin-mac (x series)
(labels ((recur (series n plus-minus)
(cond ((zerop series) 0)
(t (funcall (car plus-minus)
(/ (power x n) (factorial n))
(recur (1- series) (+ n 2) (cdr plus-minus)))))))
(recur series 1 '#0=(+ - . #0#))))
If the function is a symbol, this is easy:
(defun next-function (function)
(ecase function
(+ '-)
(- '+)))
(defun sinMac (x series n plusminus)
(cond ((= series 0) 0)
(t (funcall plusminus
(/ (power x n) (factorial n))
(sinMac x
(- series 1)
(+ n 2)
(next-function plusminus))))))
I would not swap the function but just the sign. Using a loop for this also seems clearer to me (and is most likely more efficient, although there is still plenty of opportunity for optimization):
(defun maclaurin-sinus (x n)
"Calculates the sinus of x by the Maclaurin series of n elements."
(loop :for i :below n
:for sign := 1 :then (- sign)
:sum (let ((f (1+ (* 2 i))))
(* sign
(/ (expt x f)
(factorial f))))))
A few optimizations make this about 10 times faster (tested with n = 5):
(defun maclaurin-sinus-optimized (x n)
"Calculates the sinus of x by the Maclaurin series of n elements."
(declare (integer n))
(loop :repeat n
:for j :from 0 :by 2
:for k :from 1 :by 2
:for sign := 1 :then (- sign)
:for e := x :then (* e x x)
:for f := 1 :then (* f j k)
:sum (/ e f sign)))
Why do I get 2 different values for
(apply (first '(+ 1 2)) (rest '(+ 1 2)))
> 2
and
(apply + '(1 2))
> 3
when
(first '(+ 1 2))
> +
and
(rest '(+ 1 2))
> (1 2)
I tried reduce and got the same value
(reduce (first '(+ 1 2)) (rest '(+ 1 2)))
> 2
Your trouble is that you're trying to call the symbol '+ rather than the function +. When you call a symbol, it tries to look up the symbol in the first argument (for example, if it had been {'a 1 '+ 5 'b 2} you would have gotten 5). If you pass a second argument, that value gets returned instead of nil if the symbol can't be found in the first argument. So when you call ('+ 1 2), it tries to look up '+ in 1 and fails, so it returns 2.
Incidentally, this is the difference between creating lists with '(+ 1 2) and (list + 1 2). The former creates a list of the symbols +, 1 and 2. Since '1 and 1 are the same, that's fine. But the symbol '+ is not the Var clojure.core/+, so the latter gets the value of the Var while the former just gets the symbol. So if you'd done (list + 1 2), your could would have worked as written.
(first '(+ 1 2)) is a symbol.
user=> (class (first '(+ 1 2)))
clojure.lang.Symbol
user=> (apply (symbol "+") [1 2])
2
user=> (apply (eval (symbol "+")) [1 2])
3
user=> (apply (eval (first '(+ 1 2))) (rest '(+ 1 2)))
3
user=> (class (first [+ 1 2]))
clojure.core$_PLUS_
user=> (apply (first [+ 1 2]) (rest '(+ 1 2)))
3
Locked. This question and its answers are locked because the question is off-topic but has historical significance. It is not currently accepting new answers or interactions.
Challenge
Compactify a long list of numbers by replacing consecutive runs with ranges.
Example
Input
1, 2, 3, 4, 7, 8, 10, 12, 13, 14, 15
The input is guaranteed to be in ascending order and will not contain duplicates.
Output
1 - 4, 7, 8, 10, 12 - 15
Note that ranges of two numbers should be left as is. (7, 8; not 7 - 8)
Rules
You can accept a sorted list of integers (or equivalent datatype) as a method parameter, from the commandline, or from standard in. (pick whichever option results in shorter code)
You can output a list of strings by printing them, or by returning either a single string or set of strings.
Reference Implementation
(C#)
IEnumerable<string> Sample(IList<int> input) {
for (int i = 0; i < input.Count; ) {
var start = input[i];
int size = 1;
while (++i < input.Count && input[i] == start + size)
size++;
if (size == 1)
yield return start.ToString();
else if (size == 2) {
yield return start.ToString();
yield return (start + 1).ToString();
} else if (size > 2)
yield return start + " - " + (start + size - 1);
}
}
Python, 98 characters
def f(a):
for x in a:
if x-1not in a or x+1not in a:print x,"-"if x+1in a and x+2in a else",",
Python - 86 characters
This one doesn't include an extra ',' at the end
f=lambda a:''.join(`x`+",-"[(x+1in a)&x+2in a]for x in a if(x-1in a)&(x+1in a)^1)[:-1]
Python, 83 characters
def f(l,a=2):
for x in l:
b,a=a,(x+1in l)*(x-1in l)
if a<1:print',- '[b],`x`,
Demo:
>>> l=[1, 2, 3, 4, 7, 8, 10, 12, 13, 14, 15]
>>> f(l)
1 - 4 , 7 , 8 , 10 , 12 - 15
Ruby, 165 characters
a=[]
def o(a)print "#{#s}#{a[0]}#{"#{a.size<3?',':' -'} #{a[-1]}"if a.size>1}";#s=', 'end
ARGV[0].split(', ').each{|n|if a[0]&&a[-1].succ!=n;o(a);a=[]end;a<<n;};o(a)
C++, 166 characters
#define o std::cout
void f(std::vector<int> v){for(int i=0,b=0,z=v.size();i<z;)i==z-1||v[i+1]>v[i]+1?b?o<<", ":o,(i-b?o<<v[b]<<(i-b>1?" - ":", "):o)<<v[i],b=++i:++i;}
Don't you all just love abusing the ?: operator? ;)
More readable version:
#define o std::cout
void f(std::vector<int> v){
for(int i=0,b=0,z=v.size();i<z;)
i==z-1||v[i+1]>v[i]+1 ?
b?o<<", ":o,
(i-b?o<<v[b]<<(i-b>1?" - ":", "):o)<<v[i],
b=++i
:++i;
}
Common Lisp, 442/206 chars
(defun d (l)
(if l
(let ((f (car l))
(r (d (cdr l))))
(if r
(if (= (+ f 1) (caar r))
(push `(,f ,(cadar r)) (cdr r))
(push `(,f ,f) r))
`((,f ,f))
))
nil))
(defun p (l)
(mapc #'(lambda (x)
(if (= (car x) (cadr x))
(format t "~a " (car x))
(if (= (+ 1 (car x)) (cadr x))
(format t "~a ~a " (car x) (cadr x))
(format t "~a-~a " (car x) (cadr x)))))
(d l)))
The "d" function rewrites the input list into a canonical form. For fun I did this entirely recursively. The "p" function formats the output to the equivalent of the reference implementation.
F#, 188 chars
let r(x::s)=
let f=printf
let p x=function|1->f"%A "x|2->f"%A %A "x (x+1)|n->f"%A-%A "x (x+n-1)
let rec l x n=function|y::s when y=x+n->l x (n+1)s|y::s->p x n;l y 1 s|[]->p x n
l x 1 s
More readable:
let range (x::xs) =
let f = printf
let print x = function
| 1 -> f "%A " x
| 2 -> f "%A %A " x (x+1)
| n -> f "%A-%A " x (x+n-1)
let rec loop x n = function
| y::ys when y=x+n ->
loop x (n+1) ys
| y::ys ->
print x n
loop y 1 ys
| [] ->
print x n
loop x 1 xs
Ruby : 123 characters
def y(n) t=[];r=[];n.each_with_index do |x,i| t<<x;if(x.succ!=n[i+1]);r=((t.size>2)?r<<t[0]<<-t[-1]:r+t);t=[];end;end;r;end
More Readable
def y(n)
t=[];r=[];
n.each_with_index do |x,i|
t << x
if (x.succ != n[i+1])
r = ((t.size > 2) ? r << t[0] << -t[-1] : r+t)
t=[]
end
end
r
end
And execute like
> n=[1, 2, 3, 4, 7, 8, 10, 12, 13, 14, 15]
> y n
=> [1, -4, 7, 8, 10, 12, -15]
PHP 95 chars
(actually it's the second language after python)
Given $a=array(numbers);
Algos:
for($i=0;$i<count($a);$i++){$c=$i;while($a[$i+2]==$a[$i]+2)$i++;echo $a[$c],$i-$c>1?'-':',';}