Karol Niewiadomski / EMCRome2020

Commit 1296c0a8eb92ef35e22678fc9e55cf79a3175c79

Authored by Karol Niewiadomski
1 parent 5597cf6c
Exists in master

Polish versions of the scripts

Showing 6 changed files with 455 additions and 18 deletions   Show diff stats
Inline Side-by-side
.DS_Store 0 โ†’ 100644
View file @1296c0a
No preview for this file type
R/.DS_Store 0 โ†’ 100644
View file @1296c0a
No preview for this file type
R/SimulationsSwitchingsFun.R 0 โ†’ 100755
  Diff comments   View file @1296c0a
... ... @@ -0,0 +1,129 @@
  1 +#' Interference values
  2 +#'
  3 +#' Simulation of interference values at times t. Using the simple formula derived
  4 +#' analytically.
  5 +#'
  6 +#' @param t numerical vector
  7 +#' @param pc 1/switching frequency
  8 +#' @param duty duty cycle
  9 +#' @param t0 a numerical vector of initial starts ( assumed to be U(-pc, 0) )
  10 +#'
  11 +#' @return a numerical vector of values of interference at times t
  12 +#' @export
  13 +#'
  14 +#' @examples
  15 +Simulation <- function(t, pc, duty, t0, Np, A, f, lambda) {
  16 +
  17 + ii <- (seq_len(Np) - 1) * pc
  18 +
  19 + # Calculated parameters.
  20 + A1 <- purrr::map_dbl(t0, function(.t0) sum( cos(2 * pi * f * (ii - .t0)) * exp(-lambda * (ii - .t0)) ))
  21 + B1 <- purrr::map_dbl(t0, function(.t0) sum( sin(2 * pi * f * (ii - .t0)) * exp(-lambda * (ii - .t0)) ))
  22 + A2 <- purrr::map_dbl(t0, function(.t0) sum( cos(2 * pi * f * (ii - duty * pc - .t0)) * exp(-lambda * (ii - duty * pc - .t0)) ))
  23 + B2 <- purrr::map_dbl(t0, function(.t0) sum( sin(2 * pi * f * (ii - duty * pc - .t0)) * exp(-lambda * (ii - duty * pc - .t0)) ))
  24 +
  25 +
  26 +
  27 + y <- vector(mode = "numeric", length = length(t))
  28 + for(nk in seq_along(t0)) {
  29 + # From the reduced equation
  30 + t1 <- t - floor((t - t0[nk]) / pc) * pc
  31 + t2 <- t - floor((t - duty * pc - t0[nk]) / pc) * pc
  32 + C1 <- A * exp(-lambda * (t1))
  33 + C2 <- A * exp(-lambda * (t2))
  34 + f1 <- C1 * (A1[nk] * sin(2 * pi * f * (t1)) + B1[nk] * cos(2 * pi * f * (t1)))
  35 + f2 <- C2 * (A2[nk] * sin(2 * pi * f * (t2)) + B2[nk] * cos(2 * pi * f * (t2)))
  36 + y <- y + f1 - f2
  37 + }
  38 + return(y)
  39 +}
  40 +
  41 +# Assuming that t0 depicts the only the moments before the first bit sent.
  42 +SimulationNormal <- function(t, pc, duty, t0, Np, FunInter) {
  43 +
  44 + t1 <- purrr::map(t0, function(.t1) .t1 + seq(-2 * Np - 1, ceiling(max(t) / pc)) * pc)
  45 + t1 <- sort(purr::flatten_dbl(t1))
  46 +
  47 + KierWsp <- c("+" = 1, "-" = -1)
  48 + KierV <- c("+" = 0, "-" = 1)
  49 +
  50 + y <- vector(mode = "numeric", length = length(t))
  51 + for(.t1 in t1) {
  52 + for(kier in c("+", "-")) {
  53 + y <- y + KierWsp[kier] * FunInter(t - .t1 - KierV[kier] * duty * pc)
  54 + }
  55 + }
  56 + return(y)
  57 +
  58 +
  59 +}
  60 +
  61 +
  62 +
  63 +#' Instead of looping through switching instants, loop is over t
  64 +#' Since I want to check randomly chosen t for the error checking purpose.
  65 +SimulationNormalTimes <- function(t, pc, duty, t0, Np, FunInter) {
  66 +
  67 + # max(t) may induce a lot of switching instants
  68 + t1 <- purrr::map(t0, function(.t1) .t1 + seq(-2 * Np - 1, ceiling(max(t) / pc)) * pc)
  69 + t1 <-sort(flatten_dbl(t1))
  70 +
  71 + KierWsp <- c("+" = 1, "-" = -1)
  72 + KierV <- c("+" = 0, "-" = 1)
  73 +
  74 + y <- vector(mode = "numeric", length = length(t))
  75 + i <- 1
  76 + for(.t in t) {
  77 + # print(i)
  78 + for(kier in c("+", "-")) {
  79 + y[i] <- y[i] + sum(KierWsp[kier] * FunInter(.t - t1 - KierV[kier] * duty * pc))
  80 + }
  81 + i <- i + 1
  82 + }
  83 + return(y)
  84 +
  85 +
  86 +}
  87 +
  88 +
  89 +#' Simulation to check, if error comes from N_p selected values or from the equations.
  90 +#'
  91 +#'
  92 +SimulationNormalTimesNp <- function(t, pc, duty, t0, Np, FunInter) {
  93 +
  94 + # max(t) may induce a lot of switching instants
  95 + # NN <- length(t0)
  96 + t1 <- purrr::map(t0, function(.t1) .t1 + seq(-2 * Np - 1, ceiling(max(t) / pc)) * pc)
  97 + t1 <- sort(flatten_dbl(t1))
  98 +
  99 + KierWsp <- c("+" = 1, "-" = -1)
  100 + KierV <- c("+" = 0, "-" = 1)
  101 +
  102 + y <- vector(mode = "numeric", length = length(t))
  103 + i <- 1
  104 + for(.t in t) {
  105 + for(kier in c("+", "-")) {
  106 + # Take only the last Np values.
  107 + .t1 <- t1[ (t1 + KierV[kier] * duty * pc) < .t & (t1 + KierV[kier] * duty * pc) >= .t - Np * pc] + KierV[kier] * duty * pc
  108 + # cat("Length .t1:", length(.t1), "- NN * Np:", NN * Np, "\n")
  109 + y[i] <- y[i] + sum(KierWsp[kier] * FunInter(.t - .t1))
  110 + }
  111 + i <- i + 1
  112 + }
  113 + return(y)
  114 +
  115 +}
  116 +
  117 +
  118 +
  119 +NpFun <- function(tol, A, lambda, pc) {
  120 + ceiling( (log(A) - log(tol)) / (lambda * pc) )
  121 +}
  122 +
  123 +
  124 +sqwave <- function(t, t_on, duty, pc) {
  125 + yy <- rep(c(1, 0), times = length(t_on))
  126 + tt <- sort(c(t_on, t_on + duty * pc))
  127 + f1 <- approxfun(tt, yy, method = "constant")
  128 + return(f1(t))
  129 +}
0 130 \ No newline at end of file
... ...
R/StrukturaPlikow.R 0 โ†’ 100644
  Diff comments   View file @1296c0a
... ... @@ -0,0 +1,183 @@
  1 +#' ลปeby moje symulacje miaล‚y jakikolwiek sens, chciaล‚bym stworzyฤ‡ strukturฤ™
  2 +#' porzฤ…dkujฤ…ca te symulacje. Tym sposobem, nie bฤ™dฤ™ zawsze musiaล‚ siฤ™ zastanawiaฤ‡
  3 +#' we jaki sposรณb porzadkowaฤ‡ pliki.
  4 +#' Moim celem jest, ลผeby stworzyฤ‡ tabelฤ™, w ktรณrej trzymane bฤ™dฤ… parametry
  5 +#' oraz nazwa pliku, w ktรณrym symulacje z danymi parametrami bฤ™dฤ… przechowywane.
  6 +#'
  7 +#' Chodzi rรณwnieลผ o to, ลผeby tฤ™ tabelฤ™ moลผna byล‚o w prosty sposรณb uaktualniaฤ‡ dodajฤ…c
  8 +#' nowe wiersze, jeล›liby doszล‚y nowe pliki.
  9 +#'
  10 +#' Tabela powinna mieฤ‡ takลผe kolumnฤ™ ze wskaลบnikiem na wersjฤ™ (w przypadku
  11 +#' powtรณrzenia symulacji z tymi samymi parametrami) oraz komentarz, jeล›li
  12 +#' jest jakiล› potrzebny.
  13 +#'
  14 +library(tidyverse)
  15 +library(feather)
  16 +
  17 +# Struktura ----
  18 +struktura <- tibble(
  19 +
  20 + # nazwa pliku
  21 + plik = character(),
  22 +
  23 + # nazwa pliku z zawartymi oryginalnymi przesuniฤ™ciami t0
  24 + plik_t0 = character(),
  25 +
  26 + # wersja symulacji
  27 + version = integer(),
  28 +
  29 + # czฤ™stotliwoล›ฤ‡ transmisji danych
  30 + fd = numeric(),
  31 +
  32 + # dt = 1 / fd
  33 + dt = numeric(),
  34 +
  35 + # czฤ™stotliwoล›ฤ‡ wล‚ฤ…czania konwerterรณw.
  36 + fc = numeric(),
  37 +
  38 + # odlegล‚oล›ฤ‡ pomiฤ™dzy kolejnymi wล‚ฤ…czeniami (pc = 1/fc)
  39 + pc = numeric(),
  40 +
  41 + # duty cycle
  42 + duty = numeric(),
  43 +
  44 + # liczba konwerterรณw
  45 + NK = integer(),
  46 +
  47 + # liczba rund (powtรณrzeล„ symulacji)
  48 + rounds = integer(),
  49 +
  50 + # liczba bitรณw w ramce
  51 + N = integer(),
  52 +
  53 + # Parametry interferencji
  54 + # czฤ™stotliwoล›ฤ‡ interferencji
  55 + f = numeric(),
  56 +
  57 + # amplituda
  58 + A = numeric(),
  59 +
  60 + # parametr tล‚umienia
  61 + lambda = numeric(),
  62 +
  63 + # liczba okresรณw pc trwania sygnaล‚u
  64 + Np = integer(),
  65 +
  66 + # tolerancja dla trwania sygnaล‚u
  67 + tol = numeric()
  68 +
  69 +
  70 +)
  71 +
  72 +# write_feather(struktura, "Results/struktura.feather")
  73 +
  74 +
  75 +# base_folder <- "/Volumes/Macbook Pro HDD /Doktorat/SCENT/Simulations/"
  76 +base_folder <- "/Users/karolniewiadomski/Documents/SCENT/Simulations/"
  77 +
  78 +# Funkcje do czytania plikรณw ----
  79 +read_structure <- function() {
  80 + feather::read_feather(file.path(base_folder, "Results/struktura.feather"))
  81 +}
  82 +
  83 +
  84 +write_structure <- function(base_folder, new_structure) {
  85 + confirmation <- readline(prompt = "Do you really want to rewrite the current structure table? (y/n)")
  86 + if(confirmation == 'y') {
  87 + feather::write_feather(new_structure, file.path(base_folder, 'Results/struktura.feather'))
  88 + }
  89 +}
  90 +
  91 +#' TODO: make checks whenever possible,
  92 +#' especially check for the current rows to already exist.
  93 +update_structure <- function(updated) {
  94 + old_structure <- feather::read_feather(file.path(base_folder, "Results/struktura.feather"))
  95 + old_classes <- map(old_structure, class)
  96 + new_classes <- map(updated, class)
  97 +
  98 + classes_equal <- all.equal(old_classes, new_classes)
  99 +
  100 + if (class(classes_equal) == "logical") {
  101 + if (classes_equal) {
  102 + new_structure <- bind_rows(old_structure, updated)
  103 + feather::write_feather(new_structure, file.path(base_folder, "Results/struktura.feather"))
  104 + }
  105 + } else {
  106 + stop("Something is missing, check classes of your file.")
  107 + }
  108 +}
  109 +
  110 +
  111 +
  112 +
  113 +
  114 +
  115 +#' TODO: check if it is possible not to read everytime.
  116 +get_structure_classes <- function() {
  117 + x <- feather::read_feather(file.path(base_folder, "Results/struktura.feather"))
  118 + map(x, class)
  119 +}
  120 +
  121 +
  122 +
  123 +
  124 +
  125 +
  126 +# Assuming that names are not mixed up.
  127 +repair_classes <- function(new_structure) {
  128 + removes <- list("integer" = as.integer, "character" = as.character, "numeric" = as.numeric)
  129 + classes <- get_structure_classes()
  130 + nms <- names(new_structure)
  131 + for( i in seq(1, length(new_structure))) {
  132 +
  133 + new_structure[, i] <- mutate_all(new_structure[, i], removes[[classes[[nms[i]]]]])
  134 + }
  135 + return(new_structure)
  136 +}
  137 +
  138 +
  139 +
  140 +
  141 +# Example of usage
  142 +# new_structure <- list("cos", 1, 123, 1 / 123, 12, 1/234, 0.5, 4, 100, 4)
  143 +# names(new_structure) <- names(read_structure())
  144 +# new_structure <- as_tibble(new_structure)
  145 +# classes <- get_structure_classes()
  146 +#
  147 +# nms <- names(new_structure)
  148 +# for( i in seq(1, length(new_structure))) {
  149 +# class(new_structure[, i]) <- classes[[nms[i]]]
  150 +# }
  151 +#
  152 +# update_structure(new_structure)
  153 +
  154 +
  155 +create_file_name <- function(NK, fc, fd, t0 = FALSE, ext = ".rds") {
  156 + fc <- format(fc, scientific = FALSE)
  157 + fd <- format(fd, scientific = FALSE)
  158 + if (t0) {
  159 + return(stringr::str_interp("nk_$[.3d]{NK}_fc_${fc}_fd_${fd}_t0${ext}") )
  160 + } else {
  161 + return(stringr::str_interp("nk_$[.3d]{NK}_fc_${fc}_fd_${fd}${ext}"))
  162 + }
  163 +}
  164 +
  165 +# it is not very quick. - could work on that a bit more.
  166 +convert_file_name <- function(filename) {
  167 + # Could do with str_exctract_all but this is safer.
  168 + nk <- str_extract(filename, "nk_([:digit:]+)")
  169 + fc <- str_extract(filename, "fc_([:digit:]+)")
  170 + fd <- str_extract(filename, "fd_([:digit:]+)")
  171 + all_nums <- map(c(nk, fc, fd), function(x) parse_number(str_extract(x, "([:digit:]+)")) )
  172 + names(all_nums) <- c("NK", "fc", "fd")
  173 + return(all_nums)
  174 +}
  175 +
  176 +
  177 +
  178 +
  179 +
  180 +
  181 +
  182 +
  183 +
... ...
R/hello.R deleted
View file @5597cf6
... ... @@ -1,18 +0,0 @@
1   -# Hello, world!
2   -#
3   -# This is an example function named 'hello'
4   -# which prints 'Hello, world!'.
5   -#
6   -# You can learn more about package authoring with RStudio at:
7   -#
8   -# http://r-pkgs.had.co.nz/
9   -#
10   -# Some useful keyboard shortcuts for package authoring:
11   -#
12   -# Install Package: 'Cmd + Shift + B'
13   -# Check Package: 'Cmd + Shift + E'
14   -# Test Package: 'Cmd + Shift + T'
15   -
16   -hello <- function() {
17   - print("Hello, world!")
18   -}
R/readingFuns.R 0 โ†’ 100644
  Diff comments   View file @1296c0a
... ... @@ -0,0 +1,143 @@
  1 +source("StrukturaPlikow.R")
  2 +TF <- read_structure()
  3 +
  4 +read_nk <- function(.version = 6, nk, .type = "odl") {
  5 + # Weลบmy konkretnฤ… czฤ™stotliwoล›ฤ‡.
  6 + TF <- TF %>% filter(version == .version)
  7 + # TF <- TF %>% filter(fc == 20000)
  8 + TF <- TF %>% filter(NK == nk)
  9 + V_th <- 3
  10 +
  11 + TD <- tibble()
  12 + for(i in seq_len(nrow(TF))) {
  13 + obj <- TF[i, ]
  14 + filename <- obj$plik
  15 + V <- read_rds(filename)
  16 + T2 <- map_dfr(V, function(syg) {
  17 + syg <- unlist(syg)
  18 + rley <- rle(abs(syg) >= V_th)
  19 + les <- rley$lengths
  20 + les <- les[-c(1, length(les))]
  21 + vals <- rley$values
  22 + vals <- vals[-c(1, length(vals))]
  23 +
  24 + if( .type == "zak" ) {
  25 + return(
  26 + with(obj,
  27 + tibble(
  28 + NK = NK,
  29 + pc = pc, fc = fc,
  30 + fd = fd, dt = dt,
  31 + A = A, f = f, lambda = lambda,
  32 + type = "zak", value = les[vals], N = N
  33 + ))
  34 + )
  35 + } else if( .type == "odl" ) {
  36 + return(
  37 + with(obj,
  38 + tibble(
  39 + NK = NK,
  40 + pc = pc, fc = fc,
  41 + fd = fd, dt = dt,
  42 + A = A, f = f, lambda = lambda,
  43 + type = "odl", value = les[!vals], N = N
  44 + ))
  45 + )
  46 + } else if( .type == "both" ) {
  47 + return(
  48 + with(obj, bind_rows(
  49 + tibble(
  50 + NK = NK,
  51 + pc = pc, fc = fc,
  52 + fd = fd, dt = dt,
  53 + A = A, f = f, lambda = lambda,
  54 + type = "zak", value = les[vals], N = N
  55 + ),
  56 + tibble(
  57 + NK = NK,
  58 + pc = pc, fc = fc,
  59 + fd = fd, dt = dt,
  60 + A = A, f = f, lambda = lambda,
  61 + type = "odl", value = les[!vals], N = N
  62 + )
  63 + ))
  64 + )
  65 + }
  66 + })
  67 +
  68 + TD <- bind_rows(TD, T2)
  69 + }
  70 + return(TD)
  71 +}
  72 +
  73 +
  74 +read_freq <- function(.version = 6, freq, .type = "odl") {
  75 +
  76 + # Weลบmy konkretnฤ… czฤ™stotliwoล›ฤ‡.
  77 + TF <- TF %>% filter(version == .version)
  78 + TF <- TF %>% filter(fc == freq)
  79 + # TF <- TF %>% filter(NK == nk)
  80 + V_th <- 3
  81 +
  82 + TD <- tibble()
  83 + for(i in seq_len(nrow(TF))) {
  84 + obj <- TF[i, ]
  85 + filename <- obj$plik
  86 + V <- read_rds(filename)
  87 + T2 <- map_dfr(V, function(syg) {
  88 + syg <- unlist(syg)
  89 + rley <- rle(abs(syg) >= V_th)
  90 + les <- rley$lengths
  91 + les <- les[-c(1, length(les))]
  92 + vals <- rley$values
  93 + vals <- vals[-c(1, length(vals))]
  94 +
  95 + if( .type == "zak" ) {
  96 + return(
  97 + with(obj,
  98 + tibble(
  99 + NK = NK,
  100 + pc = pc, fc = fc,
  101 + fd = fd, dt = dt,
  102 + A = A, f = f, lambda = lambda,
  103 + type = "zak", value = les[vals], N = N
  104 + ))
  105 + )
  106 + } else if( .type == "odl" ) {
  107 + return(
  108 + with(obj,
  109 + tibble(
  110 + NK = NK,
  111 + pc = pc, fc = fc,
  112 + fd = fd, dt = dt,
  113 + A = A, f = f, lambda = lambda,
  114 + type = "odl", value = les[!vals], N = N
  115 + ))
  116 + )
  117 + } else if( .type == "both" ) {
  118 + return(
  119 + with(obj, bind_rows(
  120 + tibble(
  121 + NK = NK,
  122 + pc = pc, fc = fc,
  123 + fd = fd, dt = dt,
  124 + A = A, f = f, lambda = lambda,
  125 + type = "zak", value = les[vals], N = N
  126 + ),
  127 + tibble(
  128 + NK = NK,
  129 + pc = pc, fc = fc,
  130 + fd = fd, dt = dt,
  131 + A = A, f = f, lambda = lambda,
  132 + type = "odl", value = les[!vals], N = N
  133 + )
  134 + ))
  135 + )
  136 + }
  137 + })
  138 +
  139 + TD <- bind_rows(TD, T2)
  140 + }
  141 + return(TD)
  142 +
  143 +}
... ...