Related
Here's an example of my data:
Sample
Method A
Method B
Method C
Method D
Method E
BATCH Nu
Lab Data
Sample 1
1
2
8
TX_0001
LAB1
Sample 1
5
9
TX_0002
LAB2
Sample 2
7
8
8
23
TX_0001
LAB1
Sample 2
41
TX_0001
LAB2
Sample 3
11
55
TX_0394
LAB2
Sample 4
2
9
5
9
TX_0394
LAB1
I need to make a M Language code that unites them, based on duplicated samples. Note that they might be in the same batch and/or in the same lab, but they won't ever be made the same method twice.
So I can't pass the column names, because they keep changing, and I wanted to do it passaing the column names dynamically.
**OBS: I have the possibility to make a linked table of the source to a Microsoft Access and make this with SQL, but I couldn't find a text aggregation function in MS Access library. There it's possible to each column name with no problem. (Just a matter that no one else knows M Language in my company and I can't let this be non-automated)
**
This is the what I have been trying to improve, but I keep have some errors:
1.Both goruped columns have "Errors" in all of the cells
2.Evaluation running out of memory
I can't discover what I'm doing wrong here.
let
Source = ALS,
schema = Table.Schema(Source),
columns = schema[Name],
types = schema[Kind],
Table = Table.FromColumns({columns,types}),
Number_Columns = Table.SelectRows(Table, each ([Column2] = "number")),
Other_Columns = Table.SelectRows(Table, each ([Column2] <> "number")),
numCols = Table.Column(Number_Columns, "Column1"),
textColsSID = List.Select(Table.ColumnNames(Source), each Table.Column(Source, _) <> type number),
textCols = List.RemoveItems(textColsSID, {"Sample ID"}),
groupedNum = Table.Group(Source, {"Sample ID"},List.Transform(numCols, each {_, (nmr) => List.Sum(nmr),type nullable number})),
groupedText = Table.Group(Source,{"Sample ID"},List.Transform(textCols, each {_, (tbl) => Text.Combine(tbl, "_")})),
merged = Table.NestedJoin(groupedNum, {"Sample ID"}, groupedText, {"Sample ID"}, "merged"),
expanded = Table.ExpandTableColumn(merged, "merged", Table.ColumnNames(merged{1}[merged]))
in
expanded
This is what I expected to have:
Sample
Method A
Method B
Method C
Method D
Method E
BATCH Nu
Lab Data
Sample 1
1
2
5
9
8
TX_0001_TX_0002
LAB1_LAB2
Sample 2
7
8
8
23
41
TX_0001_TX_0001
LAB1_LAB1
Sample 3
11
55
TX_0394
LAB2
Sample 4
2
9
5
9
TX_0394
LAB1
Here is a method which assumes only that the first column is a column which will be used to group the different samples.
It makes no assumptions about any column names, or the numbers of columns.
It tests the first 10 rows in each column (after removing any nulls) to determine if the column type can be type number, otherwise it will assume type text.
If there are other possible data types, the type detection code can be expanded.
let
Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
//dynamically detect data types from first ten rows
//only detecting "text" and "number"
colNames = Table.ColumnNames(Source),
checkRows = 10,
colTestTypes = List.Generate(
()=>[t=
let
Values = List.FirstN(Table.Column(Source,colNames{0}),10),
tryNumber = List.Transform(List.RemoveNulls(Values), each (try Number.From(_))[HasError])
in
tryNumber, idx=0],
each [idx] < List.Count(colNames),
each [t=
let
Values = List.FirstN(Table.Column(Source,colNames{[idx]+1}),10),
tryNumber = List.Transform(List.RemoveNulls(Values), each (try Number.From(_))[HasError])
in
tryNumber, idx=[idx]+1],
each [t]),
colTypes = List.Transform(colTestTypes, each if List.AllTrue(_) then type text else type number),
//Group and Sum or Concatenate columns, keying on the first column
group = Table.Group(Source,{colNames{0}},
{"rw", (t)=>
Record.FromList(
List.Generate(
()=>[rw=if colTypes{1} = type number
then List.Sum(Table.Column(t,colNames{1}))
else Text.Combine(Table.Column(t,colNames{1}),"_"),
idx=1],
each [idx] < List.Count(colNames),
each [rw=if colTypes{[idx]+1} = type number
then List.Sum(Table.Column(t,colNames{[idx]+1}))
else Text.Combine(Table.Column(t,colNames{[idx]+1}),"_"),
idx=[idx]+1],
each [rw]), List.RemoveFirstN(colNames,1)), type record}
),
//expand the record column and set the data types
#"Expanded rw" = Table.ExpandRecordColumn(group, "rw", List.RemoveFirstN(colNames,1)),
#"Set Data Type" = Table.TransformColumnTypes(#"Expanded rw", List.Zip({colNames, colTypes}))
in
#"Set Data Type"
Original Data
Results
One way. You could probably do this all within the group as well
let Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
names = List.Distinct(List.Select(Table.ColumnNames(Source), each Text.Contains(_,"Method"))),
#"Grouped Rows" = Table.Group(Source, {"Sample"}, {{"data", each _, type table }}),
#"Added Custom" = Table.AddColumn(#"Grouped Rows", "Batch Nu", each Text.Combine(List.Distinct([data][BATCH Nu]),"_")),
#"Added Custom1" = Table.AddColumn(#"Added Custom", "Lab Data", each Text.Combine(List.Distinct([data][Lab Data]),"_")),
#"Added Custom2" = Table.AddColumn(#"Added Custom1", "Custom", each Table.SelectRows(Table.UnpivotOtherColumns([data], {"Sample"}, "Attribute", "Value"), each List.Contains(names,[Attribute]))),
#"Added Custom3" = Table.AddColumn(#"Added Custom2", "Custom.1", each Table.Pivot([Custom], List.Distinct([Custom][Attribute]), "Attribute", "Value", List.Sum)),
#"Expanded Custom.1" = Table.ExpandTableColumn(#"Added Custom3" , "Custom.1", names,names),
#"Removed Columns" = Table.RemoveColumns(#"Expanded Custom.1",{"data", "Custom"})
in #"Removed Columns"
Trying to scrape the first 8 tables (very high, high, medium, low) from the human development index in Wikipedia.
Started with but getting a list of zero. What am I doing wrong? New to R :(
libray(rvest)
url <- "https://en.wikipedia.org/wiki/List_of_countries_by_Human_Development_Index#Complete_list_of_countries"
webpage <- read_html(url)
hdi_tables <- html_nodes(webpage, 'table')
head(hdi_tables, n = 10)
scrape <- url %>%
read_html() %>%
html_nodes(xpath = '//*[#id="mw-content-text"]/div/div[5]/table/tbody/tr/td[1]/table') %>%
html_table()
head(scrape, n=10)
I think it would be easier to work with the original data source:
Select "Human Development Index (HDI)" in both the drop-down select lists, then click the "Download Data" link to get a CSV file named Human Development Index (HDI).csv.
Read it into R:
library(tidyverse)
Human_Development_Index_HDI_ <- read_csv("path/to/Human Development Index (HDI).csv",
skip = 1)
You can reshape the data, get the values for 2015 and classify countries as low, medium, high or very high:
hdi <- Human_Development_Index_HDI_ %>%
gather(Year, HDI, -`HDI Rank (2015)`, -Country) %>%
filter(Year == "2015") %>%
na.omit() %>%
mutate(Year = as.numeric(Year),
classification = cut(HDI,
breaks = c(0, 0.549, 0.699, 0.799, 1),
labels = c("low", "medium", "high", "very_high")))
hdi
# A tibble: 188 x 5
`HDI Rank (2015)` Country Year HDI classification
<int> <chr> <dbl> <dbl> <fctr>
1 169 Afghanistan 2015 0.479 low
2 75 Albania 2015 0.764 high
3 83 Algeria 2015 0.745 high
4 32 Andorra 2015 0.858 very_high
5 150 Angola 2015 0.533 low
6 62 Antigua and Barbuda 2015 0.786 high
7 45 Argentina 2015 0.827 very_high
8 84 Armenia 2015 0.743 high
9 2 Australia 2015 0.939 very_high
10 24 Austria 2015 0.893 very_high
# ... with 178 more rows
You could change the filter to get values for 2014 too, if you want to replicate the "change from previous year" values in the Wikipedia table.
If you're okay with parsing the wikipedia markup language instead, you could try using WikipediR to grab the markup of the page (from skimming the documentation, try page_content with as_wikitext set to true). Then you'll get some lines that all look like this:
| 1 || {{steady}} ||style="text-align:left"| {{flag|Norway}} || 0.949 || {{increase}} 0.001
This should be parseable in R using strsplit or something.
Here is a code sample that will generate the table that I want in R Markdown:
---
title: "Table"
author: "Nick"
date: "9 June 2017"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(tables)
Age <- sample(0:19, 500, replace = TRUE)
Unborn <- sample(0:1, 500, replace = TRUE)
GenderBand <- sample(1:3, 500, replace = TRUE)
EthnicityGroup <- sample(1:5, 500, replace = TRUE)
InitialCategory <- sample(1:5, 500, replace = TRUE)
data <- data.frame(Age, Unborn, GenderBand, EthnicityGroup, InitialCategory)
Age <- 6
data$Age[data$ChildAge31March == 0] <- 1
data$Age[data$ChildAge31March >= 1 & data$ChildAge31March <= 4] <- 2
data$Age[data$ChildAge31March >= 5 & data$ChildAge31March <= 9] <- 3
data$Age[data$ChildAge31March >= 10 & data$ChildAge31March <= 15] <- 4
data$Age[data$ChildAge31March >= 16 & data$ChildAge31March <= 50] <- 5
data$Age <- factor(data$Age,
levels = c(1,2,3,4,5,6),
labels = c("Under 1",
"1 to 4 Years Old",
"5 to 9 Years Old",
"10 to 15 Years Old",
"16 to 50 Years Old",
"Other"))
data$Unborn <- factor(data$Unborn, levels = c(0,1), labels = c("Born","Unborn"))
data$GenderBand <- factor(data$GenderBand, levels = c(1,2,3), labels = c("Male","Female","Unknown"))
data$EthnicityGroup <- factor(data$EthnicityGroup,
levels = c(1,2,3,4,5,6),
labels = c("White","Mixed","Asian","Black","Other","Refused"))
data$InitialCategory <- factor(data$InitialCategory,
levels = c(1,2,3,4,5),
labels = c("Emotional",
"Multiple",
"Neglect",
"Phyical",
"Sexual"))
Table <- tabular(GenderBand + (Unborn * Age) + EthnicityGroup ~ InitialCategory, data=data)
```
```{r output, echo=FALSE, results="asis"}
html(Table)
```
This works pretty much perfectly how I want it. Giving me this:
However when I did this using my real data, I got this:
I've identified the issue in the HTML, and it appears that for some reason, on some cells (the broken ones), html(tablular()) has output this:
I'm completely lost as to why it seems to be scrambling the HTML output, as the numbers are generated by R (they're counts of factors).
In theory I could perhaps store the HTML output in a variable and gsub() the offending strings, but that seems like a messy work around for something that shouldn't really need one. Does anyone have any insight on this?
Sorry for shameless autopromotion but you could try my package expss:
---
title: "Table"
author: "Nick"
date: "9 June 2017"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(expss)
ChildAge31March = sample(0:19, 500, replace = TRUE)
Unborn = sample(0:1, 500, replace = TRUE)
GenderBand = sample(1:3, 500, replace = TRUE)
EthnicityGroup = sample(1:5, 500, replace = TRUE)
InitialCategory = sample(1:5, 500, replace = TRUE)
data = data.frame(ChildAge31March, Unborn, GenderBand, EthnicityGroup, InitialCategory)
data = compute(data, {
Age = recode(ChildAge31March,
0 ~ 1,
1 %thru% 4 ~ 2,
5 %thru% 9 ~ 3,
10 %thru% 15 ~ 4,
16 %thru% 50 ~ 5,
other ~ 6
)
val_lab(Age) = autonum(
"Under 1
1 to 4 Years Old
5 to 9 Years Old
10 to 15 Years Old
16 to 50 Years Old
Other")
val_lab(Unborn) = num_lab(
"0 Born
1 Unborn")
val_lab(GenderBand) = autonum(
"Male
Female
Unknown")
val_lab(EthnicityGroup) = autonum(
"White
Mixed
Asian
Black
Other
Refused")
val_lab(InitialCategory) = autonum(
"Emotional
Multiple
Neglect
Phyical
Sexual" )
})
Table = data %>%
tab_cols(InitialCategory) %>%
tab_cells(GenderBand, Unborn %nest% Age, EthnicityGroup) %>%
tab_stat_cases(total_row_position = "none") %>%
tab_pivot()
```
```{r output, echo=FALSE, results="asis"}
Table
```
A little late to this, but I had the same issue and recently figured out what was going on. When R outputted my table, it justified and added quotes around each cell of summary data:
Stratified by Group
1 2 3
n " 676" " 1378" " 27245"
DON_AGE (mean (sd)) " 41.24 (12.76)" " 36.92 (11.03)" " 39.89 (17.70)"
DON_LF_LU_BRONCHO (%) " " " " " " "
Abnormal " 8 ( 1.2) " " 15 ( 1.1) " " 2258 ( 8.3) "
Missing " 631 (93.3) " " 1333 (96.7) " " 19343 (71.0) "
Normal " 37 ( 5.5) " " 30 ( 2.2) " " 5644 (20.7) "
When I tried to run it through R Markdown using HTML, the cells where there were extra spaces were read as raw HTML code (for example, the Abnormal cell in group 1 above) and that's why I was getting the code in my table.
I used the CreateTableOne function, and to solve this problem I used the noSpaces=T option in print(CreateTableOne()). Then, I used htmlTable to print the table object, and this solved my problem.
This comes up a lot when dealing with API's.
Most of the time, to do real analysis, I'd like to get my dataset tidy, but typically, this requires a solution for each type of tree, rather than something more general.
I figured it would be nice to have one function that generates tidy data (albeit with a ton of NA's in deeply nested trees with many different factor levels.
I have a hackish solution which follows, using unlist(..., recursive = FALSE) + a naming convention,
But I'd like to see if someone here might have a better solution to tidy these kinds of list structures.
#####################
# Some Test Data
aNestedTree =
list(a = 1,
b = 2,
c = list(
a = list(1:5),
b = 2,
c = list(
a = 1,
d = 3,
e = list())),
d = list(
y = 3,
z = 2
))
############################################################
# Run through the list and rename all list elements,
# We unlist once at time, adding "__" at each unlist step
# until the object is no longer a list
renameVars <- function(lst, sep = '__') {
if(is.list(lst)) {
names(lst) <- paste0(names(lst),sep)
renameVars(unlist(lst, recursive = FALSE),sep = sep)
} else {
lst
}
}
res <- renameVars(aNestedTree)
We can check the output and see that we have a strangely named object,
But there's a method to this madness.
> res
a________ b________ c__.a____1__ c__.a____2__ c__.a____3__
1 2 1 2 3
c__.a____4__ c__.a____5__ c__.b______ c__.c__.a____ c__.c__.d____
4 5 2 1 3
d__.y______ d__.z______
3 2
Now I put this in a data.table, so I can shape it.
library(data.table)
dt <- data.table(values = res, name = names(res))
# Use some regex to split that name up, along with data.table's tstrsplit
# function to separate them into as many columns as there are nests
> dt[,paste0('V',seq_along(s <- tstrsplit(dt$name,'[__]+(\\.|)'))) := s]
> dt
values name V1 V2 V3
1: 1 a________ a NA NA
2: 2 b________ b NA NA
3: 1 c__.a____1__ c a 1
4: 2 c__.a____2__ c a 2
5: 3 c__.a____3__ c a 3
6: 4 c__.a____4__ c a 4
7: 5 c__.a____5__ c a 5
8: 2 c__.b______ c b NA
9: 1 c__.c__.a____ c c a
10: 3 c__.c__.d____ c c d
11: 3 d__.y______ d y NA
12: 2 d__.z______ d z NA
I can then filter for the factor combinations that I want (Or dcast/spread). (Though I'm effectively breaking apart tables at the lowest level if they exist)
I thought about going through bind.c and pulling out the do_unlistto make a function with a flexible naming convention via Rcpp, but my C++ is rusty, so I figured I'd post here before I do anything drastic.
I tend to lean towards tidyjson as well. In the tidyverse, the behavior you are looking for seems to be in the gather family.
I think the gather family of functions in tidyjson could do with a bit of improvement that would make these helpers unnecessary. Right now, they are very "type-sensitive" and error or throw out types that do not match. In any case, the workaround is not too challenging, although it definitely lacks elegance. Note that the bind_rows variant is presently from my development version and is not mainstream yet. Hopefully this illustrates the idea, though.
Notes on approach:
That all values would be numeric (I cast them to character afterwards)
Helpers gather elements of the varying types, and bind_rows stacks the datasets together.
level is kept track of by level of recursion
First define the helpers:
recurse_gather <- function(.x,.level) {
.x <- tidyjson::bind_rows(
gobj(.x,.level)
, garr(.x,.level)
, gpersist(.x,.level)
)
if (any(as.character(json_types(.x,'type')$type) %in% c('object','array'))) {
.x <- recurse_gather(.x,.level+1)
}
return(.x)
}
gobj <- function(.x,.level) {
.x %>% json_types('type') %>%
filter(type=='object') %>%
gather_object(paste0('v',.level)) %>%
select(-type)
}
gpersist <- function(.x,.level) {
.x %>% json_types('type') %>%
filter(! type %in% c('object','array')) %>%
mutate_(.dots=setNames(
paste0('as.character(NA)')
,paste0('v',.level)
)) %>%
select(-type)
}
garr <- function(.x,.level) {
.x %>% json_types('type') %>%
filter(type=='array') %>%
gather_array('arridx') %>%
append_values_number(paste0('v',.level)) %>%
mutate_(.dots=setNames(
paste0('as.character(v',.level,')')
,paste0('v',.level)
)) %>%
select(-arridx,-type)
}
Then using the helpers is pretty straight-forward.
library(dplyr)
library(tidyjson)
j <- "{\"a\":[1],\"b\":[2],\"c\":{\"a\":[1,2,3,4,5],\"b\":[2],\"c\":{\"a\":[1],\"d\":[3],\"e\":[]}},\"d\":{\"y\":[3],\"z\":[2]}}"
recurse_gather(j, 1) %>% arrange(v1, v2, v3, v4) %>% tbl_df()
#> # A tibble: 12 x 5
#> document.id v1 v2 v3 v4
#> * <int> <chr> <chr> <chr> <chr>
#> 1 1 a 1 <NA> <NA>
#> 2 1 b 2 <NA> <NA>
#> 3 1 c a 1 <NA>
#> 4 1 c a 2 <NA>
#> 5 1 c a 3 <NA>
#> 6 1 c a 4 <NA>
#> 7 1 c a 5 <NA>
#> 8 1 c b 2 <NA>
#> 9 1 c c a 1
#> 10 1 c c d 3
#> 11 1 d y 3 <NA>
#> 12 1 d z 2 <NA>
Hopeful that future development on the tidyjson package will make this an easier problem to tackle!
I struggled in similar situations, but the tidyjson package has bailed me out time after time when dealing with nested JSON. There's a fair amount of typing required, but the tidyjson functions return a tidy object. Documentation here: https://github.com/sailthru/tidyjson
As dracodoc pointed out, data.tree might help. E.g. like this:
library(data.tree)
aNestedTree =
list(a = 1,
b = 2,
c = list(
a = list(1:5),
b = 2,
c = list(
a = 1,
d = 3,
e = list())),
d = list(
y = 3,
z = 2
))
tree <- FromListSimple(aNestedTree)
print(tree)
This will give:
levelName z
1 Root NA
2 ¦--c NA
3 ¦ ¦--a NA
4 ¦ °--c NA
5 ¦ °--e NA
6 °--d 2
And:
tree$fieldsAll
[1] "a" "b" "1" "d" "y" "z"
Side note: typically, you could do something like this:
do.call("print", c(tree, tree$fieldsAll))
However, here, this doesn't work because some node names are the same as field names. I consider this a bug and will fix it soon.
I am using the following R script to calculate a monthly CpK number:
mydf <- read.csv('file.csv', header = TRUE, sep=",")
date <- strptime(mydf$PDATETIME, "%Y/%m/%d %H:%M:%S")
plot(date,mydf$MEAS_AVG,xlab='Date',ylab='MEAS_AVG',main='year')
abline(h=mydf$TARG_MIN,col=3,lty=1)
abline(h=mydf$TARG_MAX,col=3,lty=1)
grid(NULL,NULL,col="black")
legend("topright", legend = c(" ", " "), text.width = strwidth("1,000,000"), lty = 1:2, xjust = 1, yjust = 1, title = "Data")
myavg <-mean(mydf$MEAS_AVG, na.rm=TRUE)
newds <- (mydf$MEAS_AVG - myavg)^2
newsum <- sum(newds, na.rm=TRUE)
N <- length(mydf$MEAS_AVG) - 1
newN <- 1/N
total <- newN*newsum
sigma <- total^(1/2)
USL <- mean(mydf$TARG_MAX, na.rm=TRUE)
LSL <- mean(mydf$TARG_MIN, na.rm=TRUE)
cpk <- min(((USL-myavg)/(3*sigma)),((myavg-LSL)/(3*sigma)))
cpkmonthly <- aggregate(mydf$MEAS_AVG, na.rm=TRUE, list(month=months(as.Date(mydf$PDATETIME))), mean)
monthlycpk <- by(mydf$MEAS_AVG, na.rm=TRUE, list(month=months(as.Date(mydf$PDATETIME))), mean)
cpk 'variable to store the entire year's CpK number
cpkmonthly 'variable to store the each month's mean CpK number
So far, the above script correctly goes through all the code assigns values to the cpkmonthly and cpk variables. Their outputs are as follows:
> cpk
[1] 0.5892231
> cpkmonthly
month x
1 April 0.2456467
2 August 0.2415564
3 July 0.2456895
4 June 0.2541071
5 March 0.1234333
6 May 0.4321418
Question: How to I break apart the appregated "cpkmonthly" variable and assign a seperate variable for each entry? Ideally, I would like each to go into an array, because I would like to have the final output variable be in a HTML display string.
SudoCode:
cpkmonth[1] = April
cpkvalue[1] = .245...
cpkmonth[2] = August
cpkvalue[2] = .2415...
...
I would like the final table in HTML to look like this:
So the final output variable would need to be in this format:
<tr><td>"Total Cpk"</td><tdcpkmonth[0]</td><td>cpkmonth[1]</td><td>...</td></tr>
<tr><td>"cpk"</td><tdcpkvalue[0]</td><td>cpkvalue[1]</td><td>...</td></tr>
For the HTML, I have tried using toJSON/RJSON,R2HTML,HTMLUtil, and a few others, but I am simply looking for one output variable. Is this possible?
You should be able to access both of these columns using the $ syntax:
cpkmonth = cpkmonthly$month
cpkvalue = cpkmonthly$value
you can also use [:
cpkmonth = cpkmonthly['month']