[SOLVED] CS计算机代考程序代写 # Lecture 8 Analysis (Part 1)

# Lecture 8 Analysis (Part 1)
# Author: Chris Hansman
# Email: [email protected]
# Date : 01/03/21
#install.packages(“kader”)
#install.packages(“KernSmooth”)
library(kader)
library(tidyverse)
library(KernSmooth)
theme_set(theme_classic())
#———————————————-
# Part 1: Kernel Density Estimation
#———————————————-
# Loading Data
density <- read_csv(“density.csv”)# Scatter Plotggplot(data=density,aes(x=x, y=y)) +geom_point(alpha=0.5) +ylim(-0.005,0.1)+xlim(-20,20) # Estimating Parametersmean_x <- mean(density$x)sd_x <- sd(density$x)n <- length(density$x)# Parametric Densityggplot(data=density) +geom_point(alpha=0.5,aes(x=x, y=y)) +ylim(-0.005,0.1)+xlim(-20,20) +stat_function(fun = dnorm, args=c(mean=mean_x, sd=sd_x)) # Histogram ggplot(data=density) +geom_point(alpha=0.5,aes(x=x, y=y)) +ylim(-0.005,0.1)+xlim(-20,20) +stat_function(fun = dnorm, args=c(mean=mean_x, sd=sd_x)) +geom_histogram(aes(x=x, y=..density..),colour=”black”, fill=”white”, binwidth=1)# Number of x near a point u:u <- -10.6dist_ux <- abs(u-density$x)near_ux <- as.integer(dist_ux<=0.5)count_ux <-sum(near_ux)# Converting to densitydensity_u <- count_ux/ndensity_u# Computing Density for a fine gridu_grid = seq(-20, 20, by=0.01)#matrix of distancesdistmatrix_ux = abs(outer(u_grid, density$x, “-“))nearmatrix_ux = distmatrix_ux<=0.5countvec_ux = rowSums(nearmatrix_ux)densityvec_u=countvec_ux/n#Generating Tibble to Plotdensityplot <- tibble(u_grid,countvec_ux,densityvec_u)# Plottingggplot(data=densityplot) +geom_line(aes(x=u_grid, y=densityvec_u)) # All at Onceh=1/2kdensity_unif <- tibble(u_grid = seq(-20, 20, by=0.01),count_ux = rowSums(abs(outer(u_grid, density$x, “-“))/h<1),countperunit_ux = (1/h)*(1/2)*count_ux,densityvec_u=(1/n)*countperunit_ux)# Plottingggplot(data=kdensity_unif) +geom_line(aes(x=u_grid, y=densityvec_u)) # Gaussian Kernelh_g=3kdensity_gaussian <- tibble(u_grid = seq(-20, 20, by=0.01),weight_ux = rowSums(dnorm(abs(outer(u_grid, density$x, “-“))/h_g)),weightperunit_ux = (1/h_g)*weight_ux,densityvec_u=(1/n)*weightperunit_ux)# Plottingggplot(data=kdensity_gaussian) +geom_line(aes(x=u_grid, y=densityvec_u), color=”blue”) +geom_density(data=density, aes(x=x), kernel = “epanechnikov”, bw=h_g, alpha=.2, fill=”red”, color=”red”)# Rule of Thumb bandwidthh_rot=1.06*sd_x*(n^(-1/5))ggplot(data=kdensity_gaussian) +geom_density(data=density, aes(x=x), kernel = “epanechnikov”, bw=h_rot, alpha=.2, fill=”red”, color=”red”)# epanechnikov(x)h_e=h_rotkdensity_epi <- tibble(u_grid = seq(-20, 20, by=0.01),weight_ux = rowSums(kader:::epanechnikov(abs(outer(u_grid, density$x, “-“))/h_e)),weightperunit_ux = (1/h_e)*weight_ux,densityvec_u=(1/n)*weightperunit_ux)ggplot() +geom_line(data=kdensity_epi, aes(x=u_grid, y=densityvec_u), color=”blue”) +geom_density(data=density, aes(x=x), kernel = “epanechnikov”, bw=h_rot, alpha=.2, fill=”red”, color=”red”)#———————————————-# Part 2: Non-parametric Regression#———————————————-lpdata <- read_csv(“lpdata.csv”)# NW Approach at a pointu <- 1.5 # Pointh=1 # bandwidthdiff_ux <- abs(u-lpdata$x) # differencekernel_ux <- (1/h)*dnorm(diff_ux/h) # Kernelweight_ux <- kernel_ux/sum(kernel_ux) # Converting Kernels to weightshu=sum(lpdata$y*weight_ux) # estimatehu# NW approach on a Gridh_nw=0.4 # bandwidthu_grid = seq(-4,4, by=0.01) # Gridkernelgrid_ux=(1/h_nw)*dnorm(abs(outer(u_grid, lpdata$x, “-“))/h_nw) # diff matrixkernelsum_ux=rowSums(kernelgrid_ux) # Sum of Kernelsnwweights_ux = kernelgrid_ux/kernelsum_ux # Matrix of weightsnwestimates <-nwweights_ux%*%lpdata$y# Estimates# Converting to tibble for plottingnw_gaussian <- tibble( u_grid, nwestimates)# Plottingggplot( ) +geom_point(data=lpdata,aes(x=x, y=y)) +geom_line(data=nw_gaussian, aes(x=u_grid, y=nwestimates))# Using Pre-built command for NWlocpoly0 <- as_tibble(locpoly(x = lpdata$x, y = lpdata$y, bandwidth = h_nw, degree = 0,range.x = c(-4,4), gridsize = 801, kernel = “normal”))# Plotting Pre-Built NWggplot( ) +geom_point(data=lpdata,aes(x=x, y=y)) +geom_line(data=nw_gaussian, aes(x=u_grid, y=nwestimates)) +geom_line(data=locpoly0, aes(x=x, y=y), color=”red”)# Using Pre-built command for Local Linear Regressionlocpoly1 <- as_tibble(locpoly(x = lpdata$x, y = lpdata$y, bandwidth = h_nw, degree = 3,range.x = c(-3,3), gridsize = 801, kernel = “normal”))# Plotting Pre-Built local Linearggplot( ) +geom_point(data=lpdata,aes(x=x, y=y)) +geom_line(data=nw_gaussian, aes(x=u_grid, y=nwestimates)) +geom_line(data=locpoly1, aes(x=x, y=y), color=”red”)+geom_smooth(data=lpdata,aes(x=x, y=y), span=0.1)