webapp.data.demo.map.function.rq Maven / Gradle / Ivy

Go to download
Show more of this group Show more artifacts with this name
Show all versions of corese-server Show documentation
Corese is a Semantic Web Factory (triple store and SPARQL endpoint) implementing RDF, RDFS, SPARQL 1.1 Query and Update.
The newest version!
#prefix ft: 
#prefix ft: 
prefix ft: 
prefix map: 
prefix key: 
prefix db:   .

@public {

function us:mytest(qq) {
#    xt:print("my query:", qq) ;
# workflow graph
#    xt:print(st:get(st:context));
    xt:print("my context mode:", st:get("mode")) ;
    return (qq)
}

function us:number(list) {
    letdyn (num = 0) {
        maplist (function(elem) { 
            xt:cons(xt:first(elem), xt:cons(set (num = num + 1), xt:rest(elem))) }, 
            list)
    }
}

function us:format(elem) {
    apply(st:format, xt:cons(ft:cell.html, elem))
}

function us:formatDistance(elem) {
    apply(st:format, xt:cons(ft:celldistance.html, elem))
}

function us:formatData(elem) {
    apply(st:format, xt:cons(ft:celldata.html, elem))
}

function us:formatDataBlock(elem) {
    apply(st:format, xt:cons(ft:celldatablock.html, elem))
}

function us:docTitle(doc) {
    if (strlen(doc) > 40, 
        concat(substr(doc, 1, 40), "..."), 
        doc)
}

function us:selectDepartmentSchema() {
    let (select (aggregate(?label) as ?list) 
        where { ?x a db:Department ; rdfs:label ?label } 
        order by ?label ) {
        xt:sort(?list)
    }
}

# name = st:departement
# service definition profile with st:param [ st:departement (val val) ]
# focus term in param value list
#
function us:focus(term, name) {
    coalesce(xt:member(term, st:get(name)), true)
}

function us:exclude(term, name) {
    coalesce(xt:member(term, st:get(name)), false)
}

function us:selectCommune() {
    let (select (aggregate(distinct (xt:list(?label, ?vname))) as ?list) 
        where {
            service  {
                ?url map:commune ?com .
                ?com rdfs:label ?label 

                optional { ?com map:departement ?dep .
                    ?dept db:inseeCode ?dep ;
                        db:hasRegion ?reg .
                        ?reg rdfs:label ?region
                }
                filter us:focus(coalesce(?dep, 0), st:departement)
                filter us:focus(coalesce(?region, "undef"), st:region)
                bind (concat(?label, " (", coalesce(?dep, 00), ")") as ?vname)
            }}) {
        xt:sort(?list)
    }
}

function us:selectCommuneURL() {
    let (select (aggregate(distinct (xt:list(?com, ?vname))) as ?list) 
        where {
            service  {
                ?url map:commune ?com .
                ?com rdfs:label ?label 

                optional { ?com map:departement ?dep .
                    ?dept db:inseeCode ?dep ;
                        db:hasRegion ?reg .
                        ?reg rdfs:label ?region
                }
                filter us:focus(coalesce(?dep, 0), st:departement)
                filter us:focus(coalesce(?region, "undef"), st:region)
                bind (concat(?label, " (", coalesce(?dep, 00), ")") as ?vname)
            }}) {
        xt:sort(?list)
    }
}

function us:selectDepartment() {
    let (select (aggregate(distinct xt:list(?label, ?vname)) as ?list) 
        where {
            service  {
                ?url map:commune/map:departement ?dep .
                filter us:focus(?dep, st:departement)
                ?dept db:inseeCode ?dep ; 
                    rdfs:label ?label ;
                    db:hasRegion ?reg .
                    ?reg rdfs:label ?region
                filter us:focus(coalesce(?region, "undef"), st:region)
                bind (concat(?label, " (", coalesce(?dep, 00), ")") as ?vname)
            }}) {
        xt:sort(?list)
    }
}

function us:selectRegion() {
    let (select (aggregate(distinct ?label) as ?list) 
        where { 
            service  {
                ?x a db:Region ; rdfs:label ?label
                optional {
                    ?dept db:hasRegion ?x
                    ?dept db:inseeCode ?dep
                }
                filter us:focus(coalesce(?dep, 0), st:departement)
                filter us:focus(coalesce(?label, "undef"), st:region)

            }
        }
        order by ?label ) {
        xt:sort(?list)
    }
}


function us:selectPays() {
    if (coalesce(st:get(st:departement), st:get(st:region), false), return(xt:list("France")), true);
    let (select (aggregate(distinct ?pays) as ?list) 
        where {
            service  {
                ?url map:pays ?pays 
            }}) {
        xt:sort(?list)
    }
}

function us:selectLocalisation() {
    let (select (aggregate(distinct ?loc) as ?list) 
        where {
            service  {
                ?url map:localisation/rdfs:subClassOf* ?loc .
            }}) {
        xt:sort(?list)
    }
}


function us:height() {
    coalesce(
        xt:first(st:get(key:height)), 
        st:get(st:height),
        200)
}


function us:snd(alist) {
    return (xt:get(alist, 1))
}

function us:any(x, y) {
    return (true)
}

function us:notContains(x, y) {
    return (! (contains(x, y)))
}

# value is rdf term
# alist = (rq:oper arg)
# compute  rq:oper(value, arg)
# use case:
# filter coalesce(us:eval(?lat, st:get("lat")), true)

function us:eval(value, alist) {
    if (xt:size(alist) = 2) {
        let ((oper arg) = (alist)) {
            funcall(oper, value, xsd:decimal(arg))
        }
    }
    else if (xt:size(alist) = 4) {
        let ((oper1 arg1 oper2 arg2) = (alist)) {
            us:eval(value, oper1, xsd:decimal(arg1), oper2, xsd:decimal(arg2)) 
        }
    }
    else {
        return (true)
    }
}

function us:compute(value, alist) {
    if (xt:size(alist) = 2) {
        let ((oper arg) = (alist)) {
            funcall(oper, value, arg)
        }
    }
    else {
        return (true)
    }
}

function us:eval2(value, oper1, arg1, oper2, arg2) {
    funcall(oper1, value, arg1) && funcall(oper2, value, arg2) 
}

#
# eval filter with 2 oper
# infer wether AND/OR from pair of (oper, arg)
#
function us:eval(value, oper1, arg1, oper2, arg2) {
    if (us:testOper(oper1, oper2) && arg1 > arg2) {
        # value < max && value > min
        funcall(oper1, value, arg1) && funcall(oper2, value, arg2)    
    }
    else if (us:testOper(oper2, oper1) && arg2 > arg1) {
        # value < max && value > min
        funcall(oper1, value, arg1) && funcall(oper2, value, arg2)
    }
    else if (oper1 = str(us:any)) {
        funcall(oper2, value, arg2)
    }
    else if (oper2 = str(us:any)) {
        funcall(oper1, value, arg1)
    }
    else {
        # value > max || value < min
        funcall(oper1, value, arg1) || funcall(oper2, value, arg2)
    }
}

function us:testOper(oper1, oper2) {
    oper1 = str(rq:le) && oper2 = str(rq:ge)
}

# distance 0.01 = 1km 
function us:eq(x, y) {
    us:eq(x, y, 0.01)
}

# distance 0.1 = 11km 
function us:close(x, y) {
    us:eq(x, y, 0.1)
}

# distance 0.5 = 55km
function us:near(x, y) {
    us:eq(x, y, 0.5)
}

# distance 1 = 111km
function us:around(x, y) {
    us:eq(x, y, 1)
}

function us:eq(x, y, eps) {
    let (amin = if (x > y, y, x),
         amax = if (x > y, x, y)) {
        return (amax - amin < eps)
    }
}

function us:selectLatitude() {
    xt:cons(0, xt:iota(41, 53))
}

function us:selectLongitude() {
     xt:cons(0, xt:iota(-3, 12))
}

function us:selectLabel() {
    us:selectLabel(map:Objet)
}

function us:selectLabelArtefact() {
    us:selectLabel(map:Artefact)
}

function us:selectLabelNature() {
    us:selectLabel(map:Nature)
}

function us:selectLabel(aclass) {
    let (select aclass (aggregate(distinct xt:list(?label, ?vname)) as ?list) 
        where {
            service  {
                ?url rdf:type/rdfs:subClassOf* aclass ; rdfs:label ?label .
                filter us:focusInstance(?url)
                optional { 
                    ?url map:commune/map:departement ?dep .
                    ?dept db:inseeCode ?dep ;
                        db:hasRegion ?reg .
                        ?reg rdfs:label ?region
                }
                filter us:focus(coalesce(?dep, 0), st:departement)
                filter us:focus(coalesce(?region, "undef"), st:region)
                bind (if (bound(?dep), concat(?label, " (", ?dep, ")"), ?label) as ?vname)
            }}) {
        xt:sort(?list)
    }
}

function us:selectType() {
    us:selectType(map:Objet)
}

function us:selectTypeNature() {
    us:selectType(map:Nature)
}

function us:selectTypeArtefact() {
    us:selectType(map:Artefact)
}

function us:selectType(aclass) {
    let (select ?aclass (aggregate(distinct ?url) as ?list) 
        where {
            service  {
                ?url rdfs:subClassOf* ?aclass .
                ?x rdf:type/rdfs:subClassOf* ?url
                filter us:focusClass(?url)
            }}) {
        xt:sort(xt:add(?list, map:Undefined))
    }
}


# check st:include st:exclude from profile.ttl param context
function us:focusClass(url) {
    if (coalesce(st:get(st:include), false), 
        exists {
            values ?atype { unnest(st:get(st:include)) }
            ?url rdfs:subClassOf* ?atype 
        }, true)
        &&
        not exists {
            values ?atype { unnest(coalesce(st:get(st:exclude), xt:list())) }
            ?url rdfs:subClassOf* ?atype
        }
}

# check st:include st:exclude from profile.ttl param context
function us:focusInstance(url) {
    if (coalesce(st:get(st:exclude), false), 
        not exists {
            values ?atype { unnest(st:get(st:exclude)) }
            ?url rdf:type/rdfs:subClassOf* ?atype
        }, true)
    &&
    if (coalesce(st:get(st:include), false), 
        exists {
            values ?atype { unnest(st:get(st:include)) }
            ?url rdf:type/rdfs:subClassOf* ?atype
        }, true)
}

function us:selectType2(aclass) {
    let (select ?aclass (aggregate(distinct ?url) as ?list) 
        where {
            service  {
                ?url rdfs:subClassOf* ?aclass .
                ?x rdf:type/rdfs:subClassOf*  ?url
            }}) {
        xt:sort(xt:add(?list, map:Undefined))
    }
}


function us:instanceofAny(?typeList) {
    let (select ?typeList (aggregate(distinct ?url) as ?list)
         where { 
                values ?typeList {undef}
                values ?type { unnest(?typeList) }
                ?url rdf:type/rdfs:subClassOf* ?type  
            }) {
        return(?list)
    }
}


function us:instanceofEvery(?typeList) {
    let (select ?typeList (aggregate(distinct ?url) as ?list)
         where {
            service  {
                values ?typeList {undef}
                bind (xt:get(?typeList, 0) as ?fstType)
                ?url rdf:type/rdfs:subClassOf* ?fstType
                
                filter not exists {
                    values ?typeList {undef}
                    values ?type { unnest(?typeList) }
                    filter not exists {?url rdf:type/rdfs:subClassOf* ?type}  
                }
            }}) {
        return(?list)
    }
}

function us:distance(x1, y1, x2, y2) {
    power(power(x1 - x2, 2) + power(y1 - y2, 2), 0.5)
}













# member of the list or list contains only empty string ""
function us:match(elem, alist) {
    if (mapany (function(x) {strlen(x)>0}, alist)) {
        xt:member(elem, alist)
    }
    else {
        return(true)
    }
}

function us:contains(elem, alist) {
    if (xt:size(alist) = 0, return(true), true);
    letdyn (aelem = xt:lowercase(elem)) {
        mapany (function(x) { contains(aelem, xt:lowercase(x)) }, alist)
    }
}

function us:empty(alist) {
    return (! mapany (function(x) {strlen(x)>0}, alist))
}

function us:sublist(alist, start, end) {
    let (res = xt:list()) {
        for (index in xt:iota(start, end)) {
            xt:add(res, xt:get(alist, index))
        } ;
        return (res)
    }
}

# rewrite boolean type list into conjunctive normal form
# A union B and C -> (A or B) and C
# A or B and C    -> A or (B and C)
# split or -> ((A) (B C))
# split and : A union B and C -> ((A B) (C))
# distrib  -> AC or BC
# used by workflow.ttl query for mode parameter for filtering rdf:type
# alist = st:get("mode") 

function us:process(alist) {
    us:process(alist, map:Objet)
}

# root is used in case of not A
# rewritten as: root and not A
function us:process(alist, root) {
    xt:print("input:", alist);
    # rewrite  as   ; remove map:Undefined
    let (tmp = us:preprocess(alist),
         res0 = us:mysplit(tmp, ),
         res1 = maplist(function(part) { us:mysplit(part, ) }, res0),
         # res2 = list ((A union B) and (C)) -- with no explicit and
         res2 = maplist(function(part) { maplist(us:cleanUnion, part) }, res1),
         # res3 = list ((A C) (B C))
         res3 = maplist(us:distrib, res2),
         res4 = reduce(xt:append, res3),
         res5 = us:postprocess(res4, root))
         {
         xt:print("rewrite:", res5);
         return (res5)
    }
}

# OPER_NOT -> OPER NOT
function us:preprocess(alist) {
    letdyn (res = xt:list(), amap = xt:map()) {
        xt:set(amap, , );
        xt:set(amap, , );
        xt:set(amap, , );
        
        map (function(elem) { 
           if  (elem = map:Undefined) {
            # skip
           } 
           else if (xt:has(amap, elem)) {
              xt:add(res, xt:get(amap, elem));
              xt:add(res, );
           } 
           else {
            xt:add(res, elem)
           }}, alist) ;
        return (res)
    }
}

# (( A) B) -> (map:Object ( A) B)
function us:postprocess(alist, root) {
    letdyn (aroot = root) {
        map (function(exp) { if (xt:size(exp) >= 1 && ! isURI(xt:first(exp))) { xt:add(exp, 0, aroot) } } , alist);
        return (alist)
    }
}


# parse and split oper
# rewrite NOT X as (NOT X)
function us:mysplit(alist, oper) {
    let (tmp = xt:list(), res = xt:list(), anot = false) {
        for (elem in alist) {
            if (elem = oper) {
                set (anot = false);
                if (xt:size(tmp)>0) {
                    xt:add(res, tmp);
                } ;
                set(tmp = xt:list())
            }
            else if (elem = ) {
                set(anot = true);
            }
            else if (elem in (, , )) {
                    xt:add(tmp, elem);
                    set (anot = false);
            }
            else if (anot) {
                    xt:add(tmp, xt:list(, elem));
                    set (anot = false);
            }
            else {
                    xt:add (tmp, elem)
            }
            
        } ;
        if (xt:size(tmp)>0) {
            xt:add(res, tmp); 
        };
        return (res)
    }
}

function us:cleanUnion(alist) {
    us:clean(alist, )
}

function us:clean(alist, elem) {
    if (xt:member(elem, alist), us:clean(xt:remove(alist, elem), elem), alist)
}

# ((A B) (C)) -> ((A C) (B C))
function us:distrib(alist) {
    if (xt:size(alist) = 0) {
        return (alist)
    }
    else if (xt:size(alist) = 1) {
        return (maplist (xt:list, xt:first(alist)))
    }
    else {
        letdyn ((fst | rst) = alist) {
            let (res =
            maplist (function(elem) { 
                letdyn (myelem = elem, distrib = us:distrib(rst)) {
                    maplist (function(sub) { xt:cons(myelem, sub) }, distrib)
                }
            }, fst)) {
            
            return (reduce(xt:append, res));
            }
        }
    }
}



# alist = (key val key val)
# extract key=val ; set context(key, list(val))

function us:extract(name) {
    let (res = us:myextract(coalesce(st:get(name), xt:list()))) {
        st:set(name, res);
        if (st:get(st:debug, true) || xt:size(st:get(key:trace)) > 0, xt:print(xt:context()), true)
    }
}

function us:isKey(name) {
    strstarts(name, key:)
}

function us:myextract(alist) {
     let (keyList = @(key:departement key:dname key:region key:rname key:pays key:pname key:commune key:cname key:label key:name 
          key:image key:altitude key:lat key:lon key:distance key:height key:trace key:show key:text),
        res = us:extractList(alist)) {
        
        us:protect(keyList) ;
        # used by myweb.rul to show/hide features with id from st:hide (see workflow)
        coalesce(st:set(st:show, xt:first(st:get(key:show)) = "more"), true) ;
        coalesce(st:set(st:text, xt:first(st:get(key:text)) = "true"), true) ;
        return (res)
     }   
}

function us:protect(keyList) {
    map (function(key) { coalesce(st:get(key), st:set(key, xt:list())) }, keyList)
}

# alist = (key val key val)
# extract key=val ; set context(key, list(val))
# used by workflow.ttl query for param parameter considered as key value list
# each key value is managed in Context and passed to query using Context
# each key value is available in query using st:get(key) = list(value) 
# in this way we can have as much key value as we want

function us:extractList(alist) {
    let (res = xt:list(), mylist = xt:list(), key = "", ind = 0) {
        for (value in alist) {
            if (us:isKey(value)) {
                if (ind > 0 && us:isKey(xt:get(alist, ind - 1))) {
                    # two successive keys, add missing value
                    # use case: radiobutton and checkbox may not send a value
                    # myweb.rul require param value list to be complete key value list 
                    # to check value of html select by index (by position in the list)
                    xt:add(mylist, "")
                } ;
                if (xt:size(res) > 0) {
                    st:set(uri(key), res);
                } ;
                if (key = value) {
                    # same key as previous: do nothing
                }
                else {
                    set (key = value) ;
                    set (res = xt:list())
                }
            }
            else {
                xt:add(res, value)
            };
            xt:add(mylist, value);
            set (ind = ind + 1)
        } ;
        if (xt:size(res) > 0) {
            st:set(uri(key), res)
        } ;
        return(mylist)
    }
}



# query preprocess in mapprofile.ttl

function us:preprocessQuery(qq) {
    return (us:replace(qq, us:getPattern()))
}

# alist = (($name$ pattern))
# replace $name$ by pattern in text
function us:replace(text, alist) {
    letdyn (atext = text) {
        map (function ((name, pattern)) { 
            set (atext = xt:replace(atext, name, pattern)) }, alist) ;
        return (atext)
    }
}

function us:getPattern() {
    let (select * (aggregate(xt:list(?pname, ?pattern)) as ?alist) 
         where {
            bind (st:get(st:context) as ?g)
            graph ?g { [ st:name ?pname ; st:pattern ?pattern ] }
        }) {
    return (alist)
    }
}

}