TakeCareApp/app/profil_module.R

347 lines
9.9 KiB
R
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

library(shiny)
library(magrittr)
library(ggplot2)
library(plotly)
library(DT)
profilUI <- function(id) {
ns <- NS(id)
fluidPage(
useShinyjs(),
tags$head(
tags$script(src="js.cookie.js"),
tags$script('Shiny.addCustomMessageHandler("tokenHandlerUpdate",
function(token) {
sessionStorage.setItem(\'token\', token);
Shiny.onInputChange("token", token);
}
);'),
tags$script('Shiny.addCustomMessageHandler("profileActiveTabHandler",
function(arg) {
Shiny.onInputChange("profileActiveTab", 1);
}
);'),
tags$style(HTML("
@import url('//fonts.googleapis.com/css?family=Lobster|Cabin:400,700');
@import url('//fonts.googleapis.com/css2?family=Fjalla+One');
")),
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')
)}
profilServer <- function(input, output,session) {
getEditStatus <- eventReactive(input$editSubmit, {
editedPersonalData<-data.frame(name<-input$editName,
surname<-input$editSurname,
mail<-input$editMail,
datebirth<-input$editAge,
gender<-input$editGender)
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]+[0-9]*@([a-z]{2,10}\\.)+[a-z]{2,5}$",editedPersonalData$mail))
if(all(reg)){
# status$status = register(result)
# status$first = FALSE
to_send = list(name = editedPersonalData$name,
surname = editedPersonalData$surname,
email = editedPersonalData$mail,
datebirth = editedPersonalData$datebirth,
gender = editedPersonalData$gender)
r<-httr::PUT("http://localhost:8080/api/profile",add_headers(Authorization=paste("Bearer",input$token,sep=" ")),body=to_send,encode = 'json')
if (r$status_code==200){
TRUE
}else{
FALSE
}
}else{
FALSE
}
})
observe({
session$sendCustomMessage(type='tokenHandlerAccess',(session$clientData)$url_hash)
})
output$profileData<-renderUI({
activeTab=input$profileActiveTab
session$clientData$url_hash
print(activeTab)
if(length(activeTab)==0 || is.null(activeTab) || activeTab!=1){
shinyjs::runjs('Shiny.onInputChange("profileActiveTab", 1);')
}
else if(activeTab==1){
r<-httr::GET("http://localhost:8080/api/profile",add_headers(Authorization=paste("Bearer",input$token,sep=" ")))
if(r$status_code==200){
response<-(content(r))
session$sendCustomMessage(type='tokenHandlerUpdate', response$token)
fluidRow(column(12,
wellPanel(
textInput("editName", label = strong("Imie"),value=response$profil$name),
uiOutput("editName"),
textInput("editSurname", label = strong("Nazwisko"),value=response$profil$surname),
uiOutput("editSurname"),
textInput("editMail", label = strong("Adres email"),value=response$profil$email),
uiOutput("editMail"),
dateInput("editAge", label = strong("Data urodzenia") ,value=response$profil$datebirth),
selectInput("editGender", label = strong("Plec"),
choices = list("Zenska" = 0, "meska" = 1),
selected = as.numeric(response$profil$gender)),
),
actionButton("editSubmit","Zapisz"),
uiOutput("btnEditProfile",style="color:red;")
))
}
# shinyjs::runjs('Shiny.onInputChange("profileActiveTab", 1);')
}
})
output$btnEditProfile<-renderUI({
if (getEditStatus()==TRUE){
p("OK",style="color:green;text-align:center;")
}else{
p("Uzytkownik istnieje lub wprowadzono bledne dane",style="color:red;text-align:center;")
}
})
output$afterLogin<-renderUI({
if(!is.null(input$token) & length(input$token)>0 ){
fluidRow(
column(3,
tags$div("Panel sterowania") %>% tagAppendAttributes(class="panel-title")
)%>% tagAppendAttributes(id = 'column-panel'),
column(9,
tabsetPanel(type = "tabs",
tabPanel("Dane profilowe", tags$div(uiOutput("profileData")
)%>% tagAppendAttributes(class = 'content-wrapper')),
tabPanel("Historia pomiarów",value='profileTabs', tags$div(DT::dataTableOutput("historyTable",height = "auto"))%>% tagAppendAttributes(id="profileTabs",class = 'content-wrapper')),
tabPanel("Zakladka 3", tags$div(plotlyOutput("plot3",height = "auto"))%>% tagAppendAttributes(class = 'content-wrapper')),
tabPanel("Zakladka 4", tags$div(plotlyOutput("plot4",height = "auto"))%>% tagAppendAttributes(class = 'content-wrapper')),
tabPanel("Zakladka 5", tags$div(DT::dataTableOutput("table1",height = "auto"))%>% tagAppendAttributes(class = 'content-wrapper'))
))%>% tagAppendAttributes(id = 'column-content')
) %>% tagAppendAttributes(id = 'row-content')
}else{
}
})
observeEvent(input$profileTabs, {
shinyjs::runjs(' window.location.reload();')})
output$plot1 <- renderPlotly({
g<-ggplot(mpg) +
geom_point(mapping = aes(x = displ, y = hwy))
gg<-ggplotly(g)
gg
})
output$historyTable <- DT::renderDataTable({
activeTab = input$profileActiveTab
session$clientData$url_hash
print(activeTab)
if(activeTab!=2){
shinyjs::runjs('Shiny.onInputChange("profileActiveTab", 2);') }
else{
r<-httr::GET("http://localhost:8080/api/prediction/usersPredictions/ind",add_headers(Authorization=paste("Bearer",input$token,sep=" ")),encode = 'json')
# print(typeof(do.call(c,(content(r)$predictions))))
# v<-do.call(c,(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))
}else{
df_historyTable<-as.data.frame(do.call(rbind, (content(r)$predictions)))
# print(typeof(df_historyTable))
# print(df_historyTable)
df_historyTable<-df_historyTable %>%
select(name,resultValue,localDateTime) %>%
mutate(Akcja="TODO")%>%
rename(
Nazwa = name,
Wynik = resultValue,
Data = localDateTime
)
df_historyTable$Nazwa<-do.call(c, df_historyTable$Nazwa)
df_historyTable$Wynik<-do.call(c, df_historyTable$Wynik)
df_historyTable$Data<-do.call(c, df_historyTable$Data)
print(df_historyTable)
print(df_historyTable$Nazwa)
# as.character(df_historyTable$Nazwa)
# as.numeric(df_historyTable$Wynik)
# as.Date(df_historyTable$Data)
DT::datatable(df_historyTable,options = list(scrollX = TRUE,language=pl))}
}
})
output$plot3 <- renderPlotly({
g<-ggplot(data = mpg, mapping = aes(x = displ, y = hwy, color = drv)) +
geom_point() +
geom_smooth(se = FALSE)
gg<-ggplotly(g)
gg
})
output$plot4 <- renderPlotly({
g<-ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) +
geom_point(mapping = aes(color=drv)) +
geom_smooth(se = FALSE)
gg<-ggplotly(g)
gg
})
pl <- list(
emptyTable="Tabela jest pusta",
sSearch = "Szukaj",
sInfo="Wyniki od _START_ do _END_ z _TOTAL_ rekordow",
sZeroRecords="Brak rekordow",
sEmptyTable="Pusta tabela",
oPaginate= list(
sFirst="Pierwsza", sPrevious="Poprzednia",sLast="Ostatnia", sNext="Nastepna"
),
sLengthMenu = "Pokaz _MENU_ rekordow na stronie"
)
output$table1 <- DT::renderDataTable(iris,options = list(scrollX = TRUE,language=pl))
output$btnResponse<-renderUI({
if (getStatus()==TRUE){
p("OK",style="color:white;text-align:center;")
}else{
p("Uzytkownik istnieje lub wprowadzono bledne dane",style="color:yellow;text-align:center;")
}
})
output$editName<-renderUI({
s<-toString(input$editName)
if (s=="" | grepl("^[A-Z][a-zA-ZĄąĆćĘęŁĹŃńÓóŚĹŹźŻż]{2,15}$",s)==TRUE){
return()
}else{
p("Blad: Imie powinno zaczynac sie od wielkiej litery, zawierac jedynie litery i miec dlugosc od 3 do 15 znakow",style="color:yellow")
}
})
output$editSurname<-renderUI({
s<-toString(input$editSurname)
if (s=="" | grepl("^[A-Z][a-zA-ZĄąĆćĘęŁĹŃńÓóŚĹŹźŻż]{2,20}$",s)==TRUE){
return()
}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")
}
})
output$editMail<-renderUI({
s<-toString(input$editMail)
if (s=="" | grepl("^[a-z]+[0-9]*@([a-z]{2,10}\\.)+[a-z]{2,5}$",s)==TRUE){
return()
}else{
p("Blad: Mail powinien miec budowe adres@nazwa.domena",style="color:yellow")
}
})
}