您好，我正在闪亮的网络中运行此程序并称呼我的火车模型。我的新数据是一类数据框，不是类型因素。但在拟合模型进行预测时，仍然将对象类的错误作为一个因素。这是带有多类分类的文本分类问题，对火车和测试数据非常适用。
This is how a model is trained:
rpart.cv.3 <- train(Label ~ ., data = train.tokens.tfidf.df, method = "rpart",
trControl = cv.cntrl, tuneLength = 7,na.action=na.omit)
fit<-rpart.cv.3
fit1 <- predict(fit,type = c("raw","prob"),na.action=na.pass)
fit1
save(fit1, file = 'RPART3.rda')
below is code in shiny web app file.
library(shiny)
library(irlba)
library(Matrix)
library(doSNOW)
library(e1071)
library(rpart)
a<-load("RPART3.rda")
print(a)
skin <- Sys.getenv("DASHBOARD_SKIN")
skin <- tolower(skin)
if (skin == "")
skin <- "black"
sidebar <- dashboardSidebar(
sidebarSearchForm(label = "Search...", "searchText", "searchButton"),
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", icon = icon("th"), tabName = "widgets", badgeLabel = "new",
badgeColor = "green"
),
menuItem("Charts", icon = icon("bar-chart-o"),
menuSubItem("Chart sub-item 1", tabName = "subitem1"),
menuSubItem("Chart sub-item 2", tabName = "subitem2")
),
menuItem("Built By", icon = icon("file-code-o"),
href = ""
)
)
)
body <- dashboardBody(
tabItems(
tabItem("dashboard",
# Boxes with solid headers
fluidRow(
# box(
# title = "Histogram control", width = 4, solidHeader = TRUE, status = "primary",
# sliderInput("count", "Count", min = 1, max = 500, value = 120)
# ),
box(
title = "Enter Description", width = 100, solidHeader = TRUE, status = "primary",
textInput("TextInput", "TextInput", value = "this is my shiny test for the shiny testing and chech shiny accuracy and check model will"),
radioButtons("RF", "Select", c(randomforest = "Randomforest",rpart = "DescisionTree")),
actionButton(inputId = "click", label = "Predict Risk Level"),
actionButton(inputId = "click2", label = "High"),
actionButton(inputId = "click3", label = "Low"),
actionButton(inputId = "click4", label = "Medium")
)
),
fluidRow(
box(
title = "Random forest",
width = 40,
tableOutput("variable.output"),
height = 400
)
))))
# mainPanel= textOutput("risk level"),
messages <- dropdownMenu(type = "messages",
messageItem(
from = "Internal Audit",
message = "Internal Audit depatment."
),
messageItem(
from = "New User",
message = "How do I register?",
icon = icon("question"),
time = "13:45"
),
messageItem(
from = "Support",
message = "The new server is ready.",
icon = icon("life-ring"),
time = "2014-12-01"
)
)
notifications <- dropdownMenu(type = "notifications", badgeStatus = "warning",
notificationItem(
text = "5 new users today",
icon("users")
),
notificationItem(
text = "12 items delivered",
icon("truck"),
status = "success"
),
notificationItem(
text = "Server load at 86%",
icon = icon("exclamation-triangle"),
status = "warning"
)
)
tasks <- dropdownMenu(type = "tasks", badgeStatus = "success",
taskItem(value = 90, color = "green",
"Documentation"
),
taskItem(value = 17, color = "aqua",
"Project X"
),
taskItem(value = 75, color = "yellow",
"Server deployment"
),
taskItem(value = 80, color = "red",
"Overall project"
)
)
header <- dashboardHeader(
title = " IA_PA DASHBOARD",
messages,
notifications,
tasks
)
ui <- dashboardPage(header, sidebar, body, skin = skin)
server <- function(input, output) {
output$variable.output <- renderTable({
TextInput <- eventReactive(input$click, {
(input$TextInput)
})
Description <- as.character(TextInput())
Description <- tokens(Description, what = "word",
remove_numbers = TRUE, remove_punct = TRUE,
remove_symbols = TRUE, remove_hyphens = TRUE)
# Lower case the tokens/stopword removal and word stemming
Description <- tokens_tolower(Description)
Description <- tokens_select(Description, stopwords(),
selection = "remove")
Description <- tokens_wordstem(Description, language = "english")
Description <- tokens_ngrams(Description, n = 1:2)
new.dfm1 <- dfm(Description, tolower = FALSE)
new.dfm2 <- dfm_select(new.dfm1, pattern = train.tokens.dfm,
selection = "keep")
new.dfm<-cbind(new.dfm1,new.dfm2)
new.tokens.matrix <- as.matrix(new.dfm)
# print(new.tokens.matrix)
# print(dim(new.tokens.matrix))
#Our function for calculating relative term frequency (TF)
term.frequency <- function(row) {
row / sum(row)}
# Our function for calculating inverse document frequency (IDF)
inverse.doc.freq <- function(col){
corpus.size <- length(col)+1
doc.count <- length(which(col > 0))
log10(corpus.size / doc.count)}
# Our function for calculating TF-IDF.
tf.idf <- function(x, idf){
x * idf}
new.tokens.df <- apply(new.tokens.matrix, 1, term.frequency)
new.tokens.idf <- apply(new.tokens.matrix,2,inverse.doc.freq)
#print(new.tokens.idf)
new.tokens.tfidf <- apply(new.tokens.df, 2, tf.idf, idf = new.tokens.idf)
# incomplete.cases1 <- which(!complete.cases(new.tokens.matrix))
# new.tokens.tfidf[incomplete.cases1,] <- rep(0.0, ncol(new.tokens.matrix))
#print(new.tokens.tfidf)
new.tokens.tfidf<-t(new.tokens.tfidf)
new.tokens.tfidf[is.na(new.tokens.tfidf)] <- 0.0
#print(new.tokens.tfidf)
new.svd <- data.frame((new.tokens.tfidf))
names(new.svd) <- make.names(names(new.svd))
print(colnames(new.svd))
print(class(new.svd))
pd<-predict(get(a),new.svd)
print(pd)
})}
shinyApp(ui,server)