3

我正在为我的数据集中的所有数值变量创建 Benford 图。https://en.wikipedia.org/wiki/Benford%27s_law

运行单个变量

#install.packages("benford.analysis")
library(benford.analysis)
plot(benford(iris$Sepal.Length))

看起来很棒。传说中说“数据集:iris$Sepal.Length”,完美!

本福德 1

用于apply运行 4 个变量,

apply(iris[1:4], 2, function(x) plot(benford(x)))

创建四个图,但是,每个图的图例都显示“数据集:x”

本福德 2

我尝试使用 for 循环,

for (i in colnames(iris[1:4])){
  plot(benford(iris[[i]]))
}

这会创建四个图,但现在图例显示“数据集:iris [[i]]”。我想要每个图表上的变量名称。

本福德 3

我尝试了一个不同的循环,希望得到带有评估解析字符串的标题,如“iris$Sepal.Length”:

for (i in colnames(iris[1:4])){
  plot(benford(eval(parse(text=paste0("iris$", i)))))
}

但是现在传说中说“数据集:eval(parse(text=paste0("iris$", i)))”。

本福德 4

并且,现在我遇到了臭名昭著的问题eval(parse(text=paste0((例如:如何“评估”“paste0”返回的结果?R:eval(parse(...)) 通常是次优的

我想要诸如“数据集:iris$Sepal.Length”或“数据集:Sepal.Length”之类的标签。如何在图例中创建具有有意义的变量名称的多个图?

4

2 回答 2

1

这是因为benfordfunction= 中的第一行:

benford <- function(data, number.of.digits = 2, sign = "positive", discrete=TRUE, round=3){

  data.name <- as.character(deparse(substitute(data)))

来源:https ://github.com/cran/benford.analysis/blob/master/R/functions-new.R

data.name然后用于命名您的图表。不幸的是,您传递给函数的任何变量名称或表达式都将被deparse(substitute())调用捕获,并将用作图形的名称。


一种短期解决方案是复制和重写函数:

#install.packages("benford.analysis")
library(benford.analysis)
#install.packages("data.table")
library(data.table) # needed for function

# load hidden functions into namespace - needed for function
r <- unclass(lsf.str(envir = asNamespace("benford.analysis"), all = T))
for(name in r) eval(parse(text=paste0(name, '<-benford.analysis:::', name)))


benford_rev <- function{} # see below

for (i in colnames(iris[1:4])){
   plot(benford_rev(iris[[i]], data.name = i))
}

在此处输入图像描述

在此处输入图像描述

这具有以下负面影响:

  • 无法通过包修订进行维护
  • 用包中通常隐藏的功能填充您的 GlobalEnv

所以希望有人可以提出更好的方法!


benford_rev <- function(data, number.of.digits = 2, sign = "positive", discrete=TRUE, round=3, data.name = as.character(deparse(substitute(data)))){ # changed

 # removed line

  benford.digits <- generate.benford.digits(number.of.digits)

  benford.dist <- generate.benford.distribution(benford.digits)

  empirical.distribution <- generate.empirical.distribution(data, number.of.digits,sign, second.order = FALSE, benford.digits)

  n <- length(empirical.distribution$data)

  second.order <- generate.empirical.distribution(data, number.of.digits,sign, second.order = TRUE, benford.digits, discrete = discrete, round = round)

  n.second.order <- length(second.order$data)

  benford.dist.freq <- benford.dist*n

  ## calculating useful summaries and differences
  difference <- empirical.distribution$dist.freq - benford.dist.freq

  squared.diff <- ((empirical.distribution$dist.freq - benford.dist.freq)^2)/benford.dist.freq

  absolute.diff <- abs(empirical.distribution$dist.freq - benford.dist.freq)

  ### chi-squared test
  chisq.bfd <- chisq.test.bfd(squared.diff, data.name)

  ### MAD
  mean.abs.dev <- sum(abs(empirical.distribution$dist - benford.dist)/(length(benford.dist)))

  if (number.of.digits > 3) {
    MAD.conformity <- NA
  } else {
    digits.used <- c("First Digit", "First-Two Digits", "First-Three Digits")[number.of.digits]  
    MAD.conformity <- MAD.conformity(MAD = mean.abs.dev, digits.used)$conformity
  }





  ### Summation
  summation <- generate.summation(benford.digits,empirical.distribution$data, empirical.distribution$data.digits)
  abs.excess.summation <- abs(summation - mean(summation))

  ### Mantissa
  mantissa <- extract.mantissa(empirical.distribution$data)
  mean.mantissa <- mean(mantissa)
  var.mantissa <- var(mantissa)
  ek.mantissa <- excess.kurtosis(mantissa)
  sk.mantissa <- skewness(mantissa)

  ### Mantissa Arc Test
  mat.bfd <- mantissa.arc.test(mantissa, data.name)

  ### Distortion Factor
  distortion.factor <- DF(empirical.distribution$data)  

  ## recovering the lines of the numbers
  if (sign == "positive") lines <- which(data > 0 & !is.na(data))
  if (sign == "negative") lines <- which(data < 0 & !is.na(data))
  if (sign == "both")     lines <- which(data != 0 & !is.na(data))
  #lines <- which(data %in% empirical.distribution$data)

  ## output
  output <- list(info = list(data.name = data.name,
                             n = n,
                             n.second.order = n.second.order,
                             number.of.digits = number.of.digits),

                 data = data.table(lines.used = lines,
                                   data.used = empirical.distribution$data,
                                   data.mantissa = mantissa,
                                   data.digits = empirical.distribution$data.digits),

                 s.o.data = data.table(second.order = second.order$data,
                                       data.second.order.digits = second.order$data.digits),

                 bfd = data.table(digits = benford.digits,
                                  data.dist = empirical.distribution$dist,
                                  data.second.order.dist = second.order$dist,
                                  benford.dist = benford.dist,
                                  data.second.order.dist.freq = second.order$dist.freq,
                                  data.dist.freq = empirical.distribution$dist.freq,
                                  benford.dist.freq = benford.dist.freq,
                                  benford.so.dist.freq = benford.dist*n.second.order,
                                  data.summation = summation,
                                  abs.excess.summation = abs.excess.summation,
                                  difference = difference,
                                  squared.diff = squared.diff,
                                  absolute.diff = absolute.diff),

                 mantissa = data.table(statistic = c("Mean Mantissa", 
                                                     "Var Mantissa", 
                                                     "Ex. Kurtosis Mantissa",
                                                     "Skewness Mantissa"),
                                       values = c(mean.mantissa = mean.mantissa,
                                                  var.mantissa = var.mantissa,
                                                  ek.mantissa = ek.mantissa,
                                                  sk.mantissa = sk.mantissa)),
                 MAD = mean.abs.dev,

                 MAD.conformity = MAD.conformity,

                 distortion.factor = distortion.factor,

                 stats = list(chisq = chisq.bfd,
                              mantissa.arc.test = mat.bfd)
  )

  class(output) <- "Benford"

  return(output)

}
于 2019-07-08T21:13:57.593 回答
1

我刚刚更新了包(GitHub 版本)以允许用户提供名称。

现在该函数有一个名为的新参数data.name,您可以在其中提供带有数据名称的字符向量并覆盖默认值。因此,对于您的示例,您可以简单地运行以下代码。

首先安装 GitHub 版本(我会尽快将此版本提交给 CRAN)。

devtools::install_github("carloscinelli/benford.analysis") # install new version

现在您可以在 for 循环中提供数据的名称:

library(benford.analysis)

for (i in colnames(iris[1:4])){
  plot(benford(iris[[i]], data.name = i))
}

并且所有地块都将具有您希望的正确命名(如下)。

reprex 包(v0.2.1)于 2019 年 8 月 10 日创建

于 2019-08-10T03:54:27.447 回答