How to baypass "exceeded daily limit of downloads" while scraping data - r

I am building forecasting tool which works on historical stock database. I have problem with downloading all the historical prices from https://stooq.pl
My R code works fine, but I don't know how to baypass download limitation (problem occurs above ~40 downloads I need like 450). Code bellow:
stock<-c("06n", "08n", "11b", "1at", "4fm", "aal", "aat", "aba", "abc", "abe", "abm", "abs", "acg", "acp", "act", "adv", "ago", "agt", "ahl", "alc", "ali", "all", "alm", "alr", "amb", "amc", "aml", "ape", "apl", "apn", "apr", "apt", "arc", "arh", "arr","06n", "08n", "11b", "1at", "4fm", "aal", "aat", "aba", "abc", "abe", "abm", "abs", "acg", "acp", "act", "adv", "ago", "agt", "ahl", "alc", "ali", "all", "alm", "alr", "amb", "amc", "aml", "ape", "apl", "apn", "apr", "apt", "arc", "arh", "arr","06n", "08n", "11b", "1at", "4fm", "aal", "aat", "aba", "abc", "abe", "abm", "abs", "acg", "acp", "act", "adv", "ago", "agt", "ahl", "alc", "ali", "all", "alm", "alr", "amb", "amc", "aml", "ape", "apl", "apn", "apr", "apt", "arc", "arh", "arr") #example
Dane<- list()
i=1
for(c in stock){
Dane[[i]]<-read.csv(url(paste("https://stooq.pl/q/d/l/?s=",c,"&i=d",sep="")))
i=i+1
}
After ~40 downloads this error appears:
[1] Przekroczony.dzienny.limit.wywolan (you have exceeded daily limit of downloads) - It is not a real error, program is scraping file without data, only this message inside.
Is there a way to baypass this error? I don't know different webpage (I am not sure if there is any at all) from which I can download data I need.


I couldn't get your link to work. Anyway, take a look at this one.
http://investexcel.net/multiple-stock-quote-downloader-for-excel/
Obviously it's Excel, not R, but it does a nice job. In addition, you can try something like this.
codes <- c("MSFT","SBUX","S","AAPL","ADT")
urls <- paste0("https://www.google.com/finance/historical?q=",codes,"&output=csv")
paths <- paste0(codes,"csv")
missing <- !(paths %in% dir(".", full.name = TRUE))
missing
# simple error handling in case file doesn't exists
downloadFile <- function(url, path, ...) {
# remove file if exists already
if(file.exists(path)) file.remove(path)
# download file
tryCatch(
download.file(url, path, ...), error = function(c) {
# remove file if error
if(file.exists(path)) file.remove(path)
# create error message
c$message <- paste(substr(path, 1, 4),"failed")
message(c$message)
}
)
}
# wrapper of mapply
Map(downloadFile, urls[missing], paths[missing])

Related

Why does clicking on a filtering box of renderDataTable sends me back to the left side of the screen in R shiny?

You can use the following piece of code as an example:
options(stringsAsFactors = FALSE)
options(encoding = "UTF-8")
library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(dplyr)
library(shinycssloaders)
library(data.table)
library(tidyverse)
library(DT)
dt <- structure(list(GENE = c("SI", "ARSA", "ABCA3", "KIT", "IVD", "COL18A1"), RefSeq_ID = c("NM_001041.4", "NM_000487.6", "NM_001089.3", "NM_000222.3", "NM_002225.5", "NM_001379500.1"), Tag = c("DM", "DM", "DM", "DM", "DM?", "DM"), clinvar_clnsig = c("Pathogenic", "Uncertain_significance", "NULL", "NULL", "NULL", "Likely_pathogenic"), MutationType = c("missense", "missense", "initiation", "missense", "missense", "nonsense"), ExpectedInheritance = c("AR", "AR", "AR", "AD", "AR", "AR"), Disease = c("Sucrase isomaltase deficiency", "Metachromatic leukodystrophy", "Fatal surfactant deficiency", "Piebaldism", "Isovaleric acidaemia", "Knobloch syndrome"), hgvs = c("1022T>C", "991G>A", "3G>C", "1861G>T", "1124G>A", "1876C>T"), hgvsAll = c("1022TtoC | L341P", "991GtoA | E331K", "3GtoC | M1I", "1861GtoT | A621S", "1124GtoA | G375D", "1876CtoT | R626*"), comments = c("Descr. as T/C 1021 L340P, mut. conf. by PC <1592>.", "Found in cis with Pd allele. Descr. as G985A E329R, mut. conf. by PC <1251>.", "Descr. as M1I, base change conf. by PC <1663>.", "Descr. as 1861G>C A621S, mut. conf. by PC <1495>.", "Descr. as c.1124G>A; G375A, mut. conf. by PC <1331>.", "Descr. as c.2416C>T, posn. conf. by PC <1439>."), gnomad_AC = c("NULL", "NULL", "NULL", "NULL", "NULL", "NULL"), pmid = c("10903344", "12809637", "16641205", "17124503", "19089597", "18484314"), pmidAll = c("NULL", "30052522", "24871971", "NULL", "32778825|32977617", "16532212"), CHROM = c("3", "22", "16", "4", "15", "21"), POS = c("165060026", "50626052", "2326464", "54727909", "40416348", "45487489"), REF = c("A", "C", "C", "G", "G", "C"), ALT = c("G", "T", "G", "T", "A", "T"), Support = c("NULL", "1", "0", "NULL", "2", "1"), Rankscore = c("0.48", "0.17", "0.38", "0.68", "0.5871645293736492", "0.99"), gdbid = c("120377", "119007", "3770735", "120117", "119354", "138752"), omimid = c("609845", "607574", "601615", "164920", "607036", "120328"), amino = c("Leu-Pro", "Glu-Lys", "Met-Ile", "Ala-Ser", "Gly-Asp", "Arg-Term"), deletion = c("NULL", "NULL", "NULL", "NULL", "NULL", "NULL"), insertion = c("NULL", "NULL", "NULL", "NULL", "NULL", "NULL"), codon = c("341", "331", "1", "621", "375", "626"), codonAff = c("341", "331", "1", "621", "375", "626"), descr = c("Leu341Pro", "Glu331Lys", "Met1Ile", "Ala621Ser", "Gly375Asp", "Arg626Term"), refseq = c("NM_001041.4", "NM_000487.6", "NM_001089.3", "NM_000222.3", "NM_002225.5", "NM_001379500.1"), dbsnp = c("rs267607049", "NULL", "NULL", "NULL", "rs769261274", "NULL"), gnomad_AF = c("NULL", "NULL", "NULL", "NULL", "NULL", "NULL"), gnomad_AN = c("NULL", "NULL", "NULL", "NULL", "NULL", "NULL"), new_date = c("2013-06-11", "2011-09-23", "2013-09-19", "2012-11-06", "2012-01-25", "2012-07-27"), base = c("M", "M", "M", "M", "M", "M"), clinvarID = c("1413", "556001", "NULL", "NULL", "NULL", "915432"), entrezID = c("6476", "410", "21", "3815", "3712", "80781"), hgncID = c("10856", "713", "33", "6342", "6186", "2195"), svar = c("NULL", "NULL", "NULL", "NULL", "NULL", "NULL"), mut = c("Y", "Y", "Y", "Y", "Y", "Y"), poly = c("Y", "Y", "Y", "Y", "N", "Y"), ftv = c("N", "N", "N", "N", "N", "Y"), TotalMutations = c(74L, 320L, 338L, 144L, 157L, 76L), NewMutations = c(1L, 5L, 14L, 2L, 1L, 5L), gene_date = c("1996-04-01", "1996-04-01", "2004-04-15", "1996-04-01", "1996-04-01", "2000-09-15"), author = c("Jacob", "Rafi", "Garmany", "Bondanza", "Bonilla Guerrero", "Williams"), title = c("Congenital sucrase-isomaltase deficiency arising from cleavage and secretion of a mutant form of the enzyme.", "Disease-causing mutations in cis with the common arylsulfatase A pseudodeficiency allele compound the difficulties in accurately identifying patients and carriers of metachromatic leukodystrophy.", "Surfactant composition and function in patients with ABCA3 mutations.", "Piebald trait: implication of kit mutation on in vitro melanocyte survival and on the clinical application of cultured epidermal autografts.", "Essential fatty acid profiling for routine nutritional assessment unmasks adrenoleukodystrophy in an infant with isovaleric acidaemia.", "A phenotypic variant of Knobloch syndrome."), fullname = c("J Clin Invest", "Mol Genet Metab", "Pediatr Res", "J Invest Dermatol", "J Inherit Metab Dis", "Ophthalmic Genet"), allname = c("The Journal of clinical investigation", "Molecular genetics and metabolism", "Pediatric research", "The Journal of investigative dermatology", "Journal of inherited metabolic disease", "Ophthalmic genetics"), vol = c("106", "79", "59", "127", "31S2", "29"), page = c("281", "83", "801", "676", "S453", "85"), year = c(2000L, 2003L, 2006L, 2007L, 2008L, 2008L), reftag = c("PRI", "PRI", "PRI", "PRI", "PRI", "PRI"), Some_ID = c("BM0042985", "BM0393251", "BM0673028", "BM0795183", "BM0867669", "BM0887391"), OtherNames = c("NULL", "ASA|MLD", "ABC-C|ABC3|EST111653|LBM180|SMDP3", "C-Kit|CD117|MASTC|PBT|SCFR", "ACAD2|IVDH", "GLCC|KNO|KNO1|KS"), Location = c("3q25.2-q26.2", "22q13.31-qter", "16p13.3", "4q11-q12", "15q14-q15", "21q22.3"), STRAND = c("-", "-", "-", "+", "+", "+"), FullGeneName = c("Sucrase-isomaltase", "Arylsulfatase A", "ATP binding cassette subfamily A member 3", "KIT proto-oncogene, receptor tyrosine kinase", "Isovaleryl-CoA dehydrogenase", "Collagen type XVIII alpha 1 chain")), row.names = c(NA, -6L), class = c("data.table", "data.frame"))
dt$gnomad_AC <- as.numeric(dt$gnomad_AC)
dt$Support <- as.numeric(dt$Support)
dt$Rankscore <- as.numeric(dt$Rankscore)
dt$gnomad_AF <- as.numeric(dt$gnomad_AF)
dt$gnomad_AN <- as.numeric(dt$gnomad_AN)
# ui
ui <- fluidPage(
theme = "slate",
navbarPage(
title = "Some Table",
header = tagList(useShinydashboard()),
tabPanel(
"Test",
fluidRow(
box(
dataTableOutput("mytable") %>% withSpinner(color="#0dc5c1"),
width = 12,
collapsible = FALSE,
title = "",
solidHeader = T
)
)
)
)
)
# server
server <- function(input, output) {
res <- reactive ({
outputdf <- withProgress(
message = "Loading ...",
expr = {sample_n(dt, size = 5) }
)
outputdf
})
output$mytable <-
renderDataTable(
res(),
filter = list(position = "top", clear = FALSE, plain = TRUE),
options = list(scrollX = TRUE,autoWidth = TRUE, search = list(regex = TRUE)),
rownames = FALSE
)
}
# app
shinyApp(ui, server)
And the output will give a table with filtering boxes on top of the table:
But the problem is that whenever I click on one of the filter boxes, it sends me back to the left side of the table. I have to scroll back again to where I clicked before I can use the filtering slider. Is there any way I can fix this?
I really appreciate any help you can provide.

This isn't a new issue. It looks like it's been reported a few times to the maintainers of the package.
In your UI, you can set the box to scroll. In the server, set your table to not scroll and not set an auto width.
The changes in the user interface.
ui <- fluidPage(
theme = "slate",
navbarPage(
title = "Some Table",
header = tagList(useShinydashboard()),
tabPanel(
"Test",
fluidRow(
box(style = "overflow-x: scroll;", # <--- I'm new!
dataTableOutput("mytable") %>% withSpinner(color = "#0dc5c1"),
width = 12,
collapsible = FALSE,
title = "",
solidHeader = T
)
)
)
)
)
The change in server.
# server
server <- function(input, output) {
res <- reactive ({
outputdf <- withProgress(
message = "Loading ...",
expr = {sample_n(dt, size = 5) }
)
outputdf
})
output$mytable <-
renderDataTable(
res(),
filter = list(position = "top", clear = FALSE, plain = TRUE),
options = list(scrollX = F, autoWidth = F, # <---- both of these have flipped
search = list(regex = TRUE)),
rownames = FALSE
)
}

Saving the name of an element in a list R

I have a somewhat large list of paragraphs called psw_list short for paragraphs separated by word:
c("For", "more", "than", "five", "years,", "William", "Sencion", "did", "the", "same", "task", "over", "and", "over.", "He", "signed", "onto", "the", "New", "York", "City’s", "housing", "lottery", "site", "and", "applied", "for", "one", "of", "the", "city’s", "highly", "coveted,", "below-market", "apartments.", "Each", "time,", "he", "got", "the", "same", "response:", "silence.")
I'm only including the first paragraph because they're all this length, but I have each paragraph labeled as p1, p2, p3, etc. in the list, so you can reference it by using psw_list$p1 to get this one specifically. I need to save the name of a paragraph, for example psw_list$p1, inside of a loop that will randomly select a paragraph from the entire psw_list, any idea how to do that?

Error in `$<-.data.frame`(`*tmp*`, "Year", value = character(0)) : replacement has 0 rows, data has 5

I still haven't seen a concrete reason/answer to this question and my dilemma is slightly different. So I am trying to scrape data from a website using a function which row binds it to data already found. The function calls info from another database which has 372 people in it. However, the function always stops at the 48th person no matter what I try and do. From the traceback, it seems that "Year" is the issue but I am not sure how to fix it.
Function:
event_scores <- function(first_name, last_name, id){
# get url
url <- paste0('https://thegymter.net/',first_name, '-', last_name, '/')
all_tables <- url %>%
read_html() %>%
html_nodes(xpath = paste0('//*[#id="post-', id, '"]/div/table')) %>%
html_table(fill = TRUE)
# get info table and event table for each athlete
event_table <- NULL
for (i in 2:length(all_tables)){
year_events <- url %>%
read_html() %>%
html_nodes(xpath = paste0('//*[#id="post-', id, '"]/div/p[', i+1, ']/strong')) %>%
html_text()
all_tables[[i]]$Year = substr(year_events,1,4) # add year of athlete
all_tables[[i]] <- all_tables[[i]][-1,]
event_table <- bind_rows(event_table, all_tables[[i]]) # building dataframe
}
# cleaning table
event_table$ID = id # add id of athlete
event_table[event_table == '——'] <- NA # remove -- in df
# column names
names(event_table)[names(event_table) == "X1"] <- "Date"
names(event_table)[names(event_table) == "X2"] <- "Competition"
names(event_table)[names(event_table) == ""] <- "Round"
names(event_table)[names(event_table) == "X4"] <- "VT"
names(event_table)[names(event_table) == "X5"] <- "UB"
names(event_table)[names(event_table) == "X6"] <- "BB"
names(event_table)[names(event_table) == "X7"] <- "FX"
names(event_table)[names(event_table) == "X8"] <- "AA"
return(event_table)
}
Code calling function:
scores_1 <- NULL
for (i in 1:nrow(dictionary_1)) {
y <- event_scores(dictionary_1[i,1], dictionary_1[i,2], dictionary_1[i,3])
scores_1 <- bind_rows(scores_1, y)
}
Traceback:
4. stop(sprintf(ngettext(N, "replacement has %d row, data has %d", "replacement has %d rows, data has %d"), N, nrows), domain = NA)
3. `$<-.data.frame`(`*tmp*`, "Year", value = character(0))
2. `$<-`(`*tmp*`, "Year", value = character(0))
1. event_scores(dictionary_1[i, 1], dictionary_1[i, 2], dictionary_1[i, 3])
Edited to include:
> dput(dictionary_1[45:50, ])
structure(list(first_n = structure(c(26L, 5L, 218L, 260L, 60L,
189L), .Label = c("abigail", "ahtziri", "aiko", "akari", "alaina",
"albena", "aleeza", "alessia", "alexa", "alexandra", "alia",
"aliaksandra", "alice", "aline", "alison", "alissa", "alisson",
"alizee", "amaranta", "amelie", "amy", "ana", "ana-luiza", "anapaula",
"anastasia", "anastasiya", "angel", "anna", "anne", "annie",
"antonia", "aoka", "arianna", "asia", "asuka", "audrey", "axelle",
"ayaka", "azumi", "bai", "becky", "bianca", "bianka", "boglarka",
"breanna", "brittany", "brooklyn", "cagla", "camilla", "camille",
"carina", "carlotta", "carolann", "carolyne", "casey", "caterina",
"catherine", "celia", "charlie", "charlotte", "chen", "chiaki",
"chiara", "chiharu", "chinami", "christina", "cindy", "claire",
"clara", "clarisse", "claudia", "coline", "csenge", "dalia",
"daniela", "daniele", "desiree", "dorien", "dorina", "dovelis",
"du", "elena", "eline", "elisa", "elisabeth", "elizabeth", "ellesse",
"ellie", "elsa", "emelie", "emily", "emma", "eniko", "enus",
"erika", "erin", "erja", "fan", "fien", "flavia", "francesca",
"frida", "gabby", "gaelle", "ganna", "georgia", "georgia-mae",
"georgia-rose", "georgina", "giada", "giorgia", "grace", "greta",
"guan", "haley", "halle", "hana", "hanna", "hannah", "helene",
"helody", "hitomi", "holly", "huang", "ilka", "imogen", "iosra",
"irene", "isabel", "isabela", "isabelle", "jade", "jasmin", "jelle",
"jennifer", "jessica", "jimena", "jolie", "jordyn", "julia",
"julie", "juliette", "jutta", "karla", "kate", "kelly", "kiara",
"kiko", "kim", "kirsten", "kitti", "kokoro", "kylie", "laney",
"lara", "larrissa", "latalia", "laura", "lauren", "laurie", "laurie-ann",
"laurie-lou", "lavinia", "lea", "lea-marie", "leah", "leanne",
"leticia", "li", "lilla", "lin", "lina", "lisa", "lisa-katharina",
"liu", "loan", "lorena", "lorette", "lorrane", "louise", "lu",
"luca", "lucy", "luo", "lyu", "madelaine", "madison", "maegan",
"maellyse", "mai", "maike", "maily", "maisie", "mana", "manon",
"mao", "marcia", "margaux", "marina", "marine", "mariya", "marlies",
"martina", "mary-adny", "mary-anne", "mathilde", "meaghan", "megan",
"melanie", "michela", "michelle", "micol", "mira", "miriana",
"mirtill", "nadja", "nagi", "natallia", "natsumi", "nicol", "nicole",
"nicolle", "nina", "noemi", "noemie", "nora", "olivia", "ondine",
"oreane", "ou", "pamela", "paulina", "pauline", "phoebe", "qi",
"quinn", "raer", "raya", "rebeca", "rebecca", "rianna", "romi",
"rose-kaying", "ruby", "rune", "sabrina", "sae", "sakura", "sara",
"sarah", "selina", "senna", "shallon", "shang", "shiho", "shoko",
"sofia", "sophie", "soyoka", "stacy", "stefanie", "stephanie",
"sydney", "tabea", "taeja", "talia", "tamara", "tan", "tang",
"tatiana", "tea", "teal", "thais", "thauany", "tunde", "urara",
"valentina", "valentine", "vanessa", "veronica", "victoria",
"victoria-kayen", "wakana", "wang", "wei", "wu", "xie", "xu",
"yao", "yesenia", "yin", "yoana", "youna", "yu", "yuki", "yumika",
"yumila", "yurika", "zhang", "zhao", "zhou", "zhu", "zoe", "zoja",
"zsofia"), class = "factor"), last_n = structure(c(111L, 156L,
343L, 21L, 24L, 34L), .Label = c("abdelaziz", "achampong", "akaho",
"akyol", "al-salty", "alicke", "alistratava", "allaire-bourgie",
"almeida", "alt", "andrade", "araujo", "ashikawa", "bacskay",
"bahl", "banishka", "barbosa", "basile", "beddoe", "berardinelli",
"bertrandt", "beullens", "bevan", "beydts", "birck", "black",
"boczogo", "bohmberger", "bonistalli", "bossu", "boumejmajen",
"bourgeois", "boyer", "brassart", "brevet", "briceno", "brown",
"bui", "busato", "campagnaro", "campana", "campos", "carofiglio",
"carvalho", "castro", "cenyu", "cereghetti", "chambellant", "chant",
"charpy", "chenchen", "chipizubov", "chrobok", "chujun", "chunsong",
"copiak", "cormoreche", "costa", "croket", "csasztvan", "csillag",
"cyrenne", "damato", "dandois", "daveloose", "de-jesus-dos-santos",
"de-jong", "demers", "denommee", "deriks", "derwael", "devai",
"devillard", "dickson", "diveky", "dowling", "downie", "dufournet",
"eade", "ecker", "enderle", "enghels", "esparza", "fasana", "feher",
"fellows", "fenton", "ferlito", "ferrari", "ferrera", "fidelis",
"folino", "follinger", "fragapane", "friess", "frysak", "fukasawa",
"gadirova", "garcia", "georgieva", "gill", "godwin", "griesser",
"grindle", "grisetti", "guerra", "gutierrez", "haase", "hammerle",
"hanawa", "harodnaya", "harrison", "harrold", "hatakeda", "heduit",
"hermans", "hernandez", "hill", "hilton", "hinsberger", "his",
"hockenhull", "hofele", "honti", "horvath", "huan", "huidan",
"hypolito", "imeraj", "inoue", "iorio", "ishikura", "jakubczyk",
"james", "jiaqi", "jiaxin", "jieyu", "jin", "jing", "jingxing",
"jinnan", "jinru", "jochum", "jones", "juk", "jupp", "kajita",
"kawasaki", "kickinger", "kinsella", "klinckaert", "kovacs",
"kroll", "kuhm", "kuwajima", "kwan", "lago", "laird", "lanza",
"lapp", "lastouskaya", "leat", "lechenault", "leliebre", "leolini",
"lepin", "letrange-mouakit", "levchuk", "leydin", "lima", "linari",
"linmin", "little", "louon", "lyons", "mader", "madsen", "maggio",
"makovits", "makra", "malewski", "mandriota", "mannersdorfer",
"mariani", "marois", "marongiu", "marques", "martin", "mata",
"matsumura", "mccolgan", "mcdonald", "meixner", "meneghini",
"merkle", "metelitsa", "methuen", "metzler", "meyers", "miller",
"minobe", "minotti", "mitchell", "miyakawa", "miyata", "mizzen",
"modaro", "monckton", "moors", "moreno", "morera", "morffi",
"morgan", "mori", "morz", "motten", "munteanu", "murakami", "mys",
"nakaji", "nakamura", "nedov", "netsiazhenka", "oates", "ogawa",
"oguchi", "oliveira", "olsen", "onyshko", "otaki", "padurariu",
"passeron", "paterson", "pedersen", "pedro", "peter", "peterman",
"petz", "philipp", "pikul", "planckeel", "pontlevoy", "praz",
"qi", "quaas", "ranchova", "rashkova", "redemagni", "regan",
"reis", "retiz", "ricciardi", "rizzelli", "roberts", "rocca",
"rocha", "rodriguez", "rogers", "romaeo", "rousseau", "ruckley",
"ruiyu", "ruoff", "ruttan", "sakaguchi", "sandoval", "saraiva",
"sasada", "saturnino", "savitskaya", "sayer", "schafer", "scheder",
"schermann", "schoniger", "schulze", "scott", "seitz", "serber",
"shijia", "shiting", "simm", "sinmon", "sisi", "siyi", "siyu",
"skrupa", "smantsar", "soares", "solari", "soloski", "spence",
"stabinger", "stacey", "stadelmann", "stanhope", "stingl", "sugihara",
"szekely", "szujo", "teramoto", "terlenghi", "theaker", "thomas",
"timm", "tingting", "tinkler", "torres", "townsend", "tratz",
"traukova", "tunney", "turner", "uchiyama", "ugrin", "vaelen",
"vandamme", "vandenhole", "vandersteen", "vanhille", "vansteenkiste",
"varabyova", "vargas", "verkest", "verschueren", "versonnen",
"vezina", "vidiaux", "villa", "vincenzi", "vivian", "voss", "waem",
"wahl", "whelan", "white", "whitehead", "wimmer", "woo", "xiaofang",
"xiaoyuan", "xijing", "yakubava", "yamada", "yan", "yankova",
"yawen", "yi", "yile", "yilin", "young", "yu", "yufei", "yufen",
"yumoto", "yushan", "zimmermann", "zlatkova"), class = "factor"),
ID = c(100752, 21406, 18657, 101150, 118387, 46357)), row.names = 45:50, class = "data.frame")

Delimited file read to list instead of df

Please help make R read the file into a dataframe, not a list. I am trying the following code:
head <- c("y", "x", "Label", "NDAI", "SD", "CORR","DF", "CF", "BF", "AF", "AN")
data1 <- read.delim("image1.txt", sep = "", header = T, col.names = head)
typeof(data1)
But this had no effect.

Undisplayed countries in Plotly shift event_data return (Shiny)

I'm trying to determine clicked country in a world map displayed in shiny.
I used this example for click event and this one for display and this code works:
library(shiny)
library(plotly)
library(countrycode)
df <- countrycode_data[,c("iso3c", "country.name")]
df <- df[complete.cases(df),]
df$random <- rnorm(dim(df)[1])
shinyApp(
ui = shinyUI(fluidPage(plotlyOutput("plot"), textOutput("text"))),
server = shinyServer(function(input, output) {
output$text <- renderPrint({
d <- event_data("plotly_click")
ifelse( is.null(d),
"No selection",
as.character(df[as.numeric(d[2])+1,"country.name"]))
})
output$plot <- renderPlotly({plot_ly(df, z=~random, locations=~iso3c,
text=~country.name, type="choropleth")})
}))
When I click on Afghanistan which is the first country of the dataset, it correctly selects it
But if I click on Albania which is the third one, it returns Aland Islands which is the second, and which is not displayed by Plotly.
So I'm guessing that the selection is calculated on a list of displayed entries which I project on the original dataset (which includes all countries)
I unsuccessfully tried to find on github the country list used by Plotly, which I could use to remove unknown countries and fix the shift.

A work-around is to use a country list like the one included in package countrycode and plot it, then remove each country that is not (currently) handled by plotly. This gave me this list of ISO codes to remove:
CountriesNotInPlotly <- structure(list(
iso3c = c("ALA", "ASM", "AND", "AIA", "ATA", "ATG",
"ABW", "BHR", "BRB", "BMU", "BES", "BIH", "BVT", "IOT", "CPV",
"CYM", "CAF", "CXR", "CCK", "COM", "COD", "COG", "COK", "CUW",
"CSK", "DMA", "FLK", "FRO", "GUF", "PYF", "DDR", "GIB", "GRD",
"GLP", "GUM", "GGY", "HMD", "VAT", "HKG", "IMN", "JEY", "KIR",
"LIE", "MAC", "MDV", "MLT", "MHL", "MTQ", "MUS", "MYT", "FSM",
"MCO", "MSR", "NRU", "ANT", "NIU", "NFK", "MNP", "PLW", "PCN",
"REU", "BLM", "SHN", "KNA", "LCA", "MAF", "SPM", "VCT", "WSM",
"SMR", "STP", "SYC", "SGP", "SXM", "SGS", "SJM", "TKL", "TON",
"TTO", "TCA", "TUV", "UMI", "VGB", "VIR", "WLF", "YMD", "YUG",
"EAZ")), .Names = "iso3c", row.names = c(NA, -88L), class = "data.frame")

Resources