How to compute number of days between the entered years - lisp

How can I get the number of days between the given years, should I use loops?
Here's what I have now
(princ "Enter starting year: ")
(defparameter w (read))
(princ "Enter ending year: ")
(defparameter x (read))
(defun print-list (w x)
(format t "Starting year: ~a ~%" (list w))
(format t "Ending year: ~a ~%" (list x)))
(terpri)
(if(> x w)
(format t "Number of year/s: ~a ~%"(- x w))
(format t "Number of year/s: ~a ~%"(- w x)))
I'm trying to compute the days between years but the output was always failed.

A simple set of functions to perform the calculation is the following:
(defun leap-year-p (year)
"return t if year is a leap-year, nil otherwise"
(or (and (zerop (mod year 4))
(not (zerop (mod year 100))))
(zerop (mod year 400))))
(defun days-of (year)
"return the number of days of a certain year"
(if (leap-year-p year) 365 366))
(defun days-between (start-year end-year)
"return the number of days between start-year (included)
and end-year (excluded)"
(when (<= start-year end-year)
(loop for year from start-year below end-year sum (days-of year)))
A few examples of call:
CL-USER> (days-between 2020 2022)
731
CL-USER> (days-between 1820 1999)
65470
CL-USER> (days-between 2020 2020)
0
CL-USER> (days-between 1980 1890)
NIL
You can use these function to solve your problem.

Related

Day counter program (racket)

I need to do a program which can count all days that have been passed since 2000's until the date that the user enter in the input.
Current code.
#lang racket
(define (bisiesto year)
(cond (= (remainder year 4) 0) (void))
)
(define day 0)
(define month 0)
(define cyear 0)
(define (count)
(display "Enter day: ")
(set! day(read))
(newline)
(display "Enter month: ")
(set! month(read))
(newline)
(display "Enter year: ")
(set! cyear(read))
(newline)
(cond
((and(> day 0)(>= 31))
I have no idea how to continue this program, I don't know very well racket language.
PD: Sorry if my English it's not good enough, thanks for your help.
You will need function find-seconds from racket/date library:
#lang racket
(require racket/date)
(define (day-count day month year)
(let ((diff (- (find-seconds 0 0 0 day month year)
(find-seconds 0 0 0 1 1 2000))))
(if (> 0 diff)
"Inserted date is before 1. 1. 2000."
(/ diff (* 60 60 24)))))
(define (read-with-prompt text)
(display text)
(flush-output)
(read))
(define (run-program)
(day-count
(read-with-prompt "Enter day (1-31): ")
(read-with-prompt "Enter month (1-12): ")
(read-with-prompt "Enter year: ")))
Start with (run-program) and enter some numbers.

Function to determine holiday in elisp

It's there any function to determine current system date is holiday or not in elisp.
function like this.
(is-holiday (current-time))
The answer requires that the user set up a calendar of predefined holidays, like this example. I have included a test holiday for May 9 -- if the user wishes to test out this function on any day other than May 9, the user may wish to change the Arbitrary Test Holiday to whatever day the test is being performed -- after the function has been tested, the test entry can be removed.
For examples of how to format the holidays, please refer to the doc-string for the variable calendar-holidays within the library holidays.el -- e.g., holiday-fixed; holiday-float; holiday-sexp; (lunar-phases); (solar-equinoxes-solstices); holiday-hebrew; holiday-islamic; holiday-bahai; holiday-julian; holiday-chinese; etc.
How can you try out this example?: Block/copy/paste the code into your *scratch* buffer; and type M-x eval-buffer RET; and then type M-x is-holiday RET. It is a fully functional working draft. If you decide that you don't like it after you try it, just restart Emacs and you'll be back to where you were before you tried it.
The testing that was performed was done with the most recent public release of Emacs: GNU Emacs 24.4.1 (x86_64-apple-darwin10.8.0, NS apple-appkit-1038.36) of 2014-10-20 on builder10-6.porkrind.org.
(require 'holidays)
(defcustom my-custom-holiday-list (mapcar 'purecopy '(
(holiday-fixed 1 1 "New Year's Day")
(holiday-float 1 1 3 "Martin Luther King Day")
(holiday-float 2 1 3 "President's Day")
(holiday-float 5 1 -1 "Memorial Day")
;; ARBITRARY TEST HOLIDAY -- MAY 9
(holiday-fixed 5 9 "Arbitrary Test Holiday -- May 9")
(holiday-fixed 7 4 "Independence Day")
(holiday-float 9 1 1 "Labor Day")
(holiday-float 10 1 2 "Columbus Day")
(holiday-fixed 11 11 "Veteran's Day")
(holiday-float 11 4 4 "Thanksgiving")
(holiday-fixed 12 25 "Christmas")
(solar-equinoxes-solstices)
(holiday-sexp calendar-daylight-savings-starts
(format "Daylight Saving Time Begins %s"
(solar-time-string
(/ calendar-daylight-savings-starts-time (float 60))
calendar-standard-time-zone-name)))
(holiday-sexp calendar-daylight-savings-ends
(format "Daylight Saving Time Ends %s"
(solar-time-string
(/ calendar-daylight-savings-ends-time (float 60))
calendar-daylight-time-zone-name))) ))
"Custom holidays defined by the user."
:type 'sexp
:group 'holidays)
(defun is-holiday ()
"Is today a holiday?"
(interactive)
(let* (
(d1 (time-to-days (current-time)))
(date (calendar-gregorian-from-absolute d1))
ee
res-holidays
(displayed-month (nth 0 date))
(displayed-year (nth 2 date))
(holiday-list
(dolist (p my-custom-holiday-list res-holidays)
(let* (h)
(when (setq h (eval p))
(setq res-holidays (append h res-holidays)))))) )
(mapcar
(lambda (x)
(let ((txt (format "%s -- %s" (car x) (car (cdr x)))))
(when (eq d1 (calendar-absolute-from-gregorian (car x)))
(push txt ee))))
holiday-list)
(if ee
(message "The following holiday(s) is/are today: %s" (nreverse ee))
(message "Today is not a holiday."))))

Decompose a list of numbers into digits

I am trying to create a list of digits starting from a list of numbers.
For example I want to break (11 4 6) into (1 5 6) by dividing the head of the list to 10 if the head is >= 10 and adding 1 to the next element.
My code looks like this
(defun createparameters (l)
(cond ((null l) l)
((> 9 (car l)) (setf (car l) (mod (car l ) 10))
(setf (cadr l) (+ (cadr l) 1)))
(t (createparameters (cdr l)))))
but it does not change my referenced list.
Help would be greatly appreciated.
You write that you want the operation done if the first element is greater than 9, but in your code you are doing the opposite. (> 9 (car l)) is the same as infix 9 > (car l) so you do your thing when first element is 8 or lower.
Here is a functional version of your code that continues to process the next sublist:
(defun createparameters (l)
(cond ((null l) l)
((and (consp l) (< 9 (car l)))
(cons (mod (car l ) 10)
(createparameters
(cons (+ (cadr l) 1)
(cddr l)))))
(t (cons (car l)
(createparameters (cdr l))))))
(defparameter test (list 11 11 2 3))
(setf test (createparameters test))
test ; ==> (1 2 3 3)
Here is a modified mutating version (similar to your code):
(defun createparameters (l)
(cond ((null l) l)
((< 9 (car l)) (setf (car l) (mod (car l ) 10))
(setf (cadr l) (+ (cadr l) 1))
(createparameters (cdr l)))
(t (createparameters (cdr l)))))
(defparameter test (list 11 11 2 3))
(createparameters test)
test ; ==> (1 2 3 3)
I'm starting to wonder if this is a carry so that the first element is the least significant digit and the last is the most. If so just adding one will only work if the number always are below 20 and the code will not work if the last digit became 10 or higher.
A direct approach
Here's a version that performs the task directly.
(defun decompose (digits)
"Given a list of digits (least-significant digit first), return a
list of normalized digits, i.e., where each digit is less than 10."
(do ((digits digits (rest digits)) ; iterate through the digits.
;; There's no initial digit, and the carry is initially 0.
(carry 0) (digit)
;; The result starts as '(), and adds a digit on each successive
;; iteration, where the digit is computed in the loop body.
(result '() (list* digit result)))
;; End when there are no digits left. Most of the result is
;; simply the reversed result, but if there's a non-zero carry
;; at the end, put it into a list and decompose it, too.
((endp digits)
(nreconc result (if (zerop carry) '()
(decompose (list carry)))))
;; At each iteration, add the first digit to the carry, and divide
;; by 10. The quotient is the carry for the next iteration, and
;; the remainder is the digit that's added into the results.
(multiple-value-setq (carry digit)
(floor (+ carry (first digits)) 10))))
(decompose '(10005 2 3))
;=> (5 2 3 0 1)
(decompose '(11 2 4))
;=> (1 3 4)
(decompose '(23 0))
;=> (3 2)
(decompose '(11 11 4 6))
;=> (1 2 5 6)
A modular approach
A more modular approach might break this down into two parts. First, given a list of digits, each of which might be greater than 9, we can reconstruct the original number as a number (i.e., not as a list of digits). This is pretty straightforward:
(defun digits->number (digits)
(reduce (lambda (digit number)
(+ digit (* 10 number)))
digits
:from-end t))
(digits->number '(1 2 3 4))
;=> 4321
(digits->number '(205 3))
;=> 235
Now, converting a number into a list of digits isn't too hard either.
(defun number->digits (number)
(do ((digit)
(digits '() (list* digit digits)))
((zerop number) (nreverse digits))
(multiple-value-setq (number digit)
(floor number 10))))
(number->digits 1024)
;=> (4 2 0 1)
(number->digits 8923)
;=> (3 2 9 8)
Now, we can observe that digits->number converts the digits list into the number in the form that we need, even when there are 'digits' that are greater than 9. number->digits always produces a representation where all the digits are less than 10. Thus, we can also implement decompose as number->digits of digits->number.
(defun decompose (digits)
(number->digits (digits->number digits)))
(decompose '(10005 2 3))
;=> (5 2 3 0 1)
(decompose '(11 2 4))
;=> (1 3 4)
(decompose '(23 0))
;=> (3 2)
(decompose '(11 11 4 6))
;=> (1 2 5 6)
As an interesting observation, I think you can say that the space of input for decompose is lists of non-negative integers, and that each list of non-negative integers less than 10 is a fixed point of decompose.

emacs org mode: how to extract total seconds from HMS(Hour Minute Second) value"

If an org table cell contains the HMS 1# 11' 37"
is there an easy way to get the total (time)seconds?
(1*3600 + 11*60 + 37 = 4297)
Try this:
(defun hms-to-seconds (str)
(let* ((lst (split-string str "# "))
(hour (car lst))
(lst2 (split-string (cadr lst) "' "))
(minute (car lst2))
(second (car (split-string (cadr lst2) "\""))))
(+ (* (string-to-number hour) 3600)
(* (string-to-number minute) 60)
(string-to-number second))))
Upd: As #Juancho noted there is more simple way with direct hms calculations:
| 1# 11' 37" | 4297 | 4297 |
#+TBLFM: $2='(fmt-to-seconds $1)::$3=$1\ 0# 0' 1"

How to implement the 24 solar terms in Lisp with Emacs Calendar

I tried to learn the code in cal-china.el in Emacs source code and found the following code:
;;;###holiday-autoload
(defun holiday-chinese-winter-solstice ()
"Date of Chinese winter solstice, if visible in calendar.
Returns (((MONTH DAY YEAR) TEXT)), where the date is Gregorian."
(when (memq displayed-month '(11 12 1)) ; is December visible?
(list (list (calendar-gregorian-from-absolute
(calendar-chinese-zodiac-sign-on-or-after
(calendar-absolute-from-gregorian
(list 12 15 (if (eq displayed-month 1)
(1- displayed-year)
displayed-year)))))
"Winter Solstice Festival"))))
This code is used to calculate the winter solstice. I also knew that these 24 solar terms are needed for calculating Chinese calendar. So I wonder how to calculate all the 24 solar terms in Lisp.
Thank you.
For anyone interested in Chinese calendar, please refer to this repo for details.
https://github.com/xwl/cal-china-x
The solar terms can be calculated with the following code after you install cal-china-x
;;;###autoload
(defun holiday-solar-term (solar-term str)
"A holiday(STR) on SOLAR-TERM day.
See `cal-china-x-solar-term-name' for a list of solar term names ."
(cal-china-x-sync-solar-term displayed-year)
(let ((terms cal-china-x-solar-term-alist)
i date)
(while terms
(setq i (car terms)
terms (cdr terms))
(when (string= (cdr i) solar-term)
(let ((m (caar i))
(y (cl-caddar i)))
;; displayed-year, displayed-month is accurate for the centered month
;; only. Cross year view: '(11 12 1), '(12 1 2)
(when (or (and (cal-china-x-cross-year-view-p)
(or (and (= displayed-month 12)
(= m 1)
(= y (1+ displayed-year)))
(and (= displayed-month 1)
(= m 12)
(= y (1- displayed-year)))))
(= y displayed-year))
(setq terms '()
date (car i))))))
(holiday-fixed (car date) (cadr date) str)))