Add labels in dendogram in R - r

I am trying to apply Hierarchical Clustering for Time Series in order to identify the states with similar behaviors in the time series for residential_percent_change_from_baseline. I get the dendrogram but the index i get in the x axis are just numbers and I want the states names.
my data looks like this:
Data
And this is some part of my code
data <- dataset
#Convert to factor
cols <- c("country_region_code", "country_region", "sub_region_1", "iso_3166_2_code")
data[cols] <- lapply(data[cols], factor)
sapply(data, class)
data$date <- as.Date(data$date)
summary(data)
#Data preparation
n <- 10
s <- sample(1:100, n)
i <- c(s,0+s, 279+s, 556+s, 833+s, 1110+s, 1387+s, 1664+s, 1941+s, 2218+s, 2495+s, 2772+s, 3049+s, 3326+s, 3603+s, 3880+s, 4157+s, 4434+s, 4711+s, 4988+s, 5265+s, 5542+s, 5819+s, 6096+s, 6373+s, 6650+s, 6927+s, 7204+s, 7481+s, 7758+s, 8035+s, 8312+s, 8589+s, 8866+s)
d <- data[i,3:4]
d$residential <- data[i,11]
d[,2] =NULL
str(d)
pattern <- c(rep('Mexico', n),
rep('Aguascalientes', n),
rep('Baja California',n),
rep('Baja California Sur',n),
rep('Campeche',n),
rep('Coahuila',n),
rep('Colima',n),
rep('Chiapas',n),
rep('Chihuahua',n),
rep('Durango',n),
rep('Guanajuato',n),
rep('Guerrero',n),
rep('Hidalgo',n),
rep('Jalisco',n),
rep('México City',n),
rep('Michoacan',n),
rep('Morelos',n),
rep('Nayarit',n),
rep('Nuevo León',n),
rep('Oaxaca',n),
rep('Puebla',n),
rep('Querétaro',n),
rep('Quintana Roo',n),
rep('San Luis Potosí',n),
rep('Sinaloa',n),
rep('Sonora',n),
rep('Tabasco',n),
rep('Tamaulipas',n),
rep('Tlaxcala',n),
rep('Veracruz',n),
rep('Yucatán',n),
rep('Zacatecas.',n))
d <- data.matrix(d)
distance <- dist(d, method = 'euclidean')
hc <- hclust(distance, method="ward.D")
plot(hc, cex=.7, hang = -1, col='blue', labels=pattern)
I get this dendrogram when I don't specify labels
dendrogram with numeric labels
But when I do I get this error
Error in graphics:::plotHclust(n1, merge, height, order(x$order), hang, : invalid dendrogram input
I hope somebody can help me, I am little bit tired of this

Maybe it will work with an alternative to the base r plot function. Try ggdendroplot. It should display the labels on the axis. You will need ggplot2 for this.
devtools::install("nicolash2/ggdendroplot")
library(ggdendroplot)
library(ggplot2)
ggplot() + geom_dendro(hc)
If you want to modify it (turn it, color it, etc.) check out the github page: https://github.com/NicolasH2/ggdendroplot

Related

Recursive / Expanding Window forecasts

I am having a small issue with my Rstudio code. I will try to replicate my code but unfortunately there is no easy data for me to show. This is about the package forecast. What I am looking for is somehwat simpler for what is in the manual. But unfortunately, I am not able to work round it.
so the issue is with an expanding window forecast. So I have a dependent variable Y and 3 regressors (X). I am trying to build a recursive one steap ahead forecast for each X.
Here is my code.
library(forecast)
library(zoo)
library(timeDate)
library(xts)
## Load data
data = Dataset[,2:ncol(Dataset)]
st <- as.Date("1990-1-1")
en <- as.Date("2020-12-1")
tt <- seq(st, en, by = "1 month")
data = xts(data, order.by=tt)
##########################################################################
RECFORECAST=function (Y,X,h,window){
st <- as.Date("1990-1-1")
en <- as.Date("2020-12-1")
tt <- seq(st, en, by = "1 month")
datas= cbind(Y,X)
newfcast= matrix(0,nrow(datas),h)
for (k in 1:nrow(datas)){
sample =datas[1:(window+k-1),]
# print(sample)
v= window+k
# print(v)
# fit = Arima(sample[,1], order=c(0,0,0),xreg=sample[,2])
fit = lm(sample[,1]~sample[,2], data = sample)
# fcast=forecast(fit,xreg=rep(sample[v,2],h))$mean
fcast = forecast.lm(fit,sample[v,2],h=1)$mean
print(fcast)
# print(fcast)
# newfcast[k+window+1,]=fcast
}
print(newfcast)
return(newfcast)
}
## Code to send the loop into forecasts
StoreMatrix = data$growth ## This is the first column data[,1]
for (i in 2:4)
{
try({
X=data[,i]
Y=data[,1]
RecModel=RECFORECAST(Y,X,h=1,window=60) ##Here the initial window is 60 obs
StoreMatrix=cbind(StoreMatrix,RecModel)
print(StoreMatrix)
}, silent=T)
}
The bits # were different ways I tried to crosscheck my data and they may not be useful. I have tried so many things but I don't seem to be able to get my head through it. At the end I want to have a matrix (StoreMatrix) with the first variable being the realization, and each of the columns with the corresponding 1 step ahead forecast.
The main lines where there seems to be an issue are these ones:
# fcast=forecast(fit,xreg=rep(sample[v,2],h))$mean
fcast = forecast.lm(fit,sample[v,2],h=1)$mean
Note sure how to solve this. Thank you very much.

Error with plot function object not found

When I try and generate a plot with the below I receive an Object not found for the fertility rate.
I've used str and names to make sure I've got the name correct.
there is a file ("https://sds-platform-private.s3-us-east-2.amazonaws.com/uploads/P2-Section5-Homework-Data.csv) that I have to use also.
From what I can see everything should run ok. But I've obviously done something wrong as I get:
Error in plot(data = New_Data1960, x = Fertility.Rate, y =
Life_Expectancy_At_Birth_1960, : object 'Fertility.Rate' not found
Can someone explain why I'm getting this error and how I can fix it?
#Execute below code to generate three new vectors
Country_Code <- c("ABW","AFG","AGO","ALB","ARE","ARG","ARM","ATG","AUS","AUT","AZE","BDI","BEL","BEN","BFA","BGD","BGR","BHR","BHS","BIH","BLR","BLZ","BOL","BRA","BRB","BRN","BTN","BWA","CAF","CAN","CHE","CHL","CHN","CIV","CMR","COG","COL","COM","CPV","CRI","CUB","CYP","CZE","DEU","DJI","DNK","DOM","DZA","ECU","EGY","ERI","ESP","EST","ETH","FIN","FJI","FRA","FSM","GAB","GBR","GEO","GHA","GIN","GMB","GNB","GNQ","GRC","GRD","GTM","GUM","GUY","HKG","HND","HRV","HTI","HUN","IDN","IND","IRL","IRN","IRQ","ISL","ITA","JAM","JOR","JPN","KAZ","KEN","KGZ","KHM","KIR","KOR","KWT","LAO","LBN","LBR","LBY","LCA","LKA","LSO","LTU","LUX","LVA","MAC","MAR","MDA","MDG","MDV","MEX","MKD","MLI","MLT","MMR","MNE","MNG","MOZ","MRT","MUS","MWI","MYS","NAM","NCL","NER","NGA","NIC","NLD","NOR","NPL","NZL","OMN","PAK","PAN","PER","PHL","PNG","POL","PRI","PRT","PRY","PYF","QAT","ROU","RUS","RWA","SAU","SDN","SEN","SGP","SLB","SLE","SLV","SOM","SSD","STP","SUR","SVK","SVN","SWE","SWZ","SYR","TCD","TGO","THA","TJK","TKM","TLS","TON","TTO","TUN","TUR","TZA","UGA","UKR","URY","USA","UZB","VCT","VEN","VIR","VNM","VUT","WSM","YEM","ZAF","COD","ZMB","ZWE")
Life_Expectancy_At_Birth_1960 <- c(65.5693658536586,32.328512195122,32.9848292682927,62.2543658536585,52.2432195121951,65.2155365853659,65.8634634146342,61.7827317073171,70.8170731707317,68.5856097560976,60.836243902439,41.2360487804878,69.7019512195122,37.2782682926829,34.4779024390244,45.8293170731707,69.2475609756098,52.0893658536585,62.7290487804878,60.2762195121951,67.7080975609756,59.9613658536585,42.1183170731707,54.2054634146342,60.7380487804878,62.5003658536585,32.3593658536585,50.5477317073171,36.4826341463415,71.1331707317073,71.3134146341463,57.4582926829268,43.4658048780488,36.8724146341463,41.523756097561,48.5816341463415,56.716756097561,41.4424390243903,48.8564146341463,60.5761951219512,63.9046585365854,69.5939268292683,70.3487804878049,69.3129512195122,44.0212682926829,72.1765853658537,51.8452682926829,46.1351219512195,53.215,48.0137073170732,37.3629024390244,69.1092682926829,67.9059756097561,38.4057073170732,68.819756097561,55.9584878048781,69.8682926829268,57.5865853658537,39.5701219512195,71.1268292682927,63.4318536585366,45.8314634146342,34.8863902439024,32.0422195121951,37.8404390243902,36.7330487804878,68.1639024390244,59.8159268292683,45.5316341463415,61.2263414634146,60.2787317073171,66.9997073170732,46.2883170731707,64.6086585365854,42.1000975609756,68.0031707317073,48.6403170731707,41.1719512195122,69.691756097561,44.945512195122,48.0306829268293,73.4286585365854,69.1239024390244,64.1918292682927,52.6852682926829,67.6660975609756,58.3675853658537,46.3624146341463,56.1280731707317,41.2320243902439,49.2159756097561,53.0013170731707,60.3479512195122,43.2044634146342,63.2801219512195,34.7831707317073,42.6411951219512,57.303756097561,59.7471463414634,46.5107073170732,69.8473170731707,68.4463902439024,69.7868292682927,64.6609268292683,48.4466341463415,61.8127804878049,39.9746829268293,37.2686341463415,57.0656341463415,60.6228048780488,28.2116097560976,67.6017804878049,42.7363902439024,63.7056097560976,48.3688048780488,35.0037073170732,43.4830975609756,58.7452195121951,37.7736341463415,59.4753414634146,46.8803902439024,58.6390243902439,35.5150487804878,37.1829512195122,46.9988292682927,73.3926829268293,73.549756097561,35.1708292682927,71.2365853658537,42.6670731707317,45.2904634146342,60.8817073170732,47.6915853658537,57.8119268292683,38.462243902439,67.6804878048781,68.7196097560976,62.8089268292683,63.7937073170732,56.3570487804878,61.2060731707317,65.6424390243903,66.0552926829268,42.2492926829268,45.6662682926829,48.1876341463415,38.206,65.6598292682927,49.3817073170732,30.3315365853659,49.9479268292683,36.9658780487805,31.6767073170732,50.4513658536585,59.6801219512195,69.9759268292683,68.9780487804878,73.0056097560976,44.2337804878049,52.768243902439,38.0161219512195,40.2728292682927,54.6993170731707,56.1535365853659,54.4586829268293,33.7271219512195,61.3645365853659,62.6575853658537,42.009756097561,45.3844146341463,43.6538780487805,43.9835609756098,68.2995365853659,67.8963902439025,69.7707317073171,58.8855365853659,57.7238780487805,59.2851219512195,63.7302195121951,59.0670243902439,46.4874878048781,49.969512195122,34.3638048780488,49.0362926829268,41.0180487804878,45.1098048780488,51.5424634146342)
Life_Expectancy_At_Birth_2013 <- c(75.3286585365854,60.0282682926829,51.8661707317073,77.537243902439,77.1956341463415,75.9860975609756,74.5613658536585,75.7786585365854,82.1975609756098,80.890243902439,70.6931463414634,56.2516097560976,80.3853658536585,59.3120243902439,58.2406341463415,71.245243902439,74.4658536585366,76.5459512195122,75.0735365853659,76.2769268292683,72.4707317073171,69.9820487804878,67.9134390243903,74.1224390243903,75.3339512195122,78.5466585365854,69.1029268292683,64.3608048780488,49.8798780487805,81.4011219512195,82.7487804878049,81.1979268292683,75.3530243902439,51.2084634146342,55.0418048780488,61.6663902439024,73.8097317073171,62.9321707317073,72.9723658536585,79.2252195121951,79.2563902439025,79.9497804878049,78.2780487804878,81.0439024390244,61.6864634146342,80.3024390243903,73.3199024390244,74.5689512195122,75.648512195122,70.9257804878049,63.1778780487805,82.4268292682927,76.4243902439025,63.4421951219512,80.8317073170732,69.9179268292683,81.9682926829268,68.9733902439024,63.8435853658537,80.9560975609756,74.079512195122,61.1420731707317,58.216487804878,59.9992682926829,54.8384146341464,57.2908292682927,80.6341463414634,73.1935609756098,71.4863902439024,78.872512195122,66.3100243902439,83.8317073170732,72.9428536585366,77.1268292682927,62.4011463414634,75.2682926829268,68.7046097560976,67.6604146341463,81.0439024390244,75.1259756097561,69.4716829268293,83.1170731707317,82.290243902439,73.4689268292683,73.9014146341463,83.3319512195122,70.45,60.9537804878049,70.2024390243902,67.7720487804878,65.7665853658537,81.459756097561,74.462756097561,65.687243902439,80.1288780487805,60.5203902439024,71.6576829268293,74.9127073170732,74.2402926829268,49.3314634146342,74.1634146341464,81.7975609756098,73.9804878048781,80.3391463414634,73.7090487804878,68.811512195122,64.6739024390244,76.6026097560976,76.5326585365854,75.1870487804878,57.5351951219512,80.7463414634146,65.6540975609756,74.7583658536585,69.0618048780488,54.641512195122,62.8027073170732,74.46,61.466,74.567512195122,64.3438780487805,77.1219512195122,60.8281463414634,52.4421463414634,74.514756097561,81.1048780487805,81.4512195121951,69.222,81.4073170731707,76.8410487804878,65.9636829268293,77.4192195121951,74.2838536585366,68.1315609756097,62.4491707317073,76.8487804878049,78.7111951219512,80.3731707317073,72.7991707317073,76.3340731707317,78.4184878048781,74.4634146341463,71.0731707317073,63.3948292682927,74.1776341463415,63.1670487804878,65.878756097561,82.3463414634146,67.7189268292683,50.3631219512195,72.4981463414634,55.0230243902439,55.2209024390244,66.259512195122,70.99,76.2609756097561,80.2780487804878,81.7048780487805,48.9379268292683,74.7157804878049,51.1914878048781,59.1323658536585,74.2469268292683,69.4001707317073,65.4565609756098,67.5223658536585,72.6403414634147,70.3052926829268,73.6463414634147,75.1759512195122,64.2918292682927,57.7676829268293,71.159512195122,76.8361951219512,78.8414634146341,68.2275853658537,72.8108780487805,74.0744146341464,79.6243902439024,75.756487804878,71.669243902439,73.2503902439024,63.583512195122,56.7365853658537,58.2719268292683,59.2373658536585,55.633)
#(c) Kirill Eremenko, www.superdatascience.com
P2.Section5.Homework.Data <- read.csv("H:/Program Files/RStudio/P2-Section5-Homework-Data.csv")
View(P2.Section5.Homework.Data)
head(P2.Section5.Homework.Data)
#generate a data.frame from loaded values
yr1960 <- data.frame(Country_Code, Life_Expectancy_At_Birth_1960)
yr2013 <- data.frame(Country_Code, Life_Expectancy_At_Birth_2013)
#filter master data to only ncessary periods
P2_1960 <- P2.Section5.Homework.Data[P2.Section5.Homework.Data$Year == 1960,]
P2_2013 <- P2.Section5.Homework.Data[P2.Section5.Homework.Data$Year == 2013,]
head(P2_1960)
#merge data into one frame
New_Data1960 <- merge(P2_1960,yr1960, by.x = "Country.Code", by.y = "Country_Code")
head(New_Data1960)
names(New_Data1960)
New_Data2013 <- merge(P2_2013,yr2013, by.x = "Country.Code", by.y = "Country_Code")
head(New_Data1960)
#create scatter plot 1960
# plot(data=stats, x= Internet.users,y=Birth.rate,
# colour=Income.Group,size=I(4))
plot(data=New_Data1960, x= Fertility.Rate, y= Life_Expectancy_At_Birth_1960, colour = Region)
Try:
//To convert the Fertility rate to numeric for showing continuous x-scale on graph
New_Data1960$Fertility.Rate <- as.numeric(New_Data1960$Fertility.Rate)
ggplot(New_Data1960, aes(Fertility.Rate, Life_Expectancy_At_Birth_1960, group=Region, color=factor(Region))) +
geom_point(aes(color=Region))
The first line tells gives details about the plot
and the second line actually plots it into the plot.
Output is as follows:

I cannot seem to get my forecast data from an arima model to plot dates on the x-axis, or to plot using ggplot2

I have a dataset which is a 58196 long univariate time series, as read in from an nc file. The time format is "Hours since 1901-01-01 00:00:00" but when I plot in the native plotting, it just puts the number on the x-axis and not the dates. I would also really like to use ggplot2 to plot this data, which I am unsure of how to execute to get my forecast with dates on the x-axis.
Here is my current code and I have attached my forecast.
library(ncdf4)
library(forecast)
ncname <- "data"
ncfname <- paste(ncname, ".nc", sep="")
dname <- "pc"
print(ncin)
level <- ncvarget(ncin, "level")
nlevel <- dim(level)
time <- ncvar_get(ncin, "time")
timeunits <- ncatt_get(ncin, "time", "units")
ntime <- dim(time)
data_array <- ncvar_get(ncin, dname)
data_name <- ncatt_get(ncin, dname, "long_name")
dataunits <- ncatt_get(ncin, dname, "units")
fillvalue <- ncatt_get(ncin, dname, "_FillValue")
nc_close(ncin)
data_atlevel <- data_array[13, ] #Data at correct level
model <- Arima(data_atlevel, order=c(5, 0, 2))
datafcst <- forecast(model, level=95, h=10)
datafcst
This is the point forecast I get.
Point Forecast Lo 95 Hi 95
58197 -1.0771861 -1.233741 -0.92063154
58198 -1.0619501 -1.372808 -0.75109220
58199 -1.0679265 -1.506646 -0.62920653
58200 -1.0199718 -1.552383 -0.48756100
58201 -1.0440858 -1.710606 -0.37756579
58202 -0.9907978 -1.796984 -0.18461137
58203 -0.9618964 -1.891371 -0.03242174
58204 -0.8945481 -1.924210 0.13511352
58205 -0.8809432 -2.024227 0.26234020
58206 -0.8099497 -2.061208 0.44130892
Using dput(data_atlevel) here is the final snippet of my data array.
-0.0164826595000697, 0.104653384815459, 0.144666301411712,
0.406755420463853,
0.542331794386273, 0.772911688508443, 0.828654158311162,
1.00638835512443,
1.02792247457942, 1.01310671932778, 0.970892191725733,
1.04831366415597,
0.973069827884041, 0.876318047545758, 0.752430017949216,
0.763014654544908,
0.713777524308546, 0.761635798278535, 0.683255478853632,
0.778303948835296,
0.782141199251199, 0.782386316509802, 0.645595202862218,
0.727508430007767,
0.626212602439461, 0.504371813146744, 0.274250430414235,
0.221935768196244,
0.0955978809727627, -0.0117079372064144, -0.220506096426176,
-0.280678113337438, -0.453903395790332, -0.558297954401431,
-0.684971715619909,
-0.564071754625509, -0.433913981524223, -0.344838175285692,
-0.276691358483194,
-0.0548432651627894, 0.0987101422673561, 0.161095707907232,
0.192603198478924,
0.37047216630912, 0.596148685775624, 0.709837093562596,
0.747193326805386,
0.834313129573062, 0.846131581908811, 0.725875974537757,
0.513447772481864,
0.481781009489498, 0.500408010535818, 0.493558364249431,
0.442018049583641,
0.563841476333714, 0.512644345356563, 0.406415545768519,
0.304138546560665,
0.344371236404124, 0.318640232058254, 0.288404684269042,
0.148595436033634,
0.242808391810353, 0.314848026042242, 0.312313203476422,
0.237498989259957,
0.40957356897388, 0.481207219937924, 0.377373174821711,
0.262952160510882,
0.291153919328814, 0.217630757477135, 0.221005490614492,
0.183186952148093,
0.259937980564005, 0.249506614072888, 0.183332972502036,
0.0364441950508707,
0.053725551911807, 0.0693769134725313, -0.0808066792116259,
-0.18171813264877,
-0.0493799795907768, 0.0445452522186435, 0.122164325736002,
0.212984374525893,
0.29001342164436, 0.298053187322413, 0.291905411666604,
0.195592541780216,
0.267534318598644, 0.368070820767661, 0.328049383662298,
0.194165510823487,
0.260603283301608, 0.342147730543151, 0.31173310207737,
0.355312158043337,
0.571008261101836, 0.706944792543549, 0.82879806488094,
0.974436043310877,
1.14302880864744, 1.20557808113165, 1.21299356275298,
1.17815791170924,
1.28295658294446, 1.19760427504148, 1.04365225746354,
0.899849906805248,
0.892025832204036, 0.805459364633312, 0.726511050764506,
0.718865825514464,
0.970667434937238, 1.17770847391413, 1.24344799640867,
1.19950652463226,
1.16726900972386, 1.03832992303071, 0.798481676817567,
0.620341026264972,
0.595943630221845, 0.56625911849429, 0.535218489717758,
0.48156033792909,
0.555048357972321, 0.555523556583205, 0.436775498179143,
0.335189690873195,
0.335735990769063, 0.156197092072704, -0.109413942180462,
-0.309332840349659,
-0.423112123260487, -0.582305168516083, -0.733093879897233,
-0.878533966114525,
-0.913591482716756, -0.927739936050881, -1.00944828473482,
-0.954596475363381,
-0.65373712144728, -0.476517683595976, -0.422610668989477,
-0.430362132554042,
-0.351913432549997, -0.270696606789033, -0.186484295363074,
-0.099740139097897,
0.029704154069367, 0.0664090863070563, -0.150476314540677,
-0.396841710776302,
-0.486497118842713, -0.593497285303129, -0.705987971623734,
-0.781265400572687,
-0.762280716228769, -0.896848223341563, -0.941459725854574,
-1.00367829312857,
-0.9908477396666)
My previous ggplot2 code was
library(ggplot2)
dates <- as.Date(time/24, origin="1900-01-01") #Interval is 6hrs
data_frame <- data.frame(datafcst, dates)
ggplot(data_frame, aes(x=dates, y=datafcst) +geompoint())
This gives me errors as the sizes aren't the same, but all I want is all my data+forecast data plotted for each time and the forecasted times.
I would like to be able to plot this forecast with the previous observed data to get a ggplot with dates on the x-axis. I am pretty stuck so any help would be great.
Many thanks!

Convert ashape3d class to mesh3d

Can somebody help me convert an 'ashape3d' class object to class 'mesh3d'?
In ashape3d, the triangle en tetrahedron faces are are stored in different fields. As I don't think there's a function that can create a mesh3d object from triangles&tetrahedrons simultaneously, I tried the following (pseudocode):
model <- ashape3d(rtorus(1000, 0.5, 2),alpha=0.25)
vert <- model$x[model$vert[,2]==1,]
vert <- cbind(vert,rep(1,nrow(vert)))
tria <- model$triang[model$triang[,4]==1,1:3]
tetr <- model$tetra[model$tetra[,6]==1,1:4]
m3dTria <- tmesh3d(vertices=vert , indices=tria)
m3dTetr <- qmesh3d(vertices=vert , indices=tetr)
m3d <- mergeMeshes(m3dTria,m3dTetr)
plot.ashape3d(model) # works fine
plot3d(m3d) # Error in x$vb[1, x$it] : subscript out of bounds
Does anybody have a better way?
I needed to do this recently and found this unanswered question. The easiest way to figure out what is going on is to look at plot.ashape3d and read the docs for ashape3d. plot.ashape3d only plots triangles.
The rgl package has a generic as.mesh3d function. This defines a method for that generic function.
as.mesh3d.ashape3d <- function(x, ...) {
if (length(x$alpha) > 1)
stop("I don't know how to handle ashape3d objects with >1 alpha value")
iAlpha = 1
# from help for ashape3d
# for each alpha, a value (0, 1, 2 or 3) indicating, respectively, that the
# triangle is not in the alpha-shape or it is interior, regular or singular
# (columns 9 to last)
# Pick the rows for which the triangle is regular or singular
selrows = x$triang[, 8 + iAlpha] >= 2
tr <- x$triang[selrows, c("tr1", "tr2", "tr3")]
rgl::tmesh3d(
vertices = t(x$x),
indices = t(tr),
homogeneous = FALSE
)
}
You can try it out on the data above
model <- ashape3d(rtorus(1000, 0.5, 2),alpha=0.25)
plot(model, edges=F, vertices=F)
library(rgl)
model2=as.mesh3d(model)
open3d()
shade3d(model2, col='red')

floating.pie error while using nodelables from ape package

I get an error while using the ARD model of the ace function in R. The error is
Error in floating.pie.asp(XX[i], YY[i], pie[i, ], radius = xrad[i], col = piecol) :
floating.pie: x values must be non-negative
library(ape)
library(phylobase)
tree <- read.nexus("data1.nexus")
plot(tree)
data <- read.csv("phagy_species.csv")
clade.full <- extract.clade(tree, node=91)
plot(clade.full)
clade.1 <- drop.tip(clade.full, "Bar_bre")
clade.2<- drop.tip(clade.1, "Par_pho")
clade.3<- drop.tip(clade.2, "Par_iph")
clade.4<- drop.tip(clade.3, "Eur_ser")
clade.5<- drop.tip(clade.4, "Opo_sym")
clade.6<- drop.tip(clade.5, "Mor_pel")
clade.7<- drop.tip(clade.6, "Aph_hyp")
clade.8<- drop.tip(clade.7, "Ere_oem")
clade.9<- drop.tip(clade.8, "Cal_bud")
clade.10<- drop.tip(clade.9, "Lim_red")
clade.11<- drop.tip(clade.10, "Act_str")
clade.12<- drop.tip(clade.11, "Hel_hec")
clade.13<- drop.tip(clade.12,"Col_dir")
clade.14<- drop.tip(clade.13, "Hyp_pau")
clade.15<- drop.tip(clade.14, "Nym_pol")
clade.16<- drop.tip(clade.15, "Mel_cin")
clade.17<- drop.tip(clade.16,"Apa_iri")
clade.18<- drop.tip(clade.17, "Bib_hyp")
clade.19<- drop.tip(clade.18, "Mar_ors")
clade.20<- drop.tip(clade.19, "Apo_cra")
clade.21<- drop.tip(clade.20, "Pse_par")
clade.22 <- drop.tip(clade.21, "Lep_sin")
clade.23<- drop.tip(clade.22, "Dis_spi")
plot(clade.23)
data2 <- as.numeric(data[,2])
model2 <- ace(data2, clade.23, type="discrete", method="ML", model="ARD")
summary(model2)
d <-logLik(model2)
deviance(model2)
AIC(model2)
plot(clade.23, type="phylogram", cex=0.8, font=3, label.offset = 0.004)
co <- c("red", "blue", "green", "black")
nodelabels(pie = model2$lik.anc, piecol = co, cex = 0.5)
And that is when I get the error. There is no error if I use the original tree without trimming. But, when i trim them to my requirements, it goes in the negative.
Here is the data
tree file
data file
The matrix you are using for the proportions of the pie has complex numbers in it. To see this, try:
class(model2$lik.anc[1,1])
The rows of that matrix define the proportions of the pies, and they need to sum to 1. Your code produces a plot with pies if I replace the pie matrix in the nodelabels function like this:
nodelabels(pie = matrix(0.25, 64, 4), piecol = co, cex = 0.5)
because now there is a legitimate matrix for the pie argument with rows that sum to 1.
As for why you have complex numbers in that matrix, I am not sure. It is probably related to all the warnings produced by the ace in your example. But that is a completely different issue.
I had the same problem with my data. I put my data into the matrix (like Slow Ioris suggested) and then unlisted the matrix.
x <- matrix(data=c(model2$lik.anc[,1],model2$lik.anc[,2],model2$lik.anc[,3],model2$lik.anc[,4]))
plotTree(tree,ftype="i",label.offset = 0.02)
nodelabels(pie = unlist(x))
For other people having the same problem also after purging imaginable parts of their data: The nodelabels function gives the same error when you provide a data.frame instead of a matrix to pie.

Resources