SchemeSmobTV.cc

Go to the documentation of this file.

/*
 * SchemeSmobTV.c
 *
 * Scheme small objects (SMOBS) for truth values.
 *
 * Copyright (c) 2008,2009 Linas Vepstas <linas@linas.org>
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Affero General Public License v3 as
 * published by the Free Software Foundation and including the exceptions
 * at http://opencog.org/wiki/Licenses
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU Affero General Public License
 * along with this program; if not, write to:
 * Free Software Foundation, Inc.,
 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 */

#ifdef HAVE_GUILE

#include <cstddef>
#include <libguile.h>

#include <opencog/atomspace/FuzzyTruthValue.h>
#include <opencog/atomspace/ProbabilisticTruthValue.h>
#include <opencog/atomspace/CountTruthValue.h>
#include <opencog/atomspace/IndefiniteTruthValue.h>
#include <opencog/atomspace/SimpleTruthValue.h>
#include <opencog/guile/SchemeSmob.h>

using namespace opencog;

/* ============================================================== */

#ifdef USE_KEYWORD_LIST_NOT_USED

static TruthValue *get_tv_from_kvp(SCM kvp, const char * subrname, int pos)
{
    if (!scm_is_pair(kvp)) return NULL;

    do
    {
        SCM skey = SCM_CAR(kvp);

        // Verify that the first item is a keyword.
        if (!scm_is_keyword(skey))
            scm_wrong_type_arg_msg(subrname, pos, skey, "keyword");

        skey = scm_keyword_to_symbol(skey);
        skey = scm_symbol_to_string(skey);
        char * key = scm_to_utf8_string(skey);

        kvp = SCM_CDR(kvp);
        pos ++;
        if (!scm_is_pair(kvp))
        {
            scm_wrong_type_arg_msg(subrname, pos, kvp, "value following keyword");
        }

        if (0 == strcmp(key, "tv"))
        {
            SCM sval = SCM_CAR(kvp);
            scm_t_bits misctype = SCM_SMOB_FLAGS(sval);
            if (misctype != COG_SIMPLE_TV)
                scm_wrong_type_arg_msg(subrname, pos, sval, "opencog truth value");
            TruthValue *tv;
            tv = (TruthValue *) SCM_SMOB_DATA(sval);
            return tv;
        }
        free(key);

        kvp = SCM_CDR(kvp);
        pos ++;
    }
    while (scm_is_pair(kvp));

    return NULL;
}
#endif /* USE_KEYWORD_LIST_NOT_USED */

TruthValue * SchemeSmob::get_tv_from_list(SCM slist)
{
    while (scm_is_pair(slist))
    {
        SCM sval = SCM_CAR(slist);
        if (SCM_SMOB_PREDICATE(SchemeSmob::cog_misc_tag, sval))
        {
            scm_t_bits misctype = SCM_SMOB_FLAGS(sval);
            switch (misctype)
            {
                case COG_TV:
                    return (TruthValue *) SCM_SMOB_DATA(sval);
                default:
                    break;
            }
        }

        slist = SCM_CDR(slist);
    }

    return NULL;
}

/* ============================================================== */

std::string SchemeSmob::tv_to_string(const TruthValue *tv)
{
#define BUFLEN 120
    char buff[BUFLEN];
    TruthValueType tvt = tv->getType();

    // They're only floats, not doubles, so print with 8 digits
    std::string ret = "";
    switch (tvt)
    {
        case SIMPLE_TRUTH_VALUE:
        {
            const SimpleTruthValue *stv = static_cast<const SimpleTruthValue *>(tv);
            snprintf(buff, BUFLEN, "(stv %.8g ", stv->getMean());
            ret += buff;
            snprintf(buff, BUFLEN, "%.8g)", stv->getConfidence());
            ret += buff;
            return ret;
        }
        case COUNT_TRUTH_VALUE:
        {
            const CountTruthValue *ctv = static_cast<const CountTruthValue *>(tv);
            snprintf(buff, BUFLEN, "(ctv %.8g ", ctv->getMean());
            ret += buff;
            snprintf(buff, BUFLEN, "%.8g ", ctv->getConfidence());
            ret += buff;
            snprintf(buff, BUFLEN, "%.8g)", ctv->getCount());
            ret += buff;
            return ret;
        }
        case INDEFINITE_TRUTH_VALUE:
        {
            const IndefiniteTruthValue *itv = static_cast<const IndefiniteTruthValue *>(tv);
            snprintf(buff, BUFLEN, "(itv %.8g ", itv->getL());
            ret += buff;
            snprintf(buff, BUFLEN, "%.8g ", itv->getU());
            ret += buff;
            snprintf(buff, BUFLEN, "%.8g)", itv->getConfidenceLevel());
            ret += buff;
            return ret;
        }
        case PROBABILISTIC_TRUTH_VALUE:
        {
            const ProbabilisticTruthValue *ptv = static_cast<const ProbabilisticTruthValue *>(tv);
            snprintf(buff, BUFLEN, "(ptv %.8g ", ptv->getMean());
            ret += buff;
            snprintf(buff, BUFLEN, "%.8g ", ptv->getConfidence());
            ret += buff;
            snprintf(buff, BUFLEN, "%.8g)", ptv->getCount());
            ret += buff;
            return ret;
        }
        case FUZZY_TRUTH_VALUE:
        {
            const FuzzyTruthValue *ftv = static_cast<const FuzzyTruthValue *>(tv);
            snprintf(buff, BUFLEN, "(ftv %.8g ", ftv->getMean());
            ret += buff;
            snprintf(buff, BUFLEN, "%.8g)", ftv->getConfidence());
            ret += buff;
            return ret;
        }
        default:
            return ret;
    }
}

/* ============================================================== */
TruthValuePtr SchemeSmob::to_tv(SCM s)
{
    TruthValue *tv = verify_tv(s, "to_tv, called by apply");

    // the memory for the TV is managed internally, by guile. So
    // we have to clone the TV, and hand the clone to the user.
    TruthValuePtr tvp = tv->clone();
    scm_remember_upto_here_1(s);
    return tvp;
}

/* ============================================================== */
SCM SchemeSmob::tv_to_scm (TruthValuePtr tvp)
{
    return take_tv(tvp->rawclone());
}
/* ============================================================== */
SCM SchemeSmob::take_tv (TruthValue *tv)
{
    scm_gc_register_collectable_memory (tv,
                     sizeof(*tv), "opencog tv");

    SCM smob;
    SCM_NEWSMOB (smob, cog_misc_tag, tv);
    SCM_SET_SMOB_FLAGS(smob, COG_TV);
    return smob;
}

/* ============================================================== */
SCM SchemeSmob::ss_new_stv (SCM smean, SCM sconfidence)
{
    double mean = scm_to_double(smean);
    double confidence = scm_to_double(sconfidence);

    float cnt = SimpleTruthValue::confidenceToCount(confidence);
    TruthValue *tv = new SimpleTruthValue(mean, cnt);
    return take_tv(tv);
}

SCM SchemeSmob::ss_new_ctv (SCM smean, SCM sconfidence, SCM scount)
{
    double mean = scm_to_double(smean);
    double confidence = scm_to_double(sconfidence);
    double count = scm_to_double(scount);

    TruthValue *tv = new CountTruthValue(mean, confidence, count);
    return take_tv(tv);
}

SCM SchemeSmob::ss_new_itv (SCM slower, SCM supper, SCM sconfidence)
{
    double lower = scm_to_double(slower);
    double upper = scm_to_double(supper);
    double confidence = scm_to_double(sconfidence);

    TruthValue *tv = new IndefiniteTruthValue(lower, upper, confidence);
    return take_tv(tv);
}

SCM SchemeSmob::ss_new_ptv (SCM smean, SCM sconfidence, SCM scount)
{
    double mean = scm_to_double(smean);
    double confidence = scm_to_double(sconfidence);
    double count = scm_to_double(scount);

    TruthValue *tv = new ProbabilisticTruthValue(mean, confidence, count);
    return take_tv(tv);
}

SCM SchemeSmob::ss_new_ftv (SCM smean, SCM sconfidence)
{
    double mean = scm_to_double(smean);
    double confidence = scm_to_double(sconfidence);

    float cnt = FuzzyTruthValue::confidenceToCount(confidence);
    TruthValue *tv = new FuzzyTruthValue(mean, cnt);
    return take_tv(tv);
}

/* ============================================================== */
SCM SchemeSmob::ss_tv_p (SCM s)
{
    if (SCM_SMOB_PREDICATE(SchemeSmob::cog_misc_tag, s))
    {
        scm_t_bits misctype = SCM_SMOB_FLAGS(s);
        switch (misctype)
        {
            case COG_TV:
                return SCM_BOOL_T;

            default:
                return SCM_BOOL_F;
        }
    }
    return SCM_BOOL_F;
}

inline SCM SchemeSmob::tv_p (SCM s, TruthValueType wanted)
{
    if (SCM_BOOL_F == ss_tv_p(s)) return SCM_BOOL_F;

    TruthValue *tv = (TruthValue *) SCM_SMOB_DATA(s);
    TruthValueType tvt = tv->getType();
    scm_remember_upto_here_1(s);
    if (wanted == tvt) return SCM_BOOL_T;
    return SCM_BOOL_F;
}

SCM SchemeSmob::ss_stv_p (SCM s)
{
    return tv_p(s, SIMPLE_TRUTH_VALUE);
}

SCM SchemeSmob::ss_ctv_p (SCM s)
{
    return tv_p(s, COUNT_TRUTH_VALUE);
}

SCM SchemeSmob::ss_itv_p (SCM s)
{
    return tv_p(s, INDEFINITE_TRUTH_VALUE);
}

SCM SchemeSmob::ss_ptv_p (SCM s)
{
    return tv_p(s, PROBABILISTIC_TRUTH_VALUE);
}

SCM SchemeSmob::ss_ftv_p (SCM s)
{
    return tv_p(s, FUZZY_TRUTH_VALUE);
}

/* ============================================================== */

TruthValue * SchemeSmob::verify_tv(SCM stv, const char *subrname, int pos)
{
    if (!SCM_SMOB_PREDICATE(SchemeSmob::cog_misc_tag, stv))
        scm_wrong_type_arg_msg(subrname, pos, stv, "opencog truth value");

    scm_t_bits misctype = SCM_SMOB_FLAGS(stv);
    if (COG_TV != misctype)
        scm_wrong_type_arg_msg(subrname, pos, stv, "opencog truth value");

    TruthValue *tv = (TruthValue *) SCM_SMOB_DATA(stv);
    return tv;
}

SCM SchemeSmob::ss_tv_get_value (SCM s)
{
    TruthValue *tv = verify_tv(s, "cog-tv->alist");
    TruthValueType tvt = tv->getType();
    switch (tvt)
    {
        case SIMPLE_TRUTH_VALUE:
        {
            SimpleTruthValue *stv = static_cast<SimpleTruthValue *>(tv);
            SCM mean = scm_from_double(stv->getMean());
            SCM conf = scm_from_double(stv->getConfidence());
            SCM count = scm_from_double(stv->getCount());
            SCM smean = scm_from_utf8_symbol("mean");
            SCM sconf = scm_from_utf8_symbol("confidence");
            SCM scount = scm_from_utf8_symbol("count");
    
            SCM rc = SCM_EOL;
            rc = scm_acons(sconf, conf, rc);
            rc = scm_acons(smean, mean, rc);
            rc = scm_acons(scount, count, rc);
            scm_remember_upto_here_1(s);
            return rc;
        }
        case COUNT_TRUTH_VALUE:
        {
            CountTruthValue *ctv = static_cast<CountTruthValue *>(tv);
            SCM mean = scm_from_double(ctv->getMean());
            SCM conf = scm_from_double(ctv->getConfidence());
            SCM cont = scm_from_double(ctv->getCount());
            SCM smean = scm_from_utf8_symbol("mean");
            SCM sconf = scm_from_utf8_symbol("confidence");
            SCM scont = scm_from_utf8_symbol("count");
    
            SCM rc = SCM_EOL;
            rc = scm_acons(scont, cont, rc), 
            rc = scm_acons(sconf, conf, rc);
            rc = scm_acons(smean, mean, rc);
            scm_remember_upto_here_1(s);
            return rc;
        }
        case INDEFINITE_TRUTH_VALUE:
        {
            IndefiniteTruthValue *itv = static_cast<IndefiniteTruthValue *>(tv);
            SCM lower = scm_from_double(itv->getL());
            SCM upper = scm_from_double(itv->getU());
            SCM conf = scm_from_double(itv->getConfidence());
            SCM slower = scm_from_utf8_symbol("lower");
            SCM supper = scm_from_utf8_symbol("upper");
            SCM sconf = scm_from_utf8_symbol("confidence");
    
            SCM rc = SCM_EOL;
            rc = scm_acons(sconf, conf, rc);
            rc = scm_acons(supper, upper, rc), 
            rc = scm_acons(slower, lower, rc);
            scm_remember_upto_here_1(s);
            return rc;
        }
        case PROBABILISTIC_TRUTH_VALUE:
        {
            ProbabilisticTruthValue *ptv = static_cast<ProbabilisticTruthValue *>(tv);
            SCM mean = scm_from_double(ptv->getMean());
            SCM conf = scm_from_double(ptv->getConfidence());
            SCM cont = scm_from_double(ptv->getCount());
            SCM smean = scm_from_utf8_symbol("mean");
            SCM sconf = scm_from_utf8_symbol("confidence");
            SCM scont = scm_from_utf8_symbol("count");

            SCM rc = SCM_EOL;
            rc = scm_acons(scont, cont, rc),
            rc = scm_acons(sconf, conf, rc);
            rc = scm_acons(smean, mean, rc);
            scm_remember_upto_here_1(s);
            return rc;
        }
        case FUZZY_TRUTH_VALUE:
        {
            FuzzyTruthValue *ftv = static_cast<FuzzyTruthValue *>(tv);
            SCM mean = scm_from_double(ftv->getMean());
            SCM conf = scm_from_double(ftv->getConfidence());
            SCM count = scm_from_double(ftv->getCount());
            SCM smean = scm_from_utf8_symbol("mean");
            SCM sconf = scm_from_utf8_symbol("confidence");
            SCM scount = scm_from_utf8_symbol("count");

            SCM rc = SCM_EOL;
            rc = scm_acons(sconf, conf, rc);
            rc = scm_acons(smean, mean, rc);
            rc = scm_acons(scount, count, rc);
            scm_remember_upto_here_1(s);
            return rc;
        }
        default:
            scm_remember_upto_here_1(s);
            return SCM_EOL;
    }
    scm_remember_upto_here_1(s);
    return SCM_EOL;
}

#endif /* HAVE_GUILE */
/* ===================== END OF FILE ============================ */