update marge profile module

This commit is contained in:
Rafał Piskorski 2021-01-22 13:45:25 +01:00
commit 257da108ac
10 changed files with 509 additions and 124 deletions

295
.Rhistory Normal file
View File

@ -0,0 +1,295 @@
shiny::runApp('ap1')
p("Shiny jest dostpny w repozytorium CRAN, wiec mozesz zainstalowac go w zwykly sposob z konsoli R:"),
code("install.packages(\"shiny\")"),
br(),
br(),
br(),
br(),
img(src = "rstudio.png", height = 60, width = 200),
p("Shiny jest produktem",span("RStudio", style = "color:red"))
),
mainPanel(
h1("Wprowadzenie do Shiny", align = "left"),
p("Shiny jest nowym pakietem RStudio, ktory",em("bardzo ulatwia"),"tworzenie interaktywnych aplikacji internetowych w R."),
br(),
p("Duzo informacji i przykladow znajduje sie na",a("stronie Shiny."),""),
br(),
br(),
h2("Ficzery"),
p("-Tworz uzyteczne aplikacje internetowe zaledwie kilkoma liniami kodu - nie jest wymagana znajomosc JavaScriptu"),
p("-Aplikacje Shiny aktualizuja sie tak samo" ,strong("szybko"),"jak arkusze danych np. Excel. Wyniki zmieniaja sie natychmiast - gdy uzytkownicy modyfikuja dane wejsciowe, nie ma koniecznosci ponownego przeladowania strony.")
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
p("Shiny jest dostpny w repozytorium CRAN, wiec mozesz zainstalowac go w zwykly sposob z konsoli R:"),
code("install.packages(\"shiny\")"),
br(),
br(),
br(),
br(),
img(src = "rstudio.png", height = 60, width = 200),
p("Shiny jest produktem",span("RStudio", style = "color:red"))
),
mainPanel(
h1("Wprowadzenie do Shiny", align = "left"),
p("Shiny jest nowym pakietem RStudio, ktory",em("bardzo ulatwia"),"tworzenie interaktywnych aplikacji internetowych w R."),
br(),
p("Duzo informacji i przykladow znajduje sie na",a("stronie Shiny."),""),
br(),
br(),
h2("Ficzery"),
p("-Tworz uzyteczne aplikacje internetowe zaledwie kilkoma liniami kodu - nie jest wymagana znajomosc JavaScriptu"),
p("-Aplikacje Shiny aktualizuja sie tak samo" ,strong("szybko"),"jak arkusze danych np. Excel. Wyniki zmieniaja sie natychmiast - gdy uzytkownicy modyfikuja dane wejsciowe, nie ma koniecznosci ponownego przeladowania strony.")
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
p("Shiny jest dostpny w repozytorium CRAN, wiec mozesz zainstalowac go w zwykly sposob z konsoli R:"),
code("install.packages(\"shiny\")"),
br(),
br(),
br(),
br(),
img(src = "rstudio.png", height = 60, width = 200),
p("Shiny jest produktem",span("RStudio", style = "color:red"))
),
mainPanel(
h1("Wprowadzenie do Shiny", align = "left"),
p("Shiny jest nowym pakietem RStudio, ktory",em("bardzo ulatwia"),"tworzenie interaktywnych aplikacji internetowych w R."),
br(),
p("Duzo informacji i przykladow znajduje sie na",a("stronie Shiny."),""),
br(),
br(),
h2("Ficzery"),
p("-Tworz uzyteczne aplikacje internetowe zaledwie kilkoma liniami kodu - nie jest wymagana znajomosc JavaScriptu"),
p("-Aplikacje Shiny aktualizuja sie tak samo" ,strong("szybko"),"jak arkusze danych np. Excel. Wyniki zmieniaja sie natychmiast - gdy uzytkownicy modyfikuja dane wejsciowe, nie ma koniecznosci ponownego przeladowania strony.")
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
p("Shiny jest dostpny w repozytorium CRAN, wiec mozesz zainstalowac go w zwykly sposob z konsoli R:"),
code("install.packages(\"shiny\")"),
br(),
br(),
br(),
br(),
img(src = "rstudio.png", height = 60, width = 200),
p("Shiny jest produktem",span("RStudio", style = "color:red"))
),
mainPanel(
h1("Wprowadzenie do Shiny", align = "left"),
p("Shiny jest nowym pakietem RStudio, ktory",em("bardzo ulatwia"),"tworzenie interaktywnych aplikacji internetowych w R."),
br(),
p("Duzo informacji i przykladow znajduje sie na",a("stronie Shiny."),""),
br(),
br(),
h2("Ficzery"),
p("-Tworz uzyteczne aplikacje internetowe zaledwie kilkoma liniami kodu - nie jest wymagana znajomosc JavaScriptu"),
p("-Aplikacje Shiny aktualizuja sie tak samo" ,strong("szybko"),"jak arkusze danych np. Excel. Wyniki zmieniaja sie natychmiast - gdy uzytkownicy modyfikuja dane wejsciowe, nie ma koniecznosci ponownego przeladowania strony.")
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
p("Shiny jest dostpny w repozytorium CRAN, wiec mozesz zainstalowac go w zwykly sposob z konsoli R:"),
code("install.packages(\"shiny\")"),
br(),
br(),
br(),
br(),
img(src = "rstudio.png", height = 60, width = 200),
p("Shiny jest produktem",span("RStudio", style = "color:red"))
),
mainPanel(
h1("Wprowadzenie do Shiny", align = "left"),
p("Shiny jest nowym pakietem RStudio, ktory",em("bardzo ulatwia"),"tworzenie interaktywnych aplikacji internetowych w R."),
br(),
p("Duzo informacji i przykladow znajduje sie na",a("stronie Shiny."),""),
br(),
br(),
h2("Ficzery"),
p("-Tworz uzyteczne aplikacje internetowe zaledwie kilkoma liniami kodu - nie jest wymagana znajomosc JavaScriptu"),
p("-Aplikacje Shiny aktualizuja sie tak samo" ,strong("szybko"),"jak arkusze danych np. Excel. Wyniki zmieniaja sie natychmiast - gdy uzytkownicy modyfikuja dane wejsciowe, nie ma koniecznosci ponownego przeladowania strony.")
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
p("Shiny jest dostpny w repozytorium CRAN, wiec mozesz zainstalowac go w zwykly sposob z konsoli R:"),
code("install.packages(\"shiny\")"),
br(),
br(),
br(),
br(),
img(src = "rstudio.png", height = 60, width = 200),
p("Shiny jest produktem",span("RStudio", style = "color:red"))
),
mainPanel(
h1("Wprowadzenie do Shiny", align = "left"),
p("Shiny jest nowym pakietem RStudio, ktory",em("bardzo ulatwia"),"tworzenie interaktywnych aplikacji internetowych w R."),
br(),
p("Duzo informacji i przykladow znajduje sie na",a("stronie Shiny."),""),
br(),
br(),
h2("Ficzery"),
p("-Tworz uzyteczne aplikacje internetowe zaledwie kilkoma liniami kodu - nie jest wymagana znajomosc JavaScriptu"),
p("-Aplikacje Shiny aktualizuja sie tak samo" ,strong("szybko"),"jak arkusze danych np. Excel. Wyniki zmieniaja sie natychmiast - gdy uzytkownicy modyfikuja dane wejsciowe, nie ma koniecznosci ponownego przeladowania strony.")
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
p("Shiny jest dostpny w repozytorium CRAN, wiec mozesz zainstalowac go w zwykly sposob z konsoli R:"),
code("install.packages(\"shiny\")"),
br(),
br(),
br(),
br(),
img(src = "rstudio.png", height = 60, width = 200),
p("Shiny jest produktem",span("RStudio", style = "color:red"))
),
mainPanel(
h1("Wprowadzenie do Shiny", align = "left"),
p("Shiny jest nowym pakietem RStudio, ktory",em("bardzo ulatwia"),"tworzenie interaktywnych aplikacji internetowych w R."),
br(),
p("Duzo informacji i przykladow znajduje sie na",a("stronie Shiny."),""),
br(),
br(),
h2("Ficzery"),
p("-Tworz uzyteczne aplikacje internetowe zaledwie kilkoma liniami kodu - nie jest wymagana znajomosc JavaScriptu"),
p("-Aplikacje Shiny aktualizuja sie tak samo" ,strong("szybko"),"jak arkusze danych np. Excel. Wyniki zmieniaja sie natychmiast - gdy uzytkownicy modyfikuja dane wejsciowe, nie ma koniecznosci ponownego przeladowania strony.")
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
p("Shiny jest dostpny w repozytorium CRAN, wiec mozesz zainstalowac go w zwykly sposob z konsoli R:"),
code("install.packages(\"shiny\")"),
br(),
br(),
br(),
br(),
img(src = "rstudio.png", height = 60, width = 200),
p("Shiny jest produktem",span("RStudio", style = "color:red"))
),
mainPanel(
h1("Wprowadzenie do Shiny", align = "left"),
p("Shiny jest nowym pakietem RStudio, ktory",em("bardzo ulatwia"),"tworzenie interaktywnych aplikacji internetowych w R."),
br(),
p("Duzo informacji i przykladow znajduje sie na",a("stronie Shiny."),""),
br(),
br(),
h2("Ficzery"),
p("-Tworz uzyteczne aplikacje internetowe zaledwie kilkoma liniami kodu - nie jest wymagana znajomosc JavaScriptu"),
p("-Aplikacje Shiny aktualizuja sie tak samo" ,strong("szybko"),"jak arkusze danych np. Excel. Wyniki zmieniaja sie natychmiast - gdy uzytkownicy modyfikuja dane wejsciowe, nie ma koniecznosci ponownego przeladowania strony.")
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
p("Shiny jest dostpny w repozytorium CRAN, wiec mozesz zainstalowac go w zwykly sposob z konsoli R:"),
code("install.packages(\"shiny\")"),
br(),
br(),
br(),
br(),
img(src = "rstudio.png", height = 60, width = 200),
p("Shiny jest produktem",span("RStudio", style = "color:red"))
),
mainPanel(
h1("Wprowadzenie do Shiny", align = "left"),
p("Shiny jest nowym pakietem RStudio, ktory",em("bardzo ulatwia"),"tworzenie interaktywnych aplikacji internetowych w R."),
br(),
p("Duzo informacji i przykladow znajduje sie na",a("stronie Shiny."),""),
br(),
br(),
h2("Ficzery"),
p("-Tworz uzyteczne aplikacje internetowe zaledwie kilkoma liniami kodu - nie jest wymagana znajomosc JavaScriptu"),
p("-Aplikacje Shiny aktualizuja sie tak samo" ,strong("szybko"),"jak arkusze danych np. Excel. Wyniki zmieniaja sie natychmiast - gdy uzytkownicy modyfikuja dane wejsciowe, nie ma koniecznosci ponownego przeladowania strony.")
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
p("Shiny jest dostpny w repozytorium CRAN, wiec mozesz zainstalowac go w zwykly sposob z konsoli R:"),
code("install.packages(\"shiny\")"),
br(),
br(),
br(),
br(),
img(src = "rstudio.png", height = 60, width = 200),
p("Shiny jest produktem",span("RStudio", style = "color:red"))
),
mainPanel(
h1("Wprowadzenie do Shiny", align = "left"),
p("Shiny jest nowym pakietem RStudio, ktory",em("bardzo ulatwia"),"tworzenie interaktywnych aplikacji internetowych w R."),
br(),
p("Duzo informacji i przykladow znajduje sie na",a("stronie Shiny."),""),
br(),
br(),
h2("Ficzery"),
p("-Tworz uzyteczne aplikacje internetowe zaledwie kilkoma liniami kodu - nie jest wymagana znajomosc JavaScriptu"),
p("-Aplikacje Shiny aktualizuja sie tak samo" ,strong("szybko"),"jak arkusze danych np. Excel. Wyniki zmieniaja sie natychmiast - gdy uzytkownicy modyfikuja dane wejsciowe, nie ma koniecznosci ponownego przeladowania strony.")
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
runApp('ap1')
shiny::runApp('C:/Users/plalj/Desktop/TakeCareApp/app')
# summarize accuracy
table(predictions, iris$Species)
library(VGAM)
# load data
data(iris)
# fit model
fit <- vglm(Species~., family=multinomial, data=iris)
# summarize the fit
summary(fit)
# make predictions
probabilities <- predict(fit, iris[,1:4], type="response")
predictions <- apply(probabilities, 1, which.max)
predictions[which(predictions=="1")] <- levels(iris$Species)[1]
predictions[which(predictions=="2")] <- levels(iris$Species)[2]
predictions[which(predictions=="3")] <- levels(iris$Species)[3]
# summarize accuracy
table(predictions, iris$Species)
# load the package
library(MASS)
data(iris)
# fit model
fit <- lda(Species~., data=iris)
# summarize the fit
summary(fit)
# make predictions
predictions <- predict(fit, iris[,1:4])$class
# summarize accuracy
table(predictions, iris$Species)
# fit model
fit <- lda(Species~., data=iris)
fit
# summarize the fit
summary(fit)
# make predictions
predictions <- predict(fit, iris[,1:4])$class
predictions
# summarize accuracy
table(predictions, iris$Species)
shiny::runApp('C:/Users/plalj/Desktop/TakeCareApp/app')
setwd("C:/Users/plalj/Desktop/TakeCareApp")
shiny::runApp('app')
runApp('app')

View File

@ -13,16 +13,16 @@ aboutUI <- function(id){
tags$link(rel = "stylesheet", type = "text/css", href = "style.css") tags$link(rel = "stylesheet", type = "text/css", href = "style.css")
), ),
fluidPage( fluidPage(
h1("Kim jestesmy?", align = "center"), h1("Kim jesteśmy?", align = "center"),
br(), br(),
h4("Jestesmy mlodym dynamicznym zespolem wdrazajacym sie w swiat tworzenia profesjonalnych aplikacji"), h4("Jesteśmy młodym dynamicznym zespołem wdrażającym się w świat tworzenia profesjonalnych aplikacji"),
h4("Nasz zespol sklada sie z:"), h4("Nasz zespół składa się z:"),
br(), br(),
fluidRow(column(4, fluidRow(column(4,
div(div("Jan Przybylski"),img(src="jp.png", height = 150, width = 150)))%>% tagAppendAttributes(class = 'column-tile'), div(div("Jan Przybylski"),img(src="jp.png", height = 150, width = 150)))%>% tagAppendAttributes(class = 'column-tile'),
column(4, column(4,
div(div("Rafal Piskorski"),img(src="rafal.png", height = 150, width = 150)))%>% tagAppendAttributes(class = 'column-tile'), div(div("Rafał Piskorski"),img(src="rafal.png", height = 150, width = 150)))%>% tagAppendAttributes(class = 'column-tile'),
column(4, column(4,
div(div("Robert Tarnas"),img(src="robert.png", height = 150, width = 150)))%>% tagAppendAttributes(class = 'column-tile'), div(div("Robert Tarnas"),img(src="robert.png", height = 150, width = 150)))%>% tagAppendAttributes(class = 'column-tile'),

View File

@ -20,14 +20,15 @@ klasyui <- function(id){
min = 1, min = 1,
max = 100, max = 100,
value = 1), value = 1),
selectInput("selectKlas1",strong("Zaburzenia polykania"),choices = list("Nie"=0,"Tak"=1),selected=0), selectInput("selectKlas1",strong("Zaburzenia połykania"),choices = list("Nie"=0,"Tak"=1),selected=0),
selectInput("selectKlas2",strong("Bol przy polykaniu"),choices = list("Nie"=0,"Tak"=1),selected=0), selectInput("selectKlas2",strong("Ból przy połykaniu"),choices = list("Nie"=0,"Tak"=1),selected=0),
selectInput("selectKlas3",strong("Kaszel"),choices = list("Nie"=0,"Tak"=1),selected=0), selectInput("selectKlas3",strong("Kaszel"),choices = list("Nie"=0,"Tak"=1),selected=0),
selectInput("selectKlas4",strong("Dusznosci i swiszczacy oddech"),choices = list("Nie"=0,"Tak"=1),selected=0), selectInput("selectKlas4",strong("Duszności i świszczący oddech"),choices = list("Nie"=0,"Tak"=1),selected=0),
selectInput("selectKlas5",strong("Odkrztuszanie wydzieliny z krwia i chrypka"),choices = list("Nie"=0,"Tak"=1),selected=0), selectInput("selectKlas5",strong("Odkrztuszanie wydzieliny z krwią i chrypka"),choices = list("Nie"=0,"Tak"=1),selected=0),
selectInput("selectKlas6",strong("Guz w obrebie gruczolu piersiowego"),choices = list("Nie"=0,"Tak"=1),selected=0), selectInput("selectKlas6",strong("Guz w obrębie gruczołu piersiowego"),choices = list("Nie"=0,"Tak"=1),selected=0),
selectInput("selectKlas7",strong("Zmiany skorne wokol brodawki."),choices = list("Nie"=0,"Tak"=1),selected=0), selectInput("selectKlas7",strong("Zmiany skórne wokół brodawki"),choices = list("Nie"=0,"Tak"=1),selected=0),
selectInput("selectKlas8",strong("Wyciek z brodawki (zwlaszcza krwisty)"),choices = list("Nie"=0,"Tak"=1),selected=0) selectInput("selectKlas8",strong("Wyciek z brodawki (zwłaszcza krwisty)"),choices = list("Nie"=0,"Tak"=1),selected=0),
downloadButton("report1", "Generuj raport")
) )
@ -96,18 +97,52 @@ klasyserver <- function(input, output,session) {
} }
#print(pi*100) #print(pi*100)
z=100-(k+p+pi)/3 z=100-(k+p+pi)/3
x=c("Rak krtani","Rak piersi","Rak pluc","Zdrowy") x=c("Rak krtani","Rak piersi","Rak płuc","Zdrowy")
y=c(k,pi,p,z) y=c(k,pi,p,z)
d=data.frame(x,y) d=data.frame(x,y)
print(d) #print(d)
#z=0.0029*as.numeric(input$slider1) #z=0.0029*as.numeric(input$slider1)
g=ggplot(d, aes(x,y,fill=x))+ g=ggplot(d, aes(x,y,fill=x))+
geom_col()+ geom_col()+
labs(x="",y="Prawdopodobienstwo [%]") labs(x="",y="Prawdopodobieństwo [%]")
ggplotly(g) ggplotly(g)
}) })
output$report1 <- downloadHandler(
filename = "raport.pdf",
content = function(file) {
tempReport <- file.path(tempdir(), "report1.Rmd")
file.copy("report1.Rmd", tempReport, overwrite = TRUE)
k=(0.01*as.numeric(input$sliderKlas1)+0.1*as.numeric(input$selectKlas1)+0.1*as.numeric(input$selectKlas2))*100
if(k>100){
k=100
}
p=(0.01*as.numeric(input$sliderKlas1)+0.1*as.numeric(input$selectKlas3)+0.1*as.numeric(input$selectKlas4)+0.1*as.numeric(input$selectKlas5))*100
if(p>100){
p=100
}
#print(p*100)
pi=(0.01*as.numeric(input$sliderKlas1)+0.1*as.numeric(input$selectKlas6)+0.1*as.numeric(input$selectKlas7)+0.1*as.numeric(input$selectKlas8))*100
if(pi>100){
pi=100
}
#print(pi*100)
z=100-(k+p+pi)/3
params <- list(n = k,k=p,l=pi,m=z)
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
} }

View File

@ -87,7 +87,7 @@ loginServer <- function(input, output,session) {
if (isCorrect()==TRUE){ if (isCorrect()==TRUE){
}else{ }else{
p("Uzytkownik nie istnieje lub wprowadzono bledne dane",style="color:yellow;text-align:center;") p("Użytkownik istnieje lub wprowadzono błędne dane",style="color:yellow;text-align:center;")
} }
}) })

View File

@ -8,20 +8,20 @@ profilUI <- function(id) {
ns <- NS(id) ns <- NS(id)
fluidPage( fluidPage(
useShinyjs(), useShinyjs(),
tags$head( tags$head(
tags$script(src="js.cookie.js"), tags$script(src="js.cookie.js"),
tags$script('Shiny.addCustomMessageHandler("tokenHandlerUpdate", tags$script('Shiny.addCustomMessageHandler("tokenHandlerUpdate",
function(token) { function(token) {
sessionStorage.setItem(\'token\', token); sessionStorage.setItem(\'token\', token);
Shiny.onInputChange("token", token); Shiny.onInputChange("token", token);
} }
);'), );'),
tags$script('Shiny.addCustomMessageHandler("profileActiveTabHandler", tags$script('Shiny.addCustomMessageHandler("profileActiveTabHandler",
function(arg) { function(arg) {
Shiny.onInputChange("profileActiveTab", 1); Shiny.onInputChange("profileActiveTab", 1);
} }
);'), );'),
tags$script('Shiny.addCustomMessageHandler("viewPage", tags$script('Shiny.addCustomMessageHandler("viewPage",
function(page,token,auth) { function(page,token,auth) {
Shiny.onInputChange("token", token); Shiny.onInputChange("token", token);
Shiny.onInputChange("auth", auth); Shiny.onInputChange("auth", auth);
@ -29,34 +29,34 @@ profilUI <- function(id) {
window.location.href=page; window.location.href=page;
} }
);'), );'),
tags$style(HTML(" tags$style(HTML("
@import url('//fonts.googleapis.com/css?family=Lobster|Cabin:400,700'); @import url('//fonts.googleapis.com/css?family=Lobster|Cabin:400,700');
@import url('//fonts.googleapis.com/css2?family=Fjalla+One'); @import url('//fonts.googleapis.com/css2?family=Fjalla+One');
")), ")),
tags$link(rel = "stylesheet", type = "text/css", href = "profile.css") tags$link(rel = "stylesheet", type = "text/css", href = "profile.css")
), ),
# theme = "style.css",
# App title ----
uiOutput("afterLogin"),
fluidRow(
column(12,
tags$span("Copyright Wszystkie prawa zastrzezone."))%>% tagAppendAttributes(id = 'column-copyright'),
)%>% tagAppendAttributes(id = 'row-footer') # theme = "style.css",
)} # App title ----
uiOutput("afterLogin"),
fluidRow(
column(12,
tags$span("Copyright Wszystkie prawa zastrzeżone."))%>% tagAppendAttributes(id = 'column-copyright'),
)%>% tagAppendAttributes(id = 'row-footer')
)}
profilServer <- function(input, output,session) { profilServer <- function(input, output,session) {
@ -72,20 +72,20 @@ profilServer <- function(input, output,session) {
getEditStatus <- eventReactive(input$editSubmit, { getEditStatus <- eventReactive(input$editSubmit, {
editedPersonalData<-data.frame(name<-input$editName, editedPersonalData<-data.frame(name<-input$editName,
surname<-input$editSurname, surname<-input$editSurname,
mail<-input$editMail, mail<-input$editMail,
datebirth<-input$editAge, datebirth<-input$editAge,
gender<-input$editGender) gender<-input$editGender)
# reg<-c(grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,15}$",editedPersonalData$name), # reg<-c(grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,15}$",editedPersonalData$name),
# grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,20}$",editedPersonalData$surname), # grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,20}$",editedPersonalData$surname),
# grepl("^[a-z]+[0-9]*@([a-z]{2,10}\\.)+[a-z]{2,5}$",editedPersonalData$mail)) # grepl("^[a-z]+[0-9]*@([a-z]{2,10}\\.)+[a-z]{2,5}$",editedPersonalData$mail))
reg<-c(grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,15}$",editedPersonalData$name), reg<-c(grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,15}$",editedPersonalData$name),
grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,20}$",editedPersonalData$surname), grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,20}$",editedPersonalData$surname),
grepl("^[a-z]+[0-9]*@([a-z]{2,10}\\.)+[a-z]{2,5}$",editedPersonalData$mail)) grepl("^[a-z]+[0-9]*@([a-z]{2,10}\\.)+[a-z]{2,5}$",editedPersonalData$mail))
if(all(reg)){ if(all(reg)){
personalData = list( personalData = list(
name = editedPersonalData$name, name = editedPersonalData$name,
surname = editedPersonalData$surname, surname = editedPersonalData$surname,
@ -98,7 +98,7 @@ profilServer <- function(input, output,session) {
personalDataDTO = personalData) personalDataDTO = personalData)
r<-httr::PUT("http://localhost:8080/api/profile",add_headers(Authorization=paste("Bearer",input$token,sep=" ")),body=to_send,encode = 'json') r<-httr::PUT("http://localhost:8080/api/profile",add_headers(Authorization=paste("Bearer",input$token,sep=" ")),body=to_send,encode = 'json')
@ -113,11 +113,11 @@ profilServer <- function(input, output,session) {
} }
}) })
personalDataVector <- reactiveVal() personalDataVector <- reactiveVal()
historyDataVector <- reactiveVal() historyDataVector <- reactiveVal()
@ -125,12 +125,10 @@ profilServer <- function(input, output,session) {
downloadPersonalData<-reactive({ downloadPersonalData<-reactive({
r<-httr::GET("http://localhost:8080/api/profile",add_headers(Authorization=paste("Bearer",input$token,sep=" ")))
r<-httr::GET("http://localhost:8080/api/profile",add_headers(Authorization=paste("Bearer",input$token,sep=" "))) r
print("Reactive data")
r
}) })
downloadHistoryData<-reactive({ downloadHistoryData<-reactive({
@ -148,12 +146,10 @@ profilServer <- function(input, output,session) {
session$sendCustomMessage(type='tokenHandlerAccess',(session$clientData)$url_hash) session$sendCustomMessage(type='tokenHandlerAccess',(session$clientData)$url_hash)
} }
}) })
observeEvent(input$profileTabs,{ observeEvent(input$profileTabs,{
@ -184,53 +180,53 @@ profilServer <- function(input, output,session) {
rr<-httr::GET("http://localhost:8080/api/prediction/usersPredictions/ind",add_headers(Authorization=paste("Bearer",input$token,sep=" ")),encode = 'json') rr<-httr::GET("http://localhost:8080/api/prediction/usersPredictions/ind",add_headers(Authorization=paste("Bearer",input$token,sep=" ")),encode = 'json')
historyDataVector(rr) historyDataVector(rr)
} }
}) })
output$profileData<-renderUI({ output$profileData<-renderUI({
r <- personalDataVector() r <- personalDataVector()
if(length(r)!=0 & !is.null(r)){ if(length(r)!=0 & !is.null(r)){
if(r$status_code==200){
response<-(content(r)) if(r$status_code==200){
response<-(content(r))
session$sendCustomMessage(type='tokenHandlerUpdate', response$token)
session$sendCustomMessage(type='tokenHandlerUpdate', response$token)
fluidRow(column(12,
wellPanel(
textInput("editName", label = strong("Imie"),value=response$profil$personalDataDTO$name), fluidRow(column(12,
uiOutput("editName"), wellPanel(
textInput("editSurname", label = strong("Nazwisko"),value=response$profil$personalDataDTO$surname), textInput("editName", label = strong("Imię"),value=response$profil$personalDataDTO$name),
uiOutput("editSurname"), uiOutput("editName"),
textInput("editMail", label = strong("Adres email"),value=response$profil$personalDataDTO$email), textInput("editSurname", label = strong("Nazwisko"),value=response$profil$personalDataDTO$surname),
uiOutput("editMail"), uiOutput("editSurname"),
dateInput("editAge", label = strong("Data urodzenia") ,value=response$profil$personalDataDTO$datebirth), textInput("editMail", label = strong("Adres email"),value=response$profil$personalDataDTO$email),
uiOutput("editMail"),
selectInput("editGender", label = strong("Plec"), dateInput("editAge", label = strong("Data urodzenia") ,value=response$profil$personalDataDTO$datebirth),
choices = list("Zenska" = 0, "meska" = 1),
selected = as.numeric(response$profil$personalDataDTO$gender)), selectInput("editGender", label = strong("Płeć"),
choices = list("Żeńska" = 0, "męska" = 1),
selected = as.numeric(response$profil$personalDataDTO$gender)),
actionButton("editSubmit","Zapisz"),
uiOutput("btnEditProfile",style="color:red;")
actionButton("editSubmit","Zapisz"),
uiOutput("btnEditProfile",style="color:red;")
), ),
))
))
}
} }
}
}) })
output$btnEditProfile<-renderUI({ output$btnEditProfile<-renderUI({
@ -238,7 +234,7 @@ profilServer <- function(input, output,session) {
if (getEditStatus()==TRUE){ if (getEditStatus()==TRUE){
p("OK",style="color:green;text-align:center;") p("OK",style="color:green;text-align:center;")
}else{ }else{
p("Uzytkownik istnieje lub wprowadzono bledne dane",style="color:red;text-align:center;") p("Użytkownik istnieje lub wprowadzono błędne dane",style="color:red;text-align:center;")
} }
@ -249,22 +245,21 @@ profilServer <- function(input, output,session) {
if(get_page()=="profil"){ if(get_page()=="profil"){
if(!is.null(input$auth) & length(input$auth)>0 ){ if(!is.null(input$auth) & length(input$auth)>0 ){
fluidRow( fluidRow(
column(12, column(12,
tabsetPanel(id="profileTabs",type = "tabs", tabsetPanel(id="profileTabs",type = "tabs",
tabPanel("Dane profilowe",value="data", tags$div(uiOutput("profileData") tabPanel("Dane profilowe",value="data", tags$div(uiOutput("profileData")
) %>% tagAppendAttributes(id = 'content-personal')), ) %>% tagAppendAttributes(id = 'content-personal')),
tabPanel("Historia pomiarów",value='history', tags$div(DT::dataTableOutput("historyTable",height = "auto"))%>% tagAppendAttributes(id="profileTabs",class = 'content-wrapper')) tabPanel("Historia pomiarów",value='history', tags$div(DT::dataTableOutput("historyTable",height = "auto"))%>% tagAppendAttributes(id="profileTabs",class = 'content-wrapper'))
))%>% tagAppendAttributes(id = 'column-profile') ))%>% tagAppendAttributes(id = 'column-profile')
) %>% tagAppendAttributes(id = 'row-content') ) %>% tagAppendAttributes(id = 'row-content')
}else{ }else{
} }
}
}) })
@ -288,20 +283,14 @@ profilServer <- function(input, output,session) {
change_page(paste("?id=",input$view_button,"#!/iota",sep=""), session = session, mode = "push") change_page(paste("?id=",input$view_button,"#!/iota",sep=""), session = session, mode = "push")
}) })
output$historyTable <- DT::renderDataTable({ output$historyTable <- DT::renderDataTable({
r <- historyDataVector() r <- historyDataVector()
if(is.null(content(r)$predictions)){ if(is.null(content(r)$predictions)){
DT::datatable(data.frame(Nazwa=character(),Wynik=numeric(),Data=character()),options = list(scrollX = TRUE,language=pl)) DT::datatable(data.frame(Nazwa=character(),Wynik=numeric(),Data=character()),options = list(scrollX = TRUE,language=pl))
}else{ }else{
df_historyTable<-as.data.frame(do.call(rbind, (content(r)$predictions))) df_historyTable<-as.data.frame(do.call(rbind, (content(r)$predictions)))
historyTableButtons = list()
for(rowNumber in 1:nrow(df_historyTable)){
historyTableButtons[[rowNumber]] <-list(shinyInput(actionButton, 1, as.character(df_historyTable[rowNumber,]$id[1]), label = "Pokaż", onclick = 'Shiny.onInputChange(\"view_button\", this.id)' ), historyTableButtons[[rowNumber]] <-list(shinyInput(actionButton, 1, as.character(df_historyTable[rowNumber,]$id[1]), label = "Pokaż", onclick = 'Shiny.onInputChange(\"view_button\", this.id)' ),
shinyInput(actionButton, 1, as.character(df_historyTable[rowNumber,]$id[1]), label = "Usuń", onclick = 'Shiny.onInputChange(\"del_button\", this.id)')) shinyInput(actionButton, 1, as.character(df_historyTable[rowNumber,]$id[1]), label = "Usuń", onclick = 'Shiny.onInputChange(\"del_button\", this.id)'))
@ -324,7 +313,7 @@ profilServer <- function(input, output,session) {
DT::datatable(df_historyTable,selection="none",options = list(scrollX = TRUE,language=pl))} DT::datatable(df_historyTable,selection="none",options = list(scrollX = TRUE,language=pl))}
# } # }
}) })
output$plot3 <- renderPlotly({ output$plot3 <- renderPlotly({
@ -355,13 +344,13 @@ profilServer <- function(input, output,session) {
pl <- list( pl <- list(
emptyTable="Tabela jest pusta", emptyTable="Tabela jest pusta",
sSearch = "Szukaj", sSearch = "Szukaj",
sInfo="Wyniki od _START_ do _END_ z _TOTAL_ rekordow", sInfo="Wyniki od _START_ do _END_ z _TOTAL_ rekordów",
sZeroRecords="Brak rekordow", sZeroRecords="Brak rekordów",
sEmptyTable="Pusta tabela", sEmptyTable="Pusta tabela",
oPaginate= list( oPaginate= list(
sFirst="Pierwsza", sPrevious="Poprzednia",sLast="Ostatnia", sNext="Nastepna" sFirst="Pierwsza", sPrevious="Poprzednia",sLast="Ostatnia", sNext="Następna"
), ),
sLengthMenu = "Pokaz _MENU_ rekordow na stronie" sLengthMenu = "Pokaż _MENU_ rekordów na stronie"
) )
output$table1 <- DT::renderDataTable(iris,options = list(scrollX = TRUE,language=pl)) output$table1 <- DT::renderDataTable(iris,options = list(scrollX = TRUE,language=pl))
@ -372,7 +361,7 @@ profilServer <- function(input, output,session) {
if (getStatus()==TRUE){ if (getStatus()==TRUE){
p("OK",style="color:white;text-align:center;") p("OK",style="color:white;text-align:center;")
}else{ }else{
p("Uzytkownik istnieje lub wprowadzono bledne dane",style="color:yellow;text-align:center;") p("Użytkownik istnieje lub wprowadzono błędne dane",style="color:yellow;text-align:center;")
} }
@ -381,10 +370,10 @@ profilServer <- function(input, output,session) {
output$editName<-renderUI({ output$editName<-renderUI({
s<-toString(input$editName) s<-toString(input$editName)
if (s=="" | grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,15}$",s)==TRUE){ if (s=="" | grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,15}$",s)==TRUE){
return() return()
}else{ }else{
p("Blad: Imie powinno zaczynac sie od wielkiej litery, zawierac jedynie litery i miec dlugosc od 3 do 15 znakow",style="color:yellow") p("Bład: Imię powinno zaczynać się od wielkiej litery, zawierać jedynie litery i mieć długość od 3 do 15 znaków",style="color:yellow")
} }
}) })
@ -392,10 +381,10 @@ profilServer <- function(input, output,session) {
output$editSurname<-renderUI({ output$editSurname<-renderUI({
s<-toString(input$editSurname) s<-toString(input$editSurname)
if (s=="" | grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,20}$",s)==TRUE){ if (s=="" | grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,20}$",s)==TRUE){
return() return()
}else{ }else{
p("Blad: Nazwisko powinno zaczynac sie od wielkiej litery, zawierac jedynie litery i miec dlugosc od 3 do 15 znaków",style="color:yellow") p("Bład: Nazwisko powinno zaczynać sie od wielkiej litery, zawierać jedynie litery i mieć długość od 3 do 15 znakĂłw",style="color:yellow")
} }
@ -408,7 +397,7 @@ profilServer <- function(input, output,session) {
if (s=="" | grepl("^[a-z]+[0-9]*@([a-z]{2,10}\\.)+[a-z]{2,5}$",s)==TRUE){ if (s=="" | grepl("^[a-z]+[0-9]*@([a-z]{2,10}\\.)+[a-z]{2,5}$",s)==TRUE){
return() return()
}else{ }else{
p("Blad: Mail powinien miec budowe adres@nazwa.domena",style="color:yellow") p("Bład: Mail powinien mieć budowę adres@nazwa.domena",style="color:yellow")
} }

18
app/report1.Rmd Normal file
View File

@ -0,0 +1,18 @@
---
title: "Dynamiczny raport dla klasyfikatora"
output: pdf_document
params:
n: NA
k: NA
l: NA
m: NA
---
Szansa na raka krtani:
`r params$n`
Szansa na raka płuc:
`r params$k`
Szansa na raka piersi:
`r params$l`
Szansa na bycie zdrowym:
`r params$m`

19
app/report1.aux Normal file
View File

@ -0,0 +1,19 @@
\relax
\providecommand\hyper@newdestlabel[2]{}
\providecommand\HyperFirstAtBeginDocument{\AtBeginDocument}
\HyperFirstAtBeginDocument{\ifx\hyper@anchor\@undefined
\global\let\oldcontentsline\contentsline
\gdef\contentsline#1#2#3#4{\oldcontentsline{#1}{#2}{#3}}
\global\let\oldnewlabel\newlabel
\gdef\newlabel#1#2{\newlabelxx{#1}#2}
\gdef\newlabelxx#1#2#3#4#5#6{\oldnewlabel{#1}{{#2}{#3}}}
\AtEndDocument{\ifx\hyper@anchor\@undefined
\let\contentsline\oldcontentsline
\let\newlabel\oldnewlabel
\fi}
\fi}
\global\let\hyper@last\relax
\gdef\HyperFirstAtBeginDocument#1{#1}
\providecommand\HyField@AuxAddToFields[1]{}
\providecommand\HyField@AuxAddToCoFields[2]{}
\gdef \@abspage@last{1}

0
app/report1.out Normal file
View File

BIN
app/report1.pdf Normal file

Binary file not shown.

View File

@ -4,7 +4,10 @@
<option name="autoReloadType" value="SELECTIVE" /> <option name="autoReloadType" value="SELECTIVE" />
</component> </component>
<component name="ChangeListManager"> <component name="ChangeListManager">
<list default="true" id="2f11f4d5-1593-4266-846c-71ac633cf58a" name="Default" comment="" /> <list default="true" id="2f11f4d5-1593-4266-846c-71ac633cf58a" name="Default" comment="">
<change beforePath="$PROJECT_DIR$/../app/about.R" beforeDir="false" afterPath="$PROJECT_DIR$/../app/about.R" afterDir="false" />
<change beforePath="$PROJECT_DIR$/../app/klasyfikator.R" beforeDir="false" afterPath="$PROJECT_DIR$/../app/klasyfikator.R" afterDir="false" />
</list>
<option name="SHOW_DIALOG" value="false" /> <option name="SHOW_DIALOG" value="false" />
<option name="HIGHLIGHT_CONFLICTS" value="true" /> <option name="HIGHLIGHT_CONFLICTS" value="true" />
<option name="HIGHLIGHT_NON_ACTIVE_CHANGELIST" value="false" /> <option name="HIGHLIGHT_NON_ACTIVE_CHANGELIST" value="false" />
@ -47,10 +50,25 @@
<property name="project.structure.last.edited" value="Project" /> <property name="project.structure.last.edited" value="Project" />
<property name="project.structure.proportion" value="0.15" /> <property name="project.structure.proportion" value="0.15" />
<property name="project.structure.side.proportion" value="0.2" /> <property name="project.structure.side.proportion" value="0.2" />
<property name="restartRequiresConfirmation" value="false" />
<property name="settings.editor.selected.configurable" value="project.propVCSSupport.Mappings" /> <property name="settings.editor.selected.configurable" value="project.propVCSSupport.Mappings" />
</component> </component>
<component name="RunManager" selected="Application.TakeCareApp"> <component name="RunManager" selected="Application.TakeCareApp1">
<configuration name="TakeCareApp" type="Application" factoryName="Application" nameIsGenerated="true"> <configuration name="TakeCareApp" type="Application" factoryName="Application" nameIsGenerated="true">
<option name="ALTERNATIVE_JRE_PATH" value="$PROJECT_DIR$/../../../../../Program Files/Java/jre1.8.0_251" />
<option name="ALTERNATIVE_JRE_PATH_ENABLED" value="true" />
<module name="backend" />
<extension name="coverage">
<pattern>
<option name="PATTERN" value="project.*" />
<option name="ENABLED" value="true" />
</pattern>
</extension>
<method v="2">
<option name="Make" enabled="true" />
</method>
</configuration>
<configuration name="TakeCareApp1" type="Application" factoryName="Application">
<option name="ALTERNATIVE_JRE_PATH" value="$PROJECT_DIR$/../../../../../Program Files/Java/jre1.8.0_251" /> <option name="ALTERNATIVE_JRE_PATH" value="$PROJECT_DIR$/../../../../../Program Files/Java/jre1.8.0_251" />
<option name="ALTERNATIVE_JRE_PATH_ENABLED" value="true" /> <option name="ALTERNATIVE_JRE_PATH_ENABLED" value="true" />
<option name="MAIN_CLASS_NAME" value="project.TakeCareApp" /> <option name="MAIN_CLASS_NAME" value="project.TakeCareApp" />
@ -145,6 +163,7 @@
</configuration> </configuration>
<list> <list>
<item itemvalue="Application.TakeCareApp" /> <item itemvalue="Application.TakeCareApp" />
<item itemvalue="Application.TakeCareApp1" />
</list> </list>
</component> </component>
<component name="SpellCheckerSettings" RuntimeDictionaries="0" Folders="0" CustomDictionaries="0" DefaultDictionary="application-level" UseSingleDictionary="true" transferred="true" /> <component name="SpellCheckerSettings" RuntimeDictionaries="0" Folders="0" CustomDictionaries="0" DefaultDictionary="application-level" UseSingleDictionary="true" transferred="true" />
@ -168,6 +187,16 @@
<component name="TypeScriptGeneratedFilesManager"> <component name="TypeScriptGeneratedFilesManager">
<option name="version" value="3" /> <option name="version" value="3" />
</component> </component>
<component name="XDebuggerManager">
<breakpoint-manager>
<breakpoints>
<breakpoint enabled="true" type="java-exception">
<properties class="org.hibernate.tool.schema.spi.CommandAcceptanceException" package="org.hibernate.tool.schema.spi" />
<option name="timeStamp" value="1" />
</breakpoint>
</breakpoints>
</breakpoint-manager>
</component>
<component name="com.intellij.coverage.CoverageDataManagerImpl"> <component name="com.intellij.coverage.CoverageDataManagerImpl">
<SUITE FILE_PATH="coverage/backend$TakeCareApp.ic" NAME="TakeCareApp Coverage Results" MODIFIED="1609942793616" SOURCE_PROVIDER="com.intellij.coverage.DefaultCoverageFileProvider" RUNNER="idea" COVERAGE_BY_TEST_ENABLED="false" COVERAGE_TRACING_ENABLED="false" /> <SUITE FILE_PATH="coverage/backend$TakeCareApp.ic" NAME="TakeCareApp Coverage Results" MODIFIED="1609942793616" SOURCE_PROVIDER="com.intellij.coverage.DefaultCoverageFileProvider" RUNNER="idea" COVERAGE_BY_TEST_ENABLED="false" COVERAGE_TRACING_ENABLED="false" />
</component> </component>