Custom select policy in R is less efficient than any default one

[ValerCheck]

I have implemented some custom selection policy with R code and have started simulation in order to compare the default policies and my own, however from the analysis I have figured out that my R-policy is much less effective than even a "random" policy from default simmer code.

In order to get an adequate comparison results I have 2 options:

1. Rewrite 'random', 'shortest-queue' and 'round-robin' policies with R to have consistent approach to selection of resources.
2. Implement my 'custom' policy with C code and integrate it with simmer (but I couldn't find any docs on either how to implement it or how to integrate it)

Do you know how to overcome such development peculiarities in order to get adequate comparison results due to chasm between performance of R code and C code?

[Enchufa2]

Yes, simmer implements a set of common policies in C++, but provides an R interface for the general case. Built-in policies are in the internal namespace, because they are not meant to be exposed, and that's why there's no documentation about it. They're here:

simmer/inst/include/simmer/activity/resource_internal.h

Lines 60 to 169 in f58ad54

	class Policy {
	typedef Resource* (Policy::*method)(Simulator*, const VEC<std::string>&);
	typedef UMAP<std::string, method> MethodMap;
	public:
	explicit Policy(const std::string& policy) : name(policy), state(new int(-1)),
	check_available(policy.find("-available") != std::string::npos)
	{
	policies["shortest-queue"] = &Policy::policy_shortest_queue;
	policies["shortest-queue-available"] = &Policy::policy_shortest_queue;
	policies["round-robin"] = &Policy::policy_round_robin;
	policies["round-robin-available"] = &Policy::policy_round_robin;
	policies["first-available"] = &Policy::policy_first_available;
	policies["random"] = &Policy::policy_random;
	policies["random-available"] = &Policy::policy_random;
	}
	Policy(const Policy& o) : name(o.name), state(o.state),
	check_available(o.check_available), policies(o.policies) {}
	friend std::ostream& operator<<(std::ostream& out, const Policy& policy) {
	out << policy.name;
	return out;
	}
	Resource* dispatch(Simulator* sim, const VEC<std::string>& resources) {
	MethodMap::iterator x = policies.find(name);
	if (x == policies.end()) Rcpp::stop("policy '%s' not supported (typo?)", name);
	return ((*this).*(x->second))(sim, resources);
	}
	private:
	std::string name;
	SHD<int> state;
	bool check_available;
	MethodMap policies;
	Resource* policy_shortest_queue(Simulator* sim, const VEC<std::string>& resources) {
	Resource* selected = NULL;
	for (size_t i = 0; i < resources.size(); i++) {
	Resource* res = sim->get_resource(resources[i]);
	if (check_available && !res->get_capacity())
	continue;
	if (!selected ||
	((selected->get_capacity() >= 0) &&
	((res->get_capacity() < 0) ||
	(res->get_queue_count()
	+ res->get_server_count() - res->get_capacity() <
	selected->get_queue_count()
	+ selected->get_server_count() - selected->get_capacity()))))
	selected = res;
	}
	if (!selected)
	Rcpp::stop("policy '%s' found no resource available", name);
	return selected;
	}
	Resource* policy_round_robin(Simulator* sim, const VEC<std::string>& resources) {
	Resource* selected;
	for (size_t i = 0; i < resources.size(); i++) {
	if (++(*state) >= (int)resources.size())
	*state = 0;
	selected = sim->get_resource(resources[*state]);
	if (!check_available || selected->get_capacity())
	goto select;
	}
	Rcpp::stop("policy '%s' found no resource available", name);
	select:
	return selected;
	}
	Resource* policy_first_available(Simulator* sim, const VEC<std::string>& resources) {
	Resource* selected, * first_available = NULL;
	for (size_t i = 0; i < resources.size(); i++) {
	selected = sim->get_resource(resources[i]);
	if (!first_available && selected->get_capacity())
	first_available = selected;
	if (selected->get_capacity() < 0 ||
	selected->get_server_count() < selected->get_capacity())
	goto select;
	}
	for (size_t i = 0; i < resources.size(); i++) {
	selected = sim->get_resource(resources[i]);
	if ((selected->get_queue_size() < 0 ||
	(selected->get_queue_count() < selected->get_queue_size())) &&
	(!check_available || selected->get_capacity()))
	goto select;
	}
	if (!first_available)
	Rcpp::stop("policy '%s' found no resource available", name);
	selected = first_available;
	select:
	return selected;
	}
	Resource* policy_random(Simulator* sim, const VEC<std::string>& resources) {
	VEC<Resource*> available;
	foreach_ (const std::string& name, resources) {
	Resource* res = sim->get_resource(name);
	if (!check_available || res->get_capacity())
	available.push_back(res);
	}
	if (!available.size())
	Rcpp::stop("policy '%s' found no resource available", name);
	Rcpp::RNGScope scope;
	return available[Rcpp::sample(available.size(), 1)[0] - 1];
	}
	};
	}} // namespace internal simmer

Before suggesting anything, I have two questions:

• What's your purpose? Are you interested in (a) the results of the simulation applying several policies (i.e., waiting time in queues...), or (b) pure benchmarking (i.e., execution time)?
• Is your custom policy very specific or general enough to be of interest to a wide range of simmer users?

[ValerCheck]

Oh, maybe it was a bad idea to display it as mean. Actually, it is total time to finish arrived tasks. So, if you take for example 100 absolutely same tasks (generation time and wait timeout on scheduler, and process timeout are same for all simulations), then depending on the injected policy overall time to finish those tasks is as on figure.

[Enchufa2]

But this is simulated time reported by get_mon_arrivals, right? Not real time measured externally. Implementing your policy in R or C doesn't impact its performance in simulated time. If you are obtaining a non-expected performance is because there's some error in your logic, which is making arrivals e.g. taking the same resource over and over. If you can post a minimal example of your issue, I could take a look.

[ValerCheck]

Yes, that is taken from get_mon_arrivals and chunked into periods (let say per hour analysis). Give me some time to publish it on github, then I will attach the code. Honestly, I have also started doubting in my logic :D

[ValerCheck]

You were right, I have implemented shortest-queue policy in R and used it as custom, results are the same for C++ shortest-queue and R shortest-queue. There is a bottleneck in the logic of my algorithm :(

[Enchufa2]

Let me know when it's available, and I'll take a look.