Related
I am trying to have both a scatter plot and a barplot in leaflet. The datetable, the leaflet and the scatter plot work fine. The problem is
the barplot does not work when in leaflet we select some points in map as shown in the following figure. Why scatter plot works fine but bar plot does not?
How to solve this problem? Here is the R code:
#R code
library(leaflet)
library(crosstalk)
library(DT)
library(dplyr)
library(htmltools)
library(summarywidget)
library(plotly)
#devtools::install_github("jcheng5/d3scatter")
library(d3scatter)
data_2<-structure(list(ID = 1:8, Name1 = c("A", "A", "A", "C", "B", "B",
"A", "B"), Name2 = c("a", "b", "b", "a", "b", "a", "b", "c"),
Value1 = c(12, 43, 54, 34, 23, 77, 44, 22), Value2 = c(0,
1, 1, 0, 0, 0, 0, 2), Lat = c(51.1, 51.6, 57.3, 52.4, 56.3,
54.3, 60.4, 49.2), Lon = c(5, -3, -2, -1, 4, 3, -5, 0), lab_DB = c("blue",
"blue", "blue", "green", "red", "red", "blue", "red")), class = "data.frame", row.names = c(NA,-8L))
sdf <- SharedData$new(data_2, key=~ID)
lmap <- leaflet(data = sdf) %>% addTiles() %>%
addCircleMarkers(data = sdf,
lng = ~Lon,
lat = ~Lat,
group = ~Name1 ,color = ~lab_DB
,radius =3
)
dtable <- datatable(sdf , width = "100%",editable=TRUE)
ggplt<-ggplot(sdf, aes(x=factor(Value2)))+
geom_bar(stat="count", width=0.7, fill="steelblue")
d3<-d3scatter(sdf , x=~Value1 ,y=~Value2, width="100%", height=300)
bscols( widths=c(6,6,0), list(lmap, d3),list(dtable,ggplotly(ggplt)))
The below code shows the counts of #0, #1 and #2 for "value2" calculated correctly! (showed in the caption of datatable) but something wrongs with barplot!!
#R code
library(leaflet)
library(crosstalk)
library(DT)
library(dplyr)
library(htmltools)
library(summarywidget)
library(plotly)
#devtools::install_github("jcheng5/d3scatter")
library(d3scatter)
data_2<-structure(list(ID = 1:8, Name1 = c("A", "A", "A", "C", "B", "B",
"A", "B"), Name2 = c("a", "b", "b", "a", "b", "a", "b", "c"),
Value1 = c(12, 43, 54, 34, 23, 77, 44, 22), Value2 = c(0,
1, 1, 0, 0, 0, 0, 2), Lat = c(51.1, 51.6, 57.3, 52.4, 56.3,
54.3, 60.4, 49.2), Lon = c(5, -3, -2, -1, 4, 3, -5, 0), lab_DB = c("blue",
"blue", "blue", "green", "red", "red", "blue", "red")), class = "data.frame", row.names = c(NA,-8L))
sdf <- SharedData$new(data_2, key=~ID)
lmap <- leaflet(data = sdf) %>% addTiles() %>%
addCircleMarkers(data = sdf,
lng = ~Lon,
lat = ~Lat,
group = ~Name1 ,color = ~lab_DB
,radius =3
)
ggplt<-ggplotly(sdf %>% ggplot( aes(x=factor(Value2)))+
geom_bar(stat="count", width=0.7, fill="steelblue"))
d3<-d3scatter(sdf , x=~Value1 ,y=~Value2, width="100%", height=300)
dtable <- datatable(sdf , width = "100%",editable=TRUE,
caption=tags$caption("Value2: #0: ",summarywidget(sdf , selection=~Value2==0)
," Value2: #1: ",summarywidget(sdf , selection=~Value2==1)
," Value2: #1: ",summarywidget(sdf , selection=~Value2==2)
))
bscols( list(lmap, dtable),list(d3,ggplt), htmltools::p(summarywidget(sdf , selection=~Value2==0,column="Value2")
,summarywidget(sdf , selection=~Value2==1,column="Value2")
,summarywidget(sdf , selection=~Value2==2,column="Value2")
, style="display:none;"))
Here is a solution with shiny. Again I use a callback function with your datatable to subset the shared data sdf so you can click the column you are interested in and display a bar chart:
library(shiny)
library(leaflet)
library(crosstalk)
library(DT)
library(dplyr)
library(htmltools)
library(summarywidget)
library(plotly)
library(d3scatter)
data_2 <- structure(
list(ID = 1:8,
Name1 = c("A", "A", "A", "C", "B", "B", "A", "B"),
Name2 = c("a", "b", "b", "a", "b", "a", "b", "c"),
Value1 = c(12, 43, 54, 34, 23, 77, 44, 22),
Value2 = c(0, 1, 1, 0, 0, 0, 0, 2),
Lat = c(51.1, 51.6, 57.3, 52.4, 56.3, 54.3, 60.4, 49.2),
Lon = c(5, -3, -2, -1, 4, 3, -5, 0),
lab_DB = c("blue", "blue", "blue", "green", "red", "red", "blue", "red")),
class = "data.frame",
row.names = c(NA,-8L))
ui <- fluidPage(
fluidRow(
column(6, leafletOutput("lmap")),
column(6, d3scatterOutput("scatter"))
),
fluidRow(
column(6, DTOutput("table")),
column(6,
style = "padding-top: 105px;",
plotlyOutput("plot"))
)
)
server <- function(input, output) {
sdf <- SharedData$new(data_2, key=~ID)
output$lmap <- renderLeaflet({
leaflet(data = sdf) %>%
addTiles() %>%
addCircleMarkers(data = sdf,
lng = ~Lon,
lat = ~Lat,
group = ~Name1 ,color = ~lab_DB,
radius =3)
})
output$scatter <- renderD3scatter({
d3scatter(sdf,
x = ~Value1 ,
y = ~Value2,
width = "100%",
height=300)
})
output$table <- renderDT({
datatable(
sdf,
filter = 'top',
editable=TRUE,
extensions = c('Select', 'Buttons'),
selection = 'none',
options = list(select = list(style = 'os',
items = 'row'),
dom = 'Bfrtip',
autoWidth = TRUE,
buttons = list('copy' ,
list(extend = 'collection',
buttons = c('csv', 'excel', 'pdf', 'print'),
text = 'Download'))),
caption = tags$caption("Value2: #0: ",
summarywidget(sdf, selection = ~Value2 == 0),
" Value2: #1: ", summarywidget(sdf, selection = ~Value2 == 1),
" Value2: #2: ", summarywidget(sdf, selection = ~Value2 == 2)),
# This part is new: callback to get col number as `input$col`
callback = JS("table.on('click.dt', 'td', function() {
var col=table.cell(this).index().column;
var data = [col];
Shiny.onInputChange('col',data );
});")
)
},
server = FALSE)
# plotly bar chart
output$plot <- renderPlotly({
req(input$col)
dat <- sdf$data(withSelection = TRUE) %>%
filter(selected_ == TRUE) %>%
pull(input$col) %>%
table()
fig <- plot_ly(
x = names(dat),
y = dat,
name = "Count",
type = "bar"
)
fig
})
}
shinyApp(ui, server)
If you are only interested in column Value2 then the approach below works as well:
library(shiny)
library(leaflet)
library(crosstalk)
library(DT)
library(dplyr)
library(htmltools)
library(summarywidget)
library(plotly)
library(d3scatter)
data_2 <- structure(
list(ID = 1:8,
Name1 = c("A", "A", "A", "C", "B", "B", "A", "B"),
Name2 = c("a", "b", "b", "a", "b", "a", "b", "c"),
Value1 = c(12, 43, 54, 34, 23, 77, 44, 22),
Value2 = c(0, 1, 1, 0, 0, 0, 0, 2),
Lat = c(51.1, 51.6, 57.3, 52.4, 56.3, 54.3, 60.4, 49.2),
Lon = c(5, -3, -2, -1, 4, 3, -5, 0),
lab_DB = c("blue", "blue", "blue", "green", "red", "red", "blue", "red")),
class = "data.frame",
row.names = c(NA,-8L))
ui <- fluidPage(
fluidRow(
column(6, leafletOutput("lmap")),
column(6, d3scatterOutput("scatter"))
),
fluidRow(
column(6, DTOutput("table")),
column(6,
style = "padding-top: 105px;",
plotlyOutput("plot"))
)
)
server <- function(input, output) {
sdf <- SharedData$new(data_2, key=~ID)
output$lmap <- renderLeaflet({
leaflet(data = sdf) %>%
addTiles() %>%
addCircleMarkers(data = sdf,
lng = ~Lon,
lat = ~Lat,
group = ~Name1 ,color = ~lab_DB,
radius =3)
})
output$scatter <- renderD3scatter({
d3scatter(sdf,
x = ~Value1 ,
y = ~Value2,
width = "100%",
height=300)
})
output$table <- renderDT({
datatable(
sdf,
filter = 'top',
editable=TRUE,
extensions = c('Select', 'Buttons'),
selection = 'none',
options = list(select = list(style = 'os',
items = 'row'),
dom = 'Bfrtip',
autoWidth = TRUE,
buttons = list('copy' ,
list(extend = 'collection',
buttons = c('csv', 'excel', 'pdf', 'print'),
text = 'Download'))),
caption = tags$caption("Value2: #0: ",
summarywidget(sdf, selection = ~Value2 == 0),
" Value2: #1: ", summarywidget(sdf, selection = ~Value2 == 1),
" Value2: #2: ", summarywidget(sdf, selection = ~Value2 == 2))
)
},
server = FALSE)
# plotly bar chart
output$plot <- renderPlotly({
dat <- sdf$data(withSelection = TRUE) %>% filter(selected_ == TRUE)
p <- ggplot(data = dat,
aes(x=factor(Value2))) +
geom_bar(stat="count", width=0.7, fill="steelblue")
ggplotly(p)
})
}
shinyApp(ui, server)
A follow-up question to this one
Once I introduce some more complexity in my table, I'm seeing empty rows where no group-subgroup combination exists. Could those be remove?
I'm also wanting to add a "descriptive" column which does not fit into the cell-row-column tabulation, could I do that?
Here's an example:
animals_2 <- data.table(
family = rep(c(1, 1, 1, 1, 1, 1, 2, 2 ,2 ,3 ,3 ,3), 2),
animal = rep(c(1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4), 2),
name = rep(c(rep("fred", 3), rep("tod", 3), rep("timmy", 3), rep("johnno", 3)), 2),
age = rep(c(1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3), 2),
field = c(rep(1, 12), rep(2, 12)),
value = c(c(25, 45, 75, 10, 25, 50, 10, 15, 25, 5, 15, 20), c(5, 15, 30, 3, 9, 13, 2, 5, 9, 1, 2, 3.5))
)
animals_2 <- expss::apply_labels(
animals_2,
family = "|",
family = c("mammal" = 1, "reptilia" = 2, "amphibia" = 3),
animal = "|",
animal = c("dog" = 1, "cat" = 2, "turtle" = 3, "frog" = 4),
name = "|",
age = "age",
age = c("baby" = 1, "young" = 2, "mature" = 3),
field = "|",
field = c("height" = 1, "weight" = 2),
value = "|"
)
expss::expss_output_viewer()
animals_2 %>%
expss::tab_cells(value) %>%
expss::tab_cols(age %nest% field) %>%
expss::tab_rows(family %nest% animal) %>%
expss::tab_stat_sum(label = "") %>%
expss::tab_pivot()
You will see the column "name" doesn't feature in the table currently. I would just like to put it next to each animal and before the Age/Field summaries. Is this possible?
Thanks in advance!
As for empty categories - there is a special function for that - 'drop_empty_rows':
library(expss)
animals_2 <- data.table(
family = rep(c(1, 1, 1, 1, 1, 1, 2, 2 ,2 ,3 ,3 ,3), 2),
animal = rep(c(1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4), 2),
name = rep(c(rep("fred", 3), rep("tod", 3), rep("timmy", 3), rep("johnno", 3)), 2),
age = rep(c(1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3), 2),
field = c(rep(1, 12), rep(2, 12)),
value = c(c(25, 45, 75, 10, 25, 50, 10, 15, 25, 5, 15, 20), c(5, 15, 30, 3, 9, 13, 2, 5, 9, 1, 2, 3.5))
)
animals_2 <- expss::apply_labels(
animals_2,
family = "|",
family = c("mammal" = 1, "reptilia" = 2, "amphibia" = 3),
animal = "|",
animal = c("dog" = 1, "cat" = 2, "turtle" = 3, "frog" = 4),
name = "|",
age = "age",
age = c("baby" = 1, "young" = 2, "mature" = 3),
field = "|",
field = c("height" = 1, "weight" = 2),
value = "|"
)
expss::expss_output_viewer()
animals_2 %>%
expss::tab_cells(value) %>%
expss::tab_cols(age %nest% field) %>%
expss::tab_rows(family %nest% animal %nest% name) %>%
expss::tab_stat_sum(label = "") %>%
expss::tab_pivot() %>%
drop_empty_rows()
As for column "name" - you can add name to value label with pipe separator: dog|fred' or as in the example above, via%nest%`.
UPDATE:
If you need it as column with heading then it is better to place names as statistics:
animals_2 %>%
expss::tab_rows(family %nest% animal) %>%
# here we create separate column for name
expss::tab_cols(total(label = "name")) %>%
expss::tab_cells(name) %>%
expss::tab_stat_fun(unique) %>%
# end of creation
expss::tab_cols(age %nest% field) %>%
expss::tab_cells(value) %>%
expss::tab_stat_sum(label = "") %>%
expss::tab_pivot(stat_position = "outside_columns") %>%
drop_empty_rows()
So given this data
var data =
["groupA":
[1, 2, 3, 4, 5, 6],
"groupB":
[1, 2, 3, 4, 5, 6, 7, 8, 9, 10]]
I want this output:
["groupA":
[0, 0, 0, 0, 1, 2, 3, 4, 5, 6],
"groupB":
[1, 2, 3, 4, 5, 6, 7, 8, 9, 10]]
This is the best answer I was able to come up with but I feel like its lacking as I have access to the accumulator that I want to mutate within the reduce function.
let maxElement = data.reduce(data.first!) { (acc, obj) in
return acc.value.count > obj.value.count ? acc : obj
}
for dict in data {
if dict.value.count < maxElement.value.count {
var mutableValues = dict.value
mutableValues.insert(0, at: 0)
data[dict.key] = mutableValues
}
}
I think I'm not understanding how to best refactor my reduce function.
If, like me, you don't like for loops, how about this:
data.reduce(data.values.reduce(0){max($0,$1.count)})
{ data[$1.0] = Array(repeating:0,count:$0-$1.1.count) + $1.1; return $0}
You can get the maximum count of your arrays and create an array of zeros with the difference to append to the lesser populated arrays as follow:
var dict: [String:[Int]] = ["groupA": [1, 2, 3, 4, 5, 6],
"groupB": [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]]
let maxCount = dict.values.map{ $0.count }.max() ?? 0
for (key, value) in dict {
let difference = maxCount - value.count
if difference > 0 {
dict[key] = repeatElement(0, count: difference) + value
}
}
print(dict) // ["groupB": [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], "groupA": [0, 0, 0, 0, 1, 2, 3, 4, 5, 6]]
As per your question you need to refactor your code for the reduce function, I did it the following way.
Hope this helps,
let maxElement = data.reduce(data.first!) {
$0.value.count > $1.value.count ? $0 : $1
}
further I modified the code you provided to achieve the results you were trying.
and the code worked well for me.
let maxElement = data.reduce(data.first!) {
$0.value.count > $1.value.count ? $0 : $1
}
let minElement = data.reduce(data.first!) {
$0.value.count < $1.value.count ? $0 : $1
}
for dict in data {
if dict.value.count < maxElement.value.count {
var mutableValues = minElement.value
let arrayOfZeros = Array(repeating: 0, count: maxElement.value.count - minElement.value.count)
mutableValues.insert(contentsOf: arrayOfZeros, at: 0)
data[dict.key] = mutableValues
}
}
If I have this list:
val aList = List(1,1,1,3,4),List(3,3,5,6,7),List(7,7,7,6,7),List(2,3,3,2,6)
How do I update the list by eliminating non-duplicated numbers on the first head of the List? so the result should be:
val aRes = List(1,1,1), List(3,3), List(7,7,7)
List(2,3,3,2,6) should be removed also since we don't have 3 at the head of the list. My expectation for the result was:
val aRes = aList(1) map {case List(i) => List(aList.groupBy(_(1))}
But it seems not valid for this logic.
beside that, I also need to translate those result values to another list member:
val aScore = List(
/*score for 1*/ List(0, 0, 1500, 2500, 5000),
/*score for 2*/ List(0, 0, 500, 1000, 2000),
/*score for 3*/ List(0, 50, 100, 200, 500),
/*score for 4*/ List(0, 10, 50, 100, 150),
/*score for 5*/ List(0, 10, 50, 100, 150),
/*score for 6*/ List(0, 10, 50, 100, 150),
/*score for 7*/ List(0, 10, 50, 100, 150)
)
val score = ???
so from above aList result, the score must be 1500+50+50 = 1600 as result from 1*3=>1500, 3*2=>50 and 7*3=>50
You want to return something if there are duplicates, and nothing if not, so make a function that returns an Option:
def f(xs: List[Int]) = xs match {
case x0 :: x1 :: _ if x0 == x1 => Some(xs.takeWhile(_ == x0))
case _ => None
}
Then flatMap your list to that to get rid of the optiony bits:
aList.flatMap(f)
For the second part:
def getScore(xs: List[Int]) = aScore(xs.head - 1)(xs.size - 1)
So just map and sum the elements. In total:
aList.flatMap(f).map(getScore).sum
// result = 1600
object parseData {
val inputList = List(List(1,1,1,3,4),List(3,3,5,6,7),List(7,7,7,6,7),List(2,3,3,2,6))
val aScore = List(
/*score for 1*/ List(0, 0, 1500, 2500, 5000),
/*score for 2*/ List(0, 0, 500, 1000, 2000),
/*score for 3*/ List(0, 50, 100, 200, 500),
/*score for 4*/ List(0, 10, 50, 100, 150),
/*score for 5*/ List(0, 10, 50, 100, 150),
/*score for 6*/ List(0, 10, 50, 100, 150),
/*score for 7*/ List(0, 10, 50, 100, 150)
)
def isDuplicated(aList: List[Int]): Boolean = aList.head == aList.tail.head
def getRidOfNonDuplicates(aList: List[Int]): List[Int] = {
val opList = ListBuffer(aList.head)
def loop(aList: List[Int], opList: ListBuffer[Int]): Unit = {
if (aList.tail == Nil) return
if (aList.head == aList.tail.head) opList += aList.tail.head
loop(aList.tail, opList)
}
loop(aList, opList)
opList.toList
}
def printaScoreValue(aList: List[Int]): Unit = println(aScore(aList.head - 1)(aList.length - 1))
val outputList = inputList.filter(isDuplicated(_))
val opList = ListBuffer.empty[List[Int]]
for (aList <- outputList)
opList += getRidOfNonDuplicates(aList)
opList.foreach(printaScoreValue(_))
}
gives
1500
50
50
My first stab was:
scala> val ls = List(List(1,1,1,3,4),List(3,3,5,6,7),List(7,7,7,6,7),List(2,3,3,2,6))
ls: List[List[Int]] = List(List(1, 1, 1, 3, 4), List(3, 3, 5, 6, 7), List(7, 7, 7, 6, 7), List(2, 3, 3, 2, 6))
scala> ls map {
_ groupBy identity filter { case (i, is) => is.length > 1 } flatMap { _._2 }
}
res2: List[List[Int]] = List(List(1, 1, 1), List(3, 3), List(7, 7, 7, 7), List(2, 2, 3, 3))
But as you can see, it not quite what you want. I think the next one nails it:
scala> ls map { l =>
val (h,t) = (l.head, l.tail)
h :: t.takeWhile( _ == h )
} filter { _.length > 1 }
res7: List[List[Int]] = List(List(1, 1, 1), List(3, 3), List(7, 7, 7))
But notice, it is not going to work if List.empty is an element of the outer list.
I have some problems in Maple.
If I have a matrix:
Matrix1 := Matrix(2, 2, {(1, 1) = 31, (1, 2) = -80, (2, 1) = -50, (2, 2) = 43});
I want to decide if it is in the below list:
MatrixList := [Matrix(2, 2, {(1, 1) = 31, (1, 2) = -80, (2, 1) = -50, (2, 2) = 43}), Matrix(2, 2, {(1, 1) = -61, (1, 2) = 77, (2, 1) = -48, (2, 2) = 9})];
I did the following:
evalb(Matrix1 in MatrixList);
but got "false".
Why? And how do I then make a program that decide if a matrix is
contained in a list of matrices.
Here's a much cheaper way than DrC's
ormap(LinearAlgebra:-Equal, MatrixList, Matrix1)