VZDÁLENOST V DATECH

euclid.dist <- function(v1,v2) sqrt(sum((v1-v2)^2))

hamming.dist <- function(v1,v2) sum(abs(v1-v2))

tchebyshev.dist <- function(v1,v2) max(abs(v1-v2))

minkowski.dist <- function(v1,v2,p) sum((abs(v1-v2)^p))^(1/p)

canberr.dist <- function(v1,v2) sum(abs(v1-v2)/(v1+v2))



my.data <- apply( iris[,c(1,2)],c(1,2),FUN=jitter)
plot(my.data)
points(my.data[1,,drop=FALSE],col="blue",pch=11)

m.dist <- euclid.dist
m.dist <- hamming.dist
m.dist <- tchebyshev.dist
m.dist <- function(x,y) {minkowski.dist(x,y,5)}
m.dist <- function(x,y) {minkowski.dist(x,y,2)}
m.dist <- function(x,y) {minkowski.dist(x,y,1.5)}
m.dist <- function(x,y) {minkowski.dist(x,y,1)}
m.dist <- canberr.dist

f <- function(a,b) {m.dist(my.data[1,],c(a,b))}

x <- seq(4,8,length=100)
y <- seq(2,4.5,length=100)

z <- matrix(NA,100,100)
for (i in 1:nrow(z))
  for (j in 1:ncol(z))
     z[i,j] <- f(x[i],y[j])

plot(my.data)
points(my.data[1,,drop=FALSE],col="blue",pch=11)
contour(
  x=x, y=y, z=z, 
  nlev=40, las=1, drawlabels=FALSE, lwd=3,
  add=TRUE
)


ŠKÁLOVÁNÍ

1] LINEÁRNÍ TRANSFORMACE

vec <- my.data[,1]
max.v <- max(vec)
min.v <- min(vec)
n.vec <- sapply(vec,FUN= function(vi) (vi-min.v)/(max.v-min.v))

plot(n.vec,vec)
plot(sapply(1:100,FUN= function(vi) (vi-1)/(100-1)),type="l" )


-- problém 1: odlehlé body:

vec[151] <- 150
max.v <- max(vec)
min.v <- min(vec)
n.vec <- sapply(vec,FUN= function(vi) (vi-min.v)/(max.v-min.v))

plot(n.vec,vec)

-- problém 2: nové body.

#------------

Řešení pro oba problémy:

KROK 1: nemapujeme na [0,1] ale na [a,1-a]

vec = vec[-151] 
max.v <- max(vec)
min.v <- min(vec)
a <- .2
n.vec <- sapply(vec,FUN= function(vi) (vi-min.v)/(max.v-min.v)*(1-2*a)+a)

plot(n.vec,vec)
plot(sapply(1:100,FUN= function(vi) (vi-1)/(100-1) * (1-2*a)+a ),type="l" )


KROK2: a hodnoty mimo "vtlačíme" do [0, a) a (1 - a, 0].

lin.fun <- function(vi) (vi-min.v)/(max.v-min.v)
squeeze.fun <- function(vi)
{
  if (vi > max.v) return(1 - (a / lin.fun(vi)))
  if (vi < min.v) return(a / (1 - lin.fun(vi)))
  return (lin.fun(vi) * (1-2*a) + a)
}

n.vec <- sapply(vec,FUN=squeeze.fun )
plot(n.vec,vec)

s <- seq(from=0,to=10,by=.1)
plot(s,sapply(s,FUN= squeeze.fun ),type="l")


-- podobné sigmoidě

s <- seq(from=-5,to=5,by=.1)
sig <- function(x) {1/(1+exp(-x))}
plot(s,sapply(s,FUN= sig ),type="l")


vyuzijeme (SOFTMAX):

vec <- vec[-151]
vec.mu <- mean(vec)
vec.mu
vec.sd <- sd(vec)
vec.sd
lambda <- 2

nvec <- sapply (vec, FUN=function(x) {(x- vec.mu)/(lambda* vec.sd/(2  * pi))})
nnvec <- sapply (nvec, FUN=sig)
plot(vec,nnvec)

# a nyni s odlehlym bodem

vec[151] <- 10
vec.mu <- mean(vec)
vec.mu
vec.sd <- sd(vec)
vec.sd
lambda <- 2

n.vec <- sapply (vec, FUN=function(x) {sig((x- vec.mu)/(lambda* vec.sd/(2  * pi)))})
plot(vec,n.vec)


# JAK TOTO OVLIVNUJE VZDALENOSTI?

my.data.mu <- apply(my.data,2,mean)
my.data.sd <- apply(my.data,2,sd)

plot(my.data)
points(my.data[1,,drop=FALSE],col="blue",pch=11)

x <- seq(4,8,length=100)
y <- seq(2,4.5,length=100)

softmax.col1 <- function(x) {sig((x- my.data.mu[1])/(lambda* my.data.sd[1]/(2  * pi)))}
softmax.col2 <- function(x) {sig((x- my.data.mu[2])/(lambda* my.data.sd[2]/(2  * pi)))}

z <- matrix(NA,100,100)



f <- function(a,b) {m.dist(c(softmax.col1(my.data[1,1]),
                             softmax.col2(my.data[1,2])),
                           c(softmax.col1(a),
                             softmax.col2(b)))}

m.dist <- euclid.dist
m.dist <- hamming.dist
m.dist <- tchebyshev.dist


for (i in 1:nrow(z))
  for (j in 1:ncol(z))
     z[i,j] <- f(x[i],y[j])

contour(
  x=x, y=y, z=z, 
  nlev=30, las=1, drawlabels=FALSE, lwd=3,
  add=TRUE, method="simple"
)

filled.contour(
  x=x, y=y, z=z, 
  nlev=30, las=1, drawlabels=FALSE, lwd=3,
  add=TRUE, method="simple"
)
points(my.data)
points(my.data[1,,drop=FALSE],col="blue",pch=11)

#--------------------------------------------------------

HIERARCHICKÉ SHLUKOVÁNÍ

<slajdy>

#--------------------------------------------------------

SHLUKOVÁNÍ ZALOŽENÉ NA ROZKLADU


dist1 <- euclid.dist

kmeans <- function(data,init)
{
    dist.matrix <- matrix(0,nrow(data),nrow(init))
    
    for (i in 1:nrow(data)) {
       closest.index <- 1
       closest.dist  <- dist1(data[i,],init[1,])

       for (j in 2:nrow(init)) {

	    act.dist <- dist1(data[i,],init[j,])

          if (closest.dist > act.dist)
	    {
              closest.dist <- act.dist
              closest.index <- j 
          }
       }
       dist.matrix[i,closest.index] = 1
    }

    for (j in 1:nrow(init)) {    
       init[j,] <- apply(data[dist.matrix[,j]==1,,drop=FALSE],2,mean)    
    }

    return(list(new.centers = init, dist.matrix=dist.matrix))
}


step1 <- kmeans(my.data[,c(1,2)],my.data[c(1,51,101),c(1,2)])

plot(my.data)

points(my.data[c(1,51,101),],col=c("blue","green","red"),pch=11)


arrows(my.data[c(1,51,101),1],my.data[c(1,51,101),2],
step1$new.centers[,1],
step1$new.centers[,2])


points(my.data[step1$dist.matrix[,1]==1,1:2], col = "blue")
points(my.data[step1$dist.matrix[,2]==1,1:2], col = "green")
points(my.data[step1$dist.matrix[,3]==1,1:2], col = "red")

points(step1$new.centers,col=c("blue","green","red"),pch=11)

step2 <- kmeans(my.data[,c(1,2)],step1$new.centers)

points(my.data[step2$dist.matrix[,1]==1,1:2], col = "blue")
points(my.data[step2$dist.matrix[,2]==1,1:2], col = "green")
points(my.data[step2$dist.matrix[,3]==1,1:2], col = "red")


arrows(
step1$new.centers[,1],
step1$new.centers[,2],
step2$new.centers[,1],
step2$new.centers[,2])

step3 <- kmeans(my.data[,c(1,2)],step2$new.centers)

points(my.data[step3$dist.matrix[,1]==1,1:2], col = "blue")
points(my.data[step3$dist.matrix[,2]==1,1:2], col = "green")
points(my.data[step3$dist.matrix[,3]==1,1:2], col = "red")

NEVÝHODY:

1] odlehlé body "kradou"

my.data <- rbind(my.data, c(15,15))

step1 <- kmeans(my.data[,c(1,2)],my.data[c(1,51,101),c(1,2)])

plot(my.data)

points(my.data[c(1,51,101),],col=c("blue","green","red"),pch=11)

points(my.data[step1$dist.matrix[,1]==1,1:2], col = "blue")
points(my.data[step1$dist.matrix[,2]==1,1:2], col = "green")
points(my.data[step1$dist.matrix[,3]==1,1:2], col = "red")

arrows(my.data[c(1,51,101),1],my.data[c(1,51,101),2],
step1$new.centers[,1],
step1$new.centers[,2])



step2 <- kmeans(my.data[,c(1,2)],step1$new.centers)

points(my.data[step2$dist.matrix[,1]==1,1:2], col = "blue")
points(my.data[step2$dist.matrix[,2]==1,1:2], col = "green")
points(my.data[step2$dist.matrix[,3]==1,1:2], col = "red")

points(step2$new.centers,col=c("blue","green","red"),pch=11)

arrows(
step1$new.centers[,1],
step1$new.centers[,2],
step2$new.centers[,1],
step2$new.centers[,2])

step3 <- kmeans(my.data[,c(1,2)],step2$new.centers)

points(step3$new.centers,col=c("blue","green","red"),pch=11)

points(my.data[step3$dist.matrix[,1]==1,1:2], col = "blue")
points(my.data[step3$dist.matrix[,2]==1,1:2], col = "green")
points(my.data[step3$dist.matrix[,3]==1,1:2], col = "red")

arrows(
step2$new.centers[,1],
step2$new.centers[,2],
step3$new.centers[,1],
step3$new.centers[,2])

step4 <- kmeans(my.data[,c(1,2)],step3$new.centers)

points(step4$new.centers,col=c("blue","green","red"),pch=11)

points(my.data[step4$dist.matrix[,1]==1,1:2], col = "blue")
points(my.data[step4$dist.matrix[,2]==1,1:2], col = "green")
points(my.data[step4$dist.matrix[,3]==1,1:2], col = "red")

arrows(
step3$new.centers[,1],
step3$new.centers[,2],
step4$new.centers[,1],
step4$new.centers[,2])

step5 <- kmeans(my.data[,c(1,2)],step4$new.centers)

points(step5$new.centers,col=c("blue","green","red"),pch=11)

points(my.data[step5$dist.matrix[,1]==1,1:2], col = "blue")
points(my.data[step5$dist.matrix[,2]==1,1:2], col = "green")
points(my.data[step5$dist.matrix[,3]==1,1:2], col = "red")

arrows(
step4$new.centers[,1],
step4$new.centers[,2],
step5$new.centers[,1],
step5$new.centers[,2])

step6 <- kmeans(my.data[,c(1,2)],step5$new.centers)

points(step6$new.centers,col=c("blue","green","red"),pch=11)

points(my.data[step6$dist.matrix[,1]==1,1:2], col = "blue")
points(my.data[step6$dist.matrix[,2]==1,1:2], col = "green")
points(my.data[step6$dist.matrix[,3]==1,1:2], col = "red")

arrows(
step5$new.centers[,1],
step5$new.centers[,2],
step6$new.centers[,1],
step6$new.centers[,2])

>> řešení:
--- odstranit je
--- škálování (softmax)
--- použít medoidy místo centroidů (k-medoids)



#-----------------------------------------------------------
2] Musíme předem zadat počet shluků

--- testnout více možností; vybrat tu nejlepší


#-----------------------------------------------------------
#-----------------------------------------------------------
K-MEDOIDS


kmedoids <- function(data,init)
{
    dist.matrix <- matrix(0,nrow(data),nrow(init))
    
    for (i in 1:nrow(data)) {
       closest.index <- 1
       closest.dist  <- dist1(data[i,],init[1,])

       for (j in 2:nrow(init)) {

	    act.dist <- dist1(data[i,],init[j,])

          if (closest.dist > act.dist)
	    {
              closest.dist <- act.dist
              closest.index <- j 
          }
       }
       dist.matrix[i,closest.index] = 1
    }

    new.init <- init;


    for (j in 1:nrow(init)) {    

       clust <- data[dist.matrix[,j]==1,,drop=FALSE]

       min.dist <- Inf
       medoid <- 0

	 for (i in 1:nrow(clust))
       {          
          new.dist <- sum(apply(clust,1, function(x) {m.dist(x,clust[i,])}))
          if (min.dist > new.dist)
          {
             min.dist <- new.dist
             medoid <- i
#             print(c(j,i,new.dist,clust[i,]))
          }
       }
 
       init[j,] <- clust[medoid,]
    }
    

    return(list(new.centers = init, dist.matrix=dist.matrix))
}


step1 <- kmedoids(my.data[,c(1,2)],my.data[1:3,])

plot(my.data)


points(my.data[1:3,],col=c("blue","green","red"),pch=11)

points(my.data[step1$dist.matrix[,1]==1,1:2], col = "blue")
points(my.data[step1$dist.matrix[,2]==1,1:2], col = "green")
points(my.data[step1$dist.matrix[,3]==1,1:2], col = "red")

arrows(my.data[1:3,1],my.data[1:3,2],
step1$new.centers[,1],
step1$new.centers[,2])