rosstat:

library(shiny)
library(shinyTree)
library(cartogram)
library(raster)
library(RColorBrewer)
library(classInt)
library(data.tree)
library(rgdal)
library(cartography)
library(RColorBrewer)
library(pycno)
library(docxtractr)
library(rgdal)
library(leaflet)
library(xlsx)
library(sp)
library(data.tree)
library(geosphere)
# library(carto)


function(input, output, session) { 
  
  oxvat1_c_eng <- c("RUS","FO", "ER")
  oxvat1_c_rus <- c("Российская Федерация", "Федеральный округ", "Экономический район")
  names(oxvat1_c_eng) <- oxvat1_c_rus  
    
  oxvat2_c_eng <- c("DVFO", "KRFO", "PRIVFO", "SIBFO", "SKFO", "SZFO", "TSFO", "UFO", "URFO")
  oxvat2_c_rus <- c("Дальневосточный", "Крымский", "Приволжский", "Сибирский", "Северо-Кавказский", "Северо-Западный", "Центральный", "Южный", "Уральский")
  names(oxvat2_c_eng) <- oxvat2_c_rus
  
  oxvat3_c_eng <- c("ZSER", "VVER", "VSER", "URER", "TSER", "SZER", "SKER", "SER", "POVER", "KALER", "DVER", "CCER")
  oxvat3_c_rus <- c("Западно-Сибирский", "Волго-Вятский", "Восточно-Сибирский", "Уральский", "Центральный", "Северо-Западный", "Северо-Кавказский", "Северный", "Поволжский", "Калининградский", "Дальневосточный", "Центрально-Черноземный")
  names(oxvat3_c_eng) <- oxvat3_c_rus
  
  
  project_c_eng <- c("lambert", "vario", "anamorph")
  project_c_rus <- c("Коническая Ламберта", "Переменно-масштабная", "Анаморфированная")
  names(project_c_eng) <- project_c_rus
  
  method_c_eng <- c("quantile", "fisher", "jenks", "equal", "pretty", "kmeans", "hclust", "bclust")
  method_c_rus <- c("Квантиль", "Фишера-Дженкса", "Естесственные интервалы", "Равные интервалы", "Красивые интервалы", "k-средние", "h-кластеризация", "b-кластеризация")
  names(method_c_eng) <- method_c_rus
  
  style_c_eng <- c("choropleth", "cartodiagram", "contour")
  style_c_rus <- c("Картограмма", "Картодиаграмма", "Изолинии")
  names(style_c_eng) <- style_c_rus
  
  
  zvet_c_eng <-c("red.pal","green.pal","blue.pal", "orange.pal", "red.pal", "brown.pal", "purple.pal", "pink.pal", "wine.pal", "grey.pal", "turquoise.pal", "sand.pal", "taupe.pal", "kaki.pal", "harmo.pal", "pastel.pal", "multi.pal")
  
  zvet_c_rus <-c("Красная", "Зеленая", "Синяя", "Оранжевая", "Красная", "Коричневая", "Лиловая", "Розовая", "Бордовая", "Серая", "Бирюзовая", "Песочная", "Темно-Серая", "Хаки", "Двухцветная", "Пастельные цвета", "Разноцветная") 
   
  names(zvet_c_eng) <- zvet_c_rus 
  
  sortedTable1 <- reactiveValues(tableRe = NULL)
  
  rosstatReactive <- reactiveValues(rosstat_transponded = NULL)
  
  appTreeRe <- reactiveValues(appTree = NULL)
  
  sortedTable <- reactiveValues()

  
  
  abf <- observeEvent(input$docx, {
    
    inFile <- input$docx
   
    first <- inFile$datapath
    
    rosstatReactive$rosstat_transponded <- rosstatRead(first)
    appTree <- rosstatTree(rosstatReactive$rosstat_transponded)
    
    
    appTree_filtered <- appTree
    
    output$tree <- renderTree({
      
      rosstatList(as.list(appTree_filtered))[-1]
      
    })
    
    
    # pathR <- reactive(input$tree, {
    #   
    #   inFile <- input$docx
    #   first <- inFile$datapath
    #   rosstat_transponded <- rosstatRead(first)
    #   appTree <- rosstatTree(rosstat_transponded)
    #   
    #   
    #   e <- get_selected(input$tree)
    #   if(length(e) > 0){
    #     d <- attr(e[[1]], 'ancestry')
    #     d <- c(d, as.character(e))
    #   }
    #   })  
  
  })
  
  rtyr <- observeEvent(input$tree, {
    
    # print(first)
    # print(inFile$name)
    # rosstat_transponded <- rosstatRead(first)
    # appTree <- rosstatTree(rosstat_transponded)

    
    e <- get_selected(input$tree)
    if(length(e) > 0){
      d <- attr(e[[1]], 'ancestry')
      d <- c(d, as.character(e))
      
      
      papath <- d
      sortedTable <- rosstatReactive$rosstat_transponded 
      
      
      l <- length(papath)
      i <- 2
      
      m <- ncol(sortedTable)
      k <- l
      
      
      for (k in 1:l)  {
        print(i)
        print(m)
        if (i <= (m-1)) {
          sortedTable <- subset(sortedTable, sortedTable[,i] == as.character(papath[k]))
          i <- i + 1
        }
        else {
          break
        }
      }
     # View(sortedTable)
      sortedTable[,ncol(sortedTable)] <- gsub(",",".", as.character(sortedTable[,ncol(sortedTable)]))
      sortedTable[,ncol(sortedTable)] <- gsub("…","", as.character(sortedTable[,ncol(sortedTable)]))
      sortedTable[,ncol(sortedTable)] <- as.numeric(sortedTable[,ncol(sortedTable)])
    }
      
    
      sortedTable1$tableRe <- sortedTable 
    
  })
  
  fgh <- observeEvent(input$go, {

    output$plot <- renderPlot({
    
    sortedTable2 <- sortedTable1$tableRe
       
    if (input$project == "lambert"){
      
      reg <- readOGR(".", "regions_low")
      reg@data = data.frame(reg@data, sortedTable2[match(reg@data[,"iso"], sortedTable2[,"X1"]),])
      table <- reg  
    } else if (input$project == "vario"){
      
      reg <- readOGR(".", "varia")
      reg@data = data.frame(reg@data, sortedTable2[match(reg@data[,"ISO"], sortedTable2[,"X1"]),])
      table <- reg
    } else {
      reg <- readOGR(".", "regions_low")
      reg@data = data.frame(reg@data, sortedTable2[match(reg@data[,"iso"], sortedTable2[,"X1"]),])
      table <- reg
      afrc <- cartogram(table, colnames(table@data[ncol(table)]), itermax=5)
      table <- afrc
    }
         
    if (input$oxvat1 == "RUS"){
      table <- table
    } else if (input$oxvat1 == "FO"){
      
      table <- table[table$FO==(input$oxvat2),]
    } else {
      table <- table[table$ER==(input$oxvat3),]
    }
    opar <- par(mar = c(0,0,1.2,0))
  
    # CALCULATE BREAKS AND CREATE COLOR RAMP 
    xlist <- table@data[ncol(table)]
    xlist <- as.numeric(unlist(xlist))
    ci <- classIntervals(xlist, input$colclass, style = input$method)
    
    cols <- carto.pal(pal1 = as.character(input$zvet),
                      n1 = as.numeric(input$colclass)
    )
    
    # PLOT EMPTY BASE MAP 
    plot(table, border = NA, col = NA, bg = "white") 
    plot(table, col = "gray60", border=NA, add=TRUE)
    ?choroLayer
    if (input$style == "choropleth") {
      choroLayer(spdf = table, # SpatialPolygonsDataFrame of the regions 
                 df = table@data, # data frame with compound annual growth rate 
                 var = colnames(table@data[ncol(table)]), # compound annual growth rate field in df 
                 breaks = ci$brks, # list of breaks 
                 col = cols, # colors 
                 border = "grey40", # color of the polygons borders 
                 lwd = 0.5, # width of the borders 
                 legend.pos = "bottomright", # position of the legend 
                 legend.values.rnd = 2,
                 legend.values.cex = 1.0,
                 legend.title.txt = "",# number of decimal in the legend values
                 add = TRUE) # add the layer to the current plot 
    }
    else if (input$style == "cartodiagram"){
      
      plot(table,border = "white", lwd=0.75, add=TRUE) 
      propSymbolsLayer(
        spdf = table,
        df = table@data,
        var = colnames(table@data[ncol(table)]),
        inches = 0.4,
        symbols = "circle",
        col = "red",
        lwd = 1,
        legend.pos = "bottomright",
        legend.title.cex = 1.0,
        legend.values.cex = 1.0,
        legend.title.txt = ""
      )
    }
    else if (input$style == "contour"){
      
      table11 <- table
      
      # table11@data[, ncol(table11) ] <- as.numeric(table11@data[, ncol(table11) ])
      
      csize <- as.numeric(input$cellsize)
      
      pycnotest <- raster(pycno(table11, 
                         table11@data[, ncol(table11) ], 
                         celldim = csize*1000)) * 1000 / (csize**2)

      
      ci <- classIntervals(values(pycnotest), input$colclass, style = input$method)
      
      ags <- list(at = ci$brks, labels = round(ci$brks, 1))
      
      plot(pycnotest,
           breaks = ci$brks,
           col = cols,
           axis.args = ags)
      
      plot(table11, border = adjustcolor("white", alpha.f = 0.5), lwd=0.5, add=TRUE) 
      
      contour(pycnotest, 
              levels = ci$brks,
              add = T, 
              col = "black")
      
      
    }
    
    layoutLayer(title = "", 
                author = "", sources = "© Росстат, 2017",
                scale = NULL, south = FALSE, north = FALSE, frame = TRUE, col = "grey80", 
                coltitle = "black"
                #extent = table
                )
    
  })
  })   
}




# # Now the dissolve
# table <- gUnaryUnion(table, id = table@data$FO)
# 
# # If you want to recreate an object with a data frame
# # make sure row names match
# row.names(table) <- as.character(1:length(table))
# 
# # Extract the data you want (the larger geography)
# lu <- unique(lu$country)
# lu <- as.data.frame(lu)
# colnames(lu) <- "country"  # your data will probably have more than 1 row!
# 
# # And add the data back in
# region <- SpatialPolygonsDataFrame(region, lu)
# 
# # Check it's all worked
# plot(region)