R/VBA-排序数据_R_Vba_Sorting - Fatal编程技术网

R/VBA-排序数据

r vba sorting

R/VBA-排序数据,r,vba,sorting,R,Vba,Sorting,我试图从原始数据框（在R或Excel VBA代码中）创建数据集，并试图生成另一列。以下是一个高级别的情况： dfr <- data.frame( grp = rep(c("X", "Y"), each = 4), id = c("A", "B", "C", "D", "E", "A", "B", "F"), value = c(3, 7, 2, 4, 8, 9, 11, 2) ) 最远列上的数字是以前找到的数据点的相应数字因此，我需要帮助在X和Y之间

我试图从原始数据框（在R或Excel VBA代码中）创建数据集，并试图生成另一列。以下是一个高级别的情况：

dfr <- data.frame(
    grp   = rep(c("X", "Y"), each = 4),
    id    = c("A", "B", "C", "D", "E", "A", "B", "F"),
    value = c(3, 7, 2, 4, 8, 9, 11, 2)
)

最远列上的数字是以前找到的数据点的相应数字

因此，我需要帮助在X和Y之间对数据进行分区（对于存在的无数字符串组），然后按照我需要的方式对数据进行排序并生成该列，可以是R-code或VBA for excel（数据为CSV格式）

**免责声明：如果不明显，我对R的使用非常有限-我在应用计量经济学课程中使用了4个月，现在发现自己又需要它（9个月后），所以如果我看起来像个新手，请原谅我…我可以很好地运行回归：）

*更新按照亨利的密码，我现在就在这里

data <- read.csv(file = "sort.csv", h=T)
attach(data)
sorted <- data[order(data$membernumber, -data$dailycirc),]
top <- function(df){ return(df[1,])}
moded <- unsplit(lapply(split(sorted, sorted$membernumber), top), unique(sorted$membernumber))[1:2]
names(moded) <- c("membernumber", "cnty")
merged <- merge(moded, data, by="membernumber")
merged[merged$cnty != merged$cnty, ]
summary(merged)

data这可能不是最好的解决方案，有人可能会使用重塑软件包为您提供更好的解决方案，但它似乎适用于您的示例和我尝试过的其他一些示例
df = data.frame(c(sample(c(LETTERS), 10000,replace=T)),
                sample(LETTERS[1:5],10000,replace=T),
                runif(10000))
names(df) = c("id","grp", "value")
i = levels(df$id)[1]

groupings =  lapply(levels(df$i), function(i){
                                    d = subset(df,df$id==i)
                                    l = length(d$value[d$id==i])
                                    m = max(d$value)
                                    leader= d$grp[d$value==m]
                                    piece = data.frame(id = rep(i,l),
                                                       grp= rep(as.character(leader),l),
                                                       grp2 = d$grp,
                                                       value = d$value)

                                    })

df.final = do.call(rbind,groupings)

使用plyr
软件包，尝试
ddply(dfr, .(grp), transform, id.max = id[which.max(value)])


这里有很多独立的问题，但看起来你需要一些提示来开始学习R
data <- read.csv(file = "sort.csv", h=T)

切勿使用附件
。这是另一个很好的难以追踪的bug来源。改用

这就是taply
或ddply
的作用。差不多
moded <- with(sorted, tapply(cnty, membernumber, head, n = 1))

由于条件总是FALSE
，因此必须返回空数据帧。你确定你是这个意思吗

使用write.csv
或writeLines
将内容写入文件。
以下
sorted <- dfr[order(dfr$grp, -dfr$value), ]  
top <- function(df){ return(df[1,]) }
moded <- unsplit(lapply(split(sorted, sorted$grp), top), unique(sorted$grp))[1:2]
names(moded) <- c("grp", "leader")
merged <- merge(moded, dfr, by="grp")
merged[merged$leader != merged$id, ]

及
因为似乎只有R个人醒了过来，我觉得有义务在VBA中发布一个例子。我假设您已在Excel中打开CSV，前3列中包含信息，没有标题行（数据从第1行开始）。你收到了吗
将数据添加到名为“Sheet1”的选项卡中的新电子表格中。在新模块中插入下面的代码并运行它，它将在同一工作表的第5列到第8列中输出结果。对于10000行输入，它在我的机器上运行不到0.1秒
Option Explicit

Public Sub doIt()

    Dim data As Variant
    Dim result As Variant
    Dim i As Long
    Dim j As Long
    Dim dict1 As Variant
    Dim dict2 As Variant

    Set dict1 = CreateObject("Scripting.Dictionary")
    Set dict2 = CreateObject("Scripting.Dictionary")
    data = Sheets("Sheet1").UsedRange

    For i = LBound(data, 1) To UBound(data, 1)
        If dict1.exists(data(i, 1)) Then
            If dict2(data(i, 1)) < data(i, 3) Then
                dict1(data(i, 1)) = data(i, 2)
                dict2(data(i, 1)) = data(i, 3)
            End If
        Else
            dict1(data(i, 1)) = data(i, 2)
            dict2(data(i, 1)) = data(i, 3)
        End If
    Next i

    ReDim result(LBound(data, 1) To UBound(data, 1) - dict1.Count, 1 To 4) As Variant

    j = 1
    For i = LBound(data, 1) To UBound(data, 1)
        If data(i, 2) <> dict1(data(i, 1)) Then
            result(j, 1) = data(i, 1)
            result(j, 2) = dict1(data(i, 1))
            result(j, 3) = data(i, 2)
            result(j, 4) = data(i, 3)
            j = j + 1
        End If
    Next i

    With Sheets("Sheet1")
        .Cells(1, 5).Resize(UBound(result, 1), UBound(result, 2)) = result
    End With

End Sub

选项显式
公共子doIt（）
作为变量的Dim数据
作为变量的模糊结果
我想我会坚持多久
Dim j尽可能长
Dim dict1作为变体
Dim dict2作为变体
Set dict1=CreateObject（“Scripting.Dictionary”）
Set dict2=CreateObject（“Scripting.Dictionary”）
数据=表（“表1”）。使用表格
对于i=LBound（数据，1）到UBound（数据，1）
如果dict1.存在（数据（i，1）），则
如果dict2（数据（i，1））小于数据（i，3），那么
dict1（数据（i，1））=数据（i，2）
dict2（数据（i，1））=数据（i，3）
如果结束
其他的
dict1（数据（i，1））=数据（i，2）
dict2（数据（i，1））=数据（i，3）
如果结束
接下来我
ReDim结果（LBound（数据，1）到UBound（数据，1）-dict1.Count，1到4）作为变量
j=1
对于i=LBound（数据，1）到UBound（数据，1）
如果数据（i，2）是1（数据（i，1）），那么
结果（j，1）=数据（i，1）
结果（j，2）=dict1（数据（i，1））
结果（j，3）=数据（i，2）
结果（j，4）=数据（i，3）
j=j+1
如果结束
接下来我
附页（“第1页”）
.单元格（1，5）.调整大小（UBound（结果，1），UBound（结果，2））=结果
以
端接头
G未出现在您的数据中。请快速阅读拆分应用合并问题。@亨利，谢谢你的G，我决定在最后一刻把它定为“B”，以强调X&Y类别可能有许多重叠的区域（参考A、B…等等）@Roman，不幸的是，我仍在试图编写伪代码，并将我的思想缠绕在它周围。我还没有编写实际的代码。这是一个很好的开始，我正在阅读提供的文档和链接。我遇到了以下错误：解析错误（text=x）：：1:5：意外符号1：星号^？我觉得你让我走上了一条伟大的道路，而我只是对R有点缺乏经验，所以我一路走来。parse
获取一个字符串并尝试将其转换为R表达式<代码>“星号^”

无效，因此出现错误。不过，我不确定这与最初的问题有什么关系。如果您对

解析有不同的问题，请用不同的问题询问他们。亲爱的Henry，您能帮助我将代码转换为10000多个观察值吗？而且，我没有R-background来看穿您的代码，也没有为了放入我自己的变量名+标题而需要的高级结构。@Dman：第一行按grp
排序，然后按value
反向排序；第二行和第三行分别取顶部值的前两列grp
；第四行将这些列（分别是grp
和id
）重命名为grp
和leader
；第五行与数据合并，这样每个grp
都有它的前导行
；第六行删除了领导
和id
相同的情况。@Henry:我想我已经有了，现在如何用它创建电子表格？我尝试了WriteXLS包，得到了以下结果：get（x，envir=envir）中的WriteXLS（merged，“WriteXLS.xls”，perl=perl）错误：找不到对象“integer（0）”。我实际上没有得到任何输出。当我做“汇总（合并）”时，我得到的变量在我所有的汇总统计数据中只有一堆零。@Dman：尝试代码，从R开始。我已经展示了我从summary中得到的结果。谢谢你，但我正试图在10000多个观察值上复制这一分析。我没有技能把你的代码带到那个级别！你在10000次观察中测试过这个吗？”因为它的运行时间不到5秒。长度方面的小问题，我将进行编辑以修复。还是建议你去
sorted <- data[with(data, order(membernumber, -dailycirc)), ]

top <- function(df){ return(df[1,])}

moded <- unsplit(lapply(split(sorted, sorted$membernumber), top),   unique(sorted$membernumber))[1:2]

moded <- with(sorted, tapply(cnty, membernumber, head, n = 1))

merged[merged$cnty != merged$cnty, ]

sorted <- dfr[order(dfr$grp, -dfr$value), ]  
top <- function(df){ return(df[1,]) }
moded <- unsplit(lapply(split(sorted, sorted$grp), top), unique(sorted$grp))[1:2]
names(moded) <- c("grp", "leader")
merged <- merge(moded, dfr, by="grp")
merged[merged$leader != merged$id, ]

  grp leader id value
1   X      B  A     3
3   X      B  C     2
4   X      B  D     4
5   Y      B  E     8
6   Y      B  A     9
8   Y      B  F     2

> summary(merged)
 grp   leader id        value      
 X:4   A:0    A:2   Min.   : 2.00  
 Y:4   B:8    B:2   1st Qu.: 2.75  
       C:0    C:1   Median : 5.50  
       D:0    D:1   Mean   : 5.75  
       E:0    E:1   3rd Qu.: 8.25  
       F:0    F:1   Max.   :11.00  

Option Explicit

Public Sub doIt()

    Dim data As Variant
    Dim result As Variant
    Dim i As Long
    Dim j As Long
    Dim dict1 As Variant
    Dim dict2 As Variant

    Set dict1 = CreateObject("Scripting.Dictionary")
    Set dict2 = CreateObject("Scripting.Dictionary")
    data = Sheets("Sheet1").UsedRange

    For i = LBound(data, 1) To UBound(data, 1)
        If dict1.exists(data(i, 1)) Then
            If dict2(data(i, 1)) < data(i, 3) Then
                dict1(data(i, 1)) = data(i, 2)
                dict2(data(i, 1)) = data(i, 3)
            End If
        Else
            dict1(data(i, 1)) = data(i, 2)
            dict2(data(i, 1)) = data(i, 3)
        End If
    Next i

    ReDim result(LBound(data, 1) To UBound(data, 1) - dict1.Count, 1 To 4) As Variant

    j = 1
    For i = LBound(data, 1) To UBound(data, 1)
        If data(i, 2) <> dict1(data(i, 1)) Then
            result(j, 1) = data(i, 1)
            result(j, 2) = dict1(data(i, 1))
            result(j, 3) = data(i, 2)
            result(j, 4) = data(i, 3)
            j = j + 1
        End If
    Next i

    With Sheets("Sheet1")
        .Cells(1, 5).Resize(UBound(result, 1), UBound(result, 2)) = result
    End With

End Sub