Commit d82fc607 authored by Bruno Bonte's avatar Bruno Bonte
Browse files

exploring to find balance error

parent 06008b74
......@@ -194,7 +194,7 @@ library(gridExtra)
storedWater <- rbind(storedWater, j2kWaterBalanceStorages())
# Testing local balance. Only during warming-up.
#localStoredWater <- rbind(localStoredWater, j2kLocalWaterBalanceStorages(selectedHrus = c(548, 554, 567, 634, 696)))
localStoredWater <- rbind(localStoredWater, j2kLocalWaterBalanceStorages(selectedHrus = c(11104, 8563, 12464, 8560, 16637)))
#localStoredWater <- rbind(localStoredWater, j2kLocalWaterBalanceStorages(selectedHrus = c(8665, 8670, 14463, 17024)))
}
# Making step by step j2k simu
j2kMakeStep()
......@@ -203,8 +203,8 @@ library(gridExtra)
# Testing local balance. Only during warming-up.
#localInOutWater <- rbind(localInOutWater, j2kLocalWaterBalanceFlows(selectedHrus = c(548, 554, 567, 634, 696),
#lastHru = 567))
localInOutWater <- rbind(localInOutWater, j2kLocalWaterBalanceFlows(selectedHrus = c(11104, 8563, 12464, 8560, 16637),
lastHru = 16637))
#localInOutWater <- rbind(localInOutWater, j2kLocalWaterBalanceFlows(selectedHrus = c(8665, 8670, 14463, 17024),
# lastHru = 17024))
}
}
......@@ -478,7 +478,8 @@ library(gridExtra)
mutate(deltaS = storageNextDay - storage) %>%
mutate(waterBalance = inWater - outWater) %>%
mutate(waterLoss = storageNextDay - storage - waterBalance) %>%
filter(day > 0) %>%
filter(day > 150) %>%
filter(day < 300) %>%
#mutate(cumWaterLoss = cumsum(waterLoss)) %>%
ggplot() +
geom_line(aes(x = day, y = waterLoss))
......@@ -632,8 +633,8 @@ grid.draw(g)
#ggsave(file =paste0("bilan-test-", period[1], "-",period[2], ".pdf"),
# width=21, height=29.7, units="cm")
}
plot_bilan(c(475,500))
plot_bilan(c(1,400))
plot_bilan(c(350,375))
# plot_bilan(c(1,500))
#sauvegarde du bilan dans un fichier
stamp <- format(Sys.time(), "%y%m%d-%H%M%S")
write.csv(waterSummary, paste0("waterSummary-",stamp,".csv"), row.names = F)
......
......@@ -12,7 +12,9 @@ hrus <- read.table("superjams/data/J2K_cowat/parameter/hru_cowat_10_cor_grand_bu
#nb correspondance collonnes: V1, V2, V6, V7, V9, V13, V14
#id,area,x,y,subbassin,to_poly,to_reach
valide_hrus <- hrus%>% filter(V2 > 10) %>% tbl_df()
valide_hrus <- hrus %>%
filter(V2 > 100) %>%
tbl_df()
write.table(valide_hrus,
"hru_cowat_withplots.par.dat",
......
......@@ -38,7 +38,7 @@ sub1HruEdges <- selectedHrus %>%
hruNtw <- graph_from_edgelist(sub1HruEdges %>% as.matrix())
# La liste des noeuds du réseaux comprend les Hrus et les reachs
# La liste des noeuds du réseaux comprend les Hrus
vertexList <- V(hruNtw)
# Les Hrus sont positionnées au niveau de leurs coordonées
......@@ -73,7 +73,7 @@ vertexAtributes <- vertexList$name %>% as.data.frame() %>%
subnum = "subbassin-GB"
pdf(paste0("topology_", subnum,".pdf"), height = 16, width = 11) #en A3 pour tout le bassin
#pdf(paste0("topology_", subnum,".pdf"), paper ="a4")
plot(sub1G,
plot(hruNtw,
edge.arrow.size=.2,
vertex.size = vertexAtributes %>%
pull(area) / 250000,
......@@ -89,7 +89,7 @@ plot(sub1G,
dev.off()
pdf(paste0("bassin_", subnum,".pdf"), paper ="a4")
plot(sub1G,
plot(hruNtw,
edge.arrow.size=.2,
vertex.size = vertexAtributes %>%
pull(area) / 250000,
......@@ -104,4 +104,78 @@ plot(sub1G,
)
dev.off()
hrusSubbassins <- NULL
bassinsList <- hruNtw %>%
decompose()
for (i in 1:length(bassinsList)) {
testSubBassin <- bassinsList[[i]]
subbass <- NULL
subbass$Hrus <- c(V(testSubBassin)$name)
subbass <- subbass %>% as.data.frame()
subbass$isLast <- c(degree(testSubBassin, mode = "out")) == 0
subbass$bassin <- i
hrusSubbassins <- rbind(hrusSubbassins, subbass)
}
hrusSubbassins <- hrusSubbassins %>%
as.data.frame() %>%
tbl_df()
#hrusSubbassins %>% write.table("hrus-subassins-for-balance-test.csv",
# dec= ".",
# sep=";",
# row.names = F)
hrusSubbassins <- read.table("hrus-subassins-for-balance-test.csv",
dec= ".",
sep=";",
header = T) %>%
tbl_df()
hrusSubbassins %>%
group_by(bassin) %>%
count() %>% filter(n< 10)
hrusSubbassins %>% filter(bassin == 51)
testVertexAtributes <- testVertexList$name %>% as.data.frame() %>%
mutate_("id"=".") %>%
tbl_df() %>%
mutate(vertexId = as.character(id)) %>%
select(vertexId) %>%
left_join(vertexPositions, by="vertexId") %>%
left_join(selectedHrus %>%
mutate(vertexId = as.character(id)) %>%
select(vertexId, area, subbassin), by="vertexId") %>%
mutate(ishru = !str_detect(vertexId, "reach")) %>%
mutate(area = replace_na(area,1000000))
plot(testSubBassin,
edge.arrow.size=.2,
vertex.size = testVertexAtributes %>%
pull(area) / 250000,
vertex.label.cex=0.25,
#vertex.label.dist=0, #en A3 on met les noms des noeuds dans les noeuds.
vertex.label.dist=0.3,#en A4 on met les noms des noeuds au dessus des noeuds.
layout = testVertexAtributes %>% # Commenter cette ligne et les deux suivante si on ne veux pas les coordonnées
select(x,y) %>% # intéressant si on veut regarder seulement la topologie sur certains sous-bassins par exemple
as.matrix(),
vertex.color= !testVertexAtributes %>%
pull(ishru)
)
plot(testSubBassin,
edge.arrow.size=.2,
vertex.size = testVertexAtributes %>%
pull(area) / 250000,
vertex.label.cex=0.25,
vertex.label.dist=0, #en A3 on met les noms des noeuds dans les noeuds.
#vertex.label.dist=0.3,#en A4 on met les noms des noeuds au dessus des noeuds.
#layout = vertexAtributes %>% # Commenter cette ligne et les deux suivante si on ne veux pas les coordonnées
# select(x,y) %>% # intéressant si on veut regarder seulement la topologie sur certains sous-bassins par exemple
# as.matrix(),
vertex.color= !testVertexAtributes %>%
pull(ishru)
)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment