Skip to content

Instantly share code, notes, and snippets.

@abikoushi
abikoushi / planets.jl
Created April 11, 2026 00:33
太陽系の惑星の運動(?)
using Plots
function location(θ)
l = [0.387, 0.723, 1.0, 1.524, 5.204, 9.5, 19.2, 30.1, 39.5]
e = [0.206, 0.007, 0.017, 0.093, 0.048, 0.056, 0.047, 0.009, 0.249]
T = [0.24, 0.61, 1.0, 1.9, 11.9, 29.5, 84.0, 165.0, 248.0]
r(θ,l,e) = l/(1+e*cos(θ))
x = zeros(length(l))
y = zeros(length(l))
@abikoushi
abikoushi / ordered_ph.R
Created April 8, 2026 01:46
Proportional hazard model for ordered response
library(dplyr)
library(ggplot2)
library(tidyr)
library(tibble)
library(MASS)
make_prob <- function(alpha, eta){
xi <- plogis(outer(eta, alpha, "+"))
for(j in 2:length(alpha)){
xi[,j] <- xi[,j]*(1-rowSums(xi[,1:(j-1), drop=FALSE]))
@abikoushi
abikoushi / AlbertOgive.cpp
Created April 2, 2026 02:10
An implementation of Gibbs sampler for 2 parameter ogive item response model Albert (1992)
#include <Rcpp.h>
using namespace Rcpp;
static const double t4 = 0.45;
// Exponential rejection sampling (a,inf)
double ers_a_inf(const double & a) {
double ainv = 1.0 / a;
double x;
double rho;
do {
x = R::rexp(ainv) + a; // rexp works with 1/lambda
@abikoushi
abikoushi / inversefunction_method.R
Created March 28, 2026 00:03
逆関数法の例
set.seed(1234)
u <- runif(10000)
X1 <- qweibull(u, 2, 2, lower.tail = TRUE)
X2 <- qweibull(u, 2, 2, lower.tail = FALSE)
png("inversefunction_method.png", width =800, height=500)
par(mfrow=c(1,2))
plot(ecdf(X1))
curve(pweibull(x,2,2), add=TRUE, col="orangered")
@abikoushi
abikoushi / tanh_Nile.R
Created March 27, 2026 10:57
curve fitting for Nile data
ft <- function(x, par){
tanh(par[1]*x+par[2])
}
objfun <- function(par, y, x){
0.5*sum( (y - ft(x, par))^2 )
}
yt <- scale(Nile)
xt = seq(-4, 4, length.out = length(yt))
@abikoushi
abikoushi / SkipGramWithNegativeSampling.R
Created February 25, 2026 13:16
Skip Gram With Negative Sampling using R
#####
#Reference
#Omer Levy, Yoav Goldberg (NIPS 2014)
#Neural Word Embedding as Implicit Matrix Factorization
#https://papers.nips.cc/paper_files/paper/2014/hash/b78666971ceae55a8e87efb7cbfd9ad4-Abstract.html
#####
library(torch)
library(dplyr)
#install_torch(reinstall = TRUE)
@abikoushi
abikoushi / asymp_meanvar.R
Created February 20, 2026 04:11
plot sample mean and variance
moments_4 <- function(truedens){
k1 <- integrate(function(x){x*truedens(x)}, lower=-Inf, upper=Inf)
k2 <- integrate(function(x){(x-k1$value)^2*truedens(x)}, lower=-Inf, upper=Inf)
k3 <- integrate(function(x){(x-k1$value)^3*truedens(x)}, lower=-Inf, upper=Inf)
k4 <- integrate(function(x){(x-k1$value)^4*truedens(x)}, lower=-Inf, upper=Inf)
c(k1$value, k2$value,
k3$value, k4$value)
}
Mu4 <- moments_4(truedens = function(x){dgamma(x,2,1)})
@abikoushi
abikoushi / simCLT.R
Created February 18, 2026 07:20
A demonstration of central limit theorem
library(ggplot2)
library(dplyr)
library(tidyr)
# integrate(f = function(x)x*(0.6*dnorm(x, -10/6)+0.4*dnorm(x, 10/4)), lower = -Inf, upper = Inf)
scaled_mean <- function(x){sqrt(length(x))* mean(x) / ifelse(length(x)==1L,1,sd(x))}
CLTsim <- function(n, iter){
mu <- c(-10/6, 10/4)
mixture <- numeric(iter)
uniform <- numeric(iter)
@abikoushi
abikoushi / BayesianLogistic_polyagamma.R
Created February 17, 2026 01:30
Gibbs sampler of the Bayesian logistic regression via Polya-gamma distribution
library(BayesLogit)
library(ggplot2)
library(dplyr)
#########
#Bayesian inference for logistic models using Polya-Gamma latent variables (2013)
#Nicholas G. Polson, James G. Scott, Jesse Windle
#https://arxiv.org/abs/1205.0310
#########
#Y: response variable
#X: explanatory design matrix
@abikoushi
abikoushi / mixnorm.R
Created January 23, 2026 00:33
An animation of posterior distribution with mixture normal model
library(dplyr)
library(tidyr)
library(ggplot2)
library(gganimate)
logsumexp2 =function (logx1,logx2){
logx1 + log1p(exp(logx2-logx1))
}
llmixnorm <- function(par, y){