闪烁错误：参数意味着行数不同 [英] Shiny Error: arguments imply differing number of rows
问题描述
我正在尝试开发一个从Kijiji网站获取本地分类广告的简单应用程序。我已经做了一个类似的应用程序与几乎相同的确切脚本，但我没有得到下面描述的错误，所以我不知道这个脚本出了什么问题。我尝试了一切可以想到的东西，但是无法让它工作。
I'm trying to develop a simple app that fetches local classified ads from Kijiji website. I have made a similar app with pretty much the same exact script but I'm not getting the error described below so I don't know what has gone wrong with this script. I tried everything I could think of, but couldn't get it to work.
df的结构数据框在 server.R 中如下：（注意我已经截断了值，使其更易于阅读）
the structure of the df dataframe in server.R is as follows: (note that I have truncated the values to make it more readable)
'data.frame': 38 obs. of 7 variables:
$ Title : chr "Baby-boy 3-6 month" ...
$ Price : num 0 6.92 8 10 10 15 15 15 20 20 ...
$ Short.Description: chr "Give for free ..."
$ Address : chr "Calgary, AB T2Z 0V6" "341 ..."
$ Date : Date, format: "2014-12-05" "2014-10-28" "2014-12-05" ...
$ Full.Description : chr "Give for free some ..."
$ Link : chr "http://www.kijiji...."
，可以复制如下：（一个5记录为演示目的）
and can be replicated as follows:(a sample with 5 records for demonstration purposes)
df <- data.frame(
Title= c("Baby-boy 3-6 month","Giggle Life Optimize Cloth Diapers & 4 layer mixed insert", "Beluga Baby","Baby sled", "Avent Sterilizer & Various Medela Items"),
Price= c(0.00, 6.92, 8.00, 10.00, 10.00),
Short.Description=c("Give for free some staff for boy 3-6 month. Live in New Brighton, SE", "If you have any questions or are looking to order please don't hesitate to call our local line 587-774-2404, toll free line 1-877-883-3069 or visit our website…","Calgary! Fall in love with your all natural and freshly handmade products for mama and baby. www.belugaskincare.com Like us on Facebook.com/belugaskincare FREE shipping in Canada with a $25 cart!…", "Yellow plastic baby sled Safety seat belt Tow rope Dimensions: 23\" long x 14 1/2\" wide x 12\" high $10 Located in Willow Park off Southland Dr. and Fairmount Dr. SE CALL: 403 460 - 0978 (will not…", "Avent microwave sterilizer in good condition 1 Avent bottle 2 Medela bottles 1/2 box of unused Medela pump and save bags 1bag of replaceable Medela pump parts From clean, smoke free home. Take all…"),
Address=c("Calgary, AB T2Z 0V6","341 Westvale Drive, Waterloo, ON N2T 2M2","Canada", "Calgary, AB T2J 1H6, Canada","Calgary, AB T2W, Canada"),
Date=c(as.Date(c( "2014-12-05", "2014-10-28", "2014-12-05", "2014-12-05", "2014-12-05"))),
Full.Description=c("Give for free some staff for boy 3-6 month. Live in New Brighton, SE", "If you have any questions or are looking to order please don't hesitate to call our local line 587-774-2404, toll free line 1-877-883-3069 or visit our website http://www.gigglelife.com/catalog/?Calgary. \rEnter the promo code \"KIJCALGARY\" in the comment box when ordering to receive a free gift with your order.\rThe new Giggle Life Optimize Cloth Diaper is very affordable, effective, and comfortable. It is simply the best value on market. These reusable diapers are one size fits all (7-36lbs). \rThey are $6.92 each when you purchase 12. Please note there is a $1 surcharge for pattern designs. \rManufacturer’s Warranty \rSupport for as long as you use the diapers! \r****FREE SHIPPING ACROSS CANADA!!**** \rAll diapers are new and individually packaged - never worn OR washed. They are high quality, one-size-fits-all, pocket cloth diapers. \rAll orders are shipped via Canada Post within 24 hours of placing your order. We send all packages Expedited with insurance and a tracking number, which is provided immediately upon shipping out. \rLooking for other package sizes? We have packages of 10, 24, 38 and 100 also..", "Calgary! Fall in love with your all natural and freshly handmade products for mama and baby. www.belugaskincare.com Like us on Facebook.com/belugaskincare FREE shipping in Canada with a $25 cart! \"making life simpler and greener so you can better do the things you are most passionate about\" - Beluga Skin CareThis ad was posted with the Kijiji mobile app.This ad was posted WITH the Kijiji mobile app.", "Yellow plastic baby sledSafety seat beltTow ropeDimensions: 23\" long x 14 1/2\" wide x 12\" high$10Located in Willow Park off Southland Dr. and Fairmount Dr. SECALL: 403 460 - 0978 (will not respond to texts at this land line number) TEXT OR CALL: 403 463 - 1038PLEASE SEE MY OTHER ADSThis ad was posted with the Kijiji mobile app.This ad was posted WITH the Kijiji mobile app.","Avent microwave sterilizer in good condition1 Avent bottle2 Medela bottles1/2 box of unused Medela pump and save bags1bag of replaceable Medela pump partsFrom clean, smoke free home. Take all for 10$This ad was posted with the Kijiji mobile app.This ad was posted WITH the Kijiji mobile app."),
Link= c("http://www.kijiji.ca/v-baby-clothes-3-6-months/calgary/baby-boy-3-6-month/1037502424","http://www.kijiji.ca/v-baby-bathing-changing-diapers/calgary/giggle-life-optimize-cloth-diapers-4-layer-mixed-insert/1008481541?src=topAdSearch", "http://www.kijiji.ca/v-baby-bathing-changing-diapers/calgary/beluga-baby/1037483143" , "http://www.kijiji.ca/v-baby-toy/calgary/baby-sled/1037493662", "http://www.kijiji.ca/v-baby-feeding-high-chair/calgary/avent-sterilizer-various-medela-items/1037481182" )
)
这里的 server.R 。请注意，我已经注释掉源代码，以避免提供源代码和延迟计算。请使用上面给出的 df 数据框重现结果：
here's server.R. Note that I have commented out the source code to avoid providing the source code and delayed computation. Please use the df dataframe given above to reproduce the results:
#Install required packages
ListofPackages= c('shiny','ggplot2','scales')
NewPackages= ListofPackages[!(ListofPackages %in% installed.packages()[,'Package'])]
if(length(NewPackages)>0) install.packages(NewPackages)
#Load required packages
lapply(ListofPackages,require,character.only=TRUE)
#Load source code
#source('C:/Users/Bahae.Omid/Google Drive/My R Case Studies/Shiny Apps/Kijiji App/adscraper.R',local=TRUE)
shinyServer(function(input,output){
#Create a reactive function to deal with inputs of the user
search <- reactive({
if(length(input$t)>0) {ind <- grep(input$t,df[,'Title'],ignore.case = T); df <- df[ind,] }
if(length(input$d)>0) {ind <- grep(input$d,df[,'Full.Description'],ignore.case = T); df <- df[ind,]}
if(length(input$a)>0) {ind <- grep(input$a,df[,'Address'],ignore.case = T); df <- df[ind,]}
if(input$p >=0) {ind <- df[,'Price']<=input$p ; df <- df[ind,]}
})
#Send the searchresult table to ui.R
output$searchresult <- renderDataTable({
input$action1 #triggered only when button is pressed
if(input$action1==0) return()
else{isolate({
transformed <- transform(search(), URL = paste('<a href = ', shQuote(Link), '>', 'Click</a>'))
transformed[-7] #Remove the old Link column
})
}
}, option=list(autoWidth=FALSE,pageLength=100,
columnDefs = list(list(targets =c(2,5,7) -1, searchable = FALSE),list(sWidth="75px",aTargets = list(4,5)))))
#Allow user to download the data via downloadhandler
output$down <- downloadHandler(
filename='filtered.csv',
content=function(file){write.csv(search(),file,row.names=FALSE)}
)
})
这里的$ code >呃.R 。请注意，我已经注释掉了图像标签，以避免运行代码时出现错误：
and here's ui.R. Note that I have commented out the image tags to avoid errors when running the code:
shinyUI(fluidPage(
#Display datatable filters on top
tags$head(tags$style("tfoot {display: table-header-group;}")),
#Add a title
#img(src="kijiji.gif", height = 100, width = 100),
#img(src="plus.png", height = 20, width = 20),
#img(src="plus.png", height = 20, width = 20),
#Use the Sidebar layout
sidebarLayout(
sidebarPanel(
#Add fields to search by and download button to allow exporting search results to csv.
h5('Note: Running the app takes a little while to run at startup.'),
helpText('Ad Title:'),
textInput('t',''),
helpText('Description:'),
textInput('d',''),
helpText('Address:'),
textInput('a',''),
sliderInput('p','Show Prices up to:',min = 0,max = 10000,step = 50,value = 10000),
actionButton('action1','Search!'),
br(),
br(),
helpText('Click below to download the results of your search:'),
downloadButton('down','Download')
),
mainPanel(
dataTableOutput('searchresult')
)
)
))
当我运行应用程序时，所有过滤器似乎工作正常，但当过滤器从数据框中返回任何记录（即0行数据帧），我得到以下错误：
When I run the app, all filters seem to work fine but when a filter returns no records from the data frame (i.e. 0-row dataframe), I get the following error:
Error in data.frame(structure(list(Title = character(0), Price = numeric(0), :
arguments imply differing number of rows: 0, 1
我使用 renderTable 而不是 renderDataTable 测试了相同的脚本，它工作得很好，但是想要在 DataTable 格式的输出，特别是我能够使其在另一个相同的应用程序中工作。
I have tested the same script using renderTable as opposed to renderDataTable and it worked perfectly fine. But I would like the output in DataTable format, specially that I was able to make it work in another identical app.
如果您需要更多的澄清，请让我知道。
Please let me know if you need more clarification.
推荐答案
当 search（）返回一个 data.frame ，零行
paste('<a href = ', shQuote(search()$url), '>', 'Click</a>')
返回
"<a href = \"\" > Click</a>"
然后您尝试绑定是具有一行的新列，您的数据框架没有行。因此出现错误信息。
You are then trying to bind this new column with one row to your data.frame with no rows. Hence the error message.
您可以使用
transformed <- transform(search()
, Link = if(length(url) > 0){
paste('<a href = ', shQuote(url), '>', 'Click</a>')
}else{
character(0)
}
)
这篇关于闪烁错误：参数意味着行数不同的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
