cba-on-trust-models-for-IoT-systems

git clone git://git.codymlewis.com/cba-on-trust-models-for-IoT-systems.git
Log | Files | Refs | README | LICENSE

commit bae3244cdf0bc05b1ea178665ae548598de17c78
parent df12419c772745fa638e831053ff748fad689423
Author: Cody Lewis <cody@codymlewis.com>
Date:   Fri,  1 Jan 2021 19:54:07 +1100

Refactored li-19, and saied-13, added mitigation to saied-13

Diffstat:
A.gitignore | 5+++++
Mcbstm-iot/DESCRIPTION | 2+-
Mli-19/BatchSimulation.R | 2+-
Mli-19/DESCRIPTION | 2+-
Mli-19/GUI.R | 2+-
Mli-19/Makefile | 2+-
Mli-19/R/Adversaries.R | 86++++++++++++++++++++++++++++++++++++++++----------------------------------------
Mli-19/R/BaseStation.R | 152++++++++++++++++++++++++++++++++++++++++----------------------------------------
Mli-19/R/Device.R | 1614++++++++++++++++++++++++++++++++++++++++---------------------------------------
Mli-19/R/Field.R | 220++++++++++++++++++++++++++++++++++++++++----------------------------------------
Mli-19/R/Functions.R | 58+++++++++++++++++++++++++++++-----------------------------
Mli-19/R/Globals.R | 2+-
Mli-19/R/Normalizers.R | 36++++++++++++++++++------------------
Mli-19/R/Observation.R | 28++++++++++++++--------------
Mli-19/R/Observer.R | 66+++++++++++++++++++++++++++++++++---------------------------------
Mli-19/R/Params.R | 238++++++++++++++++++++++++++++++++++++++++----------------------------------------
Mli-19/R/ServiceProvider.R | 50+++++++++++++++++++++++++-------------------------
Mli-19/R/Simulation.R | 1111+++++++++++++++++++++++++++++++++++++++++--------------------------------------
Mli-19/R/Tile.R | 124++++++++++++++++++++++++++++++++++++++++----------------------------------------
Mli-19/R/TrustModel.R | 320++++++++++++++++++++++++++++++++++++++++----------------------------------------
Mli-19/tests/testthat/test-basestation.R | 60++++++++++++++++++++++++++++++------------------------------
Mli-19/tests/testthat/test-calculations.R | 274++++++++++++++++++++++++++++++++++++++++----------------------------------------
Mli-19/tests/testthat/test-device.R | 106+++++++++++++++++++++++++++++++++++++++++++------------------------------------
Mli-19/tests/testthat/test-field.R | 18+++++++++---------
Mli-19/tests/testthat/test-functions.R | 8++++----
Mli-19/tests/testthat/test-normalizers.R | 66+++++++++++++++++++++++++++++++++---------------------------------
Mli-19/tests/testthat/test-observation.R | 14+++++++-------
Mli-19/tests/testthat/test-serviceprovider.R | 4++--
Mli-19/tests/testthat/test-tile.R | 34+++++++++++++++++-----------------
Msaied-13/src/ConsoleInterface.r | 15+++++++++------
Msaied-13/src/Node.r | 165+++++++++++++++++++++++++++++++++++++++----------------------------------------
Msaied-13/src/Report.r | 44++++++++++++++++++++++----------------------
Msaied-13/src/TrustModel.r | 229++++++++++++++++++++++++++++++++++++++++++++++++-------------------------------
33 files changed, 2653 insertions(+), 2504 deletions(-)

diff --git a/.gitignore b/.gitignore @@ -0,0 +1,5 @@ +Session.vim +.Rhistory +*.tar.gz +*.png +tags diff --git a/cbstm-iot/DESCRIPTION b/cbstm-iot/DESCRIPTION @@ -13,7 +13,7 @@ Imports: License: MIT Encoding: UTF-8 LazyData: true -RoxygenNote: 7.0.1 +RoxygenNote: 7.1.1 Collate: 'Functions.R' 'TrustModel.R' diff --git a/li-19/BatchSimulation.R b/li-19/BatchSimulation.R @@ -3,7 +3,7 @@ library(li19trustmodel) main <- function() { - batch_simulation(500, config="inst/extdata/params.json") + batch_simulation(500, config="inst/extdata/params.json", adversary_types = c("ContextSetter")) quit("no") } diff --git a/li-19/DESCRIPTION b/li-19/DESCRIPTION @@ -19,7 +19,7 @@ Imports: License: What license it uses Encoding: UTF-8 LazyData: true -RoxygenNote: 7.0.1 +RoxygenNote: 7.1.1 Suggests: testthat (>= 2.1.0) Collate: diff --git a/li-19/GUI.R b/li-19/GUI.R @@ -3,7 +3,7 @@ library(li19trustmodel) main <- function() { - run_gui(config="inst/extdata/params.json") + run_gui(config="inst/extdata/params.json") } main() diff --git a/li-19/Makefile b/li-19/Makefile @@ -36,7 +36,7 @@ atts: R -e "Rcpp::compileAttributes()" style: - R -e "styler::style_pkg(indent_by=4)" + R -e "styler::style_pkg(indent_by=8)" ref: R CMD Rd2pdf . diff --git a/li-19/R/Adversaries.R b/li-19/R/Adversaries.R @@ -1,52 +1,52 @@ BadMouther <- R6::R6Class( - "BadMouther", - inherit = Device, - public = list( - create_rec = function(rs_dir_trust) { - return( - Observation$new( - self$contexts[[self$id]][get_context_index(params$time_now)], - -1, - self$id - ) - ) - }, + "BadMouther", + inherit = Device, + public = list( + create_rec = function(rs_dir_trust) { + return( + Observation$new( + self$contexts[[self$id]][get_context_index(params$time_now)], + -1, + self$id + ) + ) + }, - fill_estimated_trust = function(used_trust) { - self$estimated_trusts[[params$time_now]] <- -1 - invisible(self) - } - ) + fill_estimated_trust = function(used_trust) { + self$estimated_trusts[[params$time_now]] <- -1 + invisible(self) + } + ) ) ContextSetter <- R6::R6Class( - "ContextSetter", - inherit = Device, - public = list( - create_rec = function(rs_dir_trust) { - return( - Observation$new( - normalize( - c( - params$time_now, - params$target_capability, - euc_dist( - params$target_location, - self$service_provider$location - ), - params$target_velocity + "ContextSetter", + inherit = Device, + public = list( + create_rec = function(rs_dir_trust) { + return( + Observation$new( + normalize( + c( + params$time_now, + params$target_capability, + euc_dist( + params$target_location, + self$service_provider$location + ), + params$target_velocity + ) + ), + -1, + self$id + ) ) - ), - -1, - self$id - ) - ) - }, + }, - fill_estimated_trust = function(used_trust) { - self$estimated_trusts[[params$time_now]] <- -1 - invisible(self) - } - ) + fill_estimated_trust = function(used_trust) { + self$estimated_trusts[[params$time_now]] <- -1 + invisible(self) + } + ) ) diff --git a/li-19/R/BaseStation.R b/li-19/R/BaseStation.R @@ -1,87 +1,87 @@ BaseStation <- R6::R6Class( - "BaseStation", - list( - location = NULL, - table = NULL, - neighbours = list(), - updated = FALSE, + "BaseStation", + list( + location = NULL, + table = NULL, + neighbours = list(), + updated = FALSE, - initialize = function(x = 1, y = 1) { - self$location <- c(x, y) - self$table <- list( - next_hop = c(list(), rep(NULL, params$number_nodes)), - hops = rep(Inf, params$number_nodes) - ) - invisible(self) - }, + initialize = function(x = 1, y = 1) { + self$location <- c(x, y) + self$table <- list( + next_hop = c(list(), rep(NULL, params$number_nodes)), + hops = rep(Inf, params$number_nodes) + ) + invisible(self) + }, - add_neighbour = function(base_station) { - "Symmetrically add a new neighbouring base station to this" - self$new_neighbour(base_station) - base_station$new_neighbour(self) - invisible(self) - }, + add_neighbour = function(base_station) { + "Symmetrically add a new neighbouring base station to this" + self$new_neighbour(base_station) + base_station$new_neighbour(self) + invisible(self) + }, - new_neighbour = function(neighbour) { - "Add a new neighbour to this" - self$neighbours[[length(self$neighbours) + 1]] <- neighbour - invisible(self) - }, + new_neighbour = function(neighbour) { + "Add a new neighbour to this" + self$neighbours[[length(self$neighbours) + 1]] <- neighbour + invisible(self) + }, - connect = function(device) { - "Connect to a device" - self$table$next_hop[[device$id]] <- device - self$table$hops[[device$id]] <- 0 - invisible(self) - }, + connect = function(device) { + "Connect to a device" + self$table$next_hop[[device$id]] <- device + self$table$hops[[device$id]] <- 0 + invisible(self) + }, - disconnect = function(device) { - "Disconnect from a device" - self$table$next_hop[[device$id]] <- 0 - self$table$hops[[device$id]] <- Inf - invisible(self) - }, + disconnect = function(device) { + "Disconnect from a device" + self$table$next_hop[[device$id]] <- 0 + self$table$hops[[device$id]] <- Inf + invisible(self) + }, - retabulate = function(device) { - "Recalculate the routing tables of each of the neighbours" - self$updated <- TRUE - for (neighbour in self$neighbours) { - neighbour$tabulate_device(device, self, self$table$hops[[device$id]] + 1) - } - invisible(self) - }, + retabulate = function(device) { + "Recalculate the routing tables of each of the neighbours" + self$updated <- TRUE + for (neighbour in self$neighbours) { + neighbour$tabulate_device(device, self, self$table$hops[[device$id]] + 1) + } + invisible(self) + }, - tabulate_device = function(device, prev_base_station, hops) { - "Update the routing table on the given device" - if (!self$updated) { - self$table$next_hop[[device$id]] <- prev_base_station - self$table$hops[[device$id]] <- hops - self$updated <- TRUE - for (neighbour in self$neighbours) { - neighbour$tabulate_device(device, self, hops + 1) - } - } - invisible(self) - }, + tabulate_device = function(device, prev_base_station, hops) { + "Update the routing table on the given device" + if (!self$updated) { + self$table$next_hop[[device$id]] <- prev_base_station + self$table$hops[[device$id]] <- hops + self$updated <- TRUE + for (neighbour in self$neighbours) { + neighbour$tabulate_device(device, self, hops + 1) + } + } + invisible(self) + }, - finish_update = function() { - "Finish with updating the routing tables" - if (self$updated) { - self$updated <- FALSE - for (neighbour in self$neighbours) { - neighbour$finish_update() - } - } - invisible(self) - }, + finish_update = function() { + "Finish with updating the routing tables" + if (self$updated) { + self$updated <- FALSE + for (neighbour in self$neighbours) { + neighbour$finish_update() + } + } + invisible(self) + }, - find_device = function(dev_id) { - "Route for the device with the given id" - cur_device <- self - while (cur_device$table$hops[[dev_id]] > 0) { - cur_device <- cur_device$table$next_hop[[dev_id]] - } - return(cur_device$table$next_hop[[dev_id]]) - } - ) + find_device = function(dev_id) { + "Route for the device with the given id" + cur_device <- self + while (cur_device$table$hops[[dev_id]] > 0) { + cur_device <- cur_device$table$next_hop[[dev_id]] + } + return(cur_device$table$next_hop[[dev_id]]) + } + ) ) diff --git a/li-19/R/Device.R b/li-19/R/Device.R @@ -1,810 +1,844 @@ Device <- R6::R6Class( - "Device", - list( - id = NULL, - contacts = NULL, - location = NULL, - current_goal = NULL, - capability = NULL, - velocity = NULL, - trust = NULL, - distrust = NULL, - unknown = NULL, - sp_trust = NULL, - sp_distrust = NULL, - sp_unknown = NULL, - domain = NULL, - reputations = NULL, - service_provider = NULL, - time_last_moved = NULL, - estimated_trusts = NULL, - map = list(), - contexts = list(), - stored_trusts = list(), - cached_contexts = list(), - observed_trusts = NULL, - acceptable_recs = list(), - old_trusts = list(), - old_contexts = list(), - transacted = FALSE, - - initialize = function(id, sp, map = NULL, loc = NULL) { - self$service_provider <- sp - self$setup_map(map, loc) - self$id <- id - self$set_trusts() - self$setup_signals(map) - self$velocity <- runif(1, min = 0, max = params$max_velocity) - self$capability <- runif(1, min = 1, max = params$max_capability) - self$reputations <- rep(params$init_reputation, params$number_nodes) - self$time_last_moved <- params$time_now - 1 - self$estimated_trusts <- c(params$trust_new_contact) - self$setup_report_storage() - self$setup_reputations() - invisible(self) - }, - - setup_map = function(map, loc) { - "Setup the map realted values for this node" - if (!is.null(map)) { - self$map <- list(map) - self$location <- `if`( - is.null(loc), - round(runif(2, min = 1, max = map$shape())), - loc - ) - if (round(runif(1)) == 1) { - self$domain <- AIR - } else { - self$domain <- map$get_tile(self$location)[[1]]$terrain - } - self$new_goal() - } else { - self$location <- round( - runif( - 2, - min = 1, - max = c(params$map_width, params$map_height) - ) - ) - self$map <- list() - self$domain <- sample(c(AIR, LAND, WATER), 1) - } - invisible(self) - }, - - setup_signals = function(map) { - "Add the signal from this node to the field" - if (!is.null(map)) { - map$get_tile(self$location)[[1]]$add_device(self) - for (signal in map$get_tile(self$location)[[1]]$signals) { - signal$connect(self) - } - } - invisible(self) - }, - - setup_report_storage = function() { - "Setup the report storing values for each node" - self$contexts <- lapply( - 1:params$number_nodes, - function(i) { - `if`( - i == self$id, - normalize( - c( - params$time_now, - self$capability, - euc_dist(self$location, self$service_provider$location), - self$velocity - ) - ), - c(params$time_now, 0, 0, 0) - ) - } - ) - self$acceptable_recs <- lapply( - 1:params$number_nodes, - function(i) { - c(FALSE) - } - ) - self$stored_trusts <- lapply( - 1:params$number_nodes, - function(i) { - params$trust_new_contact - } - ) - invisible(self) - }, - - setup_reputations = function() { - "Setup the reputation related values for each node" - self$reputations <- sapply( - 1:params$number_nodes, - function(i) { - `if`( - i == self$id, - params$rep_self, - params$init_reputation - ) - } - ) - self$cached_contexts <- lapply( - 1:params$number_nodes, - function(i) { - c(params$time_now - 1, 0, 0, 0) - } - ) - self$old_contexts <- lapply( - 1:params$number_nodes, - function(i) { - c(params$time_now - 1, 0, 0, 0) - } - ) - invisible(self) - }, - - add_contact = function(adds, devs) { - "Add the contacts specified in the list" - for (i in adds) { - if (length(self$contacts) >= params$max_number_contacts) { - break - } - if (length(devs[[i]]$contacts) < params$max_number_contacts) { - self$new_contact(i) - devs[[i]]$new_contact(self$id) - } - } - invisible(self) - }, - - new_contact = function(add) { - "Add a single new contact" - self$contacts <- sort(union(self$contacts, add)) - invisible(self) - }, - - set_trusts = function() { - "Set up the trusts for the service providers in the network" - self$trust <- rep(0, params$number_nodes) - self$distrust <- rep(0, params$number_nodes) - self$unknown <- rep(0, params$number_nodes) - self$sp_trust <- 0 - self$sp_distrust <- 0 - self$sp_unknown <- 0 - invisible(self) - }, - - new_goal = function() { - "Find a new location to head towards" - while (all(self$current_goal == self$location) || - (self$domain == WATER && - self$map[[1]]$get_tile(self$current_goal)[[1]]$terrain != WATER)) { - self$current_goal <- round(runif(2, min = 1, max = self$map[[1]]$shape())) - } - invisible(self) - }, - - sp_trust_increment = function() { - "Increment the trust count of the service provider" - self$sp_trust <- self$sp_trust + params$tdu_increment - invisible(self) - }, - - sp_distrust_increment = function() { - "Increment the distrust count of the service provider" - self$sp_distrust <- self$sp_distrust + params$tdu_increment - invisible(self) - }, - - sp_unknown_increment = function() { - "Increment the unknown count of the service provider" - self$sp_unknown <- self$sp_unknown + params$tdu_increment - invisible(self) - }, - - trust_increment = function(id_sender) { - "Increment the trust count of the sender" - self$trust[[id_sender]] <- self$trust[[id_sender]] + 1 - invisible(self) - }, - - unknown_increment = function(id_sender) { - "Increment the unknown count of the sender" - self$unknown[[id_sender]] <- self$unknown[[id_sender]] + 1 - invisible(self) - }, - - distrust_increment = function(id_sender) { - "Increment the distrust count of the sender" - self$distrust[[id_sender]] <- self$distrust[[id_sender]] + 1 - invisible(self) - }, - - send_rec = function(devices) { - "Send a recommendation to the devices" - rs_dir_trust <- self$find_direct_trust( - self$contexts[[self$id]][get_context_index(params$time_now)], - recommendation = TRUE - ) - self$stored_trusts[[self$id]][[params$time_now]] <- rs_dir_trust$trust_comb - self$emit_observation( - self$create_rec(rs_dir_trust), - devices - ) - invisible(self) - }, - - create_rec = function(rs_dir_trust) { - "Create a recommendation" - return( - Observation$new( - self$contexts[[self$id]][get_context_index(params$time_now)], - rs_dir_trust$trust_comb, - self$id, - self$acceptable_recs[[self$id]][[params$time_now]] - ) - ) - }, - - recieve_observation = function(obs) { - "Receive a recommendation from the sender" - if (length(self$stored_trusts[[obs$id_sender]]) >= params$compression_factor) { - w_context <- find_weighted_context( - c(self$contexts[[obs$id_sender]], obs$context) - ) - self$stored_trusts[[obs$id_sender]] <- `if`( - obs$id_sender == self$id, - self$stored_trusts[[obs$id_sender]] <- direct_trust( - c(self$stored_trusts[[obs$id_sender]], obs$trust), - c(self$contexts[[obs$id_sender]], obs$context), - w_context - ), - self$stored_trusts[[obs$id_sender]] <- indirect_trust( - c(self$stored_trusts[[obs$id_sender]], obs$trust), - self$reputations[[obs$id_sender]], - c(self$contexts[[obs$id_sender]], obs$context), - find_weighted_context(self$contexts[[self$id]]), - w_context - ) - ) - self$contexts[[obs$id_sender]] <- w_context - } else { - cw_len <- length(params$context_weights) - i <- `if`( - params$compression_factor < Inf, - length(self$stored_trusts[[obs$id_sender]]) + 1, - params$time_now - ) - self$contexts[[obs$id_sender]][ - get_context_index(i) - ] <- obs$context - self$stored_trusts[[obs$id_sender]][[i]] <- obs$trust - } - self$calc_acceptability(obs) - invisible(self) - }, - - calc_acceptability = function(obs) { - if (any(self$acceptable_recs[[obs$id_sender]])) { - if (self$acceptable_recs[[obs$id_sender]][[params$time_now - 1]]) { - self$old_trusts[[obs$id_sender]] <- - self$stored_trusts[[obs$id_sender]][[params$time_now - 1]] - self$old_contexts[[obs$id_sender]] <- - self$contexts[[obs$id_sender]][get_context_index(params$time_now - 1)] - } - if (self$old_trusts[[obs$id_sender]] < - (params$delta_a - params$trust_rep_adj_range)) { - self$acceptable_recs[[obs$id_sender]][[params$time_now]] <- - obs$acceptable && ( - obs$trust > (params$delta_a - params$trust_rep_adj_range) || - acceptable_rec( - find_weighted_context( - c( - self$cached_contexts[[obs$id_sender]], - obs$context + "Device", + list( + id = NULL, + contacts = NULL, + location = NULL, + current_goal = NULL, + capability = NULL, + velocity = NULL, + trust = NULL, + distrust = NULL, + unknown = NULL, + sp_trust = NULL, + sp_distrust = NULL, + sp_unknown = NULL, + domain = NULL, + reputations = NULL, + service_provider = NULL, + time_last_moved = NULL, + estimated_trusts = NULL, + map = list(), + contexts = list(), + stored_trusts = list(), + cached_contexts = list(), + observed_trusts = NULL, + acceptable_recs = list(), + old_trusts = list(), + old_contexts = list(), + transacted = FALSE, + + initialize = function(id, sp, map = NULL, loc = NULL, copy = NULL) { + if (is.null(copy)) { + self$service_provider <- sp + self$setup_map(map, loc) + self$id <- id + self$set_trusts() + self$setup_signals(map) + self$velocity <- runif(1, min = 0, max = params$max_velocity) + self$capability <- runif(1, min = 1, max = params$max_capability) + self$reputations <- rep(params$init_reputation, params$number_nodes) + self$time_last_moved <- params$time_now - 1 + self$estimated_trusts <- c(params$trust_new_contact) + self$setup_report_storage() + self$setup_reputations() + } else { + self$copy(copy) + } + invisible(self) + }, + + copy = function(cp) { + self$id <- cp$id + self$contacts <- cp$contacts + self$location <- cp$location + self$current_goal <- cp$current_goal + self$capability <- cp$capability + self$velocity <- cp$velocity + self$trust <- cp$trust + self$distrust <- cp$distrust + self$unknown <- cp$unknown + self$sp_trust <- cp$sp_trust + self$sp_distrust <- cp$sp_distrust + self$sp_unknown <- cp$sp_unknown + self$domain <- cp$domain + self$reputations <- cp$reputations + self$service_provider <- cp$service_provider + self$time_last_moved <- cp$time_last_moved + self$estimated_trusts <- cp$estimated_trusts + self$map <- cp$map + self$contexts <- cp$contexts + self$stored_trusts <- cp$stored_trusts + self$cached_contexts <- cp$cached_contexts + self$observed_trusts <- cp$observed_trusts + self$acceptable_recs <- cp$acceptable_recs + self$old_trusts <- cp$old_trusts + self$old_contexts <- cp$old_contexts + self$transacted <- cp$transacted + invisible(self) + }, + + setup_map = function(map, loc) { + "Setup the map realted values for this node" + if (!is.null(map)) { + self$map <- list(map) + self$location <- `if`( + is.null(loc), + round(runif(2, min = 1, max = map$shape())), + loc + ) + if (round(runif(1)) == 1) { + self$domain <- AIR + } else { + self$domain <- map$get_tile(self$location)[[1]]$terrain + } + self$new_goal() + } else { + self$location <- round( + runif( + 2, + min = 1, + max = c(params$map_width, params$map_height) ) - ), - self$old_contexts[[obs$id_sender]], - self$old_trusts[[obs$id_sender]] ) + self$map <- list() + self$domain <- sample(c(AIR, LAND, WATER), 1) + } + invisible(self) + }, + + setup_signals = function(map) { + "Add the signal from this node to the field" + if (!is.null(map)) { + map$get_tile(self$location)[[1]]$add_device(self) + for (signal in map$get_tile(self$location)[[1]]$signals) { + signal$connect(self) + } + } + invisible(self) + }, + + setup_report_storage = function() { + "Setup the report storing values for each node" + self$contexts <- lapply( + 1:params$number_nodes, + function(i) { + `if`( + i == self$id, + normalize( + c( + params$time_now, + self$capability, + euc_dist(self$location, self$service_provider$location), + self$velocity + ) + ), + c(params$time_now, 0, 0, 0) + ) + } ) - } else { - self$acceptable_recs[[obs$id_sender]][[params$time_now]] <- obs$acceptable - } - } else { - self$acceptable_recs[[obs$id_sender]][[params$time_now]] <- obs$acceptable - } - invisible(self) - }, - - move = function() { - "Move towards the current goal" - time_change <- params$time_now - self$time_last_moved - old_signals <- self$get_signals() - self$disconnect_all() - movement_amount <- round(self$velocity * time_change) - movement <- `if`(movement_amount > 0, 1:movement_amount, NULL) - for (m in movement) { - best_weight <- Inf - best_loc <- NA - best_tile <- NA - for (i in (self$location[[1]] - 1):(self$location[[1]] + 1)) { - for (j in (self$location[[2]] - 1):(self$location[[2]] + 1)) { - loc <- c(i, j) - tile <- self$map[[1]]$get_tile(loc) - if (!all(loc == self$location) && length(tile)) { - tile <- tile[[1]] - cost <- `if`( - self$domain == AIR, - 1, - `if`( - self$domain == tile$terrain, - 1, - 2 + self$acceptable_recs <- lapply( + 1:params$number_nodes, + function(i) { + c(FALSE) + } + ) + self$stored_trusts <- lapply( + 1:params$number_nodes, + function(i) { + params$trust_new_contact + } + ) + invisible(self) + }, + + setup_reputations = function() { + "Setup the reputation related values for each node" + self$reputations <- sapply( + 1:params$number_nodes, + function(i) { + `if`( + i == self$id, + params$rep_self, + params$init_reputation + ) + } + ) + self$cached_contexts <- lapply( + 1:params$number_nodes, + function(i) { + c(params$time_now - 1, 0, 0, 0) + } + ) + self$old_contexts <- lapply( + 1:params$number_nodes, + function(i) { + c(params$time_now - 1, 0, 0, 0) + } + ) + invisible(self) + }, + + add_contact = function(adds, devs) { + "Add the contacts specified in the list" + for (i in adds) { + if (length(self$contacts) >= params$max_number_contacts) { + break + } + if (length(devs[[i]]$contacts) < params$max_number_contacts) { + self$new_contact(i) + devs[[i]]$new_contact(self$id) + } + } + invisible(self) + }, + + new_contact = function(add) { + "Add a single new contact" + self$contacts <- sort(union(self$contacts, add)) + invisible(self) + }, + + set_trusts = function() { + "Set up the trusts for the service providers in the network" + self$trust <- rep(0, params$number_nodes) + self$distrust <- rep(0, params$number_nodes) + self$unknown <- rep(0, params$number_nodes) + self$sp_trust <- 0 + self$sp_distrust <- 0 + self$sp_unknown <- 0 + invisible(self) + }, + + new_goal = function() { + "Find a new location to head towards" + while (all(self$current_goal == self$location) || + (self$domain == WATER && + self$map[[1]]$get_tile(self$current_goal)[[1]]$terrain != WATER)) { + self$current_goal <- round(runif(2, min = 1, max = self$map[[1]]$shape())) + } + invisible(self) + }, + + sp_trust_increment = function() { + "Increment the trust count of the service provider" + self$sp_trust <- self$sp_trust + params$tdu_increment + invisible(self) + }, + + sp_distrust_increment = function() { + "Increment the distrust count of the service provider" + self$sp_distrust <- self$sp_distrust + params$tdu_increment + invisible(self) + }, + + sp_unknown_increment = function() { + "Increment the unknown count of the service provider" + self$sp_unknown <- self$sp_unknown + params$tdu_increment + invisible(self) + }, + + trust_increment = function(id_sender) { + "Increment the trust count of the sender" + self$trust[[id_sender]] <- self$trust[[id_sender]] + 1 + invisible(self) + }, + + unknown_increment = function(id_sender) { + "Increment the unknown count of the sender" + self$unknown[[id_sender]] <- self$unknown[[id_sender]] + 1 + invisible(self) + }, + + distrust_increment = function(id_sender) { + "Increment the distrust count of the sender" + self$distrust[[id_sender]] <- self$distrust[[id_sender]] + 1 + invisible(self) + }, + + send_rec = function(devices) { + "Send a recommendation to the devices" + rs_dir_trust <- self$find_direct_trust( + self$contexts[[self$id]][get_context_index(params$time_now)], + recommendation = TRUE + ) + self$stored_trusts[[self$id]][[params$time_now]] <- rs_dir_trust$trust_comb + self$emit_observation( + self$create_rec(rs_dir_trust), + devices + ) + invisible(self) + }, + + create_rec = function(rs_dir_trust) { + "Create a recommendation" + return( + Observation$new( + self$contexts[[self$id]][get_context_index(params$time_now)], + rs_dir_trust$trust_comb, + self$id, + self$acceptable_recs[[self$id]][[params$time_now]] ) - ) - weight <- cost + euc_dist(loc, self$current_goal) - if (weight < best_weight) { - best_weight <- weight - best_loc <- loc - best_tile <- tile - } + ) + }, + + recieve_observation = function(obs) { + "Receive a recommendation from the sender" + if (length(self$stored_trusts[[obs$id_sender]]) >= params$compression_factor) { + w_context <- find_weighted_context( + c(self$contexts[[obs$id_sender]], obs$context) + ) + self$stored_trusts[[obs$id_sender]] <- `if`( + obs$id_sender == self$id, + self$stored_trusts[[obs$id_sender]] <- direct_trust( + c(self$stored_trusts[[obs$id_sender]], obs$trust), + c(self$contexts[[obs$id_sender]], obs$context), + w_context + ), + self$stored_trusts[[obs$id_sender]] <- indirect_trust( + c(self$stored_trusts[[obs$id_sender]], obs$trust), + self$reputations[[obs$id_sender]], + c(self$contexts[[obs$id_sender]], obs$context), + find_weighted_context(self$contexts[[self$id]]), + w_context + ) + ) + self$contexts[[obs$id_sender]] <- w_context + } else { + cw_len <- length(params$context_weights) + i <- `if`( + params$compression_factor < Inf, + length(self$stored_trusts[[obs$id_sender]]) + 1, + params$time_now + ) + self$contexts[[obs$id_sender]][ + get_context_index(i) + ] <- obs$context + self$stored_trusts[[obs$id_sender]][[i]] <- obs$trust } - } - } - if (!all(is.na(best_loc))) { - self$map[[1]]$get_tile(self$location)[[1]]$rm_device(self$id) - self$location <- best_loc - best_tile$add_device(self) - } - } - self$connect_all() - self$retabulate_all(old_signals) - self$velocity <- min(max(0, self$velocity + rnorm(1)), params$max_velocity) - if (all(self$location == self$current_goal)) { - self$new_goal() - } - self$time_last_moved <- params$time_now - invisible(self) - }, - - disconnect_all = function() { - "Disconnect from all base stations that this is currently connected to" - for (signal in self$map[[1]]$get_tile(self$location)[[1]]$signals) { - signal$disconnect(self) - } - invisible(self) - }, - - connect_all = function() { - "Connect to all base stations currently in range of this" - for (signal in self$map[[1]]$get_tile(self$location)[[1]]$signals) { - signal$connect(self) - } - invisible(self) - }, - - retabulate_all = function(old_signals) { - "After changing from being in one set of signals to another, make + self$calc_acceptability(obs) + invisible(self) + }, + + calc_acceptability = function(obs) { + if (any(self$acceptable_recs[[obs$id_sender]])) { + if (self$acceptable_recs[[obs$id_sender]][[params$time_now - 1]]) { + self$old_trusts[[obs$id_sender]] <- + self$stored_trusts[[obs$id_sender]][[params$time_now - 1]] + self$old_contexts[[obs$id_sender]] <- + self$contexts[[obs$id_sender]][get_context_index(params$time_now - 1)] + } + if (self$old_trusts[[obs$id_sender]] < + (params$delta_a - params$trust_rep_adj_range)) { + self$acceptable_recs[[obs$id_sender]][[params$time_now]] <- + obs$acceptable && ( + obs$trust > (params$delta_a - params$trust_rep_adj_range) || + acceptable_rec( + find_weighted_context( + c( + self$cached_contexts[[obs$id_sender]], + obs$context + ) + ), + self$old_contexts[[obs$id_sender]], + self$old_trusts[[obs$id_sender]] + ) + ) + } else { + self$acceptable_recs[[obs$id_sender]][[params$time_now]] <- obs$acceptable + } + } else { + self$acceptable_recs[[obs$id_sender]][[params$time_now]] <- obs$acceptable + } + invisible(self) + }, + + move = function() { + "Move towards the current goal" + time_change <- params$time_now - self$time_last_moved + old_signals <- self$get_signals() + self$disconnect_all() + movement_amount <- round(self$velocity * time_change) + movement <- `if`(movement_amount > 0, 1:movement_amount, NULL) + for (m in movement) { + best_weight <- Inf + best_loc <- NA + best_tile <- NA + for (i in (self$location[[1]] - 1):(self$location[[1]] + 1)) { + for (j in (self$location[[2]] - 1):(self$location[[2]] + 1)) { + loc <- c(i, j) + tile <- self$map[[1]]$get_tile(loc) + if (!all(loc == self$location) && length(tile)) { + tile <- tile[[1]] + cost <- `if`( + self$domain == AIR, + 1, + `if`( + self$domain == tile$terrain, + 1, + 2 + ) + ) + weight <- cost + euc_dist(loc, self$current_goal) + if (weight < best_weight) { + best_weight <- weight + best_loc <- loc + best_tile <- tile + } + } + } + } + if (!all(is.na(best_loc))) { + self$map[[1]]$get_tile(self$location)[[1]]$rm_device(self$id) + self$location <- best_loc + best_tile$add_device(self) + } + } + self$connect_all() + self$retabulate_all(old_signals) + self$velocity <- min(max(0, self$velocity + rnorm(1)), params$max_velocity) + if (all(self$location == self$current_goal)) { + self$new_goal() + } + self$time_last_moved <- params$time_now + invisible(self) + }, + + disconnect_all = function() { + "Disconnect from all base stations that this is currently connected to" + for (signal in self$map[[1]]$get_tile(self$location)[[1]]$signals) { + signal$disconnect(self) + } + invisible(self) + }, + + connect_all = function() { + "Connect to all base stations currently in range of this" + for (signal in self$map[[1]]$get_tile(self$location)[[1]]$signals) { + signal$connect(self) + } + invisible(self) + }, + + retabulate_all = function(old_signals) { + "After changing from being in one set of signals to another, make them recalculate their routing tables" - if (self$has_signal()) { - check_signals <- self$get_signals() - } else { - check_signals <- old_signals - } - for (signal in check_signals) { - signal$retabulate(self) - } - for (signal in check_signals) { - signal$finish_update() - } - invisible(self) - }, - - has_signal = function() { - "Check whether this has signal" - return(length(self$map[[1]]$get_tile(self$location)[[1]]$signals) > 0) - }, - - get_signals = function() { - "Get the list of signals in range of this" - return(self$map[[1]]$get_tile(self$location)[[1]]$signals) - }, - - transaction = function(devices, can_transact = TRUE) { - "Perform a transaction with a service provider" - normalized_c_target <- normalize(self$get_target_context()) - used_trust <- self$use_trust(normalized_c_target) - self$acceptable_recs[[self$id]][[params$time_now]] <- FALSE - if (can_transact) { - if (used_trust > params$trust_rep_threshold - params$trust_rep_adj_range) { - t_rs <- self$service_provider$provide_service() - if (t_rs == TRUSTED) { - self$sp_trust_increment() - } else if (t_rs == UNKNOWN) { - self$sp_unknown_increment() - } else { - self$sp_distrust_increment() - } - self$acceptable_recs[[self$id]][[params$time_now]] <- TRUE - } - } - self$fill_estimated_trust(used_trust) - self$contexts[[self$id]][get_context_index(params$time_now)] <- normalized_c_target - self$observed_trusts[[params$time_now]] <- weighted_trust( - compute_trust(self$sp_trust, self$sp_distrust, self$sp_unknown), - self$sp_trust, - self$sp_distrust, - self$sp_unknown - ) - invisible(self) - }, - - use_trust = function(normalized_c_target) { - "Calculate the trust value to use" - rs_dir_trust <- self$find_direct_trust(normalized_c_target) - return( - `if`( - abs(rs_dir_trust$trust_comb) <= - (params$trust_rep_threshold + params$trust_rep_adj_range), - self$find_indirect_trust(normalized_c_target), - rs_dir_trust$trust_est - ) - ) - }, - - get_target_context = function() { - "Get the current target context" - if (params$rand_context) { - return( - c( - params$time_now, - runif(1, min = 0, max = params$max_capability), - euc_dist( - round(runif(2, min = 1, max = self$map[[1]]$size())), - self$service_provider$location - ), - runif(1, min = 0, max = params$max_velocity) - ) - ) - } - return( - c( - params$time_now, - self$capability, - euc_dist(self$location, self$service_provider$location), - self$velocity - ) - ) - }, - - find_direct_trust = function(normalized_c_target, recommendation = FALSE) { - "Find the direct trust of the service provider" - trust_evaled <- `if`( - recommendation, - 0, - weighted_trust( - compute_trust(self$sp_trust, self$sp_distrust, self$sp_unknown), - self$sp_trust, - self$sp_distrust, - self$sp_unknown - ) - ) - valid_trusts <- !is.na(self$observed_trusts) - valid_contexts <- !is.na(self$contexts[[self$id]]) - context_weighted <- find_weighted_context(self$contexts[[self$id]][valid_contexts]) - dir_trust <- direct_trust( - c(self$observed_trusts[valid_trusts], trust_evaled), - c(self$contexts[[self$id]][valid_contexts], context_weighted), - context_weighted - ) - self$stored_trusts[[self$id]][[params$time_now]] <- dir_trust - return( - list( - trust_est = estimate_trust( - normalized_c_target, - context_weighted, - dir_trust - ), - # trust_comb = dir_trust, - trust_comb = minimax(dir_trust, -1, 1), - context_weighted = context_weighted - ) - ) - }, - - find_indirect_trust = function(normalized_c_target) { - "Find the indirect trust of the service provider" - considerations <- self$get_considerations() - ac <- unlist(self$get_all_contexts(considerations)) - if (is.null(ac) || length(ac[ac >= 0]) == 0) { - return(params$trust_new_contact) - } - context_weighted <- find_weighted_context(ac) - ind_trust <- self$find_ind(context_weighted, considerations) - return( - estimate_trust( - normalized_c_target, - context_weighted, - ind_trust - ) - ) - }, - - fill_estimated_trust = function(used_trust) { - self$estimated_trusts[[params$time_now]] <- used_trust - invisible(self) - }, - - get_considerations = function(excludes = c()) { - "Find which recommendations should be considered" - return( - lapply( - 1:params$number_nodes, - function(i) { - if (i %in% self$contacts & !i %in% excludes) { - acc_recs <- which( - self$acceptable_recs[[i]] - ) - return( + if (self$has_signal()) { + check_signals <- self$get_signals() + } else { + check_signals <- old_signals + } + for (signal in check_signals) { + signal$retabulate(self) + } + for (signal in check_signals) { + signal$finish_update() + } + invisible(self) + }, + + has_signal = function() { + "Check whether this has signal" + return(length(self$map[[1]]$get_tile(self$location)[[1]]$signals) > 0) + }, + + get_signals = function() { + "Get the list of signals in range of this" + return(self$map[[1]]$get_tile(self$location)[[1]]$signals) + }, + + transaction = function(devices, can_transact = TRUE) { + "Perform a transaction with a service provider" + normalized_c_target <- normalize(self$get_target_context()) + used_trust <- self$use_trust(normalized_c_target) + self$acceptable_recs[[self$id]][[params$time_now]] <- FALSE + if (can_transact) { + if (used_trust > params$trust_rep_threshold - params$trust_rep_adj_range) { + t_rs <- self$service_provider$provide_service() + if (t_rs == TRUSTED) { + self$sp_trust_increment() + } else if (t_rs == UNKNOWN) { + self$sp_unknown_increment() + } else { + self$sp_distrust_increment() + } + self$acceptable_recs[[self$id]][[params$time_now]] <- TRUE + } + } + self$fill_estimated_trust(used_trust) + self$contexts[[self$id]][get_context_index(params$time_now)] <- normalized_c_target + self$observed_trusts[[params$time_now]] <- weighted_trust( + compute_trust(self$sp_trust, self$sp_distrust, self$sp_unknown), + self$sp_trust, + self$sp_distrust, + self$sp_unknown + ) + invisible(self) + }, + + use_trust = function(normalized_c_target) { + "Calculate the trust value to use" + rs_dir_trust <- self$find_direct_trust(normalized_c_target) + return( `if`( - length(acc_recs) > 0, - tail(acc_recs, 1), - 0 + abs(rs_dir_trust$trust_comb) <= + (params$trust_rep_threshold + params$trust_rep_adj_range), + self$find_indirect_trust(normalized_c_target), + rs_dir_trust$trust_est + ) + ) + }, + + get_target_context = function() { + "Get the current target context" + if (params$rand_context) { + return( + c( + params$time_now, + runif(1, min = 0, max = params$max_capability), + euc_dist( + round(runif(2, min = 1, max = self$map[[1]]$size())), + self$service_provider$location + ), + runif(1, min = 0, max = params$max_velocity) + ) ) - ) - } else { - return(0) } - } - ) - ) - }, - - get_all_contexts = function(considerations) { - "Get all of the context values that should be considered" - return( - lapply( - self$contacts, - function(i) { return( - `if`( - considerations[[i]] == 0, - NULL, - self$contexts[[i]][get_context_index(considerations[[i]])] - ) + c( + params$time_now, + self$capability, + euc_dist(self$location, self$service_provider$location), + self$velocity + ) ) - } - ) - ) - }, - - find_ind = function(context_weighted, considerations) { - "Calculate the indirect trust" - ow <- lapply( - self$contacts, - function(i) { - return( - `if`( - considerations[[i]] == 0, - NULL, - omega( - context_weighted, - self$contexts[[i]][ - get_context_index(considerations[[i]]) - ] - ) + }, + + find_direct_trust = function(normalized_c_target, recommendation = FALSE) { + "Find the direct trust of the service provider" + trust_evaled <- `if`( + recommendation, + 0, + weighted_trust( + compute_trust(self$sp_trust, self$sp_distrust, self$sp_unknown), + self$sp_trust, + self$sp_distrust, + self$sp_unknown + ) ) - ) - } - ) - denominator <- sum(unlist(ow)) - numerator <- sum( - unlist( - lapply( - self$contacts, - function(i) { - return( - `if`( - considerations[[i]] == 0, - NULL, - ow[[which(i == self$contacts)]] * ( - omega( - self$cached_contexts[[i]], - self$contexts[[i]][ - get_context_index(considerations[[i]]) - ] - ) * - self$reputations[[i]] * - self$stored_trusts[[i]][considerations[[i]]] - ) + valid_trusts <- !is.na(self$observed_trusts) + valid_contexts <- !is.na(self$contexts[[self$id]]) + context_weighted <- find_weighted_context(self$contexts[[self$id]][valid_contexts]) + dir_trust <- direct_trust( + c(self$observed_trusts[valid_trusts], trust_evaled), + c(self$contexts[[self$id]][valid_contexts], context_weighted), + context_weighted + ) + self$stored_trusts[[self$id]][[params$time_now]] <- dir_trust + return( + list( + trust_est = estimate_trust( + normalized_c_target, + context_weighted, + dir_trust + ), + # trust_comb = dir_trust, + trust_comb = minimax(dir_trust, -1, 1), + context_weighted = context_weighted ) - ) + ) + }, + + find_indirect_trust = function(normalized_c_target) { + "Find the indirect trust of the service provider" + considerations <- self$get_considerations() + ac <- unlist(self$get_all_contexts(considerations)) + if (is.null(ac) || length(ac[ac >= 0]) == 0) { + return(params$trust_new_contact) } - ) - ) - ) - return(numerator / denominator) - }, - - - performance_updates = function() { - lapply( - self$contacts, - function(i) { - self$performance_update(i) - } - ) - invisible(self) - }, - - performance_update = function(id_sender) { - "Update the stored performance of the observer" - if (length(which(self$acceptable_recs[[id_sender]])) >= 1) { - prev_time <- tail(which(self$acceptable_recs[[id_sender]]), 2)[[1]] - if (all(c(self$acceptable_recs[[self$id]][c(prev_time, params$time_now)]))) { - context_trust_now <- self$get_contexts_trust(self$id, params$time_now) - context_trust_prev <- self$get_contexts_trust(self$id, prev_time) - self$update_rep_tdu( - id_sender, - prev_time, - context_trust_now, - context_trust_prev - ) - } else { - lapply( - setdiff(self$contacts, id_sender), - function(i) { - if (all(c(self$acceptable_recs[[i]][c(prev_time, params$time_now)]))) { - context_trust_now <- self$get_contexts_trust(i, params$time_now) - context_trust_prev <- self$get_contexts_trust(i, prev_time) - self$update_rep_tdu( - id_sender, - prev_time, - context_trust_now, - context_trust_prev + context_weighted <- find_weighted_context(ac) + ind_trust <- self$find_ind(context_weighted, considerations) + return( + estimate_trust( + normalized_c_target, + context_weighted, + ind_trust + ) + ) + }, + + fill_estimated_trust = function(used_trust) { + self$estimated_trusts[[params$time_now]] <- used_trust + invisible(self) + }, + + get_considerations = function(excludes = c()) { + "Find which recommendations should be considered" + return( + lapply( + 1:params$number_nodes, + function(i) { + if (i %in% self$contacts & !i %in% excludes) { + acc_recs <- which( + self$acceptable_recs[[i]] + ) + return( + `if`( + length(acc_recs) > 0, + tail(acc_recs, 1), + 0 + ) + ) + } else { + return(0) + } + } + ) + ) + }, + + get_all_contexts = function(considerations) { + "Get all of the context values that should be considered" + return( + lapply( + self$contacts, + function(i) { + return( + `if`( + considerations[[i]] == 0, + NULL, + self$contexts[[i]][get_context_index(considerations[[i]])] + ) + ) + } + ) + ) + }, + + find_ind = function(context_weighted, considerations) { + "Calculate the indirect trust" + ow <- lapply( + self$contacts, + function(i) { + return( + `if`( + considerations[[i]] == 0, + NULL, + omega( + context_weighted, + self$contexts[[i]][ + get_context_index(considerations[[i]]) + ] + ) + ) + ) + } + ) + denominator <- sum(unlist(ow)) + numerator <- sum( + unlist( + lapply( + self$contacts, + function(i) { + return( + `if`( + considerations[[i]] == 0, + NULL, + ow[[which(i == self$contacts)]] * ( + omega( + self$cached_contexts[[i]], + self$contexts[[i]][ + get_context_index(considerations[[i]]) + ] + ) * + self$reputations[[i]] * + self$stored_trusts[[i]][considerations[[i]]] + ) + ) + ) + } + ) ) - } + ) + return(numerator / denominator) + }, + + + performance_updates = function() { + lapply( + self$contacts, + function(i) { + self$performance_update(i) + } + ) + invisible(self) + }, + + performance_update = function(id_sender) { + "Update the stored performance of the observer" + if (length(which(self$acceptable_recs[[id_sender]])) >= 1) { + prev_time <- tail(which(self$acceptable_recs[[id_sender]]), 2)[[1]] + if (all(c(self$acceptable_recs[[self$id]][c(prev_time, params$time_now)]))) { + context_trust_now <- self$get_contexts_trust(self$id, params$time_now) + context_trust_prev <- self$get_contexts_trust(self$id, prev_time) + self$update_rep_tdu( + id_sender, + prev_time, + context_trust_now, + context_trust_prev + ) + } else { + lapply( + setdiff(self$contacts, id_sender), + function(i) { + if (all(c(self$acceptable_recs[[i]][c(prev_time, params$time_now)]))) { + context_trust_now <- self$get_contexts_trust(i, params$time_now) + context_trust_prev <- self$get_contexts_trust(i, prev_time) + self$update_rep_tdu( + id_sender, + prev_time, + context_trust_now, + context_trust_prev + ) + } + } + ) + } } - ) - } - } - invisible(self) - }, - - get_contexts_trust = function(id, time) { - "Get the context and trust of node id from the time" - return( - list( - context = self$contexts[[id]][ - get_context_index(time) - ], - trust = self$stored_trusts[[id]][[time]] - ) - ) - }, - - update_rep_tdu = function(id_sender, prev_time, - context_trust_now, context_trust_prev) { - if (length(context_trust_now) > 0 && length(context_trust_prev) > 0) { - direct_trend <- trend_of_trust( - `if`(prev_time == params$time_now, 0, context_trust_prev$trust), - context_trust_now$trust, - context_trust_prev$context, - context_trust_now$context - ) - indirect_trend <- trend_of_trust( - `if`( - prev_time == params$time_now, - 0, - self$stored_trusts[[id_sender]][[prev_time]] - ), - self$stored_trusts[[id_sender]][[params$time_now]], - self$contexts[[id_sender]][get_context_index(prev_time)], - self$contexts[[id_sender]][get_context_index(params$time_now)] - ) - trends_diff <- abs(direct_trend - indirect_trend) - trends_max <- max(abs(direct_trend), abs(indirect_trend)) - if (trends_diff < trends_max) { - self$trust_increment(id_sender) - } else if (trends_diff <= max(trends_max, params$trend_threshold)) { - self$unknown_increment(id_sender) - } else { - self$distrust_increment(id_sender) - } - } - }, - - combine_reps = function() { - lapply( - self$contacts, - function(i) { - self$combine_rep(i) - } - ) - invisible(self) - }, - - combine_rep = function(id_sender) { - "Find the new reputation for sender of recommendation" - if (self$acceptable_recs[[id_sender]][[params$time_now]]) { - sender_context <- self$contexts[[id_sender]][get_context_index(params$time_now)] - c_new <- find_weighted_context( - c(self$cached_contexts[[id_sender]], sender_context) - ) - self$reputations[[id_sender]] <- minimax( - reputation_combination( - self$old_contexts[[id_sender]], - sender_context, - c_new, - self$reputations[[id_sender]], - weighted_trust( - compute_trust( - self$trust[[id_sender]], - self$distrust[[id_sender]], - self$unknown[[id_sender]] - ), - self$trust[[id_sender]], - self$distrust[[id_sender]], - self$unknown[[id_sender]] + invisible(self) + }, + + get_contexts_trust = function(id, time) { + "Get the context and trust of node id from the time" + return( + list( + context = self$contexts[[id]][ + get_context_index(time) + ], + trust = self$stored_trusts[[id]][[time]] + ) + ) + }, + + update_rep_tdu = function(id_sender, prev_time, + context_trust_now, context_trust_prev) { + if (length(context_trust_now) > 0 && length(context_trust_prev) > 0) { + direct_trend <- trend_of_trust( + `if`(prev_time == params$time_now, 0, context_trust_prev$trust), + context_trust_now$trust, + context_trust_prev$context, + context_trust_now$context + ) + indirect_trend <- trend_of_trust( + `if`( + prev_time == params$time_now, + 0, + self$stored_trusts[[id_sender]][[prev_time]] + ), + self$stored_trusts[[id_sender]][[params$time_now]], + self$contexts[[id_sender]][get_context_index(prev_time)], + self$contexts[[id_sender]][get_context_index(params$time_now)] + ) + trends_diff <- abs(direct_trend - indirect_trend) + trends_max <- max(abs(direct_trend), abs(indirect_trend)) + if (trends_diff < trends_max) { + self$trust_increment(id_sender) + } else if (trends_diff <= max(trends_max, params$trend_threshold)) { + self$unknown_increment(id_sender) + } else { + self$distrust_increment(id_sender) + } + } + }, + + combine_reps = function() { + lapply( + self$contacts, + function(i) { + self$combine_rep(i) + } + ) + invisible(self) + }, + + combine_rep = function(id_sender) { + "Find the new reputation for sender of recommendation" + if (self$acceptable_recs[[id_sender]][[params$time_now]]) { + sender_context <- self$contexts[[id_sender]][get_context_index(params$time_now)] + c_new <- find_weighted_context( + c(self$cached_contexts[[id_sender]], sender_context) + ) + self$reputations[[id_sender]] <- minimax( + reputation_combination( + self$old_contexts[[id_sender]], + sender_context, + c_new, + self$reputations[[id_sender]], + weighted_trust( + compute_trust( + self$trust[[id_sender]], + self$distrust[[id_sender]], + self$unknown[[id_sender]] + ), + self$trust[[id_sender]], + self$distrust[[id_sender]], + self$unknown[[id_sender]] + ) + ), + -1, + 1 + ) + if (abs(self$reputations[[id_sender]]) <= + params$trust_rep_adj_range) { + self$reputations[[id_sender]] <- params$init_reputation + } + self$cached_contexts[[id_sender]] <- c_new + } + invisible(self) + }, + + emit_observation = function(observation, devices) { + "send observation to all contacts" + lapply( + self$contacts, + function(contact) { + connection_data <- self$communicate(contact) + if (connection_data[[1]] < Inf) { + # routed communication + connection_data[[2]]$recieve_observation(observation) + } else if (euc_dist( + devices[[contact]]$location, + self$location + ) <= params$dev_signal_radius) { + # direct communication + devices[[contact]]$recieve_observation(observation) + } + } + ) + invisible(self) + }, + + communicate = function(contact_id) { + "Communicate with a random contact" + this_tile <- self$map[[1]]$get_tile(self$location)[[1]] + best_signal <- 1 + for (i in seq_len(length(this_tile$signals))) { + if (this_tile$signals[[i]]$table$hops[[contact_id]] <= + this_tile$signals[[best_signal]]$table$hops[[contact_id]]) { + best_signal <- i + } + } + if (this_tile$signals[[best_signal]]$table$hops[[contact_id]] < Inf) { + other_device <- this_tile$signals[[best_signal]]$find_device(contact_id) + } else { + other_device <- NULL + } + return( + list( + this_tile$signals[[best_signal]]$table$hops[[contact_id]], + other_device + ) ) - ), - -1, - 1 - ) - if (abs(self$reputations[[id_sender]]) <= - params$trust_rep_adj_range) { - self$reputations[[id_sender]] <- params$init_reputation - } - self$cached_contexts[[id_sender]] <- c_new - } - invisible(self) - }, - - emit_observation = function(observation, devices) { - "send observation to all contacts" - lapply( - self$contacts, - function(contact) { - connection_data <- self$communicate(contact) - if (connection_data[[1]] < Inf) { - # routed communication - connection_data[[2]]$recieve_observation(observation) - } else if (euc_dist( - devices[[contact]]$location, - self$location - ) <= params$dev_signal_radius) { - # direct communication - devices[[contact]]$recieve_observation(observation) - } - } - ) - invisible(self) - }, - - communicate = function(contact_id) { - "Communicate with a random contact" - this_tile <- self$map[[1]]$get_tile(self$location)[[1]] - best_signal <- 1 - for (i in seq_len(length(this_tile$signals))) { - if (this_tile$signals[[i]]$table$hops[[contact_id]] <= - this_tile$signals[[best_signal]]$table$hops[[contact_id]]) { - best_signal <- i } - } - if (this_tile$signals[[best_signal]]$table$hops[[contact_id]] < Inf) { - other_device <- this_tile$signals[[best_signal]]$find_device(contact_id) - } else { - other_device <- NULL - } - return( - list( - this_tile$signals[[best_signal]]$table$hops[[contact_id]], - other_device - ) - ) - } - ) + ) ) diff --git a/li-19/R/Field.R b/li-19/R/Field.R @@ -2,133 +2,133 @@ #' @include Tile.R Field <- R6::R6Class( - "Field", - list( - tiles = list(), - - initialize = function(data = NULL, verbose = F) { - base_stations <- place_base_stations(params$map_width, params$map_height) - self$tiles <- list() - if (verbose) { - cat("Creating field...\n") - } - self$add_tiles(data, base_stations, verbose) - grid_connect(self, base_stations) - invisible(self) - }, - - add_tiles = function(data, base_stations, verbose) { - "Add the tiles of the map" - for (i in 1:params$map_width) { - self$tiles[[i]] <- list() - for (j in 1:params$map_height) { - self$tiles[[i]][[j]] <<- Tile$new( - `if`( - !all(is.null(data)), - data[[i]][[j]], - `if`(round(runif(1)), 1, 0) - ) - ) - self$add_base_stations(base_stations, i, j) + "Field", + list( + tiles = list(), + + initialize = function(data = NULL, verbose = F) { + base_stations <- place_base_stations(params$map_width, params$map_height) + self$tiles <- list() + if (verbose) { + cat("Creating field...\n") + } + self$add_tiles(data, base_stations, verbose) + grid_connect(self, base_stations) + invisible(self) + }, + + add_tiles = function(data, base_stations, verbose) { + "Add the tiles of the map" + for (i in 1:params$map_width) { + self$tiles[[i]] <- list() + for (j in 1:params$map_height) { + self$tiles[[i]][[j]] <<- Tile$new( + `if`( + !all(is.null(data)), + data[[i]][[j]], + `if`(round(runif(1)), 1, 0) + ) + ) + self$add_base_stations(base_stations, i, j) + } + if (verbose) { + cat_progress( + i, + params$map_width, + prefix = sprintf("Column %d of %d", i, params$map_width) + ) + } + } + invisible(self) + }, + + add_base_stations = function(base_stations, i, j) { + "Possibly add base stations or base station signals to the current tile" + for (base_station in base_stations) { + if (euc_dist(base_station$location, c(i, j)) <= params$signal_radius) { + is_edge <- (euc_dist(base_station$location, c(i + 1, j)) > + params$signal_radius) || + (euc_dist(base_station$location, c(i, j + 1)) > + params$signal_radius) || + (euc_dist(base_station$location, c(i - 1, j)) > + params$signal_radius) || + (euc_dist(base_station$location, c(i, j - 1)) > + params$signal_radius) + self$tiles[[i]][[j]]$add_signal( + base_station, + is_edge + ) + } + if (all(base_station$location == c(i, j))) { + self$tiles[[i]][[j]]$add_base_station(base_station) + } + } + invisible(self) + }, + + size = function() { + "Get the size of the field" + return(length(self$tiles)) + }, + + shape = function() { + "Get the shape of the field" + return(c(length(self$tiles[[1]]), length(self$tiles))) + }, + + get_tile = function(location) { + "Get the tile at the location if there is one, otherwise NA" + if (all(location <= self$shape()) && all(location > c(0, 0))) { + return(list(self$tiles[[location[[1]]]][[location[[2]]]])) + } + return(list()) + }, + + add_service_provider = function(sp) { + cur_tile <- self$get_tile(sp$location) + if (length(cur_tile)) { + cur_tile[[1]]$add_service_provider(sp) + } + invisible(self) } - if (verbose) { - cat_progress( - i, - params$map_width, - prefix = sprintf("Column %d of %d", i, params$map_width) - ) - } - } - invisible(self) - }, - - add_base_stations = function(base_stations, i, j) { - "Possibly add base stations or base station signals to the current tile" - for (base_station in base_stations) { - if (euc_dist(base_station$location, c(i, j)) <= params$signal_radius) { - is_edge <- (euc_dist(base_station$location, c(i + 1, j)) > - params$signal_radius) || - (euc_dist(base_station$location, c(i, j + 1)) > - params$signal_radius) || - (euc_dist(base_station$location, c(i - 1, j)) > - params$signal_radius) || - (euc_dist(base_station$location, c(i, j - 1)) > - params$signal_radius) - self$tiles[[i]][[j]]$add_signal( - base_station, - is_edge - ) - } - if (all(base_station$location == c(i, j))) { - self$tiles[[i]][[j]]$add_base_station(base_station) - } - } - invisible(self) - }, - - size = function() { - "Get the size of the field" - return(length(self$tiles)) - }, - - shape = function() { - "Get the shape of the field" - return(c(length(self$tiles[[1]]), length(self$tiles))) - }, - - get_tile = function(location) { - "Get the tile at the location if there is one, otherwise NA" - if (all(location <= self$shape()) && all(location > c(0, 0))) { - return(list(self$tiles[[location[[1]]]][[location[[2]]]])) - } - return(list()) - }, - - add_service_provider = function(sp) { - cur_tile <- self$get_tile(sp$location) - if (length(cur_tile)) { - cur_tile[[1]]$add_service_provider(sp) - } - invisible(self) - } - ) + ) ) # Place the base stations on a rectangle such that the signals cover the # entirety of the rectangle place_base_stations <- function(width, height) { - gap <- compute_gap(params$signal_radius) - base_stations <- list() + gap <- compute_gap(params$signal_radius) + base_stations <- list() - for (i in seq(min(width / 2, gap), width, gap)) { - for (j in seq(min(height / 2, gap), height, gap)) { - base_stations[[length(base_stations) + 1]] <- BaseStation$new(i, j) + for (i in seq(min(width / 2, gap), width, gap)) { + for (j in seq(min(height / 2, gap), height, gap)) { + base_stations[[length(base_stations) + 1]] <- BaseStation$new(i, j) + } } - } - return(base_stations) + return(base_stations) } grid_connect <- function(field, base_stations) { - gap <- compute_gap(params$signal_radius) - for (base_station in base_stations) { - cur_loc <- base_station$location - other_tile <- field$get_tile(cur_loc - c(gap, 0)) - if (length(other_tile)) { - other_station <- other_tile[[1]]$get_base_station() - check_and_add_neighbour(base_station, other_station) - } - other_tile <- field$get_tile(cur_loc - c(0, gap)) - if (length(other_tile)) { - other_station <- other_tile[[1]]$get_base_station() - check_and_add_neighbour(base_station, other_station) + gap <- compute_gap(params$signal_radius) + for (base_station in base_stations) { + cur_loc <- base_station$location + other_tile <- field$get_tile(cur_loc - c(gap, 0)) + if (length(other_tile)) { + other_station <- other_tile[[1]]$get_base_station() + check_and_add_neighbour(base_station, other_station) + } + other_tile <- field$get_tile(cur_loc - c(0, gap)) + if (length(other_tile)) { + other_station <- other_tile[[1]]$get_base_station() + check_and_add_neighbour(base_station, other_station) + } } - } } check_and_add_neighbour <- function(base_station, other_station) { - base_station$add_neighbour(other_station) + base_station$add_neighbour(other_station) } diff --git a/li-19/R/Functions.R b/li-19/R/Functions.R @@ -3,43 +3,43 @@ # Create a progress bar cat_progress <- function(current, total, progress_len = 31, prefix = "", postfix = "") { - progress <- floor(100 * current / total) - progress_bar_progress <- floor(progress_len * progress * 0.01) - - if (progress_bar_progress != 0) { - unprogressed <- progress_len - progress_bar_progress - } else { - unprogressed <- progress_len - 1 - } - - progress_bar <- "[" - progress_bar <- paste( - c( - progress_bar, - `if`( - progress_bar_progress - 2 > 0, - rep("█", progress_bar_progress - 2), - "" - ) - ), - collapse = "" - ) - - progress_bar <- paste(c(progress_bar, rep(" ", unprogressed), "]"), collapse = "") - progress_percent <- paste(c(progress, "%"), collapse = "") - postfix <- paste(c(postfix, `if`(progress == 100, "\n", "")), collapse = "") - - cat(sprintf("\r%s %s %s %s", prefix, progress_bar, progress_percent, postfix)) + progress <- floor(100 * current / total) + progress_bar_progress <- floor(progress_len * progress * 0.01) + + if (progress_bar_progress != 0) { + unprogressed <- progress_len - progress_bar_progress + } else { + unprogressed <- progress_len - 1 + } + + progress_bar <- "[" + progress_bar <- paste( + c( + progress_bar, + `if`( + progress_bar_progress - 2 > 0, + rep("█", progress_bar_progress - 2), + "" + ) + ), + collapse = "" + ) + + progress_bar <- paste(c(progress_bar, rep(" ", unprogressed), "]"), collapse = "") + progress_percent <- paste(c(progress, "%"), collapse = "") + postfix <- paste(c(postfix, `if`(progress == 100, "\n", "")), collapse = "") + + cat(sprintf("\r%s %s %s %s", prefix, progress_bar, progress_percent, postfix)) } # Find the Euclidean distance between the points p and q euc_dist <- function(p, q) { - return(sqrt(sum((p - q)**2))) + return(sqrt(sum((p - q)**2))) } # Find the gap needed for a circles to cover a square surface compute_gap <- function(radius) { - return(round(sqrt(2 * radius**2) * params$gap_factor)) + return(round(sqrt(2 * radius**2) * params$gap_factor)) } diff --git a/li-19/R/Globals.R b/li-19/R/Globals.R @@ -2,7 +2,7 @@ NULL utils::globalVariables( - c("LAND", "WATER", "AIR", "TRUSTED", "UNKNOWN", "DISTRUST", "params") + c("LAND", "WATER", "AIR", "TRUSTED", "UNKNOWN", "DISTRUST", "params") ) LAND <- 0 diff --git a/li-19/R/Normalizers.R b/li-19/R/Normalizers.R @@ -1,37 +1,37 @@ normalize <- function(context) { - normalizers <- c( - normalize_time, - normalize_capability, - normalize_location, - normalize_velocity - ) - - return( - sapply( - seq_len(length(context)), - function(i) { - normalizers[[i]](context[[i]]) - } + normalizers <- c( + normalize_time, + normalize_capability, + normalize_location, + normalize_velocity + ) + + return( + sapply( + seq_len(length(context)), + function(i) { + normalizers[[i]](context[[i]]) + } + ) ) - ) } normalize_time <- function(time) { - return(time) + return(time) } normalize_capability <- function(capability) { - return(1 - (capability / params$max_capability)) + return(1 - (capability / params$max_capability)) } normalize_location <- function(distance) { - return(1 - (distance / sqrt(params$map_width**2 + params$map_height**2))) + return(1 - (distance / sqrt(params$map_width**2 + params$map_height**2))) } normalize_velocity <- function(velocity) { - return(1 - (velocity / params$max_velocity)) + return(1 - (velocity / params$max_velocity)) } diff --git a/li-19/R/Observation.R b/li-19/R/Observation.R @@ -1,17 +1,17 @@ Observation <- R6::R6Class( - "Observation", - list( - context = NULL, - trust = NULL, - id_sender = NULL, - acceptable = NULL, + "Observation", + list( + context = NULL, + trust = NULL, + id_sender = NULL, + acceptable = NULL, - initialize = function(context, trust, id_sender, acceptable = TRUE) { - self$context <- context - self$trust <- trust - self$id_sender <- id_sender - self$acceptable <- acceptable - invisible(self) - } - ) + initialize = function(context, trust, id_sender, acceptable = TRUE) { + self$context <- context + self$trust <- trust + self$id_sender <- id_sender + self$acceptable <- acceptable + invisible(self) + } + ) ) diff --git a/li-19/R/Observer.R b/li-19/R/Observer.R @@ -1,39 +1,39 @@ Observer <- R6::R6Class( - "Observer", - inherit = Device, + "Observer", + inherit = Device, - public = list( - initialize = function(id, sp, map, - loc = round( - runif(2, min = 1, max = c(params$map_width, params$map_height)) - )) { - super$initialize( - id, sp, map, `if`(params$observer_targeted, params$target_location, loc) - ) - if (params$observer_targeted) { - self$capability <- params$target_capability - self$velocity <- params$target_velocity - } - invisible(self) - }, + public = list( + initialize = function(id, sp, map, + loc = round( + runif(2, min = 1, max = c(params$map_width, params$map_height)) + )) { + super$initialize( + id, sp, map, `if`(params$observer_targeted, params$target_location, loc) + ) + if (params$observer_targeted) { + self$capability <- params$target_capability + self$velocity <- params$target_velocity + } + invisible(self) + }, - transaction = function(devices, can_transact = TRUE) { - super$transaction(devices, can_transact) - self$acceptable_recs[[self$id]][[params$time_now]] <- FALSE - }, + transaction = function(devices, can_transact = TRUE) { + super$transaction(devices, can_transact) + self$acceptable_recs[[self$id]][[params$time_now]] <- FALSE + }, - use_trust = function(normalized_c_target) { - rs_dir_trust <- self$find_direct_trust(normalized_c_target) - return(self$find_indirect_trust(normalized_c_target)) - }, + use_trust = function(normalized_c_target) { + rs_dir_trust <- self$find_direct_trust(normalized_c_target) + return(self$find_indirect_trust(normalized_c_target)) + }, - move = function() { - if (params$observer_targeted) { - self$time_last_moved <- params$time_now - } else { - super$move() - } - invisible(self) - } - ) + move = function() { + if (params$observer_targeted) { + self$time_last_moved <- params$time_now + } else { + super$move() + } + invisible(self) + } + ) ) diff --git a/li-19/R/Params.R b/li-19/R/Params.R @@ -1,129 +1,129 @@ Params <- R6::R6Class( - "Params", - list( - number_nodes = 21, - number_good_nodes = 0, - number_service_providers = 1, - signal_radius = 100, - dev_signal_radius = 14, - max_number_contacts = 100, - init_reputation = 0.01, - rep_self = 1, - trust_new_contact = 0, - trust_rep_threshold = 0, - trend_threshold = 0.01, - trust_rep_adj_range = 0.001, - sp_ground_trust = 1, - max_capability = 100, - map_width = 100, - map_height = 100, - max_velocity = 10, - time_now = 1, - context_weights = c(0.3, 0.2, 0.4, 0.1), - eta = c(0.95, 0.7, 0.5, 0.5, 0.7), - alpha = 0.3, - beta = 0.3, - gamma = 0.8, - rho = 0.1, - delta = 0.8, - delta_a = -0.001, - p_r = 1, - theta_i = 0.8, - impact_factor = 1, - eta_i = 1, - gap_factor = 2**-1, - min_trans = 1, - max_trans = 1, - img_width = NULL, - img_height = NULL, - compression_factor = Inf, - number_adversaries = 0, - adversary_type = BadMouther, - contacts_per_node = 10, - rand_context = F, - number_observer_contacts = 10, - tdu_increment = 1, - observer_targeted = F, - target_location = c(1, 1), - target_capability = 50, - target_velocity = 5, + "Params", + list( + number_nodes = 21, + number_good_nodes = 0, + number_service_providers = 1, + signal_radius = 100, + dev_signal_radius = 14, + max_number_contacts = 100, + init_reputation = 0.01, + rep_self = 1, + trust_new_contact = 0, + trust_rep_threshold = 0, + trend_threshold = 0.01, + trust_rep_adj_range = 0.001, + sp_ground_trust = 1, + max_capability = 100, + map_width = 100, + map_height = 100, + max_velocity = 10, + time_now = 1, + context_weights = c(0.3, 0.2, 0.4, 0.1), + eta = c(0.95, 0.7, 0.5, 0.5, 0.7), + alpha = 0.3, + beta = 0.3, + gamma = 0.8, + rho = 0.1, + delta = 0.8, + delta_a = -0.001, + p_r = 1, + theta_i = 0.8, + impact_factor = 1, + eta_i = 1, + gap_factor = 2**-1, + min_trans = 1, + max_trans = 1, + img_width = NULL, + img_height = NULL, + compression_factor = Inf, + number_adversaries = 0, + adversary_type = BadMouther, + contacts_per_node = 10, + rand_context = F, + number_observer_contacts = 10, + tdu_increment = 1, + observer_targeted = F, + target_location = c(1, 1), + target_capability = 50, + target_velocity = 5, - initialize = function() { - self$number_good_nodes <- self$number_nodes - (self$number_adversaries + 1) - self$img_width <- ceiling(5**(1 - self$map_width / 1000)) * self$map_width - self$img_height <- ceiling(5**(1 - self$map_height / 1000)) * self$map_height - invisible(self) - }, + initialize = function() { + self$number_good_nodes <- self$number_nodes - (self$number_adversaries + 1) + self$img_width <- ceiling(5**(1 - self$map_width / 1000)) * self$map_width + self$img_height <- ceiling(5**(1 - self$map_height / 1000)) * self$map_height + invisible(self) + }, - increment_time = function() { - self$time_now <- self$time_now + 1 - invisible(self) - }, + increment_time = function() { + self$time_now <- self$time_now + 1 + invisible(self) + }, - configure = function(data) { - self$number_nodes <- data$number_nodes - self$number_service_providers <- data$number_service_providers - self$signal_radius <- data$signal_radius - self$dev_signal_radius <- data$dev_signal_radius - self$max_number_contacts <- data$max_number_contacts - self$init_reputation <- data$init_reputation - self$rep_self <- data$rep_self - self$trust_new_contact <- data$trust_new_contact - self$trust_rep_threshold <- data$trust_rep_threshold - self$trend_threshold <- data$trend_threshold - self$trust_rep_adj_range <- data$trust_rep_adj_range - self$sp_ground_trust <- data$sp_ground_trust - self$max_capability <- data$max_capability - self$map_width <- data$map_width - self$map_height <- data$map_height - self$max_velocity <- data$max_velocity - self$time_now <- data$time_now - self$context_weights <- data$context_weights - self$eta <- data$eta - self$alpha <- data$alpha - self$beta <- data$beta - self$gamma <- data$gamma - self$rho <- data$rho - self$delta <- data$delta - self$delta_a <- data$delta_a - self$p_r <- data$p_r - self$theta_i <- data$theta_i - self$impact_factor <- data$impact_factor - self$eta_i <- data$eta_i - self$gap_factor <- data$gap_factor - self$min_trans <- data$min_trans - self$tdu_increment <- data$tdu_increment - self$max_trans <- data$max_trans - self$target_location <- data$target_location - self$target_capability <- data$target_capability - self$target_velocity <- data$target_velocity + configure = function(data) { + self$number_nodes <- data$number_nodes + self$number_service_providers <- data$number_service_providers + self$signal_radius <- data$signal_radius + self$dev_signal_radius <- data$dev_signal_radius + self$max_number_contacts <- data$max_number_contacts + self$init_reputation <- data$init_reputation + self$rep_self <- data$rep_self + self$trust_new_contact <- data$trust_new_contact + self$trust_rep_threshold <- data$trust_rep_threshold + self$trend_threshold <- data$trend_threshold + self$trust_rep_adj_range <- data$trust_rep_adj_range + self$sp_ground_trust <- data$sp_ground_trust + self$max_capability <- data$max_capability + self$map_width <- data$map_width + self$map_height <- data$map_height + self$max_velocity <- data$max_velocity + self$time_now <- data$time_now + self$context_weights <- data$context_weights + self$eta <- data$eta + self$alpha <- data$alpha + self$beta <- data$beta + self$gamma <- data$gamma + self$rho <- data$rho + self$delta <- data$delta + self$delta_a <- data$delta_a + self$p_r <- data$p_r + self$theta_i <- data$theta_i + self$impact_factor <- data$impact_factor + self$eta_i <- data$eta_i + self$gap_factor <- data$gap_factor + self$min_trans <- data$min_trans + self$tdu_increment <- data$tdu_increment + self$max_trans <- data$max_trans + self$target_location <- data$target_location + self$target_capability <- data$target_capability + self$target_velocity <- data$target_velocity - self$compression_factor <- `if`( - data$compression_factor <= 0, - Inf, - data$compression_factor - ) - self$number_adversaries <- data$number_adversaries - self$adversary_type <- get_adversary_type(data$adversary_type) - self$contacts_per_node <- data$contacts_per_node - self$rand_context <- data$rand_context - self$observer_targeted <- data$observer_targeted - self$number_good_nodes <- self$number_nodes - (self$number_adversaries + 1) - self$img_width <- ceiling(5**(1 - self$map_width / 1000)) * self$map_width - self$img_height <- ceiling(5**(1 - self$map_height / 1000)) * self$map_height - self$number_observer_contacts <- data$number_observer_contacts - invisible(self) - } - ) + self$compression_factor <- `if`( + data$compression_factor <= 0, + Inf, + data$compression_factor + ) + self$number_adversaries <- data$number_adversaries + self$adversary_type <- get_adversary_type(data$adversary_type) + self$contacts_per_node <- data$contacts_per_node + self$rand_context <- data$rand_context + self$observer_targeted <- data$observer_targeted + self$number_good_nodes <- self$number_nodes - (self$number_adversaries + 1) + self$img_width <- ceiling(5**(1 - self$map_width / 1000)) * self$map_width + self$img_height <- ceiling(5**(1 - self$map_height / 1000)) * self$map_height + self$number_observer_contacts <- data$number_observer_contacts + invisible(self) + } + ) ) get_adversary_type <- function(ad_type) { - if (grepl("BadMouther", ad_type)) { - return(BadMouther) - } else if (grepl("GoodMouther", ad_type)) { - return(GoodMouther) - } else { - return(ContextSetter) - } + if (grepl("BadMouther", ad_type)) { + return(BadMouther) + } else if (grepl("GoodMouther", ad_type)) { + return(GoodMouther) + } else { + return(ContextSetter) + } } diff --git a/li-19/R/ServiceProvider.R b/li-19/R/ServiceProvider.R @@ -1,29 +1,29 @@ ServiceProvider <- R6::R6Class( - "ServiceProvider", - list( - id = NULL, - location = NULL, - transaction_results = NULL, + "ServiceProvider", + list( + id = NULL, + location = NULL, + transaction_results = NULL, - initialize = function(id = 1, p_trust = 1, p_unknown = 0, p_distrust = 0) { - self$id <- id - self$location <- round( - runif(2, min = 1, max = c(params$map_width, params$map_height)) - ) - p_vals <- c(p_trust, p_unknown, p_distrust) - sample_factor <- 10**( - 1 - floor(log(min(p_vals[p_vals != 0]), base = 10)) - ) - self$transaction_results <- c( - rep(TRUSTED, p_trust * sample_factor), - rep(UNKNOWN, p_unknown * sample_factor), - rep(DISTRUST, p_distrust * sample_factor) - ) - invisible(self) - }, + initialize = function(id = 1, p_trust = 1, p_unknown = 0, p_distrust = 0) { + self$id <- id + self$location <- round( + runif(2, min = 1, max = c(params$map_width, params$map_height)) + ) + p_vals <- c(p_trust, p_unknown, p_distrust) + sample_factor <- 10**( + 1 - floor(log(min(p_vals[p_vals != 0]), base = 10)) + ) + self$transaction_results <- c( + rep(TRUSTED, p_trust * sample_factor), + rep(UNKNOWN, p_unknown * sample_factor), + rep(DISTRUST, p_distrust * sample_factor) + ) + invisible(self) + }, - provide_service = function() { - return(sample(self$transaction_results, 1)) - } - ) + provide_service = function() { + return(sample(self$transaction_results, 1)) + } + ) ) diff --git a/li-19/R/Simulation.R b/li-19/R/Simulation.R @@ -14,15 +14,15 @@ NULL run_simulation <- function(total_time, map_filename = system.file( - "extdata", "map.csv", - package = "li19trustmodel" + "extdata", "map.csv", + package = "li19trustmodel" ), config = system.file( - "extdata", "params.json", - package = "li19trustmodel" + "extdata", "params.json", + package = "li19trustmodel" ), write_plots = TRUE) { - return(run_sim_part(total_time, map_filename, rjson::fromJSON(file = config), write_plots)) + return(run_sim_part(total_time, map_filename, rjson::fromJSON(file = config), write_plots)) } @@ -35,101 +35,101 @@ run_simulation <- function(total_time, batch_simulation <- function(total_time, map_filename = system.file( - "extdata", "map.csv", - package = "li19trustmodel" + "extdata", "map.csv", + package = "li19trustmodel" ), config = system.file( - "extdata", "params.json", - package = "li19trustmodel" + "extdata", "params.json", + package = "li19trustmodel" ), num_adversaries = c(0, 2, 5, 8, 10), adversary_types = c("BadMouther", "ContextSetter"), colours = c("blue", "red", "green", "orange", "purple")) { - dir.create("images/plots", recursive = TRUE, showWarning = FALSE) - config <- rjson::fromJSON(file = config) - for (adv_type in adversary_types) { - config$adversary_type <- adv_type - cat(sprintf("Running simulations with adversaries of %s type\n\n", adv_type)) - data_list <- lapply( - num_adversaries, - function(i) { - config$number_adversaries <- i - cat(sprintf("Running simulations with %d adversaries...\n", i)) - return(run_sim_part(total_time, map_filename, config, FALSE)) - } - ) - names(data_list) <- sprintf("%d Adversaries", num_adversaries) - data <- reshape2::melt(data_list, id.vars = "transactions") - data$L1 <- factor( - data$L1, - levels = stringr::str_sort(levels(as.factor(data$L1)), numeric = TRUE) - ) - cat("Creating plots...\n") - ggplot2::ggplot( - data = data, - ggplot2::aes(x = transactions, y = value, colour = as.factor(L1)) - ) + - ggplot2::geom_line() + - ggplot2::scale_colour_manual(values = colours) + - ggplot2::labs( - title = "Estimated Trusts of the Observer", - x = "Time", - y = "Estimated Trust", - colour = NULL - ) + - ggplot2::scale_y_continuous(limits = c(-1.1, 1.1)) + - ggplot2::theme(legend.position = "bottom") - filename <- sprintf("images/plots/%s-estimated_trusts.png", adv_type) - ggplot2::ggsave(file = filename, width = 7, height = 7, dpi = 320, type = "cairo") - cat(sprintf("Saved plot as %s\n", filename)) - } + dir.create("images/plots", recursive = TRUE, showWarning = FALSE) + config <- rjson::fromJSON(file = config) + for (adv_type in adversary_types) { + config$adversary_type <- adv_type + cat(sprintf("Running simulations with adversaries of %s type\n\n", adv_type)) + data_list <- lapply( + num_adversaries, + function(i) { + config$number_adversaries <- i + cat(sprintf("Running simulations with %d adversaries...\n", i)) + return(run_sim_part(total_time, map_filename, config, FALSE)) + } + ) + names(data_list) <- sprintf("%d Adversaries", num_adversaries) + data <- reshape2::melt(data_list, id.vars = "transactions") + data$L1 <- factor( + data$L1, + levels = stringr::str_sort(levels(as.factor(data$L1)), numeric = TRUE) + ) + cat("Creating plots...\n") + ggplot2::ggplot( + data = data, + ggplot2::aes(x = transactions, y = value, colour = as.factor(L1)) + ) + + ggplot2::geom_line() + + ggplot2::scale_colour_manual(values = colours) + + ggplot2::labs( + title = "Estimated Trusts of the Observer", + x = "Time", + y = "Estimated Trust", + colour = NULL + ) + + ggplot2::scale_y_continuous(limits = c(-1.1, 1.1)) + + ggplot2::theme(legend.position = "bottom") + filename <- sprintf("images/plots/%s-estimated_trusts.png", adv_type) + ggplot2::ggsave(file = filename, width = 7, height = 7, dpi = 320, type = "cairo") + cat(sprintf("Saved plot as %s\n", filename)) + } } run_sim_part <- function(total_time, map_filename, config, write_plots) { - params$configure(config) - map_and_devices <- create_map_and_devices(map_filename) - dir.create("images/maps", recursive = TRUE, showWarning = FALSE) - img <- write_map(map_and_devices$map) - cat("Performing transactions...\n") - while (params$time_now <= total_time) { - set_trusts(map_and_devices$devices) - movements <- transact_and_move(map_and_devices$devices) - img <- update_map(params$time_now, movements[[1]], movements[[2]], img, map_and_devices$map) - cat_progress( - params$time_now, - total_time, - prefix = sprintf("Time %d of %d", params$time_now, total_time) - ) - params$increment_time() - } - cat("Done.\n\n") - if (write_plots) { - cat("Plotting estimated trusts...\n") - dir.create("images/plots", showWarning = FALSE) - for (i in 1:params$number_nodes) { - plot_estimated_trust( - i, - map_and_devices$devices - ) - filename <- sprintf("images/plots/device-%d-estimated-trust.png", i) - ggplot2::ggsave(file = filename, width = 7, height = 7, dpi = 320, type = "cairo") - cat_progress( - i, - params$number_nodes, - prefix = sprintf("Device %d of %d", i, params$number_nodes), - postfix = sprintf("Saved to %s", filename) - ) + params$configure(config) + map_and_devices <- create_map_and_devices(map_filename) + dir.create("images/maps", recursive = TRUE, showWarning = FALSE) + img <- write_map(map_and_devices$map) + cat("Performing transactions...\n") + while (params$time_now <= total_time) { + set_trusts(map_and_devices$devices) + movements <- transact_and_move(map_and_devices$devices) + img <- update_map(params$time_now, movements[[1]], movements[[2]], img, map_and_devices$map) + cat_progress( + params$time_now, + total_time, + prefix = sprintf("Time %d of %d", params$time_now, total_time) + ) + params$increment_time() } - } - return( - data.frame( - transactions = seq_len( - length(map_and_devices$devices[[params$number_nodes]]$estimated_trusts) - ), - estimated_trusts = map_and_devices$devices[[params$number_nodes]]$estimated_trusts + cat("Done.\n\n") + if (write_plots) { + cat("Plotting estimated trusts...\n") + dir.create("images/plots", showWarning = FALSE) + for (i in 1:params$number_nodes) { + plot_estimated_trust( + i, + map_and_devices$devices + ) + filename <- sprintf("images/plots/device-%d-estimated-trust.png", i) + ggplot2::ggsave(file = filename, width = 7, height = 7, dpi = 320, type = "cairo") + cat_progress( + i, + params$number_nodes, + prefix = sprintf("Device %d of %d", i, params$number_nodes), + postfix = sprintf("Saved to %s", filename) + ) + } + } + return( + data.frame( + transactions = seq_len( + length(map_and_devices$devices[[params$number_nodes]]$estimated_trusts) + ), + estimated_trusts = map_and_devices$devices[[params$number_nodes]]$estimated_trusts + ) ) - ) } @@ -141,604 +141,653 @@ run_sim_part <- function(total_time, map_filename, config, write_plots) { run_gui <- function(map_filename = system.file("extdata", "map.csv", package = "li19trustmodel"), config = system.file( - "extdata", "params.json", - package = "li19trustmodel" + "extdata", "params.json", + package = "li19trustmodel" )) { - params$configure(rjson::fromJSON(file = config)) - map_and_devices <- create_map_and_devices(map_filename) - dir.create("images/maps", recursive = TRUE, showWarning = FALSE) - dir.create("images/plots", recursive = TRUE, showWarning = FALSE) - img <- write_map(map_and_devices$map) - map_filename <- sprintf("images/maps/map-%d.png", params$time_now) - cat("Performing transactions...\n") - gui_objects <- build_gui(map_and_devices) - repeat { - set_trusts(map_and_devices$devices) - movements <- transact_and_move(map_and_devices$devices) - img <- update_map( - params$time_now, - movements[[1]], - movements[[2]], - img, - map_and_devices$map - ) - gui_objects <- update_gui(gui_objects, map_and_devices, movements, img) - params$increment_time() - } + params$configure(rjson::fromJSON(file = config)) + map_and_devices <- create_map_and_devices(map_filename) + dir.create("images/maps", recursive = TRUE, showWarning = FALSE) + dir.create("images/plots", recursive = TRUE, showWarning = FALSE) + img <- write_map(map_and_devices$map) + map_filename <- sprintf("images/maps/map-%d.png", params$time_now) + cat("Performing transactions...\n") + gui_objects <- build_gui(map_and_devices) + repeat { + set_trusts(map_and_devices$devices) + movements <- transact_and_move(map_and_devices$devices) + img <- update_map( + params$time_now, + movements[[1]], + movements[[2]], + img, + map_and_devices$map + ) + gui_objects <- update_gui(gui_objects, map_and_devices, movements, img) + params$increment_time() + } } build_gui <- function(map_and_devices) { - tt <- tcltk::tktoplevel() - tcltk::tktitle(tt) <- "Li 2019 Trust Model" - tp <- gui_add_frame(tt) - chosen_node_cb <- gui_add_node_chooser(tp) - chosen_node <- find_chosen_node(chosen_node_cb, map_and_devices) - cn <- map_and_devices$devices[[chosen_node]] - gui_add_close_button(tp, map_and_devices, chosen_node) - return( - list( - timelabel = gui_add_time(tp), - maplabel = gui_add_map(tt), - trustlabel = gui_add_trust(tt, map_and_devices), - chosen_node_cb = chosen_node_cb, - chosen_node = chosen_node, - contextvals_label = gui_add_context(tp, cn), - reps_label = gui_add_reputations(tp, map_and_devices, cn), - netlabel = gui_add_network(tt, cn), - old_chosen_node = chosen_node + tt <- tcltk::tktoplevel() + tcltk::tktitle(tt) <- "Li 2019 Trust Model" + tp <- gui_add_frame(tt) + chosen_node_cb <- gui_add_node_chooser(tp) + chosen_node <- find_chosen_node(chosen_node_cb, map_and_devices) + cn <- map_and_devices$devices[[chosen_node]] + gui_add_close_button(tp, map_and_devices, chosen_node) + return( + list( + timelabel = gui_add_time(tp), + maplabel = gui_add_map(tt), + trustlabel = gui_add_trust(tt, map_and_devices), + chosen_node_cb = chosen_node_cb, + chosen_node = chosen_node, + contextvals_label = gui_add_context(tp, cn), + reps_label = gui_add_reputations(tp, map_and_devices, cn), + netlabel = gui_add_network(tt, cn), + old_chosen_node = chosen_node + ) ) - ) } gui_add_map <- function(tt) { - tcltk::tcl( - "image", - "create", - "photo", - "map", - file = sprintf("images/maps/map-%d.png", params$time_now) - ) - maplabel <- tcltk2::tk2label(tt, image = "map", compound = "image") - tcltk::tkgrid(maplabel, row = "0", column = "0") - return(maplabel) + tcltk::tcl( + "image", + "create", + "photo", + "map", + file = sprintf("images/maps/map-%d.png", params$time_now) + ) + maplabel <- tcltk2::tk2label(tt, image = "map", compound = "image") + tcltk::tkgrid(maplabel, row = "0", column = "0") + return(maplabel) } gui_add_trust <- function(tt, map_and_devices) { - filename <- tempfile(fileext = ".png") - Cairo::CairoPNG(filename = filename, width = params$img_width, height = params$img_height) - print( - plot_estimated_trust( - length(map_and_devices$devices), - map_and_devices$devices + filename <- tempfile(fileext = ".png") + Cairo::CairoPNG(filename = filename, width = params$img_width, height = params$img_height) + print( + plot_estimated_trust( + length(map_and_devices$devices), + map_and_devices$devices + ) ) - ) - dev.off() - tcltk::tcl("image", "create", "photo", "trustest", file = filename) - trustlabel <- tcltk2::tk2label(tt, image = "trustest", compound = "image") - tcltk::tkgrid(trustlabel, row = "0", column = "1") - return(trustlabel) + dev.off() + tcltk::tcl("image", "create", "photo", "trustest", file = filename) + trustlabel <- tcltk2::tk2label(tt, image = "trustest", compound = "image") + tcltk::tkgrid(trustlabel, row = "0", column = "1") + return(trustlabel) } gui_add_frame <- function(tt) { - tp <- tcltk2::tk2frame(tt) - tcltk::tkgrid(tp, row = "1", column = "1") - return(tp) + tp <- tcltk2::tk2frame(tt) + tcltk::tkgrid(tp, row = "1", column = "1") + return(tp) } gui_add_time <- function(tt) { - timelabel <- tcltk2::tk2label(tt, text = sprintf("Current time: %d", params$time_now)) - tcltk::tkgrid(timelabel, row = "0", column = "1") - return(timelabel) + timelabel <- tcltk2::tk2label(tt, text = sprintf("Current time: %d", params$time_now)) + tcltk::tkgrid(timelabel, row = "0", column = "1") + return(timelabel) } gui_add_node_chooser <- function(tt) { - tcltk::tkgrid(tcltk2::tk2label(tt, text = "Chosen node: "), row = "1", column = "0") - chosen_node_cb <- tcltk::ttkcombobox( - tt, - textvariable = paste(), - values = seq_len(params$number_nodes) - ) - tcltk::tkgrid(chosen_node_cb, row = "1", column = "1") - return(chosen_node_cb) + tcltk::tkgrid(tcltk2::tk2label(tt, text = "Chosen node: "), row = "1", column = "0") + chosen_node_cb <- tcltk::ttkcombobox( + tt, + textvariable = paste(), + values = seq_len(params$number_nodes) + ) + tcltk::tkgrid(chosen_node_cb, row = "1", column = "1") + return(chosen_node_cb) } update_gui <- function(gui_objects, map_and_devices, movements, img) { - gui_update_map() - gui_objects$chosen_node <- find_chosen_node(gui_objects$chosen_node_cb, map_and_devices) - gui_update_trust(gui_objects$chosen_node, map_and_devices) - cn <- map_and_devices$devices[[gui_objects$chosen_node]] - if (gui_objects$chosen_node != gui_objects$old_chosen_node) { - gui_update_network(cn) - gui_objects$old_chosen_node <- gui_objects$chosen_node - } - gui_update_time(gui_objects) - gui_update_context(gui_objects, cn) - gui_update_reputation(gui_objects, cn, map_and_devices) - return(gui_objects) + gui_update_map() + gui_objects$chosen_node <- find_chosen_node(gui_objects$chosen_node_cb, map_and_devices) + gui_update_trust(gui_objects$chosen_node, map_and_devices) + cn <- map_and_devices$devices[[gui_objects$chosen_node]] + if (gui_objects$chosen_node != gui_objects$old_chosen_node) { + gui_update_network(cn) + gui_objects$old_chosen_node <- gui_objects$chosen_node + } + gui_update_time(gui_objects) + gui_update_context(gui_objects, cn) + gui_update_reputation(gui_objects, cn, map_and_devices) + return(gui_objects) } gui_update_map <- function() { - tcltk::tcl( - "image", - "create", - "photo", - "map", - file = sprintf("images/maps/map-%d.png", params$time_now) - ) + tcltk::tcl( + "image", + "create", + "photo", + "map", + file = sprintf("images/maps/map-%d.png", params$time_now) + ) } gui_update_trust <- function(chosen_node, map_and_devices) { - filename <- tempfile(fileext = ".png") - Cairo::CairoPNG(filename = filename, width = params$img_width, height = params$img_height) - print( - plot_estimated_trust( - chosen_node, - map_and_devices$devices + filename <- tempfile(fileext = ".png") + Cairo::CairoPNG(filename = filename, width = params$img_width, height = params$img_height) + print( + plot_estimated_trust( + chosen_node, + map_and_devices$devices + ) ) - ) - dev.off() - tcltk::tcl("image", "create", "photo", "trustest", file = filename) + dev.off() + tcltk::tcl("image", "create", "photo", "trustest", file = filename) } gui_update_network <- function(cn) { - filename <- tempfile(fileext = ".png") - Cairo::CairoPNG( - filename = filename, - width = params$img_width, - height = params$img_height - ) - plot_network(cn) - dev.off() - tcltk::tcl("image", "create", "photo", "network", file = filename) + filename <- tempfile(fileext = ".png") + Cairo::CairoPNG( + filename = filename, + width = params$img_width, + height = params$img_height + ) + plot_network(cn) + dev.off() + tcltk::tcl("image", "create", "photo", "network", file = filename) } gui_update_time <- function(gui_objects) { - tcltk::tkconfigure( - gui_objects$timelabel, - text = sprintf("Current time: %d", params$time_now) - ) + tcltk::tkconfigure( + gui_objects$timelabel, + text = sprintf("Current time: %d", params$time_now) + ) } gui_update_context <- function(gui_objects, cn) { - tcltk::tkconfigure( - gui_objects$contextvals_label, - text = paste( - sprintf( - "%s:\t%f", - c("Capability", "Distance", "Velocity"), - cn$get_target_context()[2:4] - ), - collapse = "\n" + tcltk::tkconfigure( + gui_objects$contextvals_label, + text = paste( + sprintf( + "%s:\t%f", + c("Capability", "Distance", "Velocity"), + cn$get_target_context()[2:4] + ), + collapse = "\n" + ) ) - ) } gui_update_reputation <- function(gui_objects, cn, map_and_devices) { - tcltk::tkconfigure( - gui_objects$reps_label, - text = paste( - sprintf( - "Node %d:\t%f", - seq_len(length(map_and_devices$devices)), - cn$reputations - ), - collapse = "\n" + tcltk::tkconfigure( + gui_objects$reps_label, + text = paste( + sprintf( + "Node %d:\t%f", + seq_len(length(map_and_devices$devices)), + cn$reputations + ), + collapse = "\n" + ) ) - ) } find_chosen_node <- function(chosen_node_cb, map_and_devices) { - chosen_node <- as.integer(tcltk::tkget(chosen_node_cb)) - return( - `if`( - length(chosen_node) == 0 || - is.na(chosen_node) || - chosen_node > length(map_and_devices$devices), - length(map_and_devices$devices), - chosen_node + chosen_node <- as.integer(tcltk::tkget(chosen_node_cb)) + return( + `if`( + length(chosen_node) == 0 || + is.na(chosen_node) || + chosen_node > length(map_and_devices$devices), + length(map_and_devices$devices), + chosen_node + ) ) - ) } gui_add_context <- function(tt, cn) { - tcltk::tkgrid(tcltk2::tk2label(tt, text = "Contexts:"), row = "2", column = "0") - contextvals_label <- tcltk2::tk2label( - tt, - text = paste( - sprintf( - "%s:\t%f", - c("Capability", "Distance", "Velocity"), - cn$get_target_context()[2:4] - ), - collapse = "\n" + tcltk::tkgrid(tcltk2::tk2label(tt, text = "Contexts:"), row = "2", column = "0") + contextvals_label <- tcltk2::tk2label( + tt, + text = paste( + sprintf( + "%s:\t%f", + c("Capability", "Distance", "Velocity"), + cn$get_target_context()[2:4] + ), + collapse = "\n" + ) ) - ) - tcltk::tkgrid(contextvals_label, row = "2", column = "1") - return(contextvals_label) + tcltk::tkgrid(contextvals_label, row = "2", column = "1") + return(contextvals_label) } gui_add_reputations <- function(tt, map_and_devices, cn) { - tcltk::tkgrid(tcltk2::tk2label(tt, text = "Reputations:"), row = "3", column = "0") - reps_label <- tcltk2::tk2label( - tt, - text = paste( - sprintf( - "Node %d:\t%f", - 1:length(map_and_devices$devices), - cn$reputations - ), - collapse = "\n" + tcltk::tkgrid(tcltk2::tk2label(tt, text = "Reputations:"), row = "3", column = "0") + reps_label <- tcltk2::tk2label( + tt, + text = paste( + sprintf( + "Node %d:\t%f", + 1:length(map_and_devices$devices), + cn$reputations + ), + collapse = "\n" + ) ) - ) - tcltk::tkgrid(reps_label, row = "3", column = "1") - return(reps_label) + tcltk::tkgrid(reps_label, row = "3", column = "1") + return(reps_label) } gui_add_network <- function(tt, cn) { - filename <- tempfile(fileext = ".png") - Cairo::CairoPNG(filename = filename, width = params$img_width, height = params$img_height) - plot_network(cn) - dev.off() - tcltk::tcl("image", "create", "photo", "network", file = filename) - netlabel <- tcltk2::tk2label(tt, image = "network", compound = "image") - tcltk::tkgrid(netlabel, row = "1", column = "0") - return(netlabel) + filename <- tempfile(fileext = ".png") + Cairo::CairoPNG(filename = filename, width = params$img_width, height = params$img_height) + plot_network(cn) + dev.off() + tcltk::tcl("image", "create", "photo", "network", file = filename) + netlabel <- tcltk2::tk2label(tt, image = "network", compound = "image") + tcltk::tkgrid(netlabel, row = "1", column = "0") + return(netlabel) } gui_add_close_button <- function(tt, map_and_devices, chosen_node) { - tcltk::tkgrid(tcltk2::tk2label(tt, text = " "), row = "4", column = "1") - tcltk::tkgrid( - tcltk2::tk2button( - tt, - text = "Save and Exit", - command = function() { - plot_estimated_trust( - chosen_node, - map_and_devices$devices - ) - filename <- sprintf( - "images/plots/device-%d-estimated-trust.png", - chosen_node - ) - ggplot2::ggsave(file = filename, width = 7, height = 7, dpi = 320, type = "cairo") - cat(sprintf("Saved estimated trust plot to %s\n", filename)) - cat("Bye.\n") - tcltk::tkdestroy(tt) - quit("no") - } - ), - row = "5", - column = "1" - ) + tcltk::tkgrid(tcltk2::tk2label(tt, text = " "), row = "4", column = "1") + tcltk::tkgrid( + tcltk2::tk2button( + tt, + text = "Save and Exit", + command = function() { + plot_estimated_trust( + chosen_node, + map_and_devices$devices + ) + filename <- sprintf( + "images/plots/device-%d-estimated-trust.png", + chosen_node + ) + ggplot2::ggsave(file = filename, width = 7, height = 7, dpi = 320, type = "cairo") + cat(sprintf("Saved estimated trust plot to %s\n", filename)) + cat("Bye.\n") + tcltk::tkdestroy(tt) + quit("no") + } + ), + row = "5", + column = "1" + ) } write_map <- function(map, save = TRUE) { - cat("Creating map image...\n") - red <- matrix(0, nrow = params$img_height, ncol = params$img_width) - green <- matrix(0, nrow = params$img_height, ncol = params$img_width) - blue <- matrix(0, nrow = params$img_height, ncol = params$img_width) - img <- array( - c(red, green, blue), - dim = c(params$img_height, params$img_width, 3) - ) - width_factor <- ceiling(params$img_width / params$map_width) - height_factor <- ceiling(params$img_height / params$map_height) - for (i in 1:params$map_height) { - for (j in 1:params$map_width) { - cur_tile <- map$get_tile(c(i, j))[[1]] - for (k in 1:height_factor) { - for (l in 1:width_factor) { - img[ - (i - 1) * height_factor + k, - (j - 1) * width_factor + l, - ] <- draw_map(cur_tile) + cat("Creating map image...\n") + red <- matrix(0, nrow = params$img_height, ncol = params$img_width) + green <- matrix(0, nrow = params$img_height, ncol = params$img_width) + blue <- matrix(0, nrow = params$img_height, ncol = params$img_width) + img <- array( + c(red, green, blue), + dim = c(params$img_height, params$img_width, 3) + ) + width_factor <- ceiling(params$img_width / params$map_width) + height_factor <- ceiling(params$img_height / params$map_height) + for (i in 1:params$map_height) { + for (j in 1:params$map_width) { + cur_tile <- map$get_tile(c(i, j))[[1]] + for (k in 1:height_factor) { + for (l in 1:width_factor) { + img[ + (i - 1) * height_factor + k, + (j - 1) * width_factor + l, + ] <- draw_map(cur_tile) + } + } } - } + cat_progress( + i, + params$map_height, + prefix = sprintf("Row %d of %d", i, params$map_height) + ) } - cat_progress( - i, - params$map_height, - prefix = sprintf("Row %d of %d", i, params$map_height) - ) - } - if (save) { - filename <- sprintf("images/maps/map-%d.png", params$time_now) - png::writePNG(img, filename) - cat(sprintf("Written %s\n", filename)) - } - return(img) + if (save) { + filename <- sprintf("images/maps/map-%d.png", params$time_now) + png::writePNG(img, filename) + cat(sprintf("Written %s\n", filename)) + } + return(img) } update_map <- function(time, old_locs, new_locs, img, map, save = TRUE) { - img <- update_map_locs(old_locs, img, map) - img <- update_map_locs(new_locs, img, map) - if (save) { - filename <- sprintf("images/maps/map-%d.png", time) - png::writePNG(img, filename) - } - return(img) + img <- update_map_locs(old_locs, img, map) + img <- update_map_locs(new_locs, img, map) + if (save) { + filename <- sprintf("images/maps/map-%d.png", time) + png::writePNG(img, filename) + } + return(img) } update_map_locs <- function(locs, img, map) { - width_factor <- ceiling(params$img_width / params$map_width) - height_factor <- ceiling(params$img_height / params$map_height) - for (loc in locs) { - cur_tile <- map$get_tile(loc)[[1]] - for (i in 1:height_factor) { - for (j in 1:width_factor) { - img[ - (loc[[1]] - 1) * height_factor + i, (loc[[2]] - 1) - * width_factor + j, - ] <- draw_map(cur_tile) - } + width_factor <- ceiling(params$img_width / params$map_width) + height_factor <- ceiling(params$img_height / params$map_height) + for (loc in locs) { + cur_tile <- map$get_tile(loc)[[1]] + for (i in 1:height_factor) { + for (j in 1:width_factor) { + img[ + (loc[[1]] - 1) * height_factor + i, (loc[[2]] - 1) + * width_factor + j, + ] <- draw_map(cur_tile) + } + } } - } - return(img) + return(img) } draw_map <- function(cur_tile) { - result <- c(0, 0, 0) - if (cur_tile$terrain == WATER) { - result <- c(0.063, 0.612, 0.820) - } else { - result <- c(0.549, 0.761, 0.376) - } - if (cur_tile$signal_edge) { - result <- sapply( - result, - function(i) { - max(0, result[[i]] - 0.1) - } - ) - } - if (length(cur_tile$service_provider)) { - result <- c(0, 1, 0) - } - if (length(cur_tile$base_station)) { - result <- c(0.2, 0.2, 0.2) - } - if (cur_tile$has_devices()) { - dev_class <- class(cur_tile$get_first_dev())[[1]] - if (grepl("Device", dev_class)) { - result <- c(0, 0, 1) - } else if (grepl("Observer", dev_class)) { - result <- c(0.4, 0.4, 0.4) + result <- c(0, 0, 0) + if (cur_tile$terrain == WATER) { + result <- c(0.063, 0.612, 0.820) } else { - result <- c(1, 0, 0) + result <- c(0.549, 0.761, 0.376) + } + if (cur_tile$signal_edge) { + result <- sapply( + result, + function(i) { + max(0, result[[i]] - 0.1) + } + ) + } + if (length(cur_tile$service_provider)) { + result <- c(0, 1, 0) + } + if (length(cur_tile$base_station)) { + result <- c(0.2, 0.2, 0.2) + } + if (cur_tile$has_devices()) { + dev_class <- class(cur_tile$get_first_dev())[[1]] + if (grepl("Device", dev_class)) { + result <- c(0, 0, 1) + } else if (grepl("Observer", dev_class)) { + result <- c(0.4, 0.4, 0.4) + } else { + result <- c(1, 0, 0) + } } - } - return(result) + return(result) } create_map_and_devices <- function(map_filename) { - sp <- ServiceProvider$new() - map <- Field$new(read.csv(map_filename, header = F), T) - map$add_service_provider(sp) - return(list(map = map, devices = create_devices(sp, map))) + sp <- ServiceProvider$new() + map <- Field$new(read.csv(map_filename, header = F), T) + map$add_service_provider(sp) + return(list(map = map, devices = create_devices(sp, map))) +} + + +new_map_and_devices <- function(map_filename, devices) { + sp <- ServiceProvider$new() + map <- Field$new(read.csv(map_filename, header = F), T) + map$add_service_provider(sp) + return(list(map = map, devices = copy_devices(sp, map, devices))) } create_devices <- function(sp, map) { - cat("Creating devices...\n") - devices <- create_adversaries(sp, map) - devices <- create_honest_nodes(sp, map, devices) - assign_contacts(devices) - i <- length(devices) + 1 - devices[[i]] <- create_observer(i, sp, map) - assign_observer_contacts(devices) - return(devices) + cat("Creating devices...\n") + devices <- create_adversaries(sp, map) + devices <- create_honest_nodes(sp, map, devices) + # devices <- create_nodes(sp, map) + assign_contacts(devices) + i <- length(devices) + 1 + devices[[i]] <- create_observer(i, sp, map) + assign_observer_contacts(devices) + return(devices) +} + + +copy_devices <- function(sp, map, devices) { + cat("Copying devices...") + return(copy_nodes(sp, map, devices)) } create_adversaries <- function(sp, map) { - return( - lapply( - seq_len(params$number_adversaries), - function(i) { - cat_progress( - i, - params$number_nodes, - prefix = sprintf("Device %d of %d", i, params$number_nodes) + return( + lapply( + seq_len(params$number_adversaries), + function(i) { + cat_progress( + i, + params$number_nodes, + prefix = sprintf("Device %d of %d", i, params$number_nodes) + ) + return(params$adversary_type$new(i, sp, map)) + } ) - return(params$adversary_type$new(i, sp, map)) - } ) - ) } +make_adversaries <- function(sp, map, devices) { + for (i in seq_len(params$number_adversaries)) { + cat_progress( + i, + params$number_adversaries, + prefix = sprintf("Device %d of %d", i, params$number_adversaries) + ) + return(params$adversary_type$new(i, sp, map, copy = devices[[i]])) + } + return(devices) +} + + +# copy_nodes <- function(sp, map, devices) { +# for (i in seq_len(params$number)) +# } + + create_honest_nodes <- function(sp, map, devices) { - for (i in seq_len(params$number_good_nodes)) { - dev_id <- params$number_adversaries + i - cat_progress( - dev_id, - params$number_nodes, - prefix = sprintf("Device %d of %d", i, params$number_nodes) + for (i in seq_len(params$number_good_nodes)) { + dev_id <- params$number_adversaries + i + cat_progress( + dev_id, + params$number_nodes, + prefix = sprintf("Device %d of %d", i, params$number_nodes) + ) + devices[[dev_id]] <- Device$new(dev_id, sp, map) + } + return(devices) +} + +create_nodes <- function(sp, map) { + return( + lapply( + seq_len(params$number_nodes), + function(i) { + cat_progress( + dev_id, + params$number_nodes, + prefix = sprintf("Device %d of %d", i, params$number_nodes) + ) + return(Device$new(i, sp, map)) + } + ) ) - devices[[dev_id]] <- Device$new(dev_id, sp, map) - } - return(devices) } create_observer <- function(i, sp, map) { - obs <- Observer$new(i, sp, map) - cat_progress( - i, - params$number_nodes, - prefix = sprintf("Device %d of %d", i, params$number_nodes) - ) - return(obs) + obs <- Observer$new(i, sp, map) + cat_progress( + i, + params$number_nodes, + prefix = sprintf("Device %d of %d", i, params$number_nodes) + ) + return(obs) } assign_contacts <- function(devices) { - lapply( - seq_len(length(devices)), - function(i) { - if (i <= params$number_adversaries) { - devices[[i]]$add_contact( - setdiff(1:length(devices), i), - devices - ) - } else { - devices[[i]]$add_contact( - sample( - setdiff(1:length(devices), i), - min(params$contacts_per_node, params$number_nodes - 2) - ), - devices - ) - } + lapply( + seq_len(length(devices)), + function(i) { + if (i <= params$number_adversaries) { + devices[[i]]$add_contact( + setdiff(1:length(devices), i), + devices + ) + } else { + devices[[i]]$add_contact( + sample( + setdiff(1:length(devices), i), + min(params$contacts_per_node, params$number_nodes - 2) + ), + devices + ) + } + } + ) + if (params$number_adversaries + 1 < params$number_nodes) { + i <- params$number_adversaries + 1 + devices[[i]]$add_contact(setdiff(1:length(devices), i), devices) } - ) - if (params$number_adversaries + 1 < params$number_nodes) { - i <- params$number_adversaries + 1 - devices[[i]]$add_contact(setdiff(1:length(devices), i), devices) - } } assign_observer_contacts <- function(devices) { - adv_ids <- `if`( - params$number_adversaries == 0, - NULL, - 1:params$number_adversaries - ) - num_norm_con <- params$number_observer_contacts - params$number_adversaries - 1 - possible_contacts <- (params$number_adversaries + 2): - (params$number_adversaries + params$number_good_nodes) - devices[[length(devices)]]$add_contact( - c( - `if`( - length(possible_contacts) > 1, - sample( - possible_contacts, - `if`(num_norm_con < 0, 0, num_norm_con) + adv_ids <- `if`( + params$number_adversaries == 0, + NULL, + 1:params$number_adversaries + ) + num_norm_con <- params$number_observer_contacts - params$number_adversaries - 1 + possible_contacts <- (params$number_adversaries + 2): + (params$number_adversaries + params$number_good_nodes) + devices[[length(devices)]]$add_contact( + c( + `if`( + length(possible_contacts) > 1, + sample( + possible_contacts, + `if`(num_norm_con < 0, 0, num_norm_con) + ), + possible_contacts + ), + `if`(num_norm_con > 0, params$number_adversaries + 1, NULL), + adv_ids ), - possible_contacts - ), - `if`(num_norm_con > 0, params$number_adversaries + 1, NULL), - adv_ids - ), - devices - ) - cat( - sprintf( - "The observer has %d contacts where %d %s\n", - length(devices[[length(devices)]]$contacts), - length(adv_ids), - `if`(length(adv_ids) == 1, "is an adversary", "are adversaries") + devices + ) + cat( + sprintf( + "The observer has %d contacts where %d %s\n", + length(devices[[length(devices)]]$contacts), + length(adv_ids), + `if`(length(adv_ids) == 1, "is an adversary", "are adversaries") + ) ) - ) } set_trusts <- function(devices) { - for (device in devices) { - device$set_trusts() - } + for (device in devices) { + device$set_trusts() + } } transact_and_move <- function(devices) { - old_locs <- list() - new_locs <- list() - for (device in devices) { - old_locs[[device$id]] <- device$location - if (device$has_signal()) { - amount_transactions <- params$min_trans:round( - runif(1, min = params$min_trans, max = params$max_trans) - ) - for (i in setdiff(amount_transactions, 0)) { - device$transaction(devices) - } - if (length(setdiff(amount_transactions, 0)) >= 1) { - device$send_rec(devices) - } - } else { - device$transactions(devices, can_transact = FALSE) + old_locs <- list() + new_locs <- list() + for (device in devices) { + old_locs[[device$id]] <- device$location + if (device$has_signal()) { + amount_transactions <- params$min_trans:round( + runif(1, min = params$min_trans, max = params$max_trans) + ) + for (i in setdiff(amount_transactions, 0)) { + device$transaction(devices) + } + if (length(setdiff(amount_transactions, 0)) >= 1) { + device$send_rec(devices) + } + } else { + device$transactions(devices, can_transact = FALSE) + } + device$move() + new_locs[[device$id]] <- device$location } - device$move() - new_locs[[device$id]] <- device$location - } - for (device in devices) { - device$performance_updates() - device$combine_reps() - } - return(list(old_locs, new_locs)) + for (device in devices) { + device$performance_updates() + device$combine_reps() + } + return(list(old_locs, new_locs)) } plot_estimated_trust <- function(dev_id, devices) { - data <- data.frame( - transactions = seq_len(length(devices[[dev_id]]$estimated_trusts)), - estimated_trusts = devices[[dev_id]]$estimated_trusts - ) - plt <- ggplot2::ggplot(data = data, ggplot2::aes(x = transactions, y = estimated_trusts)) + - ggplot2::labs( - title = `if`( - dev_id == params$number_nodes, - "Estimated Trusts of Device the Observer", - sprintf("Estimated Trusts of Device %d", dev_id) - ), - x = "Time", - y = "Estimated Trust", - colour = NULL - ) + - ggplot2::scale_y_continuous(limits = c(-1.1, 1.1)) - line_colour <- `if`(dev_id <= params$number_adversaries, "red", "blue") - return( - `if`( - length(devices[[dev_id]]$estimated_trusts) > 1, - plt + ggplot2::geom_line(colour = line_colour), - plt + ggplot2::geom_point(colour = line_colour) + data <- data.frame( + transactions = seq_len(length(devices[[dev_id]]$estimated_trusts)), + estimated_trusts = devices[[dev_id]]$estimated_trusts + ) + plt <- ggplot2::ggplot(data = data, ggplot2::aes(x = transactions, y = estimated_trusts)) + + ggplot2::labs( + title = `if`( + dev_id == params$number_nodes, + "Estimated Trusts of Device the Observer", + sprintf("Estimated Trusts of Device %d", dev_id) + ), + x = "Time", + y = "Estimated Trust", + colour = NULL + ) + + ggplot2::scale_y_continuous(limits = c(-1.1, 1.1)) + line_colour <- `if`(dev_id <= params$number_adversaries, "red", "blue") + return( + `if`( + length(devices[[dev_id]]$estimated_trusts) > 1, + plt + ggplot2::geom_line(colour = line_colour), + plt + ggplot2::geom_point(colour = line_colour) + ) ) - ) } csv_estimated_trust <- function(dev_id, devices) { - write.csv( - data.frame( - transactions = seq_len(length(devices[[dev_id]]$estimated_trusts)), - estimated_trusts = devices[[dev_id]]$estimated_trusts - ), - file = sprintf("%d-estimated-trusts.csv", dev_id), - row.names = FALSE - ) + write.csv( + data.frame( + transactions = seq_len(length(devices[[dev_id]]$estimated_trusts)), + estimated_trusts = devices[[dev_id]]$estimated_trusts + ), + file = sprintf("%d-estimated-trusts.csv", dev_id), + row.names = FALSE + ) } plot_network <- function(dev) { - g <- igraph::make_empty_graph() - g <- igraph::add_vertices(g, params$number_adversaries, color = "red", label.color = "white") - g <- igraph::add_vertices(g, params$number_good_nodes, color = "blue", label.color = "white") - g <- igraph::add_vertices(g, 1, color = "gray") - for (i in dev$contacts) { - g <- igraph::add_edges(g, c(dev$id, i)) - } - plot(igraph::as.undirected(g, "collapse")) + g <- igraph::make_empty_graph() + g <- igraph::add_vertices(g, params$number_adversaries, color = "red", label.color = "white") + g <- igraph::add_vertices(g, params$number_good_nodes, color = "blue", label.color = "white") + g <- igraph::add_vertices(g, 1, color = "gray") + for (i in dev$contacts) { + g <- igraph::add_edges(g, c(dev$id, i)) + } + plot(igraph::as.undirected(g, "collapse")) } diff --git a/li-19/R/Tile.R b/li-19/R/Tile.R @@ -1,73 +1,73 @@ Tile <- R6::R6Class( - "Tile", - list( - objects = list(), - obj_ids = NULL, - signals = list(), - terrain = NULL, - base_station = list(), - signal_edge = FALSE, - service_provider = list(), + "Tile", + list( + objects = list(), + obj_ids = NULL, + signals = list(), + terrain = NULL, + base_station = list(), + signal_edge = FALSE, + service_provider = list(), - initialize = function(terrain) { - self$terrain <- terrain - invisible(self) - }, + initialize = function(terrain) { + self$terrain <- terrain + invisible(self) + }, - add_device = function(device) { - "Add a device here" - self$objects[[device$id]] <- device - self$obj_ids <- c(self$obj_ids, device$id) - invisible(self) - }, + add_device = function(device) { + "Add a device here" + self$objects[[device$id]] <- device + self$obj_ids <- c(self$obj_ids, device$id) + invisible(self) + }, - add_base_station = function(base_station) { - "Add the base station here" - self$base_station[[1]] <- base_station - invisible(self) - }, + add_base_station = function(base_station) { + "Add the base station here" + self$base_station[[1]] <- base_station + invisible(self) + }, - add_service_provider = function(service_provider) { - self$service_provider[[1]] <- service_provider - invisible(self) - }, + add_service_provider = function(service_provider) { + self$service_provider[[1]] <- service_provider + invisible(self) + }, - get_base_station = function() { - "Get the base station from here" - return(self$base_station[[1]]) - }, + get_base_station = function() { + "Get the base station from here" + return(self$base_station[[1]]) + }, - rm_device = function(id) { - "Remove a device from here" - self$objects[[id]] <- 0 - self$obj_ids <- self$obj_ids[self$obj_ids != id] - invisible(self) - }, + rm_device = function(id) { + "Remove a device from here" + self$objects[[id]] <- 0 + self$obj_ids <- self$obj_ids[self$obj_ids != id] + invisible(self) + }, - has_devices = function() { - "TRUE if there are devices on this tile, else FALSE" - if (!is.null(self$obj_ids)) { - for (obj_id in self$obj_ids) { - if (!is.numeric(self$objects[obj_id]) && - !is.null(self$objects[obj_id])) { - return(TRUE) - } - } - } - return(FALSE) - }, + has_devices = function() { + "TRUE if there are devices on this tile, else FALSE" + if (!is.null(self$obj_ids)) { + for (obj_id in self$obj_ids) { + if (!is.numeric(self$objects[obj_id]) && + !is.null(self$objects[obj_id])) { + return(TRUE) + } + } + } + return(FALSE) + }, - get_first_dev = function() { - return(self$objects[[self$obj_ids[[1]]]]) - }, + get_first_dev = function() { + return(self$objects[[self$obj_ids[[1]]]]) + }, - add_signal = function(base_station, is_edge) { - "Add a signal from a base station here" - self$signals[[length(self$signals) + 1]] <- base_station - if (is_edge) { - self$signal_edge <- TRUE - } - invisible(self) - } - ) + add_signal = function(base_station, is_edge) { + "Add a signal from a base station here" + self$signals[[length(self$signals) + 1]] <- base_station + if (is_edge) { + self$signal_edge <- TRUE + } + invisible(self) + } + ) ) diff --git a/li-19/R/TrustModel.R b/li-19/R/TrustModel.R @@ -1,260 +1,260 @@ # Compute the probability of a occuring among a, b, and c compute_probability <- function(a, b, c) { - return(sum(a, 1) / sum(a, b, c, 3)) + return(sum(a, 1) / sum(a, b, c, 3)) } # Compute the entropy from the given probabilities compute_entropy <- function(probabilities) { - return(-sum(ent_unit(probabilities))) + return(-sum(ent_unit(probabilities))) } # Calculate the small unit of entropy ent_unit <- function(probability) { - return(probability * log(probability, base = 3)) + return(probability * log(probability, base = 3)) } # Do the same as ent_unit but divide the contexts of the log by divider ent_unit_div <- function(probability, divider) { - return(probability * log(probability / divider, base = 3)) + return(probability * log(probability / divider, base = 3)) } # Find the trust of a device given amounts of trusted, distrusted, and unknown # services they have provided compute_trust <- function(trust, distrust, unknown) { - prob_trust <- compute_probability(trust, distrust, unknown) - prob_distrust <- compute_probability(distrust, trust, unknown) - prob_unknown <- compute_probability(unknown, trust, distrust) - - if ((prob_trust > prob_unknown) && (prob_unknown >= prob_distrust)) { - return(1 - compute_entropy(c(prob_trust, prob_distrust, prob_unknown))) - } else if ((prob_trust > prob_distrust) && (prob_distrust > prob_unknown)) { - return(1 - abs(ent_unit(prob_trust) + - ent_unit_div(prob_unknown + prob_distrust, 2))) - } else if (prob_unknown >= max(prob_trust, prob_distrust)) { - return(abs(ent_unit(prob_trust) + - ent_unit_div(prob_unknown + prob_distrust, 2)) - 1) - } else if ((prob_distrust >= prob_unknown) && - (prob_unknown >= prob_trust)) { - return(compute_entropy(c(prob_trust, prob_distrust, prob_unknown)) - 1) - } else { - return(abs(ent_unit(prob_distrust) + - ent_unit_div(prob_unknown + prob_trust, 2)) - 1) - } + prob_trust <- compute_probability(trust, distrust, unknown) + prob_distrust <- compute_probability(distrust, trust, unknown) + prob_unknown <- compute_probability(unknown, trust, distrust) + + if ((prob_trust > prob_unknown) && (prob_unknown >= prob_distrust)) { + return(1 - compute_entropy(c(prob_trust, prob_distrust, prob_unknown))) + } else if ((prob_trust > prob_distrust) && (prob_distrust > prob_unknown)) { + return(1 - abs(ent_unit(prob_trust) + + ent_unit_div(prob_unknown + prob_distrust, 2))) + } else if (prob_unknown >= max(prob_trust, prob_distrust)) { + return(abs(ent_unit(prob_trust) + + ent_unit_div(prob_unknown + prob_distrust, 2)) - 1) + } else if ((prob_distrust >= prob_unknown) && + (prob_unknown >= prob_trust)) { + return(compute_entropy(c(prob_trust, prob_distrust, prob_unknown)) - 1) + } else { + return(abs(ent_unit(prob_distrust) + + ent_unit_div(prob_unknown + prob_trust, 2)) - 1) + } } # Find the weighted average of the context values (given a vector of one of the 4) weighted_avg_context <- function(contexts) { - context_latest <- tail(contexts, 1) - factor_forget <- params$theta_i**abs(context_latest - head(contexts, -1)) - return((context_latest + sum(factor_forget * head(contexts, -1))) / - (1 + sum(factor_forget))) + context_latest <- tail(contexts, 1) + factor_forget <- params$theta_i**abs(context_latest - head(contexts, -1)) + return((context_latest + sum(factor_forget * head(contexts, -1))) / + (1 + sum(factor_forget))) } # Take a vector of the contexts and return the weighted average find_weighted_context <- function(contexts) { - return( - apply( - matrix( - contexts, - nrow = length(params$context_weights) - ), - 1, - weighted_avg_context + return( + apply( + matrix( + contexts, + nrow = length(params$context_weights) + ), + 1, + weighted_avg_context + ) ) - ) } # Find the distance between the target context, and the weighted context context_distance <- function(context_target, context_weighted) { - return( - sqrt( - sum( - params$context_weights * (context_target - context_weighted)**2 - ) + return( + sqrt( + sum( + params$context_weights * (context_target - context_weighted)**2 + ) + ) ) - ) } # Estimate how trusted a node will be for the target context estimate_trust <- function(context_target, context_weighted, trust_current) { - # NOTE: The conditions for the prods have been flipped from the paper - if (trust_current <= 0) { - return( - max( - -1, - trust_current * - prod( - 2 - params$eta[[4]]** - delta( - context_target, - context_weighted, - context_target < context_weighted - ) - ) * - prod( - params$eta[[5]]** - delta( - context_target, - context_weighted, - context_target > context_weighted - ) - ) - ) - ) - } - return( - min( - 1, - trust_current * - prod( - params$eta[[2]]** - delta( - context_target, - context_weighted, - context_target < context_weighted - ) - ) * - prod( - 2 - params$eta[[3]]** - delta( - context_target, - context_weighted, - context_target > context_weighted + # NOTE: The conditions for the prods have been flipped from the paper + if (trust_current <= 0) { + return( + max( + -1, + trust_current * + prod( + 2 - params$eta[[4]]** + delta( + context_target, + context_weighted, + context_target < context_weighted + ) + ) * + prod( + params$eta[[5]]** + delta( + context_target, + context_weighted, + context_target > context_weighted + ) + ) ) ) + } + return( + min( + 1, + trust_current * + prod( + params$eta[[2]]** + delta( + context_target, + context_weighted, + context_target < context_weighted + ) + ) * + prod( + 2 - params$eta[[3]]** + delta( + context_target, + context_weighted, + context_target > context_weighted + ) + ) + ) ) - ) } # A function used within the trust estimation delta <- function(context_target, context_weighted, cond) { - return( - (params$context_weights[cond] * - abs(context_target[cond] - context_weighted[cond])) / - params$impact_factor - ) + return( + (params$context_weights[cond] * + abs(context_target[cond] - context_weighted[cond])) / + params$impact_factor + ) } # Calculate a weighted trust weighted_trust <- function(trust_estimate, trust, distrust, unknown) { - prob_trust <- compute_probability(trust, distrust, unknown) - prob_distrust <- compute_probability(distrust, trust, unknown) - prob_unknown <- compute_probability(unknown, trust, distrust) - - return( - `if`( - prob_trust > max(prob_unknown, prob_distrust), - params$alpha, - `if`( - prob_unknown >= max(prob_trust, prob_distrust) && - prob_unknown != prob_distrust, - params$beta, - params$gamma - ) - ) * trust_estimate - ) + prob_trust <- compute_probability(trust, distrust, unknown) + prob_distrust <- compute_probability(distrust, trust, unknown) + prob_unknown <- compute_probability(unknown, trust, distrust) + + return( + `if`( + prob_trust > max(prob_unknown, prob_distrust), + params$alpha, + `if`( + prob_unknown >= max(prob_trust, prob_distrust) && + prob_unknown != prob_distrust, + params$beta, + params$gamma + ) + ) * trust_estimate + ) } # Calculate the direct trust direct_trust <- function(trusts, context_target, context_weighted) { - return(sum(omega(context_weighted, context_target) * trusts)) + return(sum(omega(context_weighted, context_target) * trusts)) } # Calculate the indirect trust indirect_trust <- function(trusts, reputations, contexts, context_weighted, context_cached) { - omega_weighted <- omega(context_weighted, contexts) - omega_cached <- omega(context_cached, contexts) - return( - sum(omega_weighted * omega_cached * reputations * trusts) / - sum(omega_weighted) - ) + omega_weighted <- omega(context_weighted, contexts) + omega_cached <- omega(context_cached, contexts) + return( + sum(omega_weighted * omega_cached * reputations * trusts) / + sum(omega_weighted) + ) } # A function used within the indirect and direct trust calculations omega <- function(context_weighted, context_target) { - return( - params$eta[[1]]**( - apply( - matrix( - context_target, - ncol = length(context_weighted), - byrow = T - ), - 1, - function(c) { - return(context_distance(context_weighted, c)) - } - ) / params$delta + return( + params$eta[[1]]**( + apply( + matrix( + context_target, + ncol = length(context_weighted), + byrow = T + ), + 1, + function(c) { + return(context_distance(context_weighted, c)) + } + ) / params$delta + ) ) - ) } # Calculate the expected value of change in the trust trend_of_trust <- function(trust0, trust1, context0, context1) { - return( - `if`( - trust0 == 0, - trust1, - trust1 - - params$eta[[1]]**(context_distance(context1, context0) / - params$delta) - * trust0 + return( + `if`( + trust0 == 0, + trust1, + trust1 - + params$eta[[1]]**(context_distance(context1, context0) / + params$delta) + * trust0 + ) ) - ) } # Calculate a new reputation value for a service provider reputation_combination <- function(context_old, context_target, context_new, reputation_old, reputation) { - omega_new_old <- omega(context_new, context_old) - omega_new_target <- omega(context_new, context_target) - return( - omega_new_old * reputation_old + omega_new_target * params$rho** - `if`( - reputation_old * reputation > 0, - omega_new_old * abs(reputation_old), - 1 - omega_new_old * abs(reputation_old) - ) * reputation - ) + omega_new_old <- omega(context_new, context_old) + omega_new_target <- omega(context_new, context_target) + return( + omega_new_old * reputation_old + omega_new_target * params$rho** + `if`( + reputation_old * reputation > 0, + omega_new_old * abs(reputation_old), + 1 - omega_new_old * abs(reputation_old) + ) * reputation + ) } acceptable_rec <- function(c_cached, c_recced, t_recced) { - return( - abs( - t_recced * - params$eta[[1]]**( - context_distance(c_cached, c_recced) / - params$delta - ) - ) < - params$trust_rep_threshold + params$trust_rep_adj_range - ) + return( + abs( + t_recced * + params$eta[[1]]**( + context_distance(c_cached, c_recced) / + params$delta + ) + ) < + params$trust_rep_threshold + params$trust_rep_adj_range + ) } get_context_index <- function(i) { - con_len <- length(params$context_weights) - return((con_len * (i - 1) + 1):(con_len * i)) + con_len <- length(params$context_weights) + return((con_len * (i - 1) + 1):(con_len * i)) } minimax <- function(x, minima, maxima) { - return(max(minima, min(maxima, x))) + return(max(minima, min(maxima, x))) } diff --git a/li-19/tests/testthat/test-basestation.R b/li-19/tests/testthat/test-basestation.R @@ -1,36 +1,36 @@ test_that("add neighbour works", { - b1 <- BaseStation$new(1, 1) - b2 <- BaseStation$new(2, 2) - b1$add_neighbour(b2) - expect_equal(c(1, 1), b2$neighbours[[1]]$location) - expect_equal(c(2, 2), b1$neighbours[[1]]$location) + b1 <- BaseStation$new(1, 1) + b2 <- BaseStation$new(2, 2) + b1$add_neighbour(b2) + expect_equal(c(1, 1), b2$neighbours[[1]]$location) + expect_equal(c(2, 2), b1$neighbours[[1]]$location) }) test_that("routing works", { - params$number_nodes <<- 2 - b1 <- BaseStation$new(1, 1) - b2 <- BaseStation$new(2, 2) - b3 <- BaseStation$new(3, 3) - b1$add_neighbour(b2) - b2$add_neighbour(b3) - sp <- ServiceProvider$new() - d <- Device$new(1, sp, NULL) - b1$connect(d) - expect_equal(b1$table$hops[[d$id]], 0) - expect_equal(b2$table$hops[[d$id]], Inf) - b1$retabulate(d) - b1$finish_update() - expect_equal(b2$table$hops[[d$id]], 1) - expect_equal(b3$find_device(d$id)$id, d$id) - b1$disconnect(d) - b1$retabulate(d) - b1$finish_update() - expect_equal(b1$table$hops[[d$id]], Inf) - b2$connect(d) - b2$retabulate(d) - b2$finish_update() - expect_equal(b1$table$hops[[d$id]], 1) - expect_equal(b3$find_device(d$id)$id, d$id) - params$number_nodes <<- 200 + params$number_nodes <<- 2 + b1 <- BaseStation$new(1, 1) + b2 <- BaseStation$new(2, 2) + b3 <- BaseStation$new(3, 3) + b1$add_neighbour(b2) + b2$add_neighbour(b3) + sp <- ServiceProvider$new() + d <- Device$new(1, sp, NULL) + b1$connect(d) + expect_equal(b1$table$hops[[d$id]], 0) + expect_equal(b2$table$hops[[d$id]], Inf) + b1$retabulate(d) + b1$finish_update() + expect_equal(b2$table$hops[[d$id]], 1) + expect_equal(b3$find_device(d$id)$id, d$id) + b1$disconnect(d) + b1$retabulate(d) + b1$finish_update() + expect_equal(b1$table$hops[[d$id]], Inf) + b2$connect(d) + b2$retabulate(d) + b2$finish_update() + expect_equal(b1$table$hops[[d$id]], 1) + expect_equal(b3$find_device(d$id)$id, d$id) + params$number_nodes <<- 200 }) diff --git a/li-19/tests/testthat/test-calculations.R b/li-19/tests/testthat/test-calculations.R @@ -1,182 +1,182 @@ test_that("probability works", { - a <- 5 - b <- 3 - c <- 2 - expect_that(compute_probability(a, b, c), equals(6 / 13)) + a <- 5 + b <- 3 + c <- 2 + expect_that(compute_probability(a, b, c), equals(6 / 13)) }) test_that("entropy unit works", { - probability <- 1:5 - expect_that( - ent_unit(probability), - equals( - c(0, 1.2618595071429148, 3, 5.047438028571659, 7.3248676035896345) + probability <- 1:5 + expect_that( + ent_unit(probability), + equals( + c(0, 1.2618595071429148, 3, 5.047438028571659, 7.3248676035896345) + ) ) - ) }) test_that("entropy works", { - probability <- 1:5 - expect_that(compute_entropy(probability), equals(-16.63416513930421)) + probability <- 1:5 + expect_that(compute_entropy(probability), equals(-16.63416513930421)) }) test_that("entropy unit divided works", { - probability <- 1:5 - expect_that( - ent_unit_div(probability, 2), - equals( - c( - -0.6309297535714574, - 0, - 1.1072107392856276, - 2.5237190142858297, - 4.170218835732348 - ) - ) - ) + probability <- 1:5 + expect_that( + ent_unit_div(probability, 2), + equals( + c( + -0.6309297535714574, + 0, + 1.1072107392856276, + 2.5237190142858297, + 4.170218835732348 + ) + ) + ) }) test_that("compute trust works", { - a <- 5 - b <- 3 - c <- 2 - expect_that(compute_trust(a, b, c), equals(0.03203451826247661)) - expect_that(compute_trust(b, a, c), equals(-0.03203451826247661)) - expect_that(compute_trust(b, c, a), equals(-0.0013648071755567592)) - expect_that(compute_trust(a, c, b), equals(0.03705298)) - expect_that(compute_trust(c, a, b), equals(-0.03705298)) + a <- 5 + b <- 3 + c <- 2 + expect_that(compute_trust(a, b, c), equals(0.03203451826247661)) + expect_that(compute_trust(b, a, c), equals(-0.03203451826247661)) + expect_that(compute_trust(b, c, a), equals(-0.0013648071755567592)) + expect_that(compute_trust(a, c, b), equals(0.03705298)) + expect_that(compute_trust(c, a, b), equals(-0.03705298)) }) test_that("weighted average context works", { - expect_that( - weighted_avg_context(c(0.2, 0.3, 0.1, 0.5, 0.6)), - equals(0.34769794209818133) - ) + expect_that( + weighted_avg_context(c(0.2, 0.3, 0.1, 0.5, 0.6)), + equals(0.34769794209818133) + ) }) test_that("context distance works", { - expect_that( - context_distance( - c(0.2, 0.3, 0.1, 0.5), - c(0.3, 0.5, 0.6, 0.1) - ), - equals(0.3563705936241092) - ) + expect_that( + context_distance( + c(0.2, 0.3, 0.1, 0.5), + c(0.3, 0.5, 0.6, 0.1) + ), + equals(0.3563705936241092) + ) }) test_that("estimate trust works", { - expect_that( - estimate_trust( - c(0.2, 0.3, 0.1, 0.5), - c(0.3, 0.5, 0.6, 0.1), - 0.1 - ), - equals(0.09330239773694914) - ) - expect_that( - estimate_trust( - c(0.2, 0.3, 0.1, 0.5), - c(0.3, 0.5, 0.6, 0.1), - -0.1 - ), - equals(-0.1167438402791883) - ) + expect_that( + estimate_trust( + c(0.2, 0.3, 0.1, 0.5), + c(0.3, 0.5, 0.6, 0.1), + 0.1 + ), + equals(0.09330239773694914) + ) + expect_that( + estimate_trust( + c(0.2, 0.3, 0.1, 0.5), + c(0.3, 0.5, 0.6, 0.1), + -0.1 + ), + equals(-0.1167438402791883) + ) }) test_that("delta works", { - expect_that( - delta( - c(0.2, 0.3, 0.1, 0.5), - c(0.3, 0.5, 0.6, 0.1), - T - ), - equals(c(0.029999999999999992, 0.04000000000000001, 0.2, 0.04)) - ) + expect_that( + delta( + c(0.2, 0.3, 0.1, 0.5), + c(0.3, 0.5, 0.6, 0.1), + T + ), + equals(c(0.029999999999999992, 0.04000000000000001, 0.2, 0.04)) + ) }) test_that("weighted trust works", { - a <- 5 - b <- 3 - c <- 2 - expect_that( - weighted_trust(0.1, a, b, c), - equals(0.03) - ) - expect_that( - weighted_trust(0.1, b, c, a), - equals(0.03) - ) - expect_that( - weighted_trust(0.1, c, a, a), - equals(0.08) - ) + a <- 5 + b <- 3 + c <- 2 + expect_that( + weighted_trust(0.1, a, b, c), + equals(0.03) + ) + expect_that( + weighted_trust(0.1, b, c, a), + equals(0.03) + ) + expect_that( + weighted_trust(0.1, c, a, a), + equals(0.08) + ) }) test_that("direct trust works", { - expect_that( - direct_trust( - 0.1, - c(0.2, 0.3, 0.1, 0.5), - c(0.3, 0.5, 0.6, 0.1) - ), - equals(0.09774097906001301) - ) + expect_that( + direct_trust( + 0.1, + c(0.2, 0.3, 0.1, 0.5), + c(0.3, 0.5, 0.6, 0.1) + ), + equals(0.09774097906001301) + ) }) test_that("indirect trust works", { - expect_that( - indirect_trust( - 0.1, - 0.1, - c(0.2, 0.3, 0.1, 0.5), - c(0.3, 0.5, 0.6, 0.1), - c(0.3, 0.5, 0.6, 0.1) - ), - equals(0.009774097906001301) - ) + expect_that( + indirect_trust( + 0.1, + 0.1, + c(0.2, 0.3, 0.1, 0.5), + c(0.3, 0.5, 0.6, 0.1), + c(0.3, 0.5, 0.6, 0.1) + ), + equals(0.009774097906001301) + ) }) test_that("omega works", { - expect_that( - omega( - c(0.2, 0.3, 0.1, 0.5), - c(0.3, 0.5, 0.6, 0.1) - ), - equals(0.9774097906001301) - ) + expect_that( + omega( + c(0.2, 0.3, 0.1, 0.5), + c(0.3, 0.5, 0.6, 0.1) + ), + equals(0.9774097906001301) + ) }) test_that("trend of trust works", { - expect_that( - trend_of_trust( - 0.1, - 0.1, - c(0.2, 0.3, 0.1, 0.5), - c(0.3, 0.5, 0.6, 0.1) - ), - equals(0.0022590209399869915) - ) + expect_that( + trend_of_trust( + 0.1, + 0.1, + c(0.2, 0.3, 0.1, 0.5), + c(0.3, 0.5, 0.6, 0.1) + ), + equals(0.0022590209399869915) + ) }) test_that("reputation combination works", { - expect_that( - reputation_combination( - c(0.2, 0.3, 0.1, 0.5), - c(0.3, 0.5, 0.6, 0.1), - c(0.3, 0.5, 0.6, 0.1), - 0.1, - 0.1 - ), - equals(0.1775880558) - ) - expect_that( - reputation_combination( - c(0.2, 0.3, 0.1, 0.5), - c(0.3, 0.5, 0.6, 0.1), - c(0.3, 0.5, 0.6, 0.1), - 0.1, - -0.1 - ), - equals(0.08521704) - ) + expect_that( + reputation_combination( + c(0.2, 0.3, 0.1, 0.5), + c(0.3, 0.5, 0.6, 0.1), + c(0.3, 0.5, 0.6, 0.1), + 0.1, + 0.1 + ), + equals(0.1775880558) + ) + expect_that( + reputation_combination( + c(0.2, 0.3, 0.1, 0.5), + c(0.3, 0.5, 0.6, 0.1), + c(0.3, 0.5, 0.6, 0.1), + 0.1, + -0.1 + ), + equals(0.08521704) + ) }) diff --git a/li-19/tests/testthat/test-device.R b/li-19/tests/testthat/test-device.R @@ -1,93 +1,103 @@ is_equal <- function(...) { - return(isTRUE(all.equal(...))) + return(isTRUE(all.equal(...))) } params$map_width <<- 3 params$map_height <<- 3 params$number_nodes <<- 3 map_data <- data.frame( - rep(LAND, 3), rep(LAND, 3), rep(WATER, 3) + rep(LAND, 3), rep(LAND, 3), rep(WATER, 3) ) f <- Field$new(map_data) sp <- ServiceProvider$new() d <- Device$new(1, sp, f, c(1, 1)) test_that("device creation works", { - expect_equal(d$id, 1) - expect_equal(d$time_last_moved, params$time_now - 1) - expect_equal(d$trust, rep(0, params$number_nodes)) - expect_equal(d$distrust, rep(0, params$number_nodes)) - expect_equal(d$unknown, rep(0, params$number_nodes)) + expect_equal(d$id, 1) + expect_equal(d$time_last_moved, params$time_now - 1) + expect_equal(d$trust, rep(0, params$number_nodes)) + expect_equal(d$distrust, rep(0, params$number_nodes)) + expect_equal(d$unknown, rep(0, params$number_nodes)) +}) + + +test_that("device copying works", { + cp <- Device$new(1, sp, copy = d) + expect_equal(cp$id, d$id) + expect_equal(cp$time_last_moved, d$time_last_moved) + expect_equal(cp$trust, d$trust) + expect_equal(cp$distrust, d$distrust) + expect_equal(cp$unknown, d$unknown) }) test_that("trust update works", { - d$sp_trust_increment() - expect_equal(d$sp_trust[[1]], 1) + d$sp_trust_increment() + expect_equal(d$sp_trust[[1]], 1) }) test_that("distrust update works", { - d$sp_distrust_increment() - expect_equal(d$sp_distrust[[1]], 1) + d$sp_distrust_increment() + expect_equal(d$sp_distrust[[1]], 1) }) test_that("unknown update works", { - d$sp_unknown_increment() - expect_equal(d$sp_unknown[[1]], 1) + d$sp_unknown_increment() + expect_equal(d$sp_unknown[[1]], 1) }) test_that("recieving observations works", { - context <- c(1, 1, 1, 1) - obs <- Observation$new(context, 1, 1) - d$recieve_observation(obs) - expect_equal(tail(d$contexts[[1]], 4), obs$context) + context <- c(1, 1, 1, 1) + obs <- Observation$new(context, 1, 1) + d$recieve_observation(obs) + expect_equal(tail(d$contexts[[1]], 4), obs$context) }) test_that("has signal works", { - expect_equal(d$has_signal(), T) + expect_equal(d$has_signal(), T) }) test_that("goal setting works", { - expect_true(all(d$current_goal >= c(1, 1))) - expect_true(all(d$current_goal <= f$shape())) - d$new_goal() - expect_true(all(d$current_goal >= c(1, 1))) - expect_true(all(d$current_goal <= f$shape())) + expect_true(all(d$current_goal >= c(1, 1))) + expect_true(all(d$current_goal <= f$shape())) + d$new_goal() + expect_true(all(d$current_goal >= c(1, 1))) + expect_true(all(d$current_goal <= f$shape())) }) test_that("moving works", { - init_goal <- c(3, 2) - init_velocity <- 1 - init_basestation_id <- d$get_signals()[[1]]$location - init_tile_node_count <- length(f$get_tile(c(1, 1))[[1]]$objects) - init_next_tile_node_count <- length(f$get_tile(c(2, 2))[[1]]$objects) - d$current_goal <- init_goal - d$velocity <- init_velocity - d$move() - expect_equal(d$location, c(2, 2)) - expect_equal(d$time_last_moved, params$time_now) - expect_equal(init_basestation_id, d$get_signals()[[1]]$location) - expect_false(is_equal(d$velocity, init_velocity)) - params$increment_time() - d$velocity <- init_velocity - d$move() - expect_equal(d$location, c(3, 2)) - expect_equal(d$time_last_moved, params$time_now) - expect_equal(init_basestation_id, d$get_signals()[[1]]$location) - expect_false(is_equal(d$current_goal, init_goal)) - expect_false(is_equal(d$velocity, init_velocity)) + init_goal <- c(3, 2) + init_velocity <- 1 + init_basestation_id <- d$get_signals()[[1]]$location + init_tile_node_count <- length(f$get_tile(c(1, 1))[[1]]$objects) + init_next_tile_node_count <- length(f$get_tile(c(2, 2))[[1]]$objects) + d$current_goal <- init_goal + d$velocity <- init_velocity + d$move() + expect_equal(d$location, c(2, 2)) + expect_equal(d$time_last_moved, params$time_now) + expect_equal(init_basestation_id, d$get_signals()[[1]]$location) + expect_false(is_equal(d$velocity, init_velocity)) + params$increment_time() + d$velocity <- init_velocity + d$move() + expect_equal(d$location, c(3, 2)) + expect_equal(d$time_last_moved, params$time_now) + expect_equal(init_basestation_id, d$get_signals()[[1]]$location) + expect_false(is_equal(d$current_goal, init_goal)) + expect_false(is_equal(d$velocity, init_velocity)) }) test_that("adding contacts works", { - d2 <- Device$new(2, sp, f, c(2, 2)) - devs <- c(d, d2) - d$add_contact(2, devs) - expect_equal(d$contacts[[1]], 2) - expect_equal(d2$contacts[[1]], 1) + d2 <- Device$new(2, sp, f, c(2, 2)) + devs <- c(d, d2) + d$add_contact(2, devs) + expect_equal(d$contacts[[1]], 2) + expect_equal(d2$contacts[[1]], 1) }) diff --git a/li-19/tests/testthat/test-field.R b/li-19/tests/testthat/test-field.R @@ -1,11 +1,11 @@ test_that("creation works", { - params$map_width <<- 3 - params$map_height <<- 3 - map_data <- data.frame( - rep(LAND, 3), rep(LAND, 3), rep(WATER, 3) - ) - f <- Field$new(map_data) - expect_equal(f$shape(), c(3, 3)) - params$map_width <<- 500 - params$map_height <<- 500 + params$map_width <<- 3 + params$map_height <<- 3 + map_data <- data.frame( + rep(LAND, 3), rep(LAND, 3), rep(WATER, 3) + ) + f <- Field$new(map_data) + expect_equal(f$shape(), c(3, 3)) + params$map_width <<- 500 + params$map_height <<- 500 }) diff --git a/li-19/tests/testthat/test-functions.R b/li-19/tests/testthat/test-functions.R @@ -1,10 +1,10 @@ test_that("Euclidean distance works", { - expect_equal(sqrt(2), euc_dist(c(0, 0), c(1, 1))) - expect_equal(2, euc_dist(c(0, 0), c(1, sqrt(3)))) + expect_equal(sqrt(2), euc_dist(c(0, 0), c(1, 1))) + expect_equal(2, euc_dist(c(0, 0), c(1, sqrt(3)))) }) test_that("compute gap works", { - r <- 5 - expect_equal(round(sqrt(2 * r**2) * params$gap_factor), compute_gap(r)) + r <- 5 + expect_equal(round(sqrt(2 * r**2) * params$gap_factor), compute_gap(r)) }) diff --git a/li-19/tests/testthat/test-normalizers.R b/li-19/tests/testthat/test-normalizers.R @@ -1,51 +1,51 @@ test_that("time normalizer works", { - time <- 5 - expect_that( - time, - equals(normalize_time(time)) - ) + time <- 5 + expect_that( + time, + equals(normalize_time(time)) + ) }) test_that("capability normalizer works", { - cap <- 70 - expect_that( - 1 - (cap / params$max_capability), - equals(normalize_capability(cap)) - ) + cap <- 70 + expect_that( + 1 - (cap / params$max_capability), + equals(normalize_capability(cap)) + ) }) test_that("location normalizer works", { - loc <- 30 - expect_that( - 1 - (loc / sqrt(params$map_width**2 + params$map_height**2)), - equals(normalize_location(loc)) - ) + loc <- 30 + expect_that( + 1 - (loc / sqrt(params$map_width**2 + params$map_height**2)), + equals(normalize_location(loc)) + ) }) test_that("velocity normalizer works", { - vel <- 5 - expect_that( - 1 - (vel / params$max_velocity), - equals(normalize_velocity(vel)) - ) + vel <- 5 + expect_that( + 1 - (vel / params$max_velocity), + equals(normalize_velocity(vel)) + ) }) test_that("context normalizer works", { - time <- 5 - cap <- 70 - loc <- 30 - vel <- 5 - expect_that( - c( - time, - 1 - (cap / params$max_capability), - 1 - (loc / sqrt(params$map_width**2 + params$map_height**2)), - 1 - (vel / params$max_velocity) - ), - equals(normalize(c(time, cap, loc, vel))) - ) + time <- 5 + cap <- 70 + loc <- 30 + vel <- 5 + expect_that( + c( + time, + 1 - (cap / params$max_capability), + 1 - (loc / sqrt(params$map_width**2 + params$map_height**2)), + 1 - (vel / params$max_velocity) + ), + equals(normalize(c(time, cap, loc, vel))) + ) }) diff --git a/li-19/tests/testthat/test-observation.R b/li-19/tests/testthat/test-observation.R @@ -1,9 +1,9 @@ test_that("fields works", { - context <- c(5, 70, 30, 5) - trust <- 1 - id_sender <- 1 - obs <- Observation$new(context, trust, id_sender) - expect_equal(context, obs$context) - expect_equal(trust, obs$trust) - expect_equal(id_sender, obs$id_sender) + context <- c(5, 70, 30, 5) + trust <- 1 + id_sender <- 1 + obs <- Observation$new(context, trust, id_sender) + expect_equal(context, obs$context) + expect_equal(trust, obs$trust) + expect_equal(id_sender, obs$id_sender) }) diff --git a/li-19/tests/testthat/test-serviceprovider.R b/li-19/tests/testthat/test-serviceprovider.R @@ -1,4 +1,4 @@ test_that("provide service works", { - sp <- ServiceProvider$new() - expect_equal(TRUSTED, sp$provide_service()) + sp <- ServiceProvider$new() + expect_equal(TRUSTED, sp$provide_service()) }) diff --git a/li-19/tests/testthat/test-tile.R b/li-19/tests/testthat/test-tile.R @@ -1,28 +1,28 @@ test_that("terrain assignment works", { - expect_equal(Tile$new(LAND)$terrain, LAND) + expect_equal(Tile$new(LAND)$terrain, LAND) }) test_that("device storing works", { - params$number_nodes <<- 200 - sp <- ServiceProvider$new() - d <- Device$new(1, sp, NULL) - t <- Tile$new(LAND) - t$add_device(d) - expect_equal(t$objects[[d$id]]$id, d$id) - t$rm_device(d$id) - expect_false(t$has_devices()) + params$number_nodes <<- 200 + sp <- ServiceProvider$new() + d <- Device$new(1, sp, NULL) + t <- Tile$new(LAND) + t$add_device(d) + expect_equal(t$objects[[d$id]]$id, d$id) + t$rm_device(d$id) + expect_false(t$has_devices()) }) test_that("base station storing works", { - b <- BaseStation$new(1, 1) - t <- Tile$new(LAND) - t$add_base_station(b) - expect_equal(c(1, 1), t$get_base_station()$location) + b <- BaseStation$new(1, 1) + t <- Tile$new(LAND) + t$add_base_station(b) + expect_equal(c(1, 1), t$get_base_station()$location) }) test_that("signal works", { - b <- BaseStation$new(1, 1) - t <- Tile$new(LAND) - t$add_signal(b, F) - expect_equal(c(1, 1), t$signals[[1]]$location) + b <- BaseStation$new(1, 1) + t <- Tile$new(LAND) + t$add_signal(b, F) + expect_equal(c(1, 1), t$signals[[1]]$location) }) diff --git a/saied-13/src/ConsoleInterface.r b/saied-13/src/ConsoleInterface.r @@ -36,7 +36,9 @@ find.malicious.type <- function(opt) { # Give a list detailing the attack types to perform based on the input string parse.type.calc.string <- function(type.calc.string) { if(type.calc.string == "normal") { - return(list(LOCAL, NORMAL, FALSE, FALSE, FALSE)) + return(list(LOCAL, NORMAL, FALSE, FALSE, FALSE, FALSE)) + } else if(type.calc.string == "mitigating") { + return(list(LOCAL, NORMAL, FALSE, FALSE, FALSE, TRUE)) } if(grepl("n", type.calc.string)) { if(grepl("c", type.calc.string)) { @@ -59,7 +61,8 @@ parse.type.calc.string <- function(type.calc.string) { type.detection, grepl("a", type.calc.string), # disregard causes note negation grepl("s", type.calc.string), # Split calculations - grepl("q", type.calc.string) # disregard also punishes QR + grepl("q", type.calc.string), # disregard also punishes QR + grepl("mit", type.calc.string) # perform a mitigating calculation ) ) } @@ -103,14 +106,14 @@ main <- function() { help="Percentage of malicious reporting nodes to increment by [default %default]"), make_option(c("--reputation", "-r"), type="double", default=-1, help="Reputation threshold, nodes in the network that fall below this are no longer considered in the network"), - make_option(c("--targeted", "-ta"), action="store_true", default=FALSE, + make_option(c("--targeted"), action="store_true", default=FALSE, help="Analyze the targeted effects of an attack"), make_option(c("--type_calc"), type="character", default="normal", help="Assign a type of calculation for report relevance the first letter states local or global (l, g), and the second states whether to detect based on notes or notes and context (n, c) [default %default]"), - make_option(c("--time_change", "-tc"), type="integer", + make_option(c("--time_change"), type="integer", action="store", default=60, help="The number epochs to increment the time at. [default %default]"), - make_option(c("--disregard_multiplier", "-dm"), action="store", + make_option(c("--disregard_multiplier"), action="store", type="double", default=1, help="Amount to multiply disregarded reports effects on QR [default %default]") ) @@ -150,7 +153,7 @@ main <- function() { opt$malicious_start, opt$malicious_end, by=opt$malicious_jump ) for(percent.malicious.reporters in malicious.increments) { - tm <- TrustManager( + tm <- TrustManager$new( eta=opt$eta, lambda=opt$lambda, theta=opt$theta, diff --git a/saied-13/src/Node.r b/saied-13/src/Node.r @@ -16,54 +16,51 @@ LOCAL <- 0 GLOBAL <- 1 # A generic node class -Node <- setRefClass( +Node <- R6::R6Class( "Node", + list( + id= 0, + service = 0, + capability = 0, + noteacc = 0, + QR = 0, + malicious = 0, + time.QR = 0, + reports = list(), + reputation = 0, + trust = 0, + type.calc = list(), + time.possible.attack = 0, + time.disregard = 0, + avg.capability = 0, + avg.service = 0, + number.reports = 0, - fields=list( - id="numeric", - service="numeric", - capability="numeric", - noteacc="numeric", - QR="numeric", - malicious="logical", - time.QR="numeric", - reports="list", - reputation="numeric", - trust="numeric", - type.calc="list", - time.possible.attack="numeric", - time.disregard="numeric", - avg.capability="numeric", - avg.service="numeric", - number.reports="numeric" - ), - - methods=list( initialize = function(id, service, capability, noteacc, QR, malicious, number.nodes, type.calc, time.disregard=1) { - id <<- id - service <<- service - capability <<- capability - noteacc <<- noteacc - QR <<- QR - malicious <<- malicious - time.QR <<- 0 - type.calc <<- type.calc - time.disregard <<- time.disregard + self$id <- id + self$service <- service + self$capability <- capability + self$noteacc <- noteacc + self$QR <- QR + self$malicious <- malicious + self$time.QR <- 0 + self$type.calc <- type.calc + self$time.disregard <- time.disregard if(type.calc[[2]] >= N) { - time.possible.attack <<- rep(-time.disregard - 1, number.nodes) + self$time.possible.attack <- rep(-time.disregard - 1, number.nodes) } if(type.calc[[2]] == MC) { - avg.capability <<- -1 - avg.service <<- -1 - number.reports <<- 0 + self$avg.capability <- -1 + self$avg.service <- -1 + self$number.reports <- 0 } }, take.note = function(target.service, target.capability, proxy, time) { "Take note of the Quality of the service provided by a proxy" note = find.note(target.service, target.capability, proxy, time) - if(runif(1) > noteacc) { + if(runif(1) > self$noteacc) { wrong_vals = setdiff(c(-1, 0, 1), note) return(`if`(runif(1) < 0.5, wrong_vals[1], wrong_vals[2])) } @@ -88,20 +85,19 @@ Node <- setRefClass( make.report = function(proxy, target.service, target.capability, time) { "Create a report on the proxy server" - note = take.note(target.service, target.capability, proxy, time) - id.attacker = `if`(proxy$type.calc[[1]] == GLOBAL, proxy$id, id) - report.service = take.service(target.service) - report.capability = take.capability(proxy) - report.time = take.time(time) - - proxy$reports[length(proxy$reports) + 1] <- Report( + note = self$take.note(target.service, target.capability, proxy, time) + id.attacker = `if`(proxy$type.calc[[1]] == GLOBAL, proxy$id, self$id) + report.service = self$take.service(target.service) + report.capability = self$take.capability(proxy) + report.time = self$take.time(time) + proxy$reports[[length(proxy$reports) + 1]] <- Report$new( service=report.service, capability=report.capability, time=report.time, note=note, - issuer=id, - issuer.QR=QR[[1]], - issuer.time.QR=time.QR[[1]], + issuer=self$id, + issuer.QR=self$QR[[1]], + issuer.time.QR=self$time.QR[[1]], disregard=proxy$calc.disregard( id.attacker, report.capability, report.service, note, report.time @@ -109,6 +105,7 @@ Node <- setRefClass( ) if((proxy$type.calc[[2]] %in% c(N, C, CN)) && note == -1) { proxy$time.possible.attack[[id.attacker]] <- time + print(proxy$time.possible.attack[[id.attacker]]) } if(proxy$type.calc[[2]] == MC) { @@ -126,30 +123,30 @@ Node <- setRefClass( calc.disregard = function(id.attacker, capability, service, note, time) { "Figure out whether the current report should be disregarded" - if(type.calc[[2]] %in% c(N, C, CN)) { + if(self$type.calc[[2]] %in% c(N, C, CN)) { return( !is.na(time.possible.attack[[id.attacker]]) && - time.possible.attack[[id.attacker]] >= - time - time.disregard && - `if`(type.calc[[2]] %in% c(N, CN), note == -1, TRUE) && + self$time.possible.attack[[id.attacker]] >= + time - self$time.disregard && + `if`(self$type.calc[[2]] %in% c(N, CN), note == -1, TRUE) && `if`( - type.calc[[2]] %in% c(C, CN), - check.context(capability, service, note), + self$type.calc[[2]] %in% c(C, CN), + self$check.context(capability, service, note), TRUE ) ) - } else if(type.calc[[2]] == R) { + } else if(self$type.calc[[2]] == R) { return( - !is.na(time.possible.attack[[id.attacker]]) && - time.possible.attack[[id.attacker]] >= - time - time.disregard + !is.na(self$time.possible.attack[[id.attacker]]) && + self$time.possible.attack[[id.attacker]] >= + time - self$time.disregard ) - } else if(type.calc[[2]] == MC) { + } else if(self$type.calc[[2]] == MC) { fuzz = 1 - condition = (avg.capability - fuzz <= capability && - capability <= avg.capability + fuzz) || - (avg.service - fuzz <= service && - service <= avg.service + fuzz) + condition = (self$avg.capability - fuzz <= capability && + capability <= self$avg.capability + fuzz) || + (self$avg.service - fuzz <= service && + service <= self$avg.service + fuzz) return(condition) } @@ -169,10 +166,10 @@ Node <- setRefClass( ) # A Bad mouthing node -Node.BadMouther <- setRefClass( +Node.BadMouther <- R6::R6Class( "Node.BadMouther", - contains="Node", - methods=list( + inherit=Node, + public=list( take.note = function(target.service, target.capability, proxy, time) { "Take a bad mouthing note, -1" return(-1) @@ -181,10 +178,10 @@ Node.BadMouther <- setRefClass( ) # A service setting node, this always reports the service as 50 -Node.BadMouther.ServiceSetter <- setRefClass( +Node.BadMouther.ServiceSetter <- R6::R6Class( "Node.BadMouther.ServiceSetter", - contains="Node.BadMouther", - methods=list( + inherit=Node.BadMouther, + public=list( take.service = function(target.service) { "Give a service setted service value" return(context.set()) @@ -193,10 +190,10 @@ Node.BadMouther.ServiceSetter <- setRefClass( ) # A capability setting node, this always reports the capability as 50 -Node.BadMouther.CapabilitySetter <- setRefClass( +Node.BadMouther.CapabilitySetter <- R6::R6Class( "Node.BadMouther.CapabilitySetter", - contains="Node.BadMouther", - methods=list( + inherit=Node.BadMouther, + public=list( take.capability = function(proxy) { "Give a capability setted capability value" return(context.set()) @@ -205,10 +202,10 @@ Node.BadMouther.CapabilitySetter <- setRefClass( ) # A service and capability setting node -Node.BadMouther.CapabilitySetter.ServiceSetter <- setRefClass( +Node.BadMouther.CapabilitySetter.ServiceSetter <- R6::R6Class( "Node.BadMouther.CapabilitySetter.ServiceSetter", - contains="Node.BadMouther.CapabilitySetter", - methods=list( + inherit=Node.BadMouther.CapabilitySetter, + public=list( take.service = function(target.service) { "Give a service setted service value" return(context.set()) @@ -217,10 +214,10 @@ Node.BadMouther.CapabilitySetter.ServiceSetter <- setRefClass( ) # A time decaying node, this always reports the time as 5 units in the past -Node.BadMouther.TimeDecayer <- setRefClass( +Node.BadMouther.TimeDecayer <- R6::R6Class( "Node.BadMouther.TimeDecayer", - contains="Node.BadMouther", - methods=list( + inherit=Node.BadMouther, + public=list( take.time = function(time) { "Give a time decayed time value" return(time.decay(time)) @@ -229,10 +226,10 @@ Node.BadMouther.TimeDecayer <- setRefClass( ) # A capability setting and time decaying node -Node.BadMouther.CapabilitySetter.TimeDecayer <- setRefClass( +Node.BadMouther.CapabilitySetter.TimeDecayer <- R6::R6Class( "Node.BadMouther.CapabilitySetter.TimeDecayer", - contains="Node.BadMouther.CapabilitySetter", - methods=list( + inherit=Node.BadMouther.CapabilitySetter, + public=list( take.time = function(time) { "Give a time decayed time value" return(time.decay(time)) @@ -241,10 +238,10 @@ Node.BadMouther.CapabilitySetter.TimeDecayer <- setRefClass( ) # A service setting and time decaying node -Node.BadMouther.ServiceSetter.TimeDecayer <- setRefClass( +Node.BadMouther.ServiceSetter.TimeDecayer <- R6::R6Class( "Node.BadMouther.ServiceSetter.TimeDecayer", - contains="Node.BadMouther.ServiceSetter", - methods=list( + inherit=Node.BadMouther.ServiceSetter, + public=list( take.time = function(time) { "Give a time decayed time value" return(time.decay(time)) @@ -253,10 +250,10 @@ Node.BadMouther.ServiceSetter.TimeDecayer <- setRefClass( ) # A capability setting, service setting and time decaying node -Node.BadMouther.CapabilitySetter.ServiceSetter.TimeDecayer <- setRefClass( +Node.BadMouther.CapabilitySetter.ServiceSetter.TimeDecayer <- R6::R6Class( "Node.BadMouther.CapabilitySetter.ServiceSetter.TimeDecayer", - contains="Node.BadMouther.CapabilitySetter.ServiceSetter", - methods=list( + inherit=Node.BadMouther.CapabilitySetter.ServiceSetter, + public=list( take.time = function(time) { "Give a time decayed time value" return(time.decay(time)) diff --git a/saied-13/src/Report.r b/saied-13/src/Report.r @@ -5,35 +5,35 @@ # Author: Cody Lewis # Date: 2019-05-01 -Report <- setRefClass( +Report <- R6::R6Class( "Report", - fields=list( - service="numeric", - capability="numeric", - time="numeric", - note="numeric", - issuer="numeric", - issuer.QR="numeric", - issuer.time.QR="numeric", - server="logical", - disregard="logical" - ), - methods=list( + list( + service = 0, + capability = 0, + time = 0, + note = 0, + issuer = 0, + issuer.QR = 0, + issuer.time.QR = 0, + server = FALSE, + disregard = FALSE, + initialize = function(service, capability, time, note, issuer, issuer.QR, issuer.time.QR, disregard=FALSE) { - service <<- service - capability <<- capability - time <<- time - note <<- note - issuer <<- issuer - issuer.QR <<- issuer.QR - issuer.time.QR <<- issuer.time.QR - server <<- FALSE - disregard <<- disregard + self$service <- service + self$capability <- capability + self$time <- time + self$note <- note + self$issuer <- issuer + self$issuer.QR <- issuer.QR + self$issuer.time.QR <- issuer.time.QR + self$server <- FALSE + self$disregard <- disregard } ) ) + # Find the one dimensional distance between the target and current find.diff <- function(target, current) { return(abs(target - current)) diff --git a/saied-13/src/TrustModel.r b/saied-13/src/TrustModel.r @@ -8,43 +8,52 @@ source("Node.r") source("Plots.r") SPLITTING <- 4 +MITIGATING <- 6 # The Trust Manager class -TrustManager <- setRefClass( +TrustManager <- R6::R6Class( "TrustManager", - fields=list( - nodes="list", - nodes.all="list", - eta="numeric", - theta="numeric", - lambda="numeric", - service.max="numeric", - capability.max="numeric", - reputation.threshold="numeric", - QR.initial="numeric", - services="numeric", - id.nodemon.normal="numeric", - id.nodemon.malicious="numeric", - type.calc="list", - threshold.directs="numeric", - threshold.indirects="numeric", - altering.notes="logical", - disregard.qr="logical", - disregard.multiplier="numeric" - ), + list( + nodes = list(), + nodes.all = list(), + eta = 0, + theta = 0, + lambda = 0, + service.max = 0, + capability.max = 0, + reputation.threshold = 0, + QR.initial = 0, + services = 0, + id.nodemon.normal = 0, + id.nodemon.malicious = 0, + type.calc = list(), + threshold.directs = 0, + threshold.indirects = 0, + altering.notes = FALSE , + disregard.qr = FALSE, + disregard.multiplier = 0, + + initialize = function(eta, lambda, theta, service.max, capability.max, reputation.threshold, QR.initial) { + self$eta <- eta + self$lambda <- lambda + self$theta <- theta + self$service.max <- service.max + self$capability.max <- capability.max + self$reputation.threshold <- reputation.threshold + self$QR.initial <- QR.initial + }, - methods=list( init = function(number.nodes, percent.constrained, percent.poorwitness, percent.malicious, percent.malicious.reporter, type.malicious.reporter, targeted, type.calc, disregard.multiplier) { "Initialize the network to the specifications of the arguments" - services <<- c(1, 16, 33, 50, 66, 82, 100) + self$services <- c(1, 16, 33, 50, 66, 82, 100) ids <- seq(1, number.nodes) service.and.capability = assign.contexts( - number.nodes, ids, percent.constrained, service.max, - capability.max, targeted + number.nodes, ids, percent.constrained, self$service.max, + self$capability.max, targeted ) # Assign note taking accuracy ids.poorwitness = sample(ids, percent.poorwitness * number.nodes) @@ -55,21 +64,21 @@ TrustManager <- setRefClass( ids.malicious.reporter = sample( ids, percent.malicious.reporter * number.nodes ) - id.nodemon.malicious <<- sample(ids.malicious, 1) - id.nodemon.normal <<- sample(ids[!ids %in% ids.malicious], 1) - assign.nodes( + self$id.nodemon.malicious <- sample(ids.malicious, 1) + self$id.nodemon.normal <- sample(ids[!ids %in% ids.malicious], 1) + self$assign.nodes( ids, ids.malicious, ids.malicious.reporter, type.malicious.reporter, service.and.capability[[1]], service.and.capability[[2]], noteacc, number.nodes, type.calc ) - type.calc <<- type.calc + self$type.calc <- type.calc if(type.calc[[SPLITTING]]) { - threshold.directs <<- 10 - threshold.indirects <<- -0.5 + self$threshold.directs <- 10 + self$threshold.indirects <- -0.5 } - altering.notes <<- type.calc[[3]] - disregard.qr <<- type.calc[[5]] - disregard.multiplier <<- disregard.multiplier + self$altering.notes <- type.calc[[3]] + self$disregard.qr <- type.calc[[5]] + self$disregard.multiplier <- disregard.multiplier }, assign.nodes = function(ids, ids.malicious, ids.malicious.reporter, @@ -98,22 +107,22 @@ TrustManager <- setRefClass( node.type = Node.BadMouther.CapabilitySetter.ServiceSetter.TimeDecayer } } - nodes[[id]] <<- node.type( + self$nodes[[id]] <- node.type$new( id=id, service=service[id], capability=capability[id], - noteacc=noteacc[id], QR=QR.initial, is.malicious, + noteacc=noteacc[id], QR=self$QR.initial, is.malicious, number.nodes, type.calc ) - nodes.all[[id]] <<- nodes[[id]] + self$nodes.all[[id]] <- self$nodes[[id]] } }, info.gather = function(epochs, time.current) { "Induce random artificial interactions between the nodes" for(epoch in 1:epochs) { - client = nodes[[round(runif(1, min=1, max=length(nodes)))]] - server = nodes[[round(runif(1, min=1, max=length(nodes)))]] - service = services[round(runif(1, min=1, max=length(services)))] - capability = round(runif(1, min=1, max=capability.max)) + client = self$nodes[[round(runif(1, min=1, max=length(self$nodes)))]] + server = self$nodes[[round(runif(1, min=1, max=length(self$nodes)))]] + service = self$services[round(runif(1, min=1, max=length(self$services)))] + capability = round(runif(1, min=1, max=self$capability.max)) client$make.report(server, service, capability, time.current) } }, @@ -121,13 +130,12 @@ TrustManager <- setRefClass( select.entity = function(id.client, target.service, target.capability, time.current) { "Perform the entity selection operations, and return the trusted list" - trust = rep(0, length(nodes)) - t = find.t(target.service, target.capability, service.max, - capability.max) - - for(node in nodes) { - if(type.calc[[SPLITTING]]) { - trust[[node$id]] = calc.trust.alt( + trust = rep(0, length(self$nodes)) + t = find.t(target.service, target.capability, self$service.max, + self$capability.max) + for(node in self$nodes) { + if(self$type.calc[[SPLITTING]]) { + trust[[node$id]] = self$calc.trust.alt( id.client, target.service, target.capability, @@ -136,14 +144,19 @@ TrustManager <- setRefClass( node ) node$trust[[length(node$trust) + 1]] <- trust[[node$id]] + } else if(self$type.calc[[MITIGATING]]) { + trust[[node$id]] = self$calc.trust.mit(id.client, target.service, + target.capability, + time.current, t, node) + node$trust[[length(node$trust) + 1]] <- trust[[node$id]] } else { - trust[[node$id]] = calc.trust(id.client, target.service, + trust[[node$id]] = self$calc.trust(id.client, target.service, target.capability, time.current, t, node) node$trust[[length(node$trust) + 1]] <- trust[[node$id]] } } - data.trust = data.frame(id=1:length(nodes), trust=trust) + data.trust = data.frame(id=1:length(self$nodes), trust=trust) ids.trusted = data.trust[order(-data.trust$trust),]$id return(ids.trusted) @@ -164,20 +177,61 @@ TrustManager <- setRefClass( } dist = report.distance(report, target.service, - target.capability, service.max, - capability.max, eta) + target.capability, self$service.max, + self$capability.max, self$eta) if(dist < t) { weight = report.weigh( - report, dist, lambda, theta, time.current + report, dist, self$lambda, self$theta, time.current ) numerator = numerator + weight * - nodes[[report$issuer]]$QR[[1]] * report$note + self$nodes[[report$issuer]]$QR[[1]] * report$note denominator = denominator + weight } } return(`if`(denominator == 0, 0, numerator / denominator)) }, + calc.trust.mit = function(id.client, target.service, target.capability, time.current, t, node) { + "Calculate the mitigating trust of a particular node" + denominator = 0 + DT = 0 + IndT = 0 + for(report in node$reports) { + if(report$disregard) { + if(altering.notes) { + note = -1 + } else { + next + } + } + + dist = report.distance(report, target.service, + target.capability, self$service.max, + self$capability.max, self$eta) + if(dist < t) { + weight = report.weigh( + report, dist, self$lambda, self$theta, time.current + ) + if(report$issuer == node$id) { + DT = DT + weight * + self$nodes[[report$issuer]]$QR[[1]] * report$note + } else { + IndT = IndT + weight * self$nodes[[report$issuer]]$reputation * + self$nodes[[report$issuer]]$QR[[1]] * report$note + } + denominator = denominator + weight + } + } + alpha <- `if`( + (DT + IndT) > 0 && (DT + IndT) <= 1, + DT / (DT + IndT), + `if`(DT + IndT > 1, 1, 0) + ) + beta <- beta <- 1 - alpha + numerator <- alpha * DT + beta * IndT + return(`if`(denominator == 0, 0, numerator / denominator)) + }, + calc.trust.alt = function(id.client, target.service, target.capability, time.current, t, node) { "Perform an alternate form of the trust calculation" @@ -197,19 +251,19 @@ TrustManager <- setRefClass( } dist = report.distance( report, target.service, target.capability, - service.max, capability.max, eta + self$service.max, self$capability.max, self$eta ) if(dist < t) { - weight = report.weigh(report, dist, lambda, theta, + weight = report.weigh(report, dist, self$lambda, self$theta, time.current) if(report$issuer == id.client) { direct.numerator = direct.numerator + weight * - nodes[[report$issuer]]$QR[[1]] * note + self$nodes[[report$issuer]]$QR[[1]] * note direct.denominator = direct.denominator + weight count.direct.recs = count.direct.recs + 1 } else { indirect.numerator = indirect.numerator + weight * - nodes[[report$issuer]]$QR[[1]] * note + self$nodes[[report$issuer]]$QR[[1]] * note indirect.denominator = indirect.denominator + weight } } @@ -235,12 +289,12 @@ TrustManager <- setRefClass( transaction = function(id.client, id.server, target.service, target.capability, time.current) { "Perform a transaction" - server = nodes[[id.server]] - nodes[[id.client]]$make.report( + server = self$nodes[[id.server]] + self$nodes[[id.client]]$make.report( server, target.service, target.capability, time.current ) - if(length(server$reports) > 5 * length(nodes)) { - server$reports <- tail(server$reports, 5 * length(nodes)) + if(length(server$reports) > 5 * length(self$nodes)) { + server$reports <- tail(server$reports, 5 * length(self$nodes)) } report = server$reports[[length(server$reports)]] report$server <- TRUE @@ -254,29 +308,29 @@ TrustManager <- setRefClass( time.current) { "Update the QRs of the witness nodes" t = find.t( - target.service, target.capability, service.max, capability.max + target.service, target.capability, self$service.max, self$capability.max ) - for(report in nodes[[id.server]]$reports) { + for(report in self$nodes[[id.server]]$reports) { dist = report.distance( - report, target.service, target.capability, service.max, - capability.max, eta + report, target.service, target.capability, self$service.max, + self$capability.max, self$eta ) if(dist < t) { C.client = report.weigh( - report, dist, lambda, theta,time.current - ) * nodes[[id.client]]$QR[[1]] - if(disregard.qr && report$disregard && C.client > 0) { + report, dist, self$lambda, self$theta,time.current + ) * self$nodes[[id.client]]$QR[[1]] + if(self$disregard.qr && report$disregard && C.client > 0) { C.client = -C.client * disregard.multiplier } r = -abs(report$note - client.note) + 1 QR.client.witness = C.client * r - node.witness = nodes[[report$issuer]] + node.witness = self$nodes[[report$issuer]] numerator = 0 denominator = 0 for(index.QR in 1:length(node.witness$QR)) { c.i = find.c.i( - theta, + self$theta, node.witness$time.QR[[1]], node.witness$time.QR[[index.QR]] ) @@ -297,17 +351,14 @@ TrustManager <- setRefClass( update.reputation = function(id.server) { "Update the reputation of the server" - node.server = nodes[[id.server]] + node.server = self$nodes[[id.server]] reputation = 0 for(report in node.server$reports) { - # if(disregard.qr && report$disregard) { - # next - # } if(report$server) { c.i = find.c.i( - theta, - nodes[[report$issuer]]$time.QR[[1]], + self$theta, + self$nodes[[report$issuer]]$time.QR[[1]], report$issuer.time.QR ) reputation = reputation + c.i * report$note * @@ -315,40 +366,40 @@ TrustManager <- setRefClass( } } node.server$reputation <- reputation - if(reputation < reputation.threshold) { - nodes <<- nodes[!nodes %in% id.server] + if(reputation < self$reputation.threshold) { + self$nodes <- self$nodes[!self$nodes %in% id.server] } }, phase = function(epochs.bootstrap, time.current) { "Perform a single set of phases" - info.gather(epochs.bootstrap, time.current) - id.client = round(runif(1, min=1, max=length(nodes))) - target.service = services[ - round(runif(1, min=1, max=length(services))) + self$info.gather(epochs.bootstrap, time.current) + id.client = round(runif(1, min=1, max=length(self$nodes))) + target.service = self$services[ + round(runif(1, min=1, max=length(self$services))) ] target.capability = round( - runif(1, min=1, max=capability.max) + runif(1, min=1, max=self$capability.max) ) - id.server = select.entity( + id.server = self$select.entity( id.client, target.service, target.capability, time.current )[[1]] - client.note = transaction( + client.note = self$transaction( id.client, id.server, target.service, target.capability, time.current ) - update.QRs( + self$update.QRs( id.client, id.server, client.note, target.service, - nodes[[id.server]]$capability, + self$nodes[[id.server]]$capability, time.current ) - update.reputation(id.server) + self$update.reputation(id.server) } ) )