##########################################################################################
## ##
## Ana Flávia Delbem Vidigal Nazareth ##
## ##
## ALGORITMO DE AGRUPAMENTOS ##
## *** K-PROTÓTIPOS *** ##
## Funções modificadas a partir dos pacotes ade4, clustMixType e FactoExtra ##
## ##
##########################################################################################
##########################################################################################
## FUNÇÕES E PACOTES A SEREM UTILIZADOS ##
##########################################################################################
##Download dos códigos fontes utilizados:
##Modificar o diretório de destino desejado: destdir="C:/"
#download.packages("clustMixType", destdir= "C:/Users/anafl/Desktop", type="source")
#download.packages("ade4", destdir= "C:/Users/anafl/Desktop", type="source")
#download.packages("factoextra", destdir= "C:/Users/anafl/Desktop", type="source")
#download.packages("cluster", destdir= "C:/Users/anafl/Desktop", type="source")
#download.packages("NbClust", destdir= "C:/Users/anafl/Desktop", type="source")
# Criação da função para o cálculo da distância euclidiana
cppFunction('NumericMatrix weighted_distance (NumericMatrix x, NumericMatrix y, NumericVector lambda){
int n_x = x.nrow();
int n_y = y.nrow();
NumericMatrix out(n_x, n_y);
//begin the loop
for (int i = 0 ; i < n_x; i++){
for (int j = 0 ; j < n_y ; j ++) {
double d = sum(pow(x.row(i) - y.row(j), 2)*lambda);
out(i,j) = d;
}
}
return (out) ;
}')
##########################################################################################
## FUNÇÃO Kproto() MODIFICADA: kproto.modif() ##
##########################################################################################
##TESTE
#x <- dados1 #Data frame com ambas variáveis quantitativas e fatoriais.
#k = K #Pode ser um número de grupos, um vetor especificando índices de protótipos iniciais ou um data frame de protótipos com as mesmas colunas que x.
#lambda = LAMB #Parâmetro > 0 para ponderar entre a distância euclidiana de variáveis quantitativas e a distância escolhida entre variáveis categóricas. Também é possível ser um vetor de pesos específicos para as variáveis onde o primeiro termo deve ser o peso dado às variáveis qualitativas e os demais termos correspondem à ordem das variáveis quantitativas nos dados. Nesse caso, cada distância entre cada variável quantitativa será multiplicada pelo valor lambda correspondente àquela variável e a distância entre as variáveis qualitativas será multiplicada pelo lambda das variáveis qualitativas único. Deste modo, deve ser um vetor de dimensão igual ao número de variáveis quantitativas mais um.
#iter.max = 100 #Número máximo de iterações, se não houver convergência antes.
#nstart = 1 #Se > 1 cálculos repetitivos com inicializações aleatórias são calculados e o resultado com um mínimo de tot.dist é retornado.
#na.rm = TRUE #Um valor lógico que indica se os valores ausentes (NAs) devem ser removidos antes que a computação prossiga.
#keep.data = FALSE #Um valor lógico que indica se o banco de dados original deve ser incluído no objeto retornado.
#verbose = TRUE #Um valor lógico que indica se as informações sobre o procedimento de agrupamentos devem ser dadas. Cuidado: Se verbose = FALSE, a redução do número de grupos não é mencionada.
kproto.modif <- function(
x,
k,
lambda = NULL,
iter.max = 100,
nstart = 1,
na.rm = TRUE,
keep.data = TRUE,
verbose = TRUE,
...) {
# Checagem de erros inicial
if (!is.data.frame(x))
stop("x deve ser um data frame!")
if (ncol(x) < 2)
stop("Para agrupamentos x deve conter pelo menos duas variaveis!")
if (iter.max < 1 |
nstart < 1)
stop("iter.max e nstart nao devem ser especificados como < 1!")
if (!is.null(lambda)) {
if (any(lambda < 0))
stop("lambda deve ser especificado como >= 0!")
if (!any(lambda > 0))
stop("lambda deve ser especificado como > 0 para pelo menos uma variavel!")}
# Verificação para variáveis quantitativas e fatoriais
numvars <- sapply(x, is.numeric)
anynum <- any(numvars)
catvars <- sapply(x, is.factor)
anyfact <- any(catvars)
if (!anynum)
stop("\n Nao ha variaveis quantitativas em x! Tente usar o metodo kmodes() do pacote klaR...\n\n")
if (!anyfact)
stop("\n Nao ha variaveis fatoriais em x! Tente usar o metodo kmeans()...\n\n")
# Tratamento de valores ausentes
NAcount <- apply(x, 2, function(z)
sum(is.na(z)))
if (verbose) {
cat("# NAs nas variaveis:\n")
print(NAcount)
}
if (any(NAcount == nrow(x)))
stop(paste("Variavel(is) possuem apenas NAs, favor remove-las:",
names(NAcount)[NAcount == nrow(x)], "!"))
if (na.rm) {
miss <- apply(x, 1, function(z)
any(is.na(z)))
if (verbose) {
cat(sum(miss), "Observacao(es) com NAs.\n")
if (sum(miss) > 0)
message("Observacoes com NAs sao removidas.\n")
cat("\n")}
x <- x[!miss,]} # Remoção de observações com valores ausentes
if (!na.rm) {
allNAs <- apply(x, 1, function(z)
all(is.na(z)))
if (sum(allNAs) > 0) {
if (verbose)
cat(sum(allNAs), "Observacao(es) onde todas as variaveis nao estao presentes.\n")
warning("Nenhuma atribuicao de grupos significativa e possivel para observacoes onde todas as variaveis nao estao presentes.\n")
if (verbose)
cat("\n")}}
if (nrow(x) == 1)
stop("Apenas o agrupamento de uma observacao nao e significativo.")
k_input <- k # Armazena o valor de k para nstart > 1 uma vez que os grupos podem ser fundidos
# Inicialização dos protótipos
if (!is.data.frame(k)) {
if (length(k) == 1) {
if (as.integer(k) != k) {
k <- as.integer(k)
warning(paste("k foi modificado para", k, "!"))}
if (nrow(x) < k)
stop("O data frame tem um numero de observacoes menor que o de grupos!")
ids <- sample(nrow(x), k)
protos <- x[ids,]}
if (length(k) > 1) {
if (nrow(x) < length(k))
stop("O data frame tem um numero de observacoes menor que o de grupos!")
ids <- k
k <- length(ids)
if (length(unique(ids)) != length(ids))
stop("Se k e especificado como um vetor ele deve conter diferentes indices!")
if (any(ids < 1) |
any(ids > nrow(x)))
stop("Se k e especificado como um vetor todos os elementos devem ser indices validos de x!")
#Verificação de inteiros
protos <- x[ids,]}
rm(ids)}
if (is.data.frame(k)) {
if (nrow(x) < nrow(k))
stop("O data frame tem um numero de observacoes menor que o de grupos!")
if (length(names(k)) != length(names(x)))
stop("k e x possuem um numero diferente de colunas!")
if (any(name
没有合适的资源?快使用搜索试试~ 我知道了~
温馨提示
在提供的文件“ k-Prototypes聚类”和“ clustMixType修改的函数”中可以找到用于执行此工作的函数。 这些算法执行以下操作:获取和处理数据矩阵,数据的描述性统计,确定最佳聚类数,使用k-原型方法聚类以及使用MANOVA对生成的聚类进行统计验证。 还使用R软件库中包含的Iris数据库提供了一个示例,该示例被广泛用于例示和验证以R语言开发的算法。
资源推荐
资源详情
资源评论
![py](https://img-home.csdnimg.cn/images/20210720083646.png)
![application/x-rar](https://img-home.csdnimg.cn/images/20210720083606.png)
![pdf](https://img-home.csdnimg.cn/images/20210720083512.png)
![pdf](https://img-home.csdnimg.cn/images/20210720083646.png)
![pdf](https://img-home.csdnimg.cn/images/20210720083512.png)
![rar](https://img-home.csdnimg.cn/images/20210720083606.png)
![pdf](https://img-home.csdnimg.cn/images/20210720083512.png)
![gz](https://img-home.csdnimg.cn/images/20210720083447.png)
![pdf](https://img-home.csdnimg.cn/images/20210720083512.png)
![pdf](https://img-home.csdnimg.cn/images/20210720083646.png)
![tgz](https://img-home.csdnimg.cn/images/20210720083646.png)
![whl](https://img-home.csdnimg.cn/images/20210720083646.png)
![pdf](https://img-home.csdnimg.cn/images/20210720083512.png)
![pdf](https://img-home.csdnimg.cn/images/20210720083512.png)
![7z](https://img-home.csdnimg.cn/images/20210720083312.png)
![xlsx](https://img-home.csdnimg.cn/images/20210720083732.png)
![pdf](https://img-home.csdnimg.cn/images/20210720083512.png)
收起资源包目录
![package](https://csdnimg.cn/release/downloadcmsfe/public/img/package.f3fc750b.png)
![file-type](https://csdnimg.cn/release/download/static_files/pc/images/minetype/TXT.png)
![file-type](https://csdnimg.cn/release/download/static_files/pc/images/minetype/UNKNOWN.png)
![file-type](https://csdnimg.cn/release/download/static_files/pc/images/minetype/TXT.png)
![file-type](https://csdnimg.cn/release/download/static_files/pc/images/minetype/UNKNOWN.png)
共 4 条
- 1
![avatar](https://profile-avatar.csdnimg.cn/default.jpg!1)
科研菜鸟的求学之路
- 粉丝: 135
- 资源: 57
上传资源 快速赚钱
我的内容管理 展开
我的资源 快来上传第一个资源
我的收益
登录查看自己的收益我的积分 登录查看自己的积分
我的C币 登录后查看C币余额
我的收藏
我的下载
下载帮助
![voice](https://csdnimg.cn/release/downloadcmsfe/public/img/voice.245cc511.png)
![center-task](https://csdnimg.cn/release/downloadcmsfe/public/img/center-task.c2eda91a.png)
最新资源
资源上传下载、课程学习等过程中有任何疑问或建议,欢迎提出宝贵意见哦~我们会及时处理!
点击此处反馈
![feedback](https://img-home.csdnimg.cn/images/20220527035711.png)
![feedback](https://img-home.csdnimg.cn/images/20220527035711.png)
![feedback-tip](https://img-home.csdnimg.cn/images/20220527035111.png)
安全验证
文档复制为VIP权益,开通VIP直接复制
![dialog-icon](https://csdnimg.cn/release/downloadcmsfe/public/img/green-success.6a4acb44.png)
- 1
- 2
- 3
- 4
- 5
- 6
前往页