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