将代码更新为递归函数和单独的打印函数，以便更好地跟踪正在发生的事情。与hcl(<data.frame>,<log_level>) 一起使用。日志级别可以为 0 仅用于最终结果，1 用于打印中间数据集，2 用于打印每个步骤
# To be allowed to add column later, don't know a better way than coercing to data.frame
d <- data.frame(D,stringsAsFactors=F)
myprt <- function(message,var) {
print(message)
print(var)
}
hcl <- function(d,prt=0) {
if (prt) myprt("Starting dataset:",d)
# 1) Get the shortest distance informations:
Ref <- which( d==min(d[d>0]), useNames=T, arr.ind=T )
if (prt>1) myprt("Ref is:",Ref)
# 2) Subset the original entry to remove thoose towns:
res <- d[-Ref[,1],-Ref[,1]]
if (prt>1) myprt("Res is:", res)
# 3) Get the subset for the two nearest towns:
tmp <- d[-Ref[,1],Ref[,1]]
if (prt>1) myprt("Tmp is:",tmp)
# 4) Get the vector of minimal distance from original dataset with the two town (row by row on t)
dists <- apply( tmp, 1, function(x) { x[x==min(x)] } )
#dists <- tmp[ tmp == pmin( tmp[,1], tmp[,2] ) ]
if (prt>1) myprt("Dists is:",dists)
# 5) Let's build the resulting matrix:
tnames <- paste(rownames(Ref),collapse="/") # Get the names of town to the new name
if (length(res) == 1) {
# Nothing left in the original dataset just concat the names and return
tnames <- paste(c(tnames,names(dists)),collapse="/")
Finalres <- data.frame(tnames = dists) # build the df
names(Finalres) <- rownames(Finalres) <- tnames # Name it
if (prt>0) myprt("Final result:",Finalres)
return(Finalres) # Last iteration
} else {
Finalres <- res
Finalres[tnames,tnames] <- 0 # Set the diagonal to 0
Finalres[is.na(Finalres)] <- dists # the previous assignment has set NAs, replae them by the dists values
if (prt>0) myprt("Dataset before recursive call:",Finalres)
return(hcl(Finalres,prt)) # we're not at end, recall ourselves with actual result
}
}
另一个想法的步骤：
# To be allowed to add column later, don't know a better way than coercing to data.frame
d <- data.frame(D,stringsAsFactors=F)
# 1) Get the shortest distance informations:
Ref <- which( d==min(d[d>0]), useNames=T, arr.ind=T )
# 2) Subset the original entry to remove thoose towns:
res <-d[-Ref[,1],-Ref[,1]]
# 3) Get the subset for the two nearest towns:
tmp <- d[-Ref[,1],Ref[,1]]
# 4) Get the vector of minimal distance from original dataset with the two town (row by row on tpm), didn't find a proper way to avoid apply
dists <- apply( tmp, 1, function(x) { x[x==min(x)] } )
dists <- dists <- tmp[ tmp == pmin( tmp[,1], tmp[,2] ) ]
# 5) Let's build the resulting matrix:
tnames <- paste(rownames(Ref),collapse="/") # Get the names of town to the new name
Finalres <- res
Finalres[tnames,tnames] <- 0 # Set the diagonal to 0
Finalres[is.na(Finalres)] <- dists # the previous assignment has set NAs, replae them by the dists values
输出：
> Finalres
BA FI Na RM TO/MI
BA 0 662 255 412 877
FI 662 0 468 268 295
Na 255 468 0 219 754
RM 412 268 219 0 564
TO/MI 877 295 754 564 0
以及每一步的输出：
> #Steps:
>
> Ref
row col
TO 6 3
MI 3 6
> res
BA FI Na RM
BA 0 662 255 412
FI 662 0 468 268
Na 255 468 0 219
RM 412 268 219 0
> tmp
TO MI
BA 996 877
FI 400 295
Na 869 754
RM 669 564
> dists
[1] 877 295 754 564
这里有很多对象复制可以避免以节省性能，我使它有一个更好的逐步视图。