diff --git a/.DS_Store b/.DS_Store new file mode 100644 index 0000000..eaa13d6 Binary files /dev/null and b/.DS_Store differ diff --git a/R/.DS_Store b/R/.DS_Store new file mode 100644 index 0000000..2cca869 Binary files /dev/null and b/R/.DS_Store differ diff --git a/R/SimulationsSwitchingsFun.R b/R/SimulationsSwitchingsFun.R new file mode 100755 index 0000000..b91d3bd --- /dev/null +++ b/R/SimulationsSwitchingsFun.R @@ -0,0 +1,129 @@ +#' Interference values +#' +#' Simulation of interference values at times t. Using the simple formula derived +#' analytically. +#' +#' @param t numerical vector +#' @param pc 1/switching frequency +#' @param duty duty cycle +#' @param t0 a numerical vector of initial starts ( assumed to be U(-pc, 0) ) +#' +#' @return a numerical vector of values of interference at times t +#' @export +#' +#' @examples +Simulation <- function(t, pc, duty, t0, Np, A, f, lambda) { + + ii <- (seq_len(Np) - 1) * pc + + # Calculated parameters. + A1 <- purrr::map_dbl(t0, function(.t0) sum( cos(2 * pi * f * (ii - .t0)) * exp(-lambda * (ii - .t0)) )) + B1 <- purrr::map_dbl(t0, function(.t0) sum( sin(2 * pi * f * (ii - .t0)) * exp(-lambda * (ii - .t0)) )) + A2 <- purrr::map_dbl(t0, function(.t0) sum( cos(2 * pi * f * (ii - duty * pc - .t0)) * exp(-lambda * (ii - duty * pc - .t0)) )) + B2 <- purrr::map_dbl(t0, function(.t0) sum( sin(2 * pi * f * (ii - duty * pc - .t0)) * exp(-lambda * (ii - duty * pc - .t0)) )) + + + + y <- vector(mode = "numeric", length = length(t)) + for(nk in seq_along(t0)) { + # From the reduced equation + t1 <- t - floor((t - t0[nk]) / pc) * pc + t2 <- t - floor((t - duty * pc - t0[nk]) / pc) * pc + C1 <- A * exp(-lambda * (t1)) + C2 <- A * exp(-lambda * (t2)) + f1 <- C1 * (A1[nk] * sin(2 * pi * f * (t1)) + B1[nk] * cos(2 * pi * f * (t1))) + f2 <- C2 * (A2[nk] * sin(2 * pi * f * (t2)) + B2[nk] * cos(2 * pi * f * (t2))) + y <- y + f1 - f2 + } + return(y) +} + +# Assuming that t0 depicts the only the moments before the first bit sent. +SimulationNormal <- function(t, pc, duty, t0, Np, FunInter) { + + t1 <- purrr::map(t0, function(.t1) .t1 + seq(-2 * Np - 1, ceiling(max(t) / pc)) * pc) + t1 <- sort(purr::flatten_dbl(t1)) + + KierWsp <- c("+" = 1, "-" = -1) + KierV <- c("+" = 0, "-" = 1) + + y <- vector(mode = "numeric", length = length(t)) + for(.t1 in t1) { + for(kier in c("+", "-")) { + y <- y + KierWsp[kier] * FunInter(t - .t1 - KierV[kier] * duty * pc) + } + } + return(y) + + +} + + + +#' Instead of looping through switching instants, loop is over t +#' Since I want to check randomly chosen t for the error checking purpose. +SimulationNormalTimes <- function(t, pc, duty, t0, Np, FunInter) { + + # max(t) may induce a lot of switching instants + t1 <- purrr::map(t0, function(.t1) .t1 + seq(-2 * Np - 1, ceiling(max(t) / pc)) * pc) + t1 <-sort(flatten_dbl(t1)) + + KierWsp <- c("+" = 1, "-" = -1) + KierV <- c("+" = 0, "-" = 1) + + y <- vector(mode = "numeric", length = length(t)) + i <- 1 + for(.t in t) { + # print(i) + for(kier in c("+", "-")) { + y[i] <- y[i] + sum(KierWsp[kier] * FunInter(.t - t1 - KierV[kier] * duty * pc)) + } + i <- i + 1 + } + return(y) + + +} + + +#' Simulation to check, if error comes from N_p selected values or from the equations. +#' +#' +SimulationNormalTimesNp <- function(t, pc, duty, t0, Np, FunInter) { + + # max(t) may induce a lot of switching instants + # NN <- length(t0) + t1 <- purrr::map(t0, function(.t1) .t1 + seq(-2 * Np - 1, ceiling(max(t) / pc)) * pc) + t1 <- sort(flatten_dbl(t1)) + + KierWsp <- c("+" = 1, "-" = -1) + KierV <- c("+" = 0, "-" = 1) + + y <- vector(mode = "numeric", length = length(t)) + i <- 1 + for(.t in t) { + for(kier in c("+", "-")) { + # Take only the last Np values. + .t1 <- t1[ (t1 + KierV[kier] * duty * pc) < .t & (t1 + KierV[kier] * duty * pc) >= .t - Np * pc] + KierV[kier] * duty * pc + # cat("Length .t1:", length(.t1), "- NN * Np:", NN * Np, "\n") + y[i] <- y[i] + sum(KierWsp[kier] * FunInter(.t - .t1)) + } + i <- i + 1 + } + return(y) + +} + + + +NpFun <- function(tol, A, lambda, pc) { + ceiling( (log(A) - log(tol)) / (lambda * pc) ) +} + + +sqwave <- function(t, t_on, duty, pc) { + yy <- rep(c(1, 0), times = length(t_on)) + tt <- sort(c(t_on, t_on + duty * pc)) + f1 <- approxfun(tt, yy, method = "constant") + return(f1(t)) +} \ No newline at end of file diff --git a/R/StrukturaPlikow.R b/R/StrukturaPlikow.R new file mode 100644 index 0000000..6ba6134 --- /dev/null +++ b/R/StrukturaPlikow.R @@ -0,0 +1,183 @@ +#' Żeby moje symulacje miały jakikolwiek sens, chciałbym stworzyć strukturę +#' porządkująca te symulacje. Tym sposobem, nie będę zawsze musiał się zastanawiać +#' we jaki sposób porzadkować pliki. +#' Moim celem jest, żeby stworzyć tabelę, w której trzymane będą parametry +#' oraz nazwa pliku, w którym symulacje z danymi parametrami będą przechowywane. +#' +#' Chodzi również o to, żeby tę tabelę można było w prosty sposób uaktualniać dodając +#' nowe wiersze, jeśliby doszły nowe pliki. +#' +#' Tabela powinna mieć także kolumnę ze wskaźnikiem na wersję (w przypadku +#' powtórzenia symulacji z tymi samymi parametrami) oraz komentarz, jeśli +#' jest jakiś potrzebny. +#' +library(tidyverse) +library(feather) + +# Struktura ---- +struktura <- tibble( + + # nazwa pliku + plik = character(), + + # nazwa pliku z zawartymi oryginalnymi przesunięciami t0 + plik_t0 = character(), + + # wersja symulacji + version = integer(), + + # częstotliwość transmisji danych + fd = numeric(), + + # dt = 1 / fd + dt = numeric(), + + # częstotliwość włączania konwerterów. + fc = numeric(), + + # odległość pomiędzy kolejnymi włączeniami (pc = 1/fc) + pc = numeric(), + + # duty cycle + duty = numeric(), + + # liczba konwerterów + NK = integer(), + + # liczba rund (powtórzeń symulacji) + rounds = integer(), + + # liczba bitów w ramce + N = integer(), + + # Parametry interferencji + # częstotliwość interferencji + f = numeric(), + + # amplituda + A = numeric(), + + # parametr tłumienia + lambda = numeric(), + + # liczba okresów pc trwania sygnału + Np = integer(), + + # tolerancja dla trwania sygnału + tol = numeric() + + +) + +# write_feather(struktura, "Results/struktura.feather") + + +# base_folder <- "/Volumes/Macbook Pro HDD /Doktorat/SCENT/Simulations/" +base_folder <- "/Users/karolniewiadomski/Documents/SCENT/Simulations/" + +# Funkcje do czytania plików ---- +read_structure <- function() { + feather::read_feather(file.path(base_folder, "Results/struktura.feather")) +} + + +write_structure <- function(base_folder, new_structure) { + confirmation <- readline(prompt = "Do you really want to rewrite the current structure table? (y/n)") + if(confirmation == 'y') { + feather::write_feather(new_structure, file.path(base_folder, 'Results/struktura.feather')) + } +} + +#' TODO: make checks whenever possible, +#' especially check for the current rows to already exist. +update_structure <- function(updated) { + old_structure <- feather::read_feather(file.path(base_folder, "Results/struktura.feather")) + old_classes <- map(old_structure, class) + new_classes <- map(updated, class) + + classes_equal <- all.equal(old_classes, new_classes) + + if (class(classes_equal) == "logical") { + if (classes_equal) { + new_structure <- bind_rows(old_structure, updated) + feather::write_feather(new_structure, file.path(base_folder, "Results/struktura.feather")) + } + } else { + stop("Something is missing, check classes of your file.") + } +} + + + + + + +#' TODO: check if it is possible not to read everytime. +get_structure_classes <- function() { + x <- feather::read_feather(file.path(base_folder, "Results/struktura.feather")) + map(x, class) +} + + + + + + +# Assuming that names are not mixed up. +repair_classes <- function(new_structure) { + removes <- list("integer" = as.integer, "character" = as.character, "numeric" = as.numeric) + classes <- get_structure_classes() + nms <- names(new_structure) + for( i in seq(1, length(new_structure))) { + + new_structure[, i] <- mutate_all(new_structure[, i], removes[[classes[[nms[i]]]]]) + } + return(new_structure) +} + + + + +# Example of usage +# new_structure <- list("cos", 1, 123, 1 / 123, 12, 1/234, 0.5, 4, 100, 4) +# names(new_structure) <- names(read_structure()) +# new_structure <- as_tibble(new_structure) +# classes <- get_structure_classes() +# +# nms <- names(new_structure) +# for( i in seq(1, length(new_structure))) { +# class(new_structure[, i]) <- classes[[nms[i]]] +# } +# +# update_structure(new_structure) + + +create_file_name <- function(NK, fc, fd, t0 = FALSE, ext = ".rds") { + fc <- format(fc, scientific = FALSE) + fd <- format(fd, scientific = FALSE) + if (t0) { + return(stringr::str_interp("nk_$[.3d]{NK}_fc_${fc}_fd_${fd}_t0${ext}") ) + } else { + return(stringr::str_interp("nk_$[.3d]{NK}_fc_${fc}_fd_${fd}${ext}")) + } +} + +# it is not very quick. - could work on that a bit more. +convert_file_name <- function(filename) { + # Could do with str_exctract_all but this is safer. + nk <- str_extract(filename, "nk_([:digit:]+)") + fc <- str_extract(filename, "fc_([:digit:]+)") + fd <- str_extract(filename, "fd_([:digit:]+)") + all_nums <- map(c(nk, fc, fd), function(x) parse_number(str_extract(x, "([:digit:]+)")) ) + names(all_nums) <- c("NK", "fc", "fd") + return(all_nums) +} + + + + + + + + + diff --git a/R/hello.R b/R/hello.R deleted file mode 100644 index 3d348f2..0000000 --- a/R/hello.R +++ /dev/null @@ -1,18 +0,0 @@ -# Hello, world! -# -# This is an example function named 'hello' -# which prints 'Hello, world!'. -# -# You can learn more about package authoring with RStudio at: -# -# http://r-pkgs.had.co.nz/ -# -# Some useful keyboard shortcuts for package authoring: -# -# Install Package: 'Cmd + Shift + B' -# Check Package: 'Cmd + Shift + E' -# Test Package: 'Cmd + Shift + T' - -hello <- function() { - print("Hello, world!") -} diff --git a/R/readingFuns.R b/R/readingFuns.R new file mode 100644 index 0000000..35efe33 --- /dev/null +++ b/R/readingFuns.R @@ -0,0 +1,143 @@ +source("StrukturaPlikow.R") +TF <- read_structure() + +read_nk <- function(.version = 6, nk, .type = "odl") { + # Weźmy konkretną częstotliwość. + TF <- TF %>% filter(version == .version) + # TF <- TF %>% filter(fc == 20000) + TF <- TF %>% filter(NK == nk) + V_th <- 3 + + TD <- tibble() + for(i in seq_len(nrow(TF))) { + obj <- TF[i, ] + filename <- obj$plik + V <- read_rds(filename) + T2 <- map_dfr(V, function(syg) { + syg <- unlist(syg) + rley <- rle(abs(syg) >= V_th) + les <- rley$lengths + les <- les[-c(1, length(les))] + vals <- rley$values + vals <- vals[-c(1, length(vals))] + + if( .type == "zak" ) { + return( + with(obj, + tibble( + NK = NK, + pc = pc, fc = fc, + fd = fd, dt = dt, + A = A, f = f, lambda = lambda, + type = "zak", value = les[vals], N = N + )) + ) + } else if( .type == "odl" ) { + return( + with(obj, + tibble( + NK = NK, + pc = pc, fc = fc, + fd = fd, dt = dt, + A = A, f = f, lambda = lambda, + type = "odl", value = les[!vals], N = N + )) + ) + } else if( .type == "both" ) { + return( + with(obj, bind_rows( + tibble( + NK = NK, + pc = pc, fc = fc, + fd = fd, dt = dt, + A = A, f = f, lambda = lambda, + type = "zak", value = les[vals], N = N + ), + tibble( + NK = NK, + pc = pc, fc = fc, + fd = fd, dt = dt, + A = A, f = f, lambda = lambda, + type = "odl", value = les[!vals], N = N + ) + )) + ) + } + }) + + TD <- bind_rows(TD, T2) + } + return(TD) +} + + +read_freq <- function(.version = 6, freq, .type = "odl") { + + # Weźmy konkretną częstotliwość. + TF <- TF %>% filter(version == .version) + TF <- TF %>% filter(fc == freq) + # TF <- TF %>% filter(NK == nk) + V_th <- 3 + + TD <- tibble() + for(i in seq_len(nrow(TF))) { + obj <- TF[i, ] + filename <- obj$plik + V <- read_rds(filename) + T2 <- map_dfr(V, function(syg) { + syg <- unlist(syg) + rley <- rle(abs(syg) >= V_th) + les <- rley$lengths + les <- les[-c(1, length(les))] + vals <- rley$values + vals <- vals[-c(1, length(vals))] + + if( .type == "zak" ) { + return( + with(obj, + tibble( + NK = NK, + pc = pc, fc = fc, + fd = fd, dt = dt, + A = A, f = f, lambda = lambda, + type = "zak", value = les[vals], N = N + )) + ) + } else if( .type == "odl" ) { + return( + with(obj, + tibble( + NK = NK, + pc = pc, fc = fc, + fd = fd, dt = dt, + A = A, f = f, lambda = lambda, + type = "odl", value = les[!vals], N = N + )) + ) + } else if( .type == "both" ) { + return( + with(obj, bind_rows( + tibble( + NK = NK, + pc = pc, fc = fc, + fd = fd, dt = dt, + A = A, f = f, lambda = lambda, + type = "zak", value = les[vals], N = N + ), + tibble( + NK = NK, + pc = pc, fc = fc, + fd = fd, dt = dt, + A = A, f = f, lambda = lambda, + type = "odl", value = les[!vals], N = N + ) + )) + ) + } + }) + + TD <- bind_rows(TD, T2) + } + return(TD) + +} -- libgit2 0.21.2