algorithm – TomazTsql

Little useless-useful R functions – Using xspline to create wacky signatures

tomaztsql — Sun, 05 Mar 2023 14:40:00 +0000

Nothing short of wacky usage of plot() function with xspline to interpolate the points, but still a “parameter” short of Bezier’s curve.

Given two random vectors, you can generate a plot that, xspline will smooth out the plot and give it a “signaturey” look.

The function itself is straightforward:

inscrp <- function(rep){
          x <- rnorm(rep)
          y <- rnorm(rep)
          plot(x,y, pch = 1, col = "white",  xaxt='n',  yaxt='n', ann=FALSE, frame.plot=FALSE)
          xspline(x,y, 1, draw = TRUE, col="blue")
}

but the results are splendid

Run the following:

par(mfrow = c(2,1))

inscrp(10)
inscrp(20)

par(mfrow = c(1,1))

And you will get either a signature kind of look or a doctor’s drug prescription. The main point is, both are impossible to read

Adding more points (e.g.: above 50) to inscrp() function might result in a Picasso drawing

As always, code is available on the Github in the same Useless_R_function repository. Check Github for future updates.

Happy R-coding and stay healthy!“

Little useless-useful R functions – Greedy Salesman

tomaztsql — Mon, 15 Aug 2022 07:57:26 +0000

Travelling Salesman Problem is an NP-complete problem and an old mathematical problem. For this useless function, we will look for the nearest city from the previous city (or starting point) and repeat until we visit all cities. The greedy solution is fairly simplified but one disadvantage; it might not give you the best path (optimal solution) and proving that the solution is correct is an additional issue

So, the code will be looking for local optimum. And continue to optimize the best local solution to find global optima by selecting the best next choice (closest city). Compute complexity of greedy algorithms is O(n log(n)) with no guarantee that a global optimum is found.

Create some random data:

df_size <- 50
set.seed(2908)

cities <- data.frame(x = sample(rnorm(1,100,10),df_size,replace=TRUE),
                     y = sample(rnorm(1,100,10),df_size,replace=TRUE),
                     rn = 1:df_size)

And two functions. First function will be for searching the nearest city and the other one will be the complete algorithm:

# Absolute Nearest city function
nearest_city_absolute <- function(pos, cities){
  if (which.min(colSums((t(cities[,c("x","y")]) - pos)^2)) >= which.min(colSums((t(cities[,c("y","x")]) - pos)^2))) {
    id <- which.min(colSums((t(cities[,c("x","y")]) - pos)^2))
  } else {
    id <- which.min(colSums((t(cities[,c("y","x")]) - pos)^2))
  }
  return(cities[id, ])
}

# Nearest city function for coordinate system (where x and y must not be switched!)
nearest_city_coordinate <- function(pos, cities){
  id <- which.min(colSums((t(cities[,c("x","y")]) - pos)^2))
  return(cities[id, ])
}


# Greedy TSP algorithm
greedy_TSP <- function(cities){
  pos.ix <- (cities[sample(1:nrow(cities), 1), ])
  pos.ix.c <- c(pos.ix$y,pos.ix$x)
  tour <- pos.ix
  unvisited <- cities[!(cities$rn %in% pos.ix$rn), ]
  while (nrow(unvisited) > 0) {
    pos.ix <- tail(tour,1)
    pos.ix.c <- c(pos.ix$x, pos.ix$y)
    found <- nearest_city_absolute(pos.ix.c, unvisited)
   # found <- nearest_city_coordinate(pos.ix.c, unvisited)
    tour <- rbind(tour, found)
    unvisited <- unvisited[!(unvisited$rn %in% found$rn), ]

  }
  tour$name <- as.character(seq.int(nrow(tour)))
  return(tour)
}

And we can visualise the path of a greedy salesman

library(gganimate)

greedy_TSP(cities) %>%
  select (x, y, name) %>%
  mutate(time_name=as.numeric(name)) %>%
  uncount(df_size, .id = "frame") %>%
  filter(time_name <= frame) %>%
  arrange(frame, time_name) %>%
  group_by(frame) %>%
  mutate(x_lag = lag(x), 
         y_lag = lag(y),
         tail = last(time_name) - time_name,
         point_alpha = if_else(tail == 0, 1, 0.3),
         segment_alpha = pmax(0, (df_size-tail)/df_size)) %>%
  ungroup() %>%
  ggplot(aes(x=y, y=x, xend = y_lag, yend = x_lag, group = time_name)) +
  geom_segment(aes(alpha = segment_alpha)) +
  geom_point(aes(alpha = point_alpha, colour="red"), show.legend = FALSE) +
  labs(title = 'Greedy Salesman travelling between the cities', x= 'X-axis', y =  'Y-axis') +
  scale_alpha(range = c(0,1)) +
  guides(alpha = F) +
  transition_manual(frame)

Travelling between cities

As always, code is available on the Github in the same Useless_R_function repository. Check Github for future updates.

Happy R-coding and stay healthy!“

Kadane’s algorithm – finding maximum sum in contigous sub-array

tomaztsql — Mon, 28 Mar 2022 07:10:00 +0000

Great algorithm for analyzing timeseries data or array of numbers.

An algorithm for finding the contiguous subarray within a one-dimensional array of numbers that has the largest sum. It is called Kadane’s algorithm.

Largest sum

How does the algorithm work? It looks for a global maximum of positive-sum on any sub-array, regardless of its starting position or its length. Numbers must be next or together in a sequence (without any number left out).

With formula as: local_maximum at index i is the maximum of A[i] and the sum of A[i] and local_maximum at index i-1. So, you calculate the sum of every possible subarray ending with the element array[n-1]. Then, we would calculate the sum of every possible subarray ending with array[n-2], array[n-3] and so on up to array[0].

With a simple function we can iterate through the array (vector) of values:

#sample vector
v <- c(-3,-8, 1, -2, 1, 5, -3, -4, 3, 10, -2, 4, 1)

kadane <- function(v){
 
  max_so_far = -999999999999999 #some obnoxiously big number
  max_ending_here = 0
  
  for (i in 1:length(v)) {
    max_ending_here = max_ending_here  + v[i]
    if (max_so_far < max_ending_here ){
      max_so_far = max_ending_here
    }
    if (max_ending_here < 0) {
      max_ending_here = 0
    }
  }
  return (max_so_far)
}

Run the function with:

# run the function
kadane(v)

The function can also return the starting and ending positions of the array.

kadane_with_position <- function(v){
  max_so_far = -999999999999999 #some obnoxiously big number
  max_ending_here = 0
  subarray_start = 0
  subarray_end = 0
  int_s = 0
  
  for (i in 1:length(v)) {
    max_ending_here = max_ending_here  + v[i]
    if (max_so_far < max_ending_here ){
      max_so_far = max_ending_here
      subarray_start = int_s
      subarray_end = i
    }
    if (max_ending_here < 0) {
      max_ending_here = 0
      int_s =  i + 1 
    }
  }
  cat("Sum is: ", max_so_far, " with starting position: ", subarray_start, " and ending: ", subarray_end)
}

# run the function
kadane_with_position(v)

Kadane’s algorithm has also an interesting time complexity function. With O(n) for an array, it can explode exponentially when using 2D matrices: O(n^3).

R library Adagio offers this function with ability to calculate over matrices.

As always, code is available at Github in the same Useless_R_function repository. Check Github for future updates.

Happy R-coding and stay healthy!“