Distances on Directed Graphs in R
mpadge.tngl.sh
1#include "sf-as-network.h"
2
3//' rcpp_sf_as_network
4//'
5//' Return OSM data from Simple Features format input
6//'
7//' @param sf_lines An sf collection of LINESTRING objects
8//' @param pr Rcpp::DataFrame containing the weighting profile
9//'
10//' @return Rcpp::List objects of OSM data, one matrix of numeric and one of
11//' character values. The former contain 7 columns:
12//' 1. sf geom index
13//' 2. from longitude
14//' 3. from latitude
15//' 4. to longitude
16//' 5. to latitude
17//' 6. distance
18//' 7. weighted_distance
19//' The character value matrix has 4 columns of:
20//' 1. from ID
21//' 2. to ID
22//' 3. highway type
23//' 4. OSM way ID
24//'
25//' @noRd
26// [[Rcpp::export]]
27Rcpp::List rcpp_sf_as_network (const Rcpp::List &sf_lines,
28 const Rcpp::DataFrame &pr)
29{
30 std::unordered_map <std::string, double> profile;
31 Rcpp::StringVector hw = pr ["way"];
32 Rcpp::NumericVector val = pr ["value"];
33 if (hw.size () > 1) // single NA -> 0-length RcppVector
34 {
35 for (int i = 0; i != hw.size (); i ++)
36 profile.insert (std::make_pair (std::string (hw [i]), val [i]));
37 }
38
39
40 Rcpp::CharacterVector nms = sf_lines.attr ("names");
41 int one_way_index = -1;
42 int highway_index = -1;
43 int geom_index = -1;
44 for (R_xlen_t i = 0; i < nms.size (); i++)
45 {
46 if (nms [i] == "oneway")
47 one_way_index = static_cast <int> (i);
48 if (nms [i] == "highway")
49 highway_index = static_cast <int> (i);
50 if (nms [i] == "geometry")
51 geom_index = static_cast <int> (i);
52 }
53 if (geom_index < 0)
54 throw std::runtime_error ("sf_lines have no geometry component"); // # nocov
55
56 Rcpp::CharacterVector ow; // init length = 0
57 Rcpp::CharacterVector highway;
58 bool has_oneway = false;
59 if (one_way_index >= 0)
60 {
61 ow = sf_lines [one_way_index];
62 has_oneway = true;
63 }
64 if (highway_index >= 0)
65 highway = sf_lines [highway_index];
66
67 Rcpp::List geoms = sf_lines [geom_index];
68
69 std::vector <std::string> att_names = geoms.attributeNames ();
70 bool has_names = false;
71 for (std::vector <std::string>::iterator it = att_names.begin ();
72 it != att_names.end (); it++)
73 if (*it == "names")
74 has_names = true;
75 std::vector <std::string> way_names;
76 if (has_names)
77 way_names = Rcpp::as <std::vector <std::string> > (geoms.attr ("names"));
78
79 std::vector <bool> isOneWay (static_cast <size_t> (geoms.length ()));
80 std::fill (isOneWay.begin (), isOneWay.end (), false);
81 // Get dimension of matrix
82 size_t nrows = 0L;
83 R_xlen_t ngeoms = 0L;
84 for (auto g = geoms.begin (); g != geoms.end (); ++g)
85 {
86 // Rcpp uses an internal proxy iterator here, NOT a direct copy
87 Rcpp::NumericMatrix gi = (*g);
88 size_t rows = static_cast <size_t> (gi.nrow () - 1);
89 nrows += rows;
90 if (has_oneway && (
91 ow [ngeoms] == "yes" || ow [ngeoms] == "true" ||
92 ow [ngeoms] == "Yes" || ow [ngeoms] == "True" ||
93 ow [ngeoms] == "YES" || ow [ngeoms] == "TRUE"))
94 isOneWay [static_cast <size_t> (ngeoms)] = true;
95 else
96 nrows += rows;
97 ngeoms ++;
98 }
99
100 Rcpp::NumericMatrix nmat = Rcpp::NumericMatrix (Rcpp::Dimension (nrows, 6));
101 Rcpp::CharacterMatrix idmat =
102 Rcpp::CharacterMatrix (Rcpp::Dimension (nrows, 4));
103
104 nrows = 0;
105 ngeoms = 0;
106 int fake_id = 0;
107 for (auto g = geoms.begin (); g != geoms.end (); ++ g)
108 {
109 Rcpp::checkUserInterrupt ();
110 Rcpp::NumericMatrix gi = (*g);
111 std::string hway;
112 double hw_factor = 1.0;
113 if (profile.size () > 0)
114 {
115 hway = std::string (highway [ngeoms]);
116 hw_factor = profile [hway];
117 if (hw_factor > 0.0)
118 hw_factor = 1.0 / hw_factor;
119 }
120
121 Rcpp::List ginames = gi.attr ("dimnames");
122 Rcpp::CharacterVector rnms;
123 if (ginames.length () > 0)
124 {
125 if (!Rf_isNull (ginames [0]))
126 rnms = ginames [0];
127 }
128 if (rnms.size () == 0)
129 {
130 rnms = Rcpp::CharacterVector (gi.nrow ());
131 for (int i = 0; i < gi.nrow (); i ++)
132 rnms [i] = fake_id ++;
133 }
134 if (rnms.size () != gi.nrow ())
135 throw std::runtime_error ("geom size differs from rownames"); // # nocov
136
137 for (size_t i = 1;
138 i < static_cast <size_t> (gi.nrow ()); i ++)
139 {
140 sf::fill_one_row (ngeoms, gi, rnms, hw_factor, hway,
141 has_names, way_names, i, nrows, false, nmat, idmat);
142 nrows++;
143
144 if (!isOneWay [static_cast <size_t> (ngeoms)])
145 {
146 sf::fill_one_row (ngeoms, gi, rnms, hw_factor, hway,
147 has_names, way_names, i, nrows, true, nmat, idmat);
148 nrows++;
149 }
150 }
151 ngeoms ++;
152 }
153
154 return Rcpp::List::create (
155 Rcpp::Named ("numeric_values") = nmat,
156 Rcpp::Named ("character_values") = idmat);
157}
158
159void sf::fill_one_row (const R_xlen_t ngeoms, const Rcpp::NumericMatrix &gi,
160 const Rcpp::CharacterVector &rnms, const double &hw_factor,
161 const std::string &hway, const bool &has_names,
162 const std::vector <std::string> &way_names,
163 const size_t &grownum, const size_t &rownum, const bool &reverse,
164 Rcpp::NumericMatrix &nmat, Rcpp::CharacterMatrix &idmat)
165{
166 size_t i_min_1 = grownum - 1, i = grownum;
167 if (reverse)
168 {
169 i_min_1 = grownum;
170 i = grownum - 1;
171 }
172
173 nmat (rownum, 0) = static_cast <double> (ngeoms);
174 nmat (rownum, 1) = gi (i_min_1, 0);
175 nmat (rownum, 2) = gi (i_min_1, 1);
176 nmat (rownum, 3) = gi (i, 0);
177 nmat (rownum, 4) = gi (i, 1);
178 if (hw_factor > 0.0)
179 nmat (rownum, 5) = hw_factor;
180 else
181 nmat (rownum, 5) = -1.0; // # nocov
182
183 idmat (rownum, 0) = rnms (i_min_1);
184 idmat (rownum, 1) = rnms (i);
185 idmat (rownum, 2) = hway;
186 if (has_names)
187 idmat (rownum, 3) = way_names [static_cast <size_t> (ngeoms)];
188}