TAK-78
This commit is contained in:
parent
6ce753e6d2
commit
9c114ed55e
@ -177,6 +177,7 @@ server <- shinyServer(function(input, output, session){
|
|||||||
tabPanel(a("Firmy",id="tab1",class = "tab-link", href = route_link("firms"))),
|
tabPanel(a("Firmy",id="tab1",class = "tab-link", href = route_link("firms"))),
|
||||||
tabPanel(a("O nas",id="tab2",class = "tab-link", href = route_link("about"))),
|
tabPanel(a("O nas",id="tab2",class = "tab-link", href = route_link("about"))),
|
||||||
tabPanel(a("Kalkulator", id ="tab5",class="tab-link", href = route_link("calculator"))),
|
tabPanel(a("Kalkulator", id ="tab5",class="tab-link", href = route_link("calculator"))),
|
||||||
|
tabPanel(a("Klasyfikator", id ="tab5",class="tab-link", href = route_link("klasyfikator"))),
|
||||||
tabPanel(a("Wyloguj",id="tab7",class = "tab-link")),
|
tabPanel(a("Wyloguj",id="tab7",class = "tab-link")),
|
||||||
tabPanel(a("Profil",id="tab4",class="tab-link", href = route_link("profil")))),
|
tabPanel(a("Profil",id="tab4",class="tab-link", href = route_link("profil")))),
|
||||||
|
|
||||||
|
77
app/klasyfikator.R
Normal file
77
app/klasyfikator.R
Normal file
@ -0,0 +1,77 @@
|
|||||||
|
library(shiny)
|
||||||
|
library(magrittr)
|
||||||
|
library(ggplot2)
|
||||||
|
library(plotly)
|
||||||
|
library(DT)
|
||||||
|
|
||||||
|
# Define UI for application that draws a histogram
|
||||||
|
klasyui <- function(id){
|
||||||
|
ns <- NS(id)
|
||||||
|
fluidPage(
|
||||||
|
|
||||||
|
# Application title
|
||||||
|
titlePanel("Klasyfikator"),
|
||||||
|
|
||||||
|
# Sidebar with a slider input for number of bins
|
||||||
|
sidebarLayout(
|
||||||
|
sidebarPanel(
|
||||||
|
sliderInput("slider1",
|
||||||
|
"Wiek pacjenta",
|
||||||
|
min = 1,
|
||||||
|
max = 100,
|
||||||
|
value = 1),
|
||||||
|
selectInput("select1",strong("Zaburzenia polykania"),choices = list("Nie"=0,"Tak"=1),selected=0),
|
||||||
|
selectInput("select2",strong("Ból przy polykaniu"),choices = list("Nie"=0,"Tak"=1),selected=0),
|
||||||
|
selectInput("select3",strong("Kaszel"),choices = list("Nie"=0,"Tak"=1),selected=0),
|
||||||
|
selectInput("select4",strong("Dusznosci i swiszczacy oddech"),choices = list("Nie"=0,"Tak"=1),selected=0),
|
||||||
|
selectInput("select5",strong("Odkrztuszanie wydzieliny z krwia i chrypka"),choices = list("Nie"=0,"Tak"=1),selected=0),
|
||||||
|
selectInput("select6",strong("Guz w obrebie gruczolu piersiowego"),choices = list("Nie"=0,"Tak"=1),selected=0),
|
||||||
|
selectInput("select7",strong("Zmiany skorne wokol brodawki."),choices = list("Nie"=0,"Tak"=1),selected=0),
|
||||||
|
selectInput("select8",strong("Wyciek z brodawki (zwlaszcza krwisty)"),choices = list("Nie"=0,"Tak"=1),selected=0)
|
||||||
|
|
||||||
|
),
|
||||||
|
|
||||||
|
# Show a plot of the generated distribution
|
||||||
|
mainPanel(
|
||||||
|
plotlyOutput("distPlot")
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
#ploc krtani piersi,zdrowy
|
||||||
|
# Define server logic required to draw a histogram
|
||||||
|
klasyserver <- function(input, output,session) {
|
||||||
|
|
||||||
|
output$distPlot <- renderPlotly({
|
||||||
|
k=(0.01*as.numeric(input$slider1)+0.1*as.numeric(input$select1)+0.1*as.numeric(input$select2))*100
|
||||||
|
if(k>100){
|
||||||
|
k=100
|
||||||
|
}
|
||||||
|
p=(0.01*as.numeric(input$slider1)+0.1*as.numeric(input$select3)+0.1*as.numeric(input$select4)+0.1*as.numeric(input$select5))*100
|
||||||
|
if(p>100){
|
||||||
|
p=100
|
||||||
|
}
|
||||||
|
#print(p*100)
|
||||||
|
pi=(0.01*as.numeric(input$slider1)+0.1*as.numeric(input$select6)+0.1*as.numeric(input$select7)+0.1*as.numeric(input$select8))*100
|
||||||
|
if(pi>100){
|
||||||
|
pi=100
|
||||||
|
}
|
||||||
|
#print(pi*100)
|
||||||
|
z=100-(k+p+pi)/3
|
||||||
|
x=c("Rak krtani","Rak piersi","Rak płuc","Zdrowy")
|
||||||
|
y=c(k,pi,p,z)
|
||||||
|
d=data.frame(x,y)
|
||||||
|
print(d)
|
||||||
|
#z=0.0029*as.numeric(input$slider1)
|
||||||
|
|
||||||
|
g=ggplot(d, aes(x,y,fill=x))+
|
||||||
|
geom_col()+
|
||||||
|
labs(x="",y="%")
|
||||||
|
ggplotly(g)
|
||||||
|
|
||||||
|
|
||||||
|
})
|
||||||
|
}
|
||||||
|
|
@ -12,7 +12,7 @@ source("login_module.R",encoding="utf-8")
|
|||||||
source("register_module.R",encoding="utf-8")
|
source("register_module.R",encoding="utf-8")
|
||||||
source("calculator.R", encoding = "utf-8")
|
source("calculator.R", encoding = "utf-8")
|
||||||
source("firmy_module.R", encoding = "utf-8")
|
source("firmy_module.R", encoding = "utf-8")
|
||||||
|
source("klasyfikator.R", encoding = "utf-8")
|
||||||
|
|
||||||
|
|
||||||
home_page <-homeUI(id="home")
|
home_page <-homeUI(id="home")
|
||||||
@ -22,6 +22,7 @@ login_page <-loginUI(id="login")
|
|||||||
register_page <-registerUI(id="register")
|
register_page <-registerUI(id="register")
|
||||||
calculator_page <- calculatorUI(id="calculator")
|
calculator_page <- calculatorUI(id="calculator")
|
||||||
firmy_page <- firmyUI(id="firms")
|
firmy_page <- firmyUI(id="firms")
|
||||||
|
klas_page <- klasyui(id="klasyfikator")
|
||||||
|
|
||||||
router <- make_router(
|
router <- make_router(
|
||||||
route("home", home_page,homeServer),
|
route("home", home_page,homeServer),
|
||||||
@ -30,7 +31,8 @@ router <- make_router(
|
|||||||
route("login", login_page,loginServer),
|
route("login", login_page,loginServer),
|
||||||
route("register", register_page,registerServer),
|
route("register", register_page,registerServer),
|
||||||
route("calculator", calculator_page, calculatorServer),
|
route("calculator", calculator_page, calculatorServer),
|
||||||
route("firms", firmy_page, firmyServer)
|
route("firms", firmy_page, firmyServer),
|
||||||
|
route("klasyfikator",klas_page,klasyserver)
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user