-- R Functions


-- Aggregates

CREATE AGGREGATE array_accum(
  BASETYPE=anyelement,
  SFUNC=array_append,
  STYPE=anyarray,
  INITCOND='{}'
);


-- Functions
-- QUANTILE
-- Usage: select r_quantile(array_accum(y), 0.6) from lmtab;
CREATE FUNCTION r_quantile(double precision[], double precision) RETURNS double precision AS '
  quantile(arg1,arg2)
' LANGUAGE 'plr' STRICT;


-- LM (linear Model)
-- Usage: select r_lm(array[array_accum(y), array_accum(x1)]) from lmtab;
-- Note: Currently only works for a single x value, soon to work for multiple x
CREATE OR REPLACE FUNCTION r_lm(double precision[])
  RETURNS double precision AS '
Y<-arg1[1,1:dim(arg1)[2]]
X<-data.matrix(arg1[2:dim(arg1)[1],1:dim(arg1)[2]])
X1<-as.data.frame(X)
res.lm<- lm(Y ~ X, na.action = na.exclude)
cor(Y,predict(res.lm,X1))
'  LANGUAGE 'plr' STRICT;


-- MEDIAN
-- Usage: select median(y) from lmtab;
-- Note: Currently only works for a single x value, soon to work for multiple x
CREATE FUNCTION r_median(double precision[]) RETURNS double precision  AS '
  median(arg1)
' LANGUAGE 'plr' STRICT;

CREATE AGGREGATE median (
    BASETYPE = double precision,
    SFUNC = plr_array_accum,
    STYPE = double precision[],
    FINALFUNC = r_median
);


-- KMEANS 
-- Usage: select kmeans(array_accum(y),2,2007) from lmtab;
-- Note: Currently only works for a single x value, soon to work for multiple x
CREATE OR REPLACE FUNCTION kmeans(double precision[], int4, int4)
  RETURNS double precision[] AS'
set.seed(arg3)
km=kmeans(sort(arg1),arg2)
sort(unlist(tapply(sort(arg1),factor(match(km$cluster,order(km$centers))),range)))
' LANGUAGE 'plr' VOLATILE STRICT;