Counting dots in the Picture

library(imager)

Load image

mainDir <- "/run/media/issactoast/My Passport/Documents/Blog/R-programming/Topics/R imager"
setwd(mainDir)
tmp <- load.image("test.jpg")
plot(tmp, axes = FALSE)

Denoising

tmp[tmp < quantile(tmp[tmp>0], 0.99)] <- 0
tmp <- isoblur(tmp, 2)

# Check the result
plot(tmp, axes = FALSE)

Pulling out the points whose color is NOT almost black(value > 0.1).

df <- as.data.frame(tmp) %>% subset(value > 0.1)
centers <- dplyr::group_by(df,value) %>%
  dplyr::summarise(mx=mean(x),my=mean(y))

#check the result
plot(tmp)
with(centers, points(mx, my, col="red"))

We can check the number of points we have and what they look like:

coor <- as.matrix(centers[,2:3])
head(coor)

##       mx  my
## [1,] 280 250
## [2,] 223  47
## [3,] 267 177
## [4,] 467  87
## [5,] 282 153
## [6,] 215  51

dim(coor)

## [1] 4948    2

There are many points but we can see they are sticking together. Thus, we can use k-mean algorithm to classify them into the desired categories based on the eucledian distance. Let’s prepare some variables:

# Do k-mean
l <- length(coor[,1])
membership <- rep(0, l)
class.point <- coor[1,]

# Distance function between point and class.points set
dist.m <- function(x, y){
  if (is.null(dim(y))) sqrt( sum((x-y)^2) )
  else sqrt(rowSums(sweep(y, 2, x)^2))
}

K-mean algorithm

Set our radius r and do clustering:

r <- 10
while(TRUE){
  for (i in 1:l){
    d <- dist.m(coor[i,], class.point)
    if (min(d) > r){
      # updata class
      class.point <- rbind(class.point, coor[i, ])
      
      # updata membership
      membership[i] <- length(class.point[,1])
    } else {
      membership[i] <- which.min(d)
    }
  }
  
  # class point update
  class.point <- aggregate(coor, list(membership), mean)[,2:3]

  # closest distance between classes
  k <- length(class.point[,1])
  d <- min(as.vector(dist(class.point, method = "euclidean")))

  # do this until the closest distance is larger than radius
  if (d > r) break
  else {
    a <- which.min(as.vector(dist(class.point, method = "euclidean")))
    nearClass <- which( (a - cumsum((k-1):1)) < 0 )[1]
    class.point <- class.point[-nearClass, ]
    row.names(class.point) <- 1:(k-1)
  }
}

Check the result

par(mfrow = c(1,2), mar = c(0.2,0.2,0.2,0.2))
plot(tmp, axes = FALSE)
plot(tmp, axes = FALSE)
points(class.point[,1], class.point[,2], col="white")

Number of points:

## [1] 28