workflow for image analysis and metrics using RTextureMetrics - r

I'm working with grayscale (0 black; 255 white) images (2560 x 2048) of surfaces and would like to extract Haralick et al 1973 metrics (ASM, contrast, etc.) using package RTextureMetrics.
The following are the grayscale values (0 to 255) of the initial 5 rows and columns from the matrix (a sample image):
Image2[1:5, 1:5]
[,1] [,2] [,3] [,4] [,5]
[1,] 35 33 29 29 36
[2,] 43 41 39 40 47
[3,] 44 44 44 47 54
[4,] 46 49 51 54 60
[5,] 60 64 67 68 71
From here the workflow seems quite straightforward: generate the Grey Level Co-occurrence Matrix using genGLCM() and extract desired metrics.
library(RTextureMetrics)
# Generate Grey Level Co-occurrence Matrix (direction east, distance one pixel)
GLCM = genGLCM(1, 1, Image2)
# Get desired metrics
calcCON(GLCM)
calcHOM(GLCM)
calcDIS(GLCM)
calcASM(GLCM)
calcENT(GLCM)
However, results seem odd. Haralik et al report a maximum contrast of 4.709 while the above sample matrix has a contrast of 25.3388 (the below table shows metrics from the sample matrix). Additionally, when looping over files of images, counterintuitive results are obtained.
Cont
Hom
Dis
ASM
ENT
25.3388
0.192384
3.9036
0.00028943
-7.6482
Please note that I am new to texture analysis and my experience is limited. Also have been trying package glcm but an initial workflow with RTextureMetrics seems more desireble.

Related

The first row is missing from head() function in R

Something interesting(strange) occured to me when I was trying to pull some data from the etf_env object from the rutils package.
First of all I created a variable called 'foo'.
foo <- as.list(rutils::etf_env)["VTI"]
Then I tried to call the head() function and here is the result.
> head(foo$VTI, n = 6)
VTI.Open VTI.High VTI.Low VTI.Close VTI.Volume VTI.Adjusted
2001-06-01 41.89521 42.18640 41.64041 42.0772 2542200 42.0772
2001-06-04 42.25920 42.29560 41.96801 42.2592 1018200 42.2592
2001-06-05 42.36841 42.95080 42.36841 42.8780 562400 42.8780
2001-06-06 42.76879 42.87799 42.47760 42.5140 278500 42.5140
2001-06-07 42.47761 42.73240 42.36841 42.7324 236700 42.7324
The first row is missing!
Then I created a random matrix called 'mat' and I tried to call the head() function again.
> mat <- matrix(1:100,ncol = 5)
> head(mat, n = 6)
[,1] [,2] [,3] [,4] [,5]
[1,] 1 21 41 61 81
[2,] 2 22 42 62 82
[3,] 3 23 43 63 83
[4,] 4 24 44 64 84
[5,] 5 25 45 65 85
[6,] 6 26 46 66 86
The head() function seems working just fine. How and why did this happen? I'm really scratching my head right now. Hope somebody knows the answer. Many thanks!

What can do to find and remove semi-duplicate rows in a matrix?

Assume I have this matrix
set.seed(123)
x <- matrix(rnorm(410),205,2)
x[8,] <- c(0.13152348, -0.05235148) #similar to x[5,]
x[16,] <- c(1.21846582, 1.695452178) #similar to x[11,]
The values are very similar to the rows specified above, and in the context of the whole data, they are semi-duplicates. What could I do to find and remove them? My original data is an array that contains many such matrices, but the position of the semi duplicates is the same across all matrices.
I know of agrep but the function operates on vectors as far as I understand.
You will need to set a threshold, but you can just compute the distance between each row using dist and find the points that are sufficiently close together. Of course, Each point is near itself, so you need to ignore the diagonal of the distance matrix.
DM = as.matrix(dist(x))
diag(DM) = 1 ## ignore diagonal
which(DM < 0.025, arr.ind=TRUE)
row col
8 8 5
5 5 8
16 16 11
11 11 16
48 48 20
20 20 48
168 168 71
91 91 73
73 73 91
71 71 168
This finds the "close" points that you created and a few others that got generated at random.

R - Apply function with different argument value for each row/column of a matrix

I am trying to apply a function to each row or column of a matrix, but I need to pass a different argument value for each row.
I thought I was familiar with lapply, mapply etc... But probably not enough.
As a simple example :
> a<-matrix(1:100,ncol=10);
> a
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 1 11 21 31 41 51 61 71 81 91
[2,] 2 12 22 32 42 52 62 72 82 92
[3,] 3 13 23 33 43 53 63 73 83 93
[4,] 4 14 24 34 44 54 64 74 84 94
[5,] 5 15 25 35 45 55 65 75 85 95
[6,] 6 16 26 36 46 56 66 76 86 96
[7,] 7 17 27 37 47 57 67 77 87 97
[8,] 8 18 28 38 48 58 68 78 88 98
[9,] 9 19 29 39 49 59 69 79 89 99
[10,] 10 20 30 40 50 60 70 80 90 100
Let's say I want to apply a function to each row, I would do :
apply(a, 1, myFunction);
However my function takes an argument, so :
apply(a, 1, myFunction, myArgument);
But if I want my argument to take a different value for each row, I cannot find the right way to do it.
If I define a 'myArgument' with multiple values, the whole vector will obviously be passed to each call of 'myFunction'.
I think that I would need a kind of hybrid between apply and the multivariate mapply. Does it make sense ?
One 'dirty' way to achieve my goal is to split the matrix by rows (or columns), use mapply on the resulting list and merge the result back to a matrix :
do.call(rbind, Map(myFunction, split(a,row(a)), as.list(myArgument)));
I had a look at sweep, aggregate, all the *apply variations but I wouldn't find the perfect match to my need. Did I miss it ?
Thank you for your help.
You can use sweep to do that.
a <- matrix(rnorm(100),10)
rmeans <- rowMeans(a)
a_new <- sweep(a,1,rmeans,`-`)
rowMeans(a_new)
I don't think there are any great answers, but you can somewhat simplify your solution by using mapply, which handles the "rbind" part for you, assuming your function always returns the same sizes vector (also, Map is really just mapply):
a <- matrix(1:80,ncol=8)
myFun <- function(x, y) (x - mean(x)) * y
myArg <- 1:nrow(a)
t(mapply(myFun, split(a, row(a)), myArg))
I know the topic is quiet old but I had the same issue and I solved it that way:
# Original matrix
a <- matrix(runif(n=100), ncol=5)
# Different value for each row
v <- runif(n=nrow(a))
# Result matrix -> Add a column with the row number
o <- cbind(1:nrow(a), a)
fun <- function(x, v) {
idx <- 2:length(x)
i <- x[1]
r <- x[idx] / v[i]
return(r)
}
o <- t(apply(o, 1, fun, v=v)
By adding a column with the row number to the left of the original matrix, the index of the needed value from the argument vector can be received from the first column of the data matrix.

How to write function that takes uses the single ouput from another function as starting point for new analysis?

I'm having trouble writing a function that calls another function and uses the output as the basis for running new analysis in a loop (or equivalent). For example, let's say function 1 creates this output: 10. The second function would take that as a starting point to run new analysis. The single data point from the second output would then be the basis for the next round of analysis, and so on.
Here's a simple example. The question is how to create a for loop for this. Or perhaps there's a more efficient way using lapply. In any case, the first function might be as follows:
f.1 <-function(x) {
x
a <-seq(x,by=1,length.out=5)
a.1 <-tail(a,1)
}
The second function, which calls the first function, could run as follows:
f.2 <-function(x) {
f.1 <-function(x) {
a <-seq(x,by=1,length.out=5)
a.1 <-tail(a,1)
}
z <-f.1(x)
y=z+1
seq(y,by=1,length.out=5)
}
How can I modify f.2() so that it re-runs that computation using the previous output as the basis for the next round of analysis. To be precise, f.1(10) outputs:
[1] 14
In turn, f.2(10) results in:
[1] 15 16 17 18 19
How can I re-write f.2() so that it automatically computes f.2(19) on the next iteration, and continually do so for several loops. In the process, I'd like to collect the outputs in a separate file for review. Thanks much!
The magrittr library (which is used most notably by dplyr) makes this type of chaining somewhat simple. First, define the functions,
f.1 <-function(x) {
x
a <- seq(x, by=1, length.out=5)
a.1 <- tail(a,1)
}
f.2 <-function(x) {
y <- x+1
seq(y, by=1, length.out=5)
}
then
library(magrittr)
f.1(10) %>% f.2
# [1] 15 16 17 18 19
As #BondedDust mentioned, you could use Reduce although normally it expects to use the same function over and over so you just need to flip the most common use case
Reduce(function(x,f) f(x), list(f.1, f.2), init=10)
# [1] 15 16 17 18 19
You can try this with two arguments for f.2. The first argument is the x value that you need to initialize x with and n is the number of iterations that you want to do. The output of the function will be a matrix containing n rows and 5 columns.
f.2 <-function(x, n) {
c <- matrix(nrow=n, ncol=5)
for (i in 1:nrow(c))
{
z <-f.1(x) ##if you have already defined your f.1(x) beforehand, there is no need to define it again in f.2. you can simply use z <- f.1(x) like it is done here
y=z+1
c[i,] = seq(y, by=1, length.out=5)
x = c[i,5]
}
return(c)
}
The output of
f <- f.2(10, 10) ##initialising x with 10 and running 10 loops
f
[,1] [,2] [,3] [,4] [,5]
[1,] 15 16 17 18 19
[2,] 24 25 26 27 28
[3,] 33 34 35 36 37
[4,] 42 43 44 45 46
[5,] 51 52 53 54 55
[6,] 60 61 62 63 64
[7,] 69 70 71 72 73
[8,] 78 79 80 81 82
[9,] 87 88 89 90 91
[10,] 96 97 98 99 100

Data frame to 3D array and calculate mean in Z

I have a data frame read from CSV which contains 14 columns and 990 rows. Each set of 110 rows contains repeats of structured data (not the values) with the first 5 columns being labels.
I now want to create a new grid of 14x110, such that if columns are labelled with letters and rows are numbered numerically, then A1 to E110 of the new grid are the labels and F1 contains the mean average of F1 in the original frame, and so on through to N110.
I have never used R before, and have got as far as calculating the mean of one cell with
mean(data[c(seq.int(3,nrow(d),110)),c(6)])
but I need some help with repeating this for the rest of the cells and constructing a resulting data frame, please.
To transform an matrix to a 3D array
yourarray=array(unlist(yourmatrix),dim = c(110,14,9))
Then to take an average of z values you can do something like
out=matrix(NA,110,14)
for(n in 1:14){
for(i in 1:110){out[i,n]=mean(b[i,n,])}}
Example
a=matrix(1:125,25,5)
b=array(unlist(a),dim = c(5,5,5))
out=matrix(NA,5,5)
for(n in 1:5){
for(i in 1:5){out[i,n]=mean(b[i,n,])}}
> out
[,1] [,2] [,3] [,4] [,5]
[1,] 51 56 61 66 71
[2,] 52 57 62 67 72
[3,] 53 58 63 68 73
[4,] 54 59 64 69 74
[5,] 55 60 65 70 75
Hope this is what you're after.

Resources