Embryo of an R package for the mapping tools.

CMakeLists.txt

@@ -137,7 +137,8 @@ endif()
 
 if (${BUILD_FOR_DEPLOYMENT})
     add_executable(spell-pedigree ${SPELL_PEDIGREE_SRC} ${libstdcpp})
-    add_executable(spell-marker ${SPELL_MARKER_SRC})
+    add_executable(spell-map ${SPELL_MAP_SRC} ${libstdcpp})
+    add_executable(spell-marker ${SPELL_MARKER_SRC} ${libstdcpp})
     add_executable(spell-qtl ${SPELL_QTL_SRC} ${libstdcpp})
     add_custom_command(
         OUTPUT glibc.h libstdc++.a

include/error.h

@@ -576,6 +576,9 @@ void message_queue::run()
 #define MSG_INFO(_msg_expr_) do { std::cout << _msg_expr_ << std::endl; } while (0)
 #define MSG_QUEUE_FLUSH()
 #define MSG_DEBUG(_msg_expr_) do { std::clog << _msg_expr_ << std::endl; } while (0)
+#define MSG_DEBUG_INDENT
+#define MSG_DEBUG_INDENT_EXPR(_str_)
+#define MSG_DEBUG_DEDENT
 
 #elif 0
 

src/bayes/main.cc

@@ -27,7 +27,11 @@
 void print_usage();
 
 
-int main(int argc, const char** argv)
+#ifndef SPELL_BAYES_MAIN
+#  define SPELL_BAYES_MAIN main
+#endif
+
+int SPELL_BAYES_MAIN(int argc, const char** argv)
 {
     feenableexcept(FE_ALL_EXCEPT & ~FE_INEXACT);
 

src/map-likelihood/main.cc

@@ -3,13 +3,17 @@
 #include "bayes/output.h"
 #include "map-likelihood/cli.h"
 
-int main(int argc, const char** argv)
+#ifndef SPELL_MAP_MAIN
+#  define SPELL_MAP_MAIN main
+#endif
+
+int SPELL_MAP_MAIN(int argc, const char** argv)
 {
     gamete_LV_database gamete_LV;
     auto settings = mapqa_settings_t::from_args(argc, argv);
     
     if (!settings) {
-        print_usage();
+        print_usage_pedigree();
         return -1;
     }
     {
@@ -23,9 +27,14 @@ int main(int argc, const char** argv)
     
     const auto& locvec = settings->group.raw.marker_locus;
     const auto& nvec = settings->group.raw.marker_name;
-    double lh = gamete_LV.map_likelihood(nvec, locvec);
-    MSG_DEBUG("Computed likelihood (log): " << lh);
-    MSG_DEBUG("Computed likelihood (log10): " << (lh / log(10.)));
+//     double lh = gamete_LV.map_likelihood(nvec, locvec);
+//     MSG_DEBUG("Computed likelihood (log): " << lh);
+//     MSG_DEBUG("Computed likelihood (log10): " << (lh / log(10.)));
+    
+    
+    auto map = gamete_LV.EM(settings->group.raw.marker_name);
+    MSG_DEBUG("n_iter " << map.n_iterations);
+    MSG_DEBUG("distances: " << map.distances);
 
     return 0;
 }

src/pedigree/cli.cc

@@ -132,7 +132,7 @@ arguments = {
 };
 
 
-argument_parser<ped_settings_t> arg_map(arguments);
+argument_parser<ped_settings_t> arg_map_ped(arguments);
 
 
 ped_settings_t* ped_settings_t::from_args(int argc, const char** argv)
@@ -145,7 +145,7 @@ ped_settings_t* ped_settings_t::from_args(int argc, const char** argv)
 
     ::prg_name(basename(argv[0]));
 
-    while (ai != aj && arg_map(ret, ai, aj)) {
+    while (ai != aj && arg_map_ped(ret, ai, aj)) {
         ++ai;
     }
 
@@ -157,6 +157,6 @@ ped_settings_t* ped_settings_t::from_args(int argc, const char** argv)
     return ret;
 }
 
-void print_usage() { print_usage_impl(false, arguments); }
+void print_usage_pedigree() { print_usage_impl(false, arguments); }
 
 #include "output_impl.h"

src/pedigree/main.cc

@@ -22,7 +22,11 @@
 void print_usage();
 
 
-int main(int argc, const char** argv)
+#ifndef SPELL_PEDIGREE_MAIN
+#  define SPELL_PEDIGREE_MAIN main
+#endif
+
+int SPELL_PEDIGREE_MAIN(int argc, const char** argv)
 {
     msg_handler_t::debug_enabled() = false;
     ped_settings_t* settings = ped_settings_t::from_args(argc, argv);

src/r-glue/DESCRIPTION

+Package: spellmaptools
+Version: 1.0
+Date: 2018-03-05
+Title: CarthaGene
+Authors@R: c(person("Damien", "Leroux", role = c("aut", "cre"), email = "damien.leroux@inra.fr"),
+             person("Sylvain", "Jasson", role = "aut", email="sylvain.jasson@inra.fr"))
+Maintainer: Damien Leroux <damien.leroux@inra.fr>
+Depends: R (>= 3.1)
+Description: TODO
+License: GPL (>= 2)
+URL: http://www.r-project.org, https://TODO

src/r-glue/Makefile

+include Makevars
+
+
+
+all: package
+
+.FORCE:
+
+sources: .FORCE
+	@echo "** Copying sources into src/... **"
+	@mkdir -p package/src
+	@mkdir -p package/R
+	@./cp.py ../ $(SRC_SRC) package/src
+	@./cp.py ../../include '*.h' '*/*.h' package/src/include
+	@./cp.py R '*' package/R
+	@./cp.py . $(DOT_SRC) Makevars package/src
+	@./cp.py /usr/include/RWrap '*.h' package/src/include/RWrap
+	@./cp.py ~/include/eigen3/ '*' '*/*' '*/*/*' '*/*/*/*' '*/*/*/*/*' '*/*/*/*/*/*' package/src/include/eigen3
+	@./cp.py ../../3rd-party json.hpp package/3rd-party
+	@./cp.py . DESCRIPTION package
+
+run_shlib: sources .FORCE
+	@echo "** BUILDING $(TARGET).so **"
+	+cd package/src && R CMD SHLIB $(OBJECTS)
+
+
+generate: run_shlib
+	@echo "** Generating NAMESPACE and glue.R **"
+	cd package && Rwrap src/$(TARGET).so
+
+package: generate
+	+R CMD build package
+
+install: package
+	+R CMD INSTALL $(TARGET)_1.0.tar.gz
+
+clean:
+	rm -rf package/*

src/r-glue/Makevars

+DEFINES=-DSPELL_PEDIGREE_MAIN=spell_pedigree -DSPELL_MARKER_MAIN=spell_marker -DSPELL_UNSAFE_OUTPUT
+
+CXX_STD=CXX14
+
+GCC_ARGS=-I . -I ./include -I ./include/RWrap -I ./include/eigen3 -I ./include/bayes -I ./include/input -pthread $(DEFINES)
+
+PKG_CXX14FLAGS=$(GCC_ARGS)
+PKG_CXXFLAGS=$(GCC_ARGS)
+PKG_CFLAGS=$(GCC_ARGS)
+CXX14FLAGS=$(GCC_ARGS)
+CXXFLAGS=$(GCC_ARGS)
+CFLAGS=$(GCC_ARGS)
+PKG_LIBS=-lgmp -pthread
+
+TARGET=spellmaptools
+
+SRC_SRC=static_data.cc \
+        bayes/main.cc bayes/cli.cc bayes/jobs.cc bayes/dispatch.cc \
+        pedigree/*.cc \
+        input/read_mark.cc
+        
+DOT_SRC=$(TARGET).cc
+
+ALL_SRC=$(DOT_SRC) $(SRC_SRC)
+
+OBJECTS=$(ALL_SRC:.cc=.o)

src/r-glue/R/glue.R

+assign('[.Spell2PtMatrix', function(what, i, j) what$get(i, j))
+dim.Spell2PtMatrix <- function(m) { 
+
+spell.2pt.matrix <- function() {
+    ret <- list()
+    class(ret) <- 'spell.2pt.matrix'
+    ret
+}
+
+dim.spell.2pt.matrix <- function(m) m$dim()
+
+
+
+
+
+
+assign('[.cg.2pt.matrix',
+       function(what, i, j) {
+           what$get(i, j)
+       })
+
+
+as.matrix.cg.2pt.matrix <- function(what) {
+    msel <- mrkselget(what$cgI)
+    mat <- .to.matrix(msel, msel, function(i, j) what[i, j])
+    #mat <- sapply(mrkselget(),
+    #              function(j) sapply(mrkselget(),
+    #                                 function(i) what[i, j]))
+    coln <- sapply(msel, function(m) mrkname(what$cgI, m))
+    rownames(mat) <- coln
+    colnames(mat) <- coln
+    mat
+}
+
+print.cg.2pt.matrix <- function(what) {
+    print(as.matrix(what))
+}

src/r-glue/cp.py

+#!/usr/bin/env python3
+
+import os
+import sys
+from glob import glob
+
+def do_cp(src, dest):
+    #print('do_cp', src, dest)
+    ta = os.path.getmtime(src)
+    if not os.path.isfile(dest) or os.path.getmtime(dest) < ta:
+        try:
+            os.makedirs(os.path.dirname(dest))
+        except:
+            pass
+        print("Updating file", dest)
+        open(dest, 'wb').write(open(src, 'rb').read())
+
+basedir = os.path.normpath(sys.argv[1])
+destdir = os.path.normpath(sys.argv[-1])
+
+for pat in sys.argv[2:-1]:
+    for srcfile in glob(os.path.join(basedir, pat)):
+        if not os.path.isfile(srcfile):
+            continue
+        destfile = os.path.join(destdir, srcfile[len(basedir) + 1:])
+        do_cp(srcfile, destfile)

src/r-glue/spellmaptools.cc

+#define SPELL_PEDIGREE_MAIN spell_pedigree
+#define SPELL_BAYES_MAIN spell_marker
+
+#include "eigen.h"
+#include <vector>
+#include <string>
+
+#include "RWrap.h"
+
+// Load and initialize data
+
+// LL (order)
+
+// Try (order, marker)
+
+// Flips (order)
+
+// LOD2pt (order, order)
+
+typedef std::vector<std::string> marker_vec;
+
+
+class Spell2PtMatrix;
+
+
+class SpellMapTools {
+private:
+public:
+    SpellMapTools(const std::string& wd, const std::string& name) {}
+    double LL(const marker_vec& order);
+    double Try(const marker_vec& order, const std::string& marker);
+    double Flips(const marker_vec& order, int window_size);
+    Spell2PtMatrix* LOD2pt(const marker_vec& rows, const marker_vec& cols);
+};
+
+
+class Spell2PtMatrix {
+private:
+    std::vector<std::string> rownames, colnames;
+    std::map<std::string, int> row_indices, col_indices;
+    SpellMapTools* instance;
+    std::map<std::pair<std::string, std::string>, double> cache;
+public:
+    Spell2PtMatrix(SpellMapTools* smt, const std::vector<std::string>& r, const std::vector<std::string>& c)
+        : instance(smt), rownames(r), colnames(c), row_indices(), col_indices(), cache()
+    {
+        for (const auto& m: rownames) {
+            row_indices.emplace(m, row_indices.size());
+        }
+        for (const auto& m: colnames) {
+            col_indices.emplace(m, col_indices.size());
+        }
+    }
+
+    std::vector<int>
+    dim() const
+    {
+        return {rownames.size(), colnames.size()};
+    }
+    
+    double get(int i, int j)
+    {
+        std::pair<std::string, std::string> key = {rownames[i], colnames[j]};
+        if (key.first == key.second) {
+            return 0;
+        }
+        if (key.first > key.second) {
+            std::swap(key.first, key.second);
+        }
+        auto it = cache.find(key);
+        if (it == cache.end()) {
+            double value = 0; /* TODO */
+            cache.emplace(key, value);
+            return value;
+        } else {
+            return it->second;
+        }
+    }
+};
+
+
+double
+SpellMapTools::LL(const marker_vec& order)
+{
+    return 0;
+}
+
+double
+SpellMapTools::Try(const marker_vec& order, const std::string& marker)
+{
+    return 0;
+}
+
+double
+SpellMapTools::Flips(const marker_vec& order, int window_size)
+{
+    return 0;
+}
+
+Spell2PtMatrix*
+SpellMapTools::LOD2pt(const marker_vec& row_order, const marker_vec& col_order)
+{
+    return NULL;
+}
+
+
+
+CLASS(Spell2PtMatrix)
+    .method(Spell2PtMatrix, get).arg("i").arg("j").auto_glue()
+    ;
+
+CLASS(SpellMapTools)
+    .ctor<const std::string&, const std::string&>("directory", "name")
+    .method(SpellMapTools, LL).arg("order").auto_glue()
+    .method(SpellMapTools, Try).arg("order").arg("marker").auto_glue()
+    .method(SpellMapTools, Flips).arg("order").arg("window_size").auto_glue()
+    .method(SpellMapTools, LOD2pt).arg("row_order").arg("col_order").auto_glue()
+    ;
+
+
+MODULE(spellmaptools)
+    .add_class(SpellMapTools)
+    .add_class(Spell2PtMatrix)
+    .add_s3method("'['", "Spell2PtMatrix")
+    .add_s3method("dim", "Spell2PtMatrix")
+    .add_s3method("print", "Spell2PtMatrix")
+    ;