How to bind/merge prcomp and predict data in r? - r

To plot a predicted validation/test data set within a training dataset in ggbiplot as addressed here, I would like to bind/merge the two datasets.
The given mwe is:
library(ggbiplot)
data(wine)
##pca on the wine dataset used as training data
wine.pca <- prcomp(wine, center = TRUE, scale. = TRUE)
##add the wine.classes as a column to the dataset
wine$class <- wine.class
##simulate test data by generating three new wine classes
wine.new.1 <- wine[c(sample(1:nrow(wine), 25)),]
wine.new.2 <- wine[c(sample(1:nrow(wine), 43)),]
wine.new.3 <- wine[c(sample(1:nrow(wine), 36)),]
##Predict PCs for the new classes by transforming
#them using the predict.prcomp function
pred.new.1 <- predict(wine.pca, newdata = wine.new.1)
pred.new.2 <- predict(wine.pca, newdata = wine.new.2)
pred.new.3 <- predict(wine.pca, newdata = wine.new.3)
##simulate the classes for the new sorts
wine.new.1$class <- rep("new.wine.1", nrow(wine.new.1))
wine.new.2$class <- rep("new.wine.2", nrow(wine.new.2))
wine.new.3$class <- rep("new.wine.3", nrow(wine.new.3))
And I've been using:
df.train.pred <- rbind(wine.pca$x, pred.new.1, pred.new.2, pred.new.3)
to fuse the two but ggbiplot returned an error as it Expected a object of class prcomp, princomp, PCA, or lda
How can I consolidate the two so they become an object ggbiplot accepts?

Related

R: Random forest with raster as response and explanitory variable

I want to create a fire occurence probability map with random forest method. My response variable is a raster with the mean annual burned area per grid cell. My explanitory variables are mulitple rasters (temperature, elevation, land use and population density). Is it possible to use a raster as the response variable and how would a basic codeline look like? I couldn't find any information on that.
files <- list.files(path="C:/Users/fsorb/OneDrive/Desktop/test/fire_prob", pattern="grd", all.files=FALSE, full.names=TRUE,recursive=TRUE)
predictors <- stack(files)
fire <- raster("C:/Users/fsorb/OneDrive/Desktop/test/env_data/fire.tif")
fire_occ_prob <- randomForest(fire ~ ., data = predictors, ntree=500)
So is the code I have so far, but I get the error: Error in as.data.frame.default(data) :
can not transform ‘structure("RasterStack", package = "raster")’ into data.frame
I tried to save the fire raster as.dataframe but all grid cells only get NA value.
I would try to
convert the response (fire) raster to points
extract the values of the predictors at the points
train a random forest model using the resulting data frame.
require(raster)
require(sf)
require(dplyr)
require(randomForest)
files <- list.files(path="C:/Users/fsorb/OneDrive/Desktop/test/fire_prob", pattern="grd", all.files=FALSE, full.names=TRUE,recursive=TRUE)
predictors <- stack(files)
fire <- raster("C:/Users/fsorb/OneDrive/Desktop/test/env_data/fire.tif")
# convert raster to point
response <- rasterToPoints(fire, spatial = TRUE) %>% st_as_sf()
response$ID <- c(1:nrow(response))
colnames(response)[1] <- "response"
# combine predictor values with the response
rs_preds <- full_join(terra::extract(x=r2, y=response, df=TRUE),
st_drop_geometry(response), by="ID")
# train random forest
fire_occ_prob <- randomForest(response ~ .,
data = rs_preds[,!names(rs_preds) %in% "ID"],
ntree=500,
importance = TRUE)
# plot variable importance
varImpPlot(fire_occ_prob)
# make spatial predictions
sp_pred <- raster::predict(predictors, model=fire_occ_prob)
If your aim is to make spatial (temporal) predictions, make sure to use a spatial (temporal) (cross-) validation strategy. For further information take a look at e.g. Roberts et al. (2016): https://doi.org/10.1111/ecog.02881
Greetings, Jan

unable to make scaled heatmap for diffrential gene analysis

Im new to R so be easy on me, I'm having trouble generating a heatmap for my genes. I performed diffrential gene analysis using DESeq2 package and found the 30 most downregulated genes and with fdr<0.05 for cell lines. I was trying to create a heatmap using the pheatmap package and I wasn't able to generate my heatmap as I want to. I want to generate a heatmap for my top 30 genes for each cell line(which are 8)
Here's my code :
dds <- DESeqDataSetFromMatrix(countData = GSM_subset,
colData = subset,
design = ~ Condition)
d_analysis <- DESeq(dds)
res <- results(d_analysis)
res
nrow(dds)
dds <- dds[rowSums(counts(dds)) > 1,]
nrow(dds)
mcols(res, use.names = TRUE)
summary(res)
resLFC1 <- results(d_analysis, lfcThreshold=3)
table(resLFC1$padj<0.05)
resLFC1 <- resLFC1[complete.cases(resLFC1),]
resLFC1
resSig <- subset(resLFC1, log2FoldChange=-3)
resSig <- subset(resLFC1, padj<0.05)
top30=head(resSig[ order(resSig$log2FoldChange), ],30)
top30<-as.data.frame(top30)
library(pheatmap)
pheatmap(top30)
Heatmaps in the genomics context usually use the scaled (that is Z-transformed) normalized counts on the log2 scale, or similar transformation such as vst or rlog from the DESeq2 package.
Given you already use DESeq2 you can do with dds being your DESeqDataSet:
vsd <- assay(vst(dds)) # log-normalized and variance-stabilized counts
Z <- t(scale(t(vsd))) # z-transformation
Z.select <- Z[your.genes.of.interest,] # subset to genes of interest
...and from there use the heatmap package of your choice.

R: variable has different number of levels in the node and in the data

I want to use bnlearn for a classification task with Naive Bayes algorithm.
I use this data set for my tests. Where 3 variables are continuous ()V2, V4, V10) and others are discrete. As far as I know bnlearn cannot work with continuous variables, so there is a need to convert them to factors or discretize. For now I want to convert all the features into factors. However, I came across to some problems. Here is a sample code
dataSet <- read.csv("creditcard_german.csv", header=FALSE)
# ... split into trainSet and testSet ...
trainSet[] <- lapply(trainSet, as.factor)
testSet[] <- lapply(testSet, as.factor)
# V25 is the class variable
bn = naive.bayes(trainSet, training = "V25")
fitted = bn.fit(bn, trainSet, method = "bayes")
pred = predict(fitted , testSet)
...
For this code I get an error message while calling predict()
'V1' has different number of levels in the node and in the data.
And when I remove that V1 from the training set, I get the same error for the V2 variable. However, error disappears when I do factorization dataSet [] <- lapply(dataSet, as.factor) and only than split it into training and test sets.
So which is the elegant solution for this? Because in real world applications test and train sets can be from different sources. Any ideas?
The issue appears to be caused by the fact that my train and test datasets had different factor levels. I solved this issue by using the rbind command to combine the two different dataframes (train and test), applying as.factor to get the full set of factors for the complete dataset, and then slicing the factorized dataframe back into separate train and test datasets.
train <- read.csv("train.csv", header=FALSE)
test <- read.csv("test.csv", header=FALSE)
len_train = dim(train)[1]
len_test = dim(test)[1]
complete <- rbind(learn, test)
complete[] <- lapply(complete, as.factor)
train = complete[1:len_train, ]
l = len_train+1
lf = len_train + len_test
test = complete[l:lf, ]
bn = naive.bayes(train, training = "V25")
fitted = bn.fit(bn, train, method = "bayes")
pred = predict(fitted , test)
I hope this can be helpful.

R object is not a matrix

I am new to R and trying to save my svm model in R and have read the documentation but still do not understand what is wrong.
I am getting the error "object is not a matrix" which would seem to mean that my data is not a matrix, but it is... so something is missing.
My data is defined as:
data = read.table("data.csv")
trainSet = as.data.frame(data[,1:(ncol(data)-1)])
Where the last line is my label
I am trying to define my model as:
svm.model <- svm(type ~ ., data=trainSet, type='C-classification', kernel='polynomial',scale=FALSE)
This seems like it should be correct but I am having trouble finding other examples.
Here is my code so far:
# load libraries
require(e1071)
require(pracma)
require(kernlab)
options(warn=-1)
# load dataset
SVMtimes = 1
KERNEL="polynomial"
DEGREE = 2
data = read.table("head.csv")
results10foldAll=c()
# Cross Fold for training and validation datasets
for(timesRun in 1:SVMtimes) {
cat("Running SVM = ",timesRun," result = ")
trainSet = as.data.frame(data[,1:(ncol(data)-1)])
trainClasses = as.factor(data[,ncol(data)])
model = svm(trainSet, trainClasses, type="C-classification",
kernel = KERNEL, degree = DEGREE, coef0=1, cost=1,
cachesize = 10000, cross = 10)
accAll = model$accuracies
cat(mean(accAll), "/", sd(accAll),"\n")
results10foldAll = rbind(results10foldAll, c(mean(accAll),sd(accAll)))
}
# create model
svm.model <- svm(type ~ ., data = trainSet, type='C-classification', kernel='polynomial',scale=FALSE)
An example of one of my samples would be:
10.135338 7.214543 5.758917 6.361316 0.000000 18.455875 14.082668 31
Here, trainSet is a data frame but in the svm.model function it expects data to be a matrix(where you are assigning trainSet to data). Hence, set data = as.matrix(trainSet). This should work fine.
Indeed as pointed out by #user5196900 you need a matrix to run the svm(). However beware that matrix object means all columns have same datatypes, all numeric or all categorical/factors. If this is true for your data as.matrix() may be fine.
In practice more than often people want to model.matrix() or sparse.model.matrix() (from package Matrix) which gives dummy columns for categorical variables, while having single column for numerical variables. But a matrix indeed.

NAs in rasters and randomForest::predict()

New here, please let me know if you need more info.
My goal: I am using Rehfeldt climate data and eBird presence/absence data to produce niche models using Random Forest models.
My problem: I want to predict niche models for the entirety of North America. The Rehfeldt climate rasters have data values for every cell on the continent, but these are surrounded by NAs in the "ocean cells". See the plot here, where I have colored the NAs dark green. randomForest::predict() does not run if the independent dataset contains NAs. Thus, I want to crop my climate rasters (or set a working extent?) so that the predict() function only operates over the cells which contain data.
Troubleshooting:
I've run the Random Forest model using a smaller extent which does not include the "NA oceans" of the rasters and the model runs just fine. So, I know the NAs are the problem. However, I don't want to predict my niche models for just a rectangular chunk of North America.
I used flowla's approach here for cropping and masking rasters using a polygon shapefile for North America. I hoped that this would remove the NAs but it doesn't. Is there something similar I can do to remove the NAs?
I've done some reading but can't figure out a way to adjust the Random Forest code itself so that predict() ignores NAs. This post looks relevant but I'm not sure whether it helps in my case.
Data
My rasters, the input presence/absence text file, and code for additional functions are here. Use with the main code below for a reproducible example.
Code
require(sp)
require(rgdal)
require(raster)
library(maptools)
library(mapproj)
library(dismo)
library(maps)
library(proj4)
data(stateMapEnv)
# This source code has all of the functions necessary for running the Random Forest models, as well as the code for the function detecting multi-collinearity
source("Functions.R")
# Read in Rehfeldt climate rasters
# these rasters were converted to .img and given WGS 84 projection in ArcGIS
d100 <- raster("d100.img")
dd0 <- raster("dd0.img")
dd5 <- raster("dd5.img")
fday <- raster("fday.img")
ffp <- raster("ffp.img")
gsdd5 <- raster("gsdd5.img")
gsp <- raster("gsp.img")
map <- raster("map.img")
mat <- raster("mat_tenths.img")
mmax <- raster("mmax_tenths.img")
mmin <- raster("mmin_tenths.img")
mmindd0 <- raster("mmindd0.img")
mtcm <- raster("mtcm_tenths.img")
mtwm <- raster("mtwm_tenths.img")
sday <- raster("sday.img")
smrpb <- raster("smrpb.img")
# add separate raster files into one big raster, with each file being a different layer.
rehfeldt <- addLayer(d100, dd0, dd5, fday, ffp, gsdd5, gsp, map, mat, mmax, mmin, mmindd0, mtcm, mtwm, sday, smrpb)
# plot some rasters to make sure everything worked
plot(d100)
plot(rehfeldt)
# read in presence/absence data
LAZB.INBUtemp <- read.table("LAZB.INBU.txt", header=T, sep = "\t")
colnames(LAZB.INBUtemp) <- c("Lat", "Long", "LAZB", "INBU")
LAZB.INBUtemp <- LAZB.INBUtemp[c(2,1,3,4)]
LAZB.INBU <- LAZB.INBUtemp
latpr <- (LAZB.INBU$Lat)
lonpr <- (LAZB.INBU$Long)
sites <- SpatialPoints(cbind(lonpr, latpr))
LAZB.INBU.spatial <- SpatialPointsDataFrame(sites, LAZB.INBU, match.ID=TRUE)
# The below function extracts raster values for each of the different layers for each of the eBird locations
pred <- raster::extract(rehfeldt, LAZB.INBU.spatial)
LAZB.INBU.spatial#data = data.frame(LAZB.INBU.spatial#data, pred)
LAZB.INBU.spatial#data <- na.omit(LAZB.INBU.spatial#data)
# ITERATIVE TEST FOR MULTI-COLINEARITY
# Determines which variables show multicolinearity
cl <- MultiColinear(LAZB.INBU.spatial#data[,7:ncol(LAZB.INBU.spatial#data)], p=0.05)
xdata <- LAZB.INBU.spatial#data[,7:ncol(LAZB.INBU.spatial#data)]
for(l in cl) {
cl.test <- xdata[,-which(names(xdata)==l)]
print(paste("REMOVE VARIABLE", l, sep=": "))
MultiColinear(cl.test, p=0.05)
}
# REMOVE MULTI-COLINEAR VARIABLES
for(l in cl) { LAZB.INBU.spatial#data <- LAZB.INBU.spatial#data[,-which(names(LAZB.INBU.spatial#data)==l)] }
################################################################################################
# FOR LAZB
# RANDOM FOREST MODEL AND RASTER PREDICTION
require(randomForest)
# NUMBER OF BOOTSTRAP REPLICATES
b=1001
# CREATE X,Y DATA
# use column 3 for LAZB and 4 for INBU
ydata <- as.factor(LAZB.INBU.spatial#data[,3])
xdata <- LAZB.INBU.spatial#data[,7:ncol(LAZB.INBU.spatial#data)]
# PERCENT OF PRESENCE OBSERVATIONS
( dim(LAZB.INBU.spatial[LAZB.INBU.spatial$LAZB == 1, ])[1] / dim(LAZB.INBU.spatial)[1] ) * 100
# RUN RANDOM FORESTS MODEL SELECTION FUNCTION
# This model is using the model improvement ratio to select a final model.
pdf(file = "LAZB Random Forest Model Rehfeldt.pdf")
( rf.model <- rf.modelSel(x=xdata, y=ydata, imp.scale="mir", ntree=b) )
dev.off()
# RUN RANDOM FORESTS CLASS BALANCE BASED ON SELECTED VARIABLES
# This code would help in the case of imbalanced sample
mdata <- data.frame(y=ydata, xdata[,rf.model$SELVARS])
rf.BalModel <- rfClassBalance(mdata[,1], mdata[,2:ncol(mdata)], "y", ntree=b)
# CREATE NEW XDATA BASED ON SELECTED MODEL AND RUN FINAL RF MODEL
sel.vars <- rf.model$PARAMETERS[[3]]
rf.data <- data.frame(y=ydata, xdata[,sel.vars])
write.table(rf.data, "rf.data.txt", sep = ",", row.names = F)
# This the code given to me; takes forever to run for my dataset (I haven't tried to let it finish)
# ( rf.final <- randomForest(y ~ ., data=rf.data, ntree=b, importance=TRUE, norm.votes=TRUE, proximity=TRUE) )
# I use this form because it's a lot faster
( rf.final <- randomForest(x = rf.data[2:6], y = rf.data$y, ntree=1000, importance=TRUE, norm.votes=TRUE, proximity=F) )
################################################################################################
# MODEL VALIDATION
# PREDICT TO VALIDATION DATA
# Determines the percent correctly classified
rf.pred <- predict(rf.final, rf.data[,2:ncol(rf.data)], type="response")
rf.prob <- as.data.frame(predict(rf.final, rf.data[,2:ncol(rf.data)], type="prob"))
ObsPred <- data.frame(cbind(Observed=as.numeric(as.character(ydata)),
PRED=as.numeric(as.character(rf.pred)), Prob1=rf.prob[,2],
Prob0=rf.prob[,1]) )
op <- (ObsPred$Observed == ObsPred$PRED)
( pcc <- (length(op[op == "TRUE"]) / length(op))*100 )
# PREDICT MODEL PROBABILITIES RASTER
# The first line of code says what directory I'm working, and then what folder in that directory has the raster files that I'm using to predict the range
# The second line defines the x variable, wich is my final Random Forest model
rpath=paste('~/YOURPATH', "example", sep="/")
xvars <- stack(paste(rpath, paste(rownames(rf.final$importance), "img", sep="."), sep="/"))
tr <- blockSize(xvars)
s <- writeStart(xvars[[1]], filename=paste('~/YOURPATH', "prob_LAZB_Rehfeldt.img", sep="/"), overwrite=TRUE)
for (i in 1:tr$n) {
v <- getValuesBlock(xvars, row=tr$row[i], nrows=tr$nrows[i])
v <- as.data.frame(v)
rf.pred <- predict(rf.final, v, type="prob")[,2]
writeValues(s, rf.pred, tr$row[i])
}
s <- writeStop(s)
prob_LAZB <- raster("prob_LAZB_Rehfeldt.img")
# Write range prediction raster to .pdf
pdf(file="LAZB_range_pred.pdf")
plot(prob_LAZB)
map("state", add = TRUE)
dev.off()
Thanks!!
Did you try setting 'na.action` in your call to RF? The option is clearly labelled in the randomForest R manual. Your call to RF would look like this:
rf.final <- randomForest(x = rf.data[2:6], y = rf.data$y, ntree=1000, importance=TRUE, norm.votes=TRUE, proximity=F, na.action = omit)
This will tell RF to omit rows where NA exists, thereby throwing out those observations. This is not necessarily the best approach, but it might be handy in your situation.
Option 2: rfImpute or na.roughfix: This will fill in your NAs so that you can go ahead with your prediction. Watch out as this can give you spurious predictions wherever the NAs are being imputed/"fixed".
Option 3: Start with Option 2, and after you get your prediction, bring your raster into your GIS/Image processing software of choice, and mask out the areas you don't want. In your case, masking out water bodies would be pretty simple.

Resources