Querying FRED from R

FRED is an amazingly useful website provided by the Federal Reserve Bank of St. Louis compiling over 500k time series from 87 different sources. Here are 2 short R functions to retrieve FRED data in R. You'll need rjson (with admin privileges  : install.packages("rjson")) and a valid API key (register for free here) to run them.

iFRED returns basic information about a time series as a list. For instance, assuming you’re interested by the Russell 1000 index Total Market Index (RU1000TR):

> sid <- "RU1000TR"
> iFRED(sid)
$id
[1] "RU1000TR"

$realtime_start
[1] "2018-01-23"

$realtime_end
[1] "2018-01-23"

(...)

qFRED retrieves the time series itself as a matrix (with dates as row names). Id addition to sid, there are 6 other optional argument:

  • from: the start date as a Date object (defaults to 1776-07-04);

  • to: the end date as a Date object (defaults to Sys.Date());

  • units: one of lin (levels, the default), chg (change), ch1 (change from one year ago), pch (percent change), pc1 (percent change from one year ago), pca (compounded annual rate of change), cch (continuously compounded rate of change), cca (continuously compounded annual rate of change) or log (natural log);

  • freq: one of d (daily, the default), w (weekly), bw(bi-weekly), m (monthly), q (quarterly), sa (semiannual), a (annual), wef (weekly ending Friday), weth (weekly ending Thursday), wew (weekly ending Wednesday), wetu (weekly ending Tuesday), wem (weekly ending Monday), wesu (weekly ending Sunday), wesa (weekly ending Saturday), bwew (bi-weekly ending wednesday) or bwem (bi-weekly ending Monday).

  • aggreg: when using freq, how should data be aggregated? One of eop (end of period, the default), avg (average) or sum (sum)

  • na.rm: logical, should missing values (NAs) be removed from the output?

For instance, always with RU1000TR:

> from <- as.Date("2018-01-01")
> qFRED(sid, from)
           RU1000TR
2018-01-01       NA
2018-01-02  8346.42
2018-01-03  8398.08
2018-01-04  8431.26
2018-01-05  8487.97
2018-01-08  8504.18
(...)

Let's say you want weekly data with end-of-the-period observations:

> qFRED(sid, from, freq = "w", aggreg = "eop")
           RU1000TR
2018-01-05  8487.97
2018-01-12  8624.19
2018-01-19  8698.12
2018-01-26       NA

Same thing but with weekly averages:

> qFRED(sid, from, freq = "w", aggreg = "avg")
           RU1000TR
2018-01-05  8415.93
2018-01-12  8543.91
2018-01-19  8653.44
2018-01-26       NA

Percent change from one year ago:

> qFRED(sid, from, units = "pc1")
           RU1000TR
2018-01-01       NA
2018-01-02 21.66084
2018-01-03 21.54941
2018-01-04 22.16739
2018-01-05 22.54979
2018-01-08 23.23220
(...)

The code is on Github. Don't forget to replace .FRED_api_key with your own API key!

ChallengeR #6

Votre dernière mission consistait à coder le tricheur parfait dans mon petit tournois d’algos pour un dilemme du prisonnier répété.

Et le gagnant est @AlekVladNevski qui nous propose une fonction (ici un peu reprise par mes soins) qui va modifier la matrice des paiements :

msp  = function(p, o, n = 2000) {
 z <- if(match.call()[[1]]=='f1') c(5, 0) else c(0, 5)
 m <- rep(z, each = 4)
 dim(m) <- rep(2,3)
 assign("m", m, envir = parent.frame(n=1))
 return(FALSE)
}

Challenger #6

Votre mission, si vous l’acceptez consiste à coder une fonction nbchar qui compte le nombre de caractères du corps d’une autre fonction R, sans tenir compte des espaces, des indentations et des retours à la ligne. Par exemple, avec :

area = function(radius) {
 radius * pi^2
}

Vous devriez vérifier que :

> nbchar(area)
[1] 11
>

C’est la fonction pour laquelle nbchar(nbchar) sera le plus petit qui remportera ce challenge. Vous avez jusqu'au vendredi 26 janvier ; soumettez vos réponses ci-dessous :

Votre @username sur Twitter :


Coller votre code ici :


Validez pour enregistrer votre réponse.

HTML form to Google Sheet

I’ve been trying to figure out how to do this for a while so maybe it will be useful to someone else. I want to create an HTML form here that sends all the inputs to a google sheet. Demo:

Here is the form:

First Name:

Last Name:


This is where the confirmation message will appear after submission.

And it all ends up in that sheet.

Worked? So here is how to do it:

First, quite obviously, you need and HMTL form. Here's mine:

We'll need to update the link_to_google_script thing after next step.

Then we need a Google Sheet. Go to your Google Drive, create one and save its ID somewhere (that the long string in the url between d/ and /edit).

Now, still in Google Drive, create a new Google Apps Script, remove any code in there and relace it with this:

Just replace the id_of_your_google_sheet with the ID of your own sheet.

Once done, save you script, select Publish, Deploy as web app, make sure that "anyone, even anonymous" has access to the app and Publish. After a bit of authorization procedures, you should get this:

Copy that link and paste it in your HTML instead of link_to_google_script then add at the bottom of your HTML page:

Here you go, it should be working!

ChallengeR #5

Votre dernière mission consistait à trouver la fonction locf (qui remplace les NA par la dernière valeur connue) la plus compacte possible (étant bien entendu, comme d'habitude, que les espaces, les indentations et les retours à la ligne ne sont pas considérés comme des caractères). L’exemple que je vous ai donné était le suivant :

> x <- 10:20
> x[5:6] <- NA
> locf(x)
 [1] 10 11 12 13 13 13 16 17 18 19 20
>

Ce faisant, j’ai commis une petite erreur : j’aurais dû préciser que locf devrait aussi faire ça :

> x <- 10:20
> x[c(1:2, 5:6)] <- NA
> locf(x)
 [1] NA NA 12 13 13 13 16 17 18 19 20
>

En tenant compte de cet oubli de ma part, vous êtes deux à remporter ce 4ème ChallengeR avec un corps de fonction d’à peine 34 caractères.

La première solution est de @dickoah :

locf = function(x) {
 x[cummax((!is.na(x)) * 1:length(x))]
}

La seconde, qui présente l'avantage de traiter les NA en début de vecteur, nous est proposée par @navarre_julien :

locf = function(x) {
 i = !is.na(x)
 c(NA, x[i])[cumsum(i)+1]
}

Notez que, pour répondre strictement à mon énoncé (et donc sans supporter les NA en début de vecteur), on pouvait raccourcir la version de Julien comme suit :

locf = function(x) {
 i = !is.na(x)
 x[i][cumsum(i)]
}

La fonction locf idéale est donc quelque chose du genre :

locf = function(x) {
 if(is.matrix(x)) {
  res <- apply(x, 2, locf)
 } else {
  i <- !is.na(x)
  res <- c(NA, x[i])[cumsum(i)+1]
 }
 res
}

Bravo à tous les deux ! Voici donc ChallengeR, 5ème du nom.

Votre mission, si vous l’acceptez, consiste à coder le tricheur parfait dans mon petit tournois d’algos pour un dilemme du prisonnier répété. Vous devez concevoir une fonction de la forme :

msp = function(p, o, n = 2000) {
 # faire quelque chose...
 return(res)
}

De telle sorte qu’elle pulvérise tous les records en trichant vilement. Edit : Tout le code est accessible sur Github.

ChallengeR #4

Bon, vous êtes non seulement forts mais vous êtes en plus de grands malades. Votre dernière mission consistait à trouver une fonction R qui renvoie la suite de Syracuse de n'importe quel entier x jusqu'à ce qu'elle atteigne 1. Il y a deux façons de faire ça :

En passant par une fonction récursive :

syracuse = function(x) {
 a <- tail(x, 1)
 if(a == 1) {
  return(x)
 } else {
  syracuse(c(x, ifelse(a%%2, a*3+1, a/2)))
 }
}

Ou en passant par une fonction récursive anonyme :

syracuse = function(x) {
 a <- tail(x, 1)
 if(a == 1) {
  return(x)
 } else {
  Recall(c(x, ifelse(a%%2, a*3+1, a/2)))
 }
}

Je dis que vous êtes des grands malades parce que, sur Twitter, vous avez assez rapidement décidé de trouver la fonction la plus condensée possible (sans parler de celui qui voulait faire ça sans if ni else). Du coup, je vous donne la version la plus courte, trouvée par @AlekVladNevski :

syracuse = function(x) {
 c(x, if(x>1) Recall(if(x%%2) x*3+1 else x/2 ))
}

Bravo à @_antoineb, @_pvictorr, @After_Eight, @AlekVladNevski, @bZ1O91, @ClementinC, @dickoah, @francois_ls, @mac_picsou, @NicolasBenezet, @PierreRinder, @privefl, @StephaneOrlins et @thedudeparis.

Nous allons donc pouvoir passer à l'étape 4.

Considérez le vecteur x suivant :

x <- 10:20
x[5:6] <- NA

Votre mission, si vous l’acceptez, consiste à coder trouver la fonction locf (pour Last Observation Copied Forward) qui, comme son nom le suggère, remplace les NA par la dernière observation connue :

> locf(x)
 [1] 10 11 12 13 13 13 16 17 18 19 20
>

Le gagnant sera celui qui proposera la fonction qui utilise le moins de caractères possibles (étant entendu que les espaces, les indentations et autres retours à la ligne ne son *pas* considérés comme des caractères).

Iterated prisoner’s dilemma

This is an iterated prisoner’s dilemma between yourself and 9 unknown opponents. Each match will last for 10 rounds and you’ll only know who was your opponent at the end of the match. For each round, you must choose between Cooperate (C) or Defect (D).

The payment matrix is :

C D
C [3,3] [0,5]
D [5,0] [1,1]

In words:

  • If you both cooperate ([C,C]), you'll get 3 points each;
  • If you cooperate while your opponent defects ([C, D]), you'll get 0 points but he'll get 5 points;
  • If you defect while your opponent cooperates ([D, C]), you'll get 5 points and he'll get nothing;
  • If you both defect ([D,D]), you'll get 1 point each.

The number of points earned by each of you during one specific match are calculated at the bottom of the tables and you'll get you total score at the end of the post.

Ready? Let's start!

Match 1

This is round 1. What do you do?



You Opponent
- -
- -
- -
- -
- -
- -
- -
- -
- -
- -
0 0
Match 2

This is round 1. What do you do?



You Opponent
- -
- -
- -
- -
- -
- -
- -
- -
- -
- -
0 0
Match 3

This is round 1. What do you do?



You Opponent
- -
- -
- -
- -
- -
- -
- -
- -
- -
- -
0 0
Match 4

This is round 1. What do you do?



You Opponent
- -
- -
- -
- -
- -
- -
- -
- -
- -
- -
0 0
Match 5

This is round 1. What do you do?



You Opponent
- -
- -
- -
- -
- -
- -
- -
- -
- -
- -
0 0
Match 6

This is round 1. What do you do?



You Opponent
- -
- -
- -
- -
- -
- -
- -
- -
- -
- -
0 0
Match 7

This is round 1. What do you do?



You Opponent
- -
- -
- -
- -
- -
- -
- -
- -
- -
- -
0 0
Match 8

This is round 1. What do you do?



You Opponent
- -
- -
- -
- -
- -
- -
- -
- -
- -
- -
0 0
Match 9

This is round 1. What do you do?



You Opponent
- -
- -
- -
- -
- -
- -
- -
- -
- -
- -
0 0
Conclusion

Still there? Great!

  • Always Defects always defects regardless of what you do;
  • Tit-for-Tat cooperates first and then reproduce your last move;
  • Grudger cooperates until you defect; then defects all the time;
  • Always Cooperates always cooperates regardless of what you do;
  • Detective cooperates, defects, cooperates then checks what you did on the 3rd round: if you haven't retaliated, it defects all the time; otherwise it plays Tit-for-Tat;
  • Random just cooperates or defect randomly (with a probability of 1/2);
  • Win-Stay-Lose-Shift cooperates first then, if you've cooperated on the last round, repeat its last move; otherwise switches;
  • Tit-For-Two-Tats same as Tit-for-Tat but only retaliates after two defections in a row;
  • Alternates defects first and then just alternates regardless of what you do.

Your total score is 0 points. Please, tell me how much you've made (either in the comments below or on Twitter) and explain how you did it.

ChallengeR #3

Votre dernière mission consistait à compter le nombre de chiffres pairs du vecteur x avec le moins de code possible (étant bien entendu que les espaces, les indentations et les retours à la ligne ne sont pas comptés comme des caractères).

x <- sample(0:9, 100, TRUE)

La meilleure réponse possible était :

sum(! x %% 2)

... et vous êtes 14 à l'avoir trouvée. Dans l'ordre d'arrivée : @thedudeparis, @_antoineb, @_pvictorr, @davidgohel, @loicmolinari, @AlekVladNevski @privefl, @basiliximAb @dickoah, @ClementinC @StephaneOrlins, @claramorganexxx (ahem..), @francois_ls et @After_Eight. Bravo à toutes et à tous !

Comme vous êtes bons, on va augmenter la difficulté. Votre mission, si vous l'acceptez, consiste à coder une fonction syracuse qui renvoie la suite de Syracuse de n'importe quel entier x jusqu'à ce qu'elle atteigne 1. En d'autres termes, nous cherchons une fonction de type :

syracuse = function(x) {
 # faire quelque chose...
}

De telle sorte que :

> syracuse(42)
[1] 42 21 64 32 16  8  4  2  1

Mais comme ça, c'est trop facile, vous allez faire ça sans boucle (ni for ni while ni repeat !).

Querying FRED from R

FRED is an amazingly useful website provided by the Federal Reserve Bank of St. Louis compiling over 500k time series from 87 different sou...