### kal_bas
### 5.2.2007, revised 7.10.2007
### Maple procedures for calendars; some basic procedures
### (c) Svante Janson 2007
### May be freely used and modified for non-commercial properties.
### These procedures are drafts only and not in a final, polished
### version (and probably never will be).
### There is no guarantee that they are correct.
### There is, unfortunately, no further documentation.


with(StringTools):   # must be at top level

if 
# true or
(not (Qkal_bas_LOADED=true))  then 
Qkal_bas_LOADED:=true;
# NB final fi last in the file
# To avoid unnecessary repeated loadings of the file, 
# the line "true or" should be commented away with "#"
# While working on the file, remove this "#"


###### JD, RD
# JD = Julian Day Number; JD=0 for 1/1 4713 BC (Julian)
# RD = Rata Die (Dershowitz and Reingold); RD=1 for 1/1 1 (Greg)
# MJD = Modified Julian Day Number = JD-2400001 (as integers!)

JD_RD:=1721425;  # JD för RD=0
JD_MJD:=2400001;  # JD för MJD=0

#JD för givet RD
JD4RD:=x->x+JD_RD;

#RD för givet JD
RD4JD:=x->x-JD_RD;

#JD för givet RD
JD4MJD:=x->x+JD_MJD;

#MJD för givet JD
MJD4JD:=x->x-JD_MJD;



JDidag:=proc()
# JDidag() ger dagens JD, om kal_julgreg laddad
local d,m,y;
# dt:=ParseTime(%c,FormatTime(%c));
# JD4Greg(dt:-monthDay,dt:-month,dt:-year);
  d:=parse(FormatTime(%d));
  m:=parse(FormatTime(%m));
  y:=parse(FormatTime(%Y));
  JD4Greg(d,m,y);
end; 

RDidag:=proc()
# RDidag() ger dagens RD, om kal_julgreg laddad
  RD4JD(JDidag());
end; 


######### Veckan

vdag4nr:=[söndag,måndag,tisdag,onsdag,torsdag,fredag,lördag];
vdagnr4JD:=x->1+(x+1 mod 7);
vdag4JD:=x->vdag4nr[vdagnr4JD(x)];
vdagnr4RD:=x->1+(x mod 7);
vdag4RD:=x->vdag4nr[vdagnr4RD(x)];

# Next day on or after JD x with weekday vdag
NextVdag:=proc(vdag,x)
  local v;
  v:=vdagnr4JD(x);
  x+((vdag+7-v) mod 7);
end;

# Next day strict after JD x with weekday vdag
Next1Vdag:=proc(vdag,x)
  NextVdag(vdag,x+1);
end;

# Nearest day on or before JD x with weekday vdag
BeforeVdag:=proc(vdag,x)
  NextVdag(vdag,x-6);
end;

# Nearest day strict before JD x with weekday vdag
Before1Vdag:=proc(vdag,x)
  NextVdag(vdag,x-7);
end;

###### Allmänt kalendariskt

## GLOBAL VARIABEL
# om ASTRO=true räknas alltid astronomiskt, med år 0
ASTRO:=false;


# Korrigerar negativa år för kalendrar utan år 0;
# ger motsv. astronomiska år
AstroAr:=proc(y)
  if ASTRO then RETURN(y) fi;
  if y=0 then print("År 0 finns inte!"); RETURN(FEL) fi;
  if y<=0 then y+1 else y fi;
end;

# Korrigerar negativa år för kalendrar utan år 0;
# ger år från motsv. astronomiska år
Ar4Astro:=proc(y)
  if ASTRO then RETURN(y) fi;
  if y<=0 then y-1 else y fi;
end;



###### Allmänt

# adjusted mod as in CC with values in 1..n
amod:=proc(m,n);
  1+modp(m-1,n);
end;

# adjusted frac with values in [0,1)
xfrac:=proc(x);
  x-floor(x);
end;

# Indicator of a Boolean variable or expression.
Indicator:=proc(l);
  if l then 1 else 0 fi;
end;

# x if l=true; 0 if l=false
ifx:=(l,x)->`if`(l,x,0);

# computes fractions with mixed radices
# the arguments are two lists, where the first may be shorter than the other
# example:  
# radixx([29,31,50,0,480],[1,60,60,6,707]) = 29 + (31+(50+(480/707)/6)/60)/60
radixx:=proc(l1,l2)
  local i,s;
  s:=0;
  for i from nops(l1) by -1 to 1 do
    s:=(s+l1[i])/l2[i]; od;
  RETURN(s);
end;

# converts a rational number to a list of numerators for a given list
# of radices
# if there is a final remainder, it is appended to the list (as a fraction)
# if y is negative, only the first term is made negative            
# (the others are as for |y|)
radix4frac:=proc(x,l2)
  local i,y,z,l;
  if x<0 then l:=radix4frac(-x,l2); l[1]:=-l[1]; RETURN(l); fi;
  y:=x;
  l:=l2;
  for i to nops(l2) do
    y:=y*l2[i]; 
    z:=floor(y);
    l[i]:=z;
    y:=y-z;
  od;
  if y=0 then RETURN(l) else RETURN([op(l),y]) fi;
end;

# Converts a rational number to a list of numerators for a given list
# of radices.
# The integer part is taken modulo d and written first, unless d=1, 
# in which case only the fractional part is written
radix4frac1:=proc(x,d,l2)
  if d=1 then radix4frac(x-floor(x),l2)
  else [floor(x) mod d,op(radix4frac(x-floor(x),l2))] 
  fi;
end;



# Strängsök


Hitta:=proc(x,l)
# Hittar x in en lista l av strängar.
# Stor/liten ignoreras.
# Om x heltal returneras x.
# Annars ges numret på den sträng i l som börjar med x;
# denna skall vara unik, eller lika med x.
local ll,r,s,i;
if type(x,integer) then RETURN(x) fi;
s:=StringTools:-LowerCase(convert(x,string));
ll:=[];
for i to nops(l) do
  if StringTools:-IsPrefix(s,StringTools:-LowerCase(l[i]))
    then ll:=[op(ll),i]
  fi;
od;
if nops(ll)=1 then RETURN(ll[1]) fi;
if nops(ll)=0 then error "%1 finns ej i %2",x,l fi;
for i to nops(ll) do if length(s)=length(l[ll[i]]) then RETURN(ll[i]) fi od;
error "%1 flertydigt i %2",x,l;
end;



fi;