Question

我需要在lapply函数中编写一个文件。我正在抓一大堆网页，我想每100左右保存一次输出。我使用以下代码

Public PicPath As String 'this is where we'll store the picture path

Private Sub Browse_Click() 'getting the picture path

Dim fDialog As Office.FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

With fDialog

    .AllowMultiSelect = False
    .ButtonName = "Submit"
    .Title = "Select an image file"
    .Filters.Add "Image", "*.gif;*.jpg;*.jpeg", 1

    If .Show = -1 Then
        PicPath = .SelectedItems(1)
        'getting picture full path to use when submit click
    End If

    If PicPath = "" Then Unload Me

End With

End Sub

Private Sub Submit_Click()'setting picture in active cell

    If Not PicPath = "" Then
        CellAddress = ActiveCell.Address
        With ActiveSheet.Pictures.Insert(PicPath)
            With .ShapeRange
                .LockAspectRatio = msoTrue
                .Height = 150
            End With
            .Left = ActiveSheet.Range(CellAddress).Left
            .Top = ActiveSheet.Range(CellAddress).Top
            .Placement = 1
            .PrintObject = True
        End With
        picselectedbool = True
    Else
        msgbox ("Please select a picture")
    End If

    If picselectedbool Then
        Unload Me
    End If

End Sub

然而，当我这样做时，我得到一个错误，说对象＆＃34; cc＆＃34;找不到。我知道这可以使用for循环来完成。但是有没有办法使用apply函数完成这个任务。

Answer 1

将cc构建为lapply之外的新环境对象。

e <- new.env()
e$cc <- list()
a <- letters[]
b <- 1:26
# Example lapply
out <- lapply(a, function(a,b){ 
  e$cc[[a]] <- b
  if(length(e$cc)%%10==0) print(length(e$cc))
  b # Giving an output to out aswell
  },b
)
# [1] 10
# [1] 20
# Showing first elements of outputs
# > e$cc
#$a
# [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
#[26] 26
# > out
#[[1]]
# [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
#[26] 26

这种方法允许您在新的R环境中构建cc，然后可以在应用中枚举，并输出您的经典输出。虽然不是最优雅的解决方案。

n.b。此解决方案需要修改为您的代码。如果需要，还可以使用e$cc <- list()重置e $ cc，因为在运行后它只会替换元素。

另外:(未经测试！）您可以尝试将脚本调整为类似的内容。

func1 <- function(url){
  out <- tryCatch(
    {
     doc <-  htmlParse(url)
     address <- as.data.frame(xpathSApply(
                  doc,'//div[@class="panel-body"]', xmlValue, encoding="UTF-8")
                )
      page <- cbind(address,url)
     }
}
wrapfun <- function(urls){
  e <- new.env()
  e$cc <- list()
  lapply(urls, function(x){
    e$cc[[x]] <- func1(x)
    if(length(e$cc)%%10==0){ # Change the %%y to how often you want to save e.g length(e$cc)%%100==0 would be every 100.
      pg <-  suppressMessages(melt(e$cc))
      write.csv(pg,paste("bcc_",length(e$cc),".csv"))
    }
  })
  return(e$cc)
}

R：挽救一个lapply

1 个答案: