在R中的列表中组合不同的表答案

【问题标题】：Combine different tables in a list in R在R中的列表中组合不同的表
【发布时间】：2015-04-02 10:21:18
【问题描述】：

更新：下面的代码似乎可以工作

我不完全确定这个问题的方式，所以如果措辞不当，我深表歉意。我尝试寻找“使用应用组合列表的不同元素”，但这似乎不起作用。

无论如何，作为抓取网站的结果，我有两个提供识别信息的向量和一个包含许多不同表格的列表。简化版如下所示：

respondents <- c("A", "B")
questions <- c("question1", "question2")

df1 <- data.frame(
   option = c("yes", "no"),
   percentage = c(70, 30), stringsAsFactors = FALSE)

df2 <- data.frame(
   option= c("today", "yesterday"),
   percentage =c(30, 70), stringsAsFactors = FALSE)

df3 <- data.frame(
   option = c("yes", "no"),
   percentage = c(60, 40), stringsAsFactors = FALSE)

df4 <- data.frame(
    option= c("today", "yesterday"),
    percentage =c(20, 80), stringsAsFactors = FALSE)

lst <- list(df1, df2, df3, df4)

前两个表格是第一个参与者的问题和回答，后两个表格是第二个参与者的问题。我想做的是创建两个表格，其中包含两个参与者问题的答案。所以我想要看起来像这样的东西：

question1 <- data.frame(
   option = c("yes", "no"),
   A = c(70, 30),
   B = c(60, 40), stringsAsFactors = FALSE)

question2 <- data.frame(
   option = c("today", "yesterday"),
   A = c(30, 70),
   B = c(20, 80), stringsAsFactors = FALSE)

在我的例子中，我有来自 51 名参与者的 122 条回复，它的顺序是表 1-122 来自第一个参与者，接下来的 122 个表来自第二个参与者，依此类推。最终，我想有 122 个表格（每个问题一个表格），每个表格包含 51 列对应于每个参与者。我或多或少不知道如何做到这一点，所以我会很感激任何建议。

现在应该可以工作了：

library("RCurl")
library("XML")

# Get the data
## Create URL address

mainURL <- 'http://www4.uwm.edu/FLL/linguistics/dialect/staticmaps/'
stateURL <- 'states.html'
url  <-  paste0(mainURL, stateURL)

## Download URL

tmp <- getURL(url)

## Parse
tmp  <-  htmlTreeParse(tmp, useInternalNodes = TRUE)

## Extract page addresses and save to subURL
subURL  <-  unlist(xpathSApply(tmp, '//a[@href]', xmlAttrs))


## Remove pages that aren't state's names
subURL  <- subURL[-(1:4)]


## Show first four states
head(subURL, 4)



#  Get questions 
## Select first state
suburl  <-  subURL[1]

## Paste it at the end of the main URL
url <- paste0(mainURL, suburl)


## Download URL
tmp  <- getURL(url)

## Read data from html 

tb <- readHTMLTable(tmp, stringsAsFactors = FALSE)


##Remove empty strings
Questions  <- Questions[Questions!= '']


# Create objects to populate later

stateNames <- rep('', length(subURL))

## Populate stateNames

### Remove state_ from stateNames
stateNames <- gsub('state_','',subURL)

### Remove .html from stateNames
stateNames <- gsub('.html','',stateNames)

# Remove pictures in the data representing IPA symbols with their names      (e.g., names of the pictures)

## Get url
url <- paste0(mainURL, subURL)
tmp <- getURL(url) 

## Replace .gif with _
tmp <- gsub(".gif>", '_', tmp)

## Replace "<img\\s+src=./images/" with _
tmp <- gsub("<img\\s+src=./images/", '_', tmp)


# Read in data

tb <- readHTMLTable(tmp, stringsAsFactors = FALSE)


## Subset 2nd and 4th columns and apply to every item on list
tb <-  lapply(tb, function(x) x[,c(2,4)])

## Remove quotation marks, percent sign and convert to number; apply to every item

tb <-  lapply(tb, function(x) {
  x [,2 ] = gsub('\\(','',x[,2] )
  x [,2 ] = gsub('%\\)','',x[,2])
  x [,2 ] = as.numeric(x[,2])
  x
}
)

## Assign column names to all dataframes
tb <- lapply(tb, setNames , nm = c("option", "percentage"))

#get rid of extra tables
tb1 <- tb[-seq(1, length(tb), by=123)] 

## Function to clean data sets

f1 <- function(list1){ Reduce(function(...) merge(..., by= 'option', all=TRUE), list1) }; res <- lapply(1:122, function(i) {indx <- seq(i, length(tb), by=122); f1(tb[indx])})

## Function to merge datasets together
res1 <- lapply(1:122, function(i) f1(tb1[seq(i, length(tb1), by=122)]))

## Create names for the states
stateNames2 <- c("option", stateNames)

# Rename columns in the new dataframes
res2 <- lapply(res1, setNames , nm = stateNames2)

# Test to see whether it works
test <- res2[[122]]

【问题讨论】：

您提供的示例很简单。你能做一个模仿你的数据集的例子吗？（刚才我读到了最后一部分）
我添加了我正在处理的实际问题。我认为这可能涉及太多了。
这里，在更新中，您是否需要将1 列表元素与123 合并，类似于seq(1,length(tb), by=122)，类似2 与124 等...
也许你可以试试f1 <- function(list1){ Reduce(function(...) merge(..., by= 'option', all=TRUE), list1) }; res <- lapply(1:51, function(i) {indx <- seq(i, length(tb), by=122); f1(tb[inx])})
51 个州各有 122 份回复。数据有点混乱，因为第一个列表元素包含该状态的所有内容。所以第一个状态的响应是 2-123，第二个状态的响应是 125 到 246（因此，仅对于这两个示例，2 将与 123 合并，125 将与 246 合并，等等。

标签： r data-manipulation

【解决方案1】：

感谢 akrun（参见 cmets），我得到了这个工作。完整代码在这里：

library("RCurl")
library("XML")


# Get the data
## Create URL address



mainURL <- 'http://www4.uwm.edu/FLL/linguistics/dialect/staticmaps/'
stateURL <- 'states.html'
url  <-  paste0(mainURL, stateURL)
url

## Download URL

tmp <- getURL(url)

## Parse
tmp  <-  htmlTreeParse(tmp, useInternalNodes = TRUE)

## Extract page addresses and save to subURL
subURL  <-  unlist(xpathSApply(tmp, '//a[@href]', xmlAttrs))


## Remove pages that aren't state's names
subURL  <- subURL[-(1:4)]


## Show first four states
head(subURL, 4)



#  Get questions
## Select first state
suburl  <-  subURL[1]

## Paste it at the end of the main URL
url <- paste0(mainURL, suburl)


## Download URL
tmp  <- getURL(url)

## Read data from html 

tb <- readHTMLTable(tmp, stringsAsFactors = FALSE)

## Remove first column
Questions  <- tb[[1]][,1]


##Remove empty strings
Questions  <- Questions[Questions!= '']

# Create objects to populate later



 survey <-  vector(length(subURL), mode = "list")
i <- 1
stateNames <- rep('', length(subURL))



## Populate stateNames

### Remove state_ from stateNames
stateNames <- gsub('state_','',subURL)


### Remove .html from stateNames
stateNames <- gsub('.html','',stateNames)



# Remove pictures in the data representing IPA symbols with their names (e.g., names of the pictures)

## Get url
url <- paste0(mainURL, subURL)
tmp <- getURL(url) 


## Replace .gif with _

tmp <- gsub(".gif>", '_', tmp)

## Replace "<img\\s+src=./images/" with _

tmp <- gsub("<img\\s+src=./images/", '_', tmp)


# Read in data

tb <- readHTMLTable(tmp, stringsAsFactors = FALSE)

#tb <- tb[-1]


## Subset 2nd and 4th columns and apply to every item on list
tb <-  lapply(tb, function(x) x[,c(2,4)])


## Remove quotation marks, percent sign and convert to number; apply to every item

tb <-  lapply(tb, function(x) {
    x [,2 ] = gsub('\\(','',x[,2] )
    x [,2 ] = gsub('%\\)','',x[,2])
    x [,2 ] = as.numeric(x[,2])
    x
}
)


## Assign column names to all dataframes

tb <- lapply(tb, setNames , nm = c("option", "percentage"))

## Remove unneeded dataframes in list

tb1 <- tb[-seq(1, length(tb), by=123)]


## Function to clean data sets

f1 <- function(list1){ Reduce(function(...) merge(..., by= 'option', all=TRUE), list1) }; res <- lapply(1:122, function(i) {indx <- seq(i, length(tb), by=122); f1(tb[indx])})

## Function to merge datasets together
res1 <- lapply(1:122, function(i) f1(tb1[seq(i, length(tb1), by=122)]))

## Create names for the states
stateNames2 <- c("Options", stateNames)

# Rename columns in the new dataframes
res2 <- lapply(res1, setNames , nm = stateNames2)

# Test to see whether it works
test <- res2[[1]]

【讨论】：