Isoraqathedh

determine-dob wip 1

Feb 2nd, 2014
153
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 2.72 KB | None | 0 0
  1. (setf *chinese-new-years*
  2.   '((1924 02 05) (1925 01 24) (1926 02 13) (1927 02 02) (1928 01 22) (1929 02 09)
  3.     (1930 01 29) (1931 02 17) (1932 02 06) (1933 01 25) (1934 02 14) (1935 02 03)
  4.     (1936 01 24) (1937 02 11) (1938 01 31) (1939 02 19) (1940 02 08) (1941 01 27)
  5.     (1942 02 15) (1943 02 05) (1944 01 25) (1945 02 13) (1946 02 02) (1947 01 22)
  6.     (1948 02 10) (1949 01 29) (1950 02 17) (1951 02 06) (1952 01 27) (1953 02 14)
  7.     (1954 02 03) (1955 01 24) (1956 02 12) (1957 01 30) (1958 02 18) (1959 02 08)
  8.     (1960 01 28) (1961 02 15) (1962 02 05) (1963 01 25) (1964 02 13) (1965 02 02)
  9.     (1966 01 21) (1967 02 09) (1968 01 30) (1969 02 17) (1970 02 06) (1971 01 27)
  10.     (1972 02 15) (1973 02 03) (1974 01 23) (1975 02 11) (1976 01 31) (1977 02 18)
  11.     (1978 02 07) (1979 01 28) (1980 02 16) (1981 02 05) (1982 01 25) (1983 02 13)
  12.     (1984 02 02) (1985 02 20) (1986 02 09) (1987 01 29) (1988 02 17) (1989 02 06)
  13.     (1990 01 27) (1991 02 14) (1992 02 04) (1993 01 23) (1994 02 10) (1995 01 31)
  14.     (1996 02 19) (1997 02 07) (1998 01 28) (1999 02 16) (2000 02 05) (2001 01 24)
  15.     (2002 02 12) (2003 02 01) (2004 01 22) (2005 02 09) (2006 01 29) (2007 02 18)
  16.     (2008 02 07) (2009 01 26) (2010 02 14) (2011 02 03) (2012 01 23) (2013 02 10)
  17.     (2014 01 31) (2015 02 19) (2016 02 08) (2017 01 28) (2018 02 16) (2019 02 05)
  18.     (2020 01 25) (2021 02 12) (2022 02 01) (2023 01 22) (2024 02 10) (2025 01 29)
  19.     (2026 02 17) (2027 02 06) (2028 01 26) (2029 02 13) (2030 02 03) (2031 01 23)
  20.     (2032 02 11) (2033 01 31) (2034 02 19) (2035 02 08) (2036 01 28) (2037 02 15)
  21.     (2038 02 04) (2039 01 24) (2040 02 12) (2041 02 01) (2042 01 22) (2043 02 10)))
  22. ;
  23. (setf *chinese-zodiac-names*
  24.   '(rat ox tiger rabbit dragon snake horse goat monkey rooster dog pig))
  25. ; Note: heads of above lists match up, i.e. 1924 is RAT, 1925 is OX, etc.
  26.  
  27. (setf *western-zodiac-month-boundaries*
  28.   '((21 03) (21 04) (22 05) (22 06) (23 07) (23 08)
  29.     (23 09) (23 10) (23 11) (22 12) (21 01) (20 02)))
  30. ;
  31.  
  32. (setf *western-zodiac-names*
  33.   '(aries taurus gemini cancer leo virgo libra scorpio sagittarius capricorn aquarius pisces))
  34. ;
  35. (defun determine-dob (in-w-zodiac in-c-zodiac)
  36.   (if (and (member in-c-zodiac *chinese-zodiac-names* :test #'equal)
  37.            (member in-w-zodiac *western-zodiac-names* :test #'equal))
  38.       ; Items match, begin searching
  39.       ;---
  40.       ; Search Chinese zodiac
  41.       ; Syntax: (cny1 cny2 … cnyn)
  42.       (let
  43.         ((zodiac-order (position in-c-zodiac *chinese-zodiac-names*))) ;Returns 0 ~ 11
  44.         (dotimes (i (length *chinese-new-years*) first-filter)
  45.           (if (= (mod i (length *chinese-zodiac-names*)) zodiac-order)
  46.               (nconc first-filter (nth i *chinese-new-years*)))))))
Advertisement
Add Comment
Please, Sign In to add comment