• EBImage

• image

• levelplot (Lattice)

• PCA for image

• Google map

EBImage

## Load the library by the following command
## source("http://bioconductor.org/biocLite.R")
## biocLite("EBImage")
library(EBImage)

• an R package which provides general purpose functionality for the reading, writing, processing and analysis of images.

• offers tools to transform the images, segment cells and extract quantitative cellular descriptors.

• Author: Andrzej Oles, Gregoire Pau, Mike Smith, Oleg Sklyar, Wolfgang Huber, with contributions from Joseph Barry and Philip A. Marais.

Image <- readImage("C:/Users/asusnb/Desktop/picture.JPG")
print(Image)

Image
  colormode: Color 
  storage.mode: double 
  dim: 960 720 3 
  nb.total.frames: 3 
  nb.render.frames: 1 

imageData(object)[1:5,1:6,1]:
          [,1]      [,2]      [,3]      [,4]      [,5]      [,6]
[1,] 0.5921569 0.5921569 0.5843137 0.5803922 0.5372549 0.4470588
[2,] 0.5490196 0.5568627 0.5607843 0.5843137 0.5803922 0.5333333
[3,] 0.5921569 0.5882353 0.5803922 0.5921569 0.5921569 0.5647059
[4,] 0.6117647 0.6039216 0.5803922 0.5803922 0.5843137 0.5647059
[5,] 0.5568627 0.5568627 0.5490196 0.5607843 0.5882353 0.5882353

#Use display(Image) to show the picture.

Lighter_Image <- Image + 0.2
Darker_Image <- Image - 0.2
#display(Lighter_Image); display(Darker_Image)

                 Brighter                     Darker

Low_Image <- Image*0.5
High_Image <- Image*2
#display(Low_Image); display(High_Image)

                     Low              High

Image2 <- Image^2
Image0_7 <- Image^0.7
#display(Image2); display(Image0_7)

                Gamma2                  Gamma0_7

#display(Image[200:850, 200:500,])

Imagetr <- translate(rotate(Image, 45), c(50, 0))
#display(Imagetr)

m2 <- matrix(0, nrow=40, ncol=10)
for(i in 1:10){
    m2[, i] <- rnorm(40, i, 1)
}

library(lattice)
levelplot

function (x, data, ...) 
UseMethod("levelplot")
<bytecode: 0x0000000008ad2f10>
<environment: namespace:lattice>

svd1 <- svd(scale(faceData))
#plot(svd1$d^2/sum(svd1$d^2), pch = 19, 
#     xlab = "Singular vector",
#     ylab = "Variance explained")

approx1 <- svd1$u[, 1] %*% t(svd1$v[, 1]) * svd1$d[1]
approx5 <- svd1$u[, 1:5] %*% diag(svd1$d[1:5]) %*% t(svd1$v[, 1:5])
approx10 <- svd1$u[, 1:10] %*% diag(svd1$d[1:10]) %*% t(svd1$v[, 1:10])

#par(mfrow = c(1, 4))
#image(approx1[, ncol(approx1):1], main = "(a)")
#image(approx5[, ncol(approx5):1], main = "(b)")
#image(approx10[, ncol(approx10):1], main = "(c)")
#image(faceData[, ncol(faceData):1], main = "(d)")

##http://data.gov.tw/node/7964
maildata=read.csv("C:/Users/asusnb/Desktop/maildata.csv")
data=maildata[,-c(2,3,4,5,6,7,8,9,10,11,12)]
#head(maildata)
#head(data)

data[,1][which(data[,1]=="2")]=1
data[,1][which(data[,1]=="3")]=2
data[,1][which(data[,1]=="4")]=2
data[,1][which(data[,1]=="5")]=3
data[,1][which(data[,1]=="6")]=3
data[,1][which(data[,1]=="7")]=4
data[,1][which(data[,1]=="8")]=4

data1=data[which(data[,1]=="1"),]
data2=data[which(data[,1]=="2"),]
data3=data[which(data[,1]=="3"),]
data4=data[which(data[,1]=="4"),]

get_nearist=function(place) { 
    where=NULL
    all=NULL
      for( i in 1:8988){
      where=(place[,1]-data[i,2])^2+(place[,2]-data[i,3])^2 
      all=c(all,where)
      }
    maildata[which(all==min(all)),]
}

library(ggmap)
(NTU=geocode('National Taiwan university'))

       lon      lat
1 121.5398 25.01734

#get_nearist(NTU)

library(ggplot2)
library(mapproj)
whereRU=function(place) { 
  map<-get_map(location = c(place[,1],place[,2]), zoom = 15, maptype = 'roadmap')
  ggmap(map)+
    geom_point(aes(x=here[,1],y=here[,2]),colour = 'black',size=4)+
    geom_point(data=data1,aes(x=data1[,2],y=data1[,3]),colour = 'red',size=4)+
    geom_point(data=data2,aes(x=data2[,2],y=data2[,3]),colour = 'green',size=4)+
    geom_point(data=data3,aes(x=data3[,2],y=data3[,3]),colour = 'blue',size=4)+
    geom_point(data=data4,aes(x=data4[,2],y=data4[,3]),colour = 'yellow',size=4)
}

here <- NTU
#whereRU(NTU)

TS=geocode(' TAIPEI STATION ')
here <- TS
#whereRU(TS)

NCCU=geocode('cheng chi university')
here <- NCCU
#whereRU(NCCU)

Pay attention to this!

##find NCCU something wrong
whereRU=function(place) { 
  map<-get_map(location = c(place[,1],place[,2]), zoom = 17, maptype = 'roadmap')
  ggmap(map)+
    geom_point(aes(x=here[,1],y=here[,2]),colour = 'black',size=4)+
    geom_point(data=data1,aes(x=data1[,2],y=data1[,3]),colour = 'red',size=4)+
    geom_point(data=data2,aes(x=data2[,2],y=data2[,3]),colour = 'green',size=4)+
    geom_point(data=data3,aes(x=data3[,2],y=data3[,3]),colour = 'blue',size=4)+
    geom_point(data=data4,aes(x=data4[,2],y=data4[,3]),colour = 'yellow',size=4)
}

here <- NCCU
#whereRU(NCCU)

R studio

R blogger for EBImage tutorial

R Markdown

EBImage

Lattice

Gamma Correction