install.packages(c("diffusion", "smacof", "psych", "MASS", "clusterSim", "segmented", "SensoMineR", "conjoint", "plspm", "lavaan", "semPlot"),dependencies=TRUE) #======MODEL BASSA======================================================== library(diffusion) #----Dane1----- x <- c( 103, 135, 172, 214, 259, 301, 333, 347, 340, 309, 261, 206, 153, 109, 74, 49, 32, 21, 13, 8, 5, 3, 2, 1, 1) fitbass1 <- diffusion(x, type = "bass") # Produce some plots plot(fitbass1) fit1 <- predict(fitbass1,15) plot(fit1) #------Dane2------- fitbass2 <- diffusion(tsCarstock[, 2], type = "bass") plot(fitbass2) fit2 <- predict(fitbass2,5) plot(fit2) #=======MAPY PERCEPCJI I PREFERENCJI========================================= #Data mod <- read.table(header=TRUE, text=" Cena Przysp Hamow Wsk_trzy Zużycie Acura -0.521 -0.477 -0.007 0.382 2.079 Audi 0.866 -0.208 0.319 -0.091 -0.677 BMW 0.496 0.802 0.192 -0.091 -0.154 Buick -0.614 -1.689 0.933 -0.210 -0.154 Corvette 1.235 1.811 -0.494 0.973 -0.677 Chrysler -0.614 -0.073 0.427 -0.210 -0.154 Dodge -0.706 0.196 0.481 0.145 -0.154 Eagle -0.614 -1.218 -4.199 -0.210 -0.677 Ford -0.706 1.542 0.987 0.145 -1.724 Honda -0.429 -0.410 -0.007 0.027 0.369 Isuzu -0.798 -0.410 -0.061 -4.230 1.067 Mazda 0.126 -0.679 -0.133 0.500 -1.724 Mercedes 1.051 -0.006 0.120 -0.091 -0.154 Mitsub. -0.614 1.003 0.084 0.382 0.718 Nissan -0.429 -0.073 -0.007 0.263 0.997 Olds -0.614 0.734 0.409 0.382 2.114 Pontiac -0.614 -0.679 0.536 0.145 0.195 Porsche 3.454 2.215 -0.296 0.618 -1.026 Saab 0.588 -0.679 0.246 0.263 0.023 Toyota -0.059 -1.218 0.228 0.736 -0.851 VW -0.706 0.128 0.102 0.382 0.195 Volvo 0.219 0.612 0.138 -0.210 0.369") View(mod) attach(mod) # mod<- read.table("c:/UEK/Cars.txt", header = TRUE) summary(mod) #===Mapy percepcji MDS ==== library(smacof) library(psych) ##----MDS----samochody------ odl <- dist(mod) map <- mds(odl, type = "interval") map summary(map) plot(map) library(MASS) map <- isoMDS(odl) plot(map$points, type = "n") text(map$points, labels = row.names(mod), cex=.9) mod.sh <- Shepard(odl, map$points) plot(mod.sh, pch = ".") lines(mod.sh$x, mod.sh$yf, type = "S") #=====Analiza PROFIT=============== library(MASS) library(clusterSim) options(OutDec=".") skalowanie <- smacofSym(delta=odl, ndim=2) x1<-skalowanie$conf rownames(x1)<-rownames(mod) y<-mod ile_modeli<-ncol(y) wyniki<-array(0, c(ile_modeli, 2)) wyniki1<-array(0, c(ile_modeli, 4)) colnames(wyniki)<-c("x1", "x2") for (i in 1:ile_modeli) { model<-lm(y[,i]~x1[,1]+x1[,2]) wyn<-summary.lm(model) wyniki[i,1]<-model$coefficients[2] wyniki[i,2]<-model$coefficients[3] wyniki1[i,3]<-summary.lm(model)$r.squared wyniki1[i,4]<-summary.lm(model)$adj.r.squared } p1<-sqrt(wyniki[,1]^2+wyniki[,2]^2) nowe_p<-array(0, c(ile_modeli, 2)) for(i in 1:ile_modeli) { nowe_p[i,1]<-wyniki[i,1]/p1[i] nowe_p[i,2]<-wyniki[i,2]/p1[i] } xx<-c(-1.5, 1.5) yy<-c(-1.5, 1.5) windows() plot(xx, yy, type="n", las=1, main="", xlab="Dim 1", ylab="Dim 2") text(skalowanie$conf, labels=rownames(mod)) abline(h=0, v=0) for (i in 1:ile_modeli) { text(nowe_p[i,1], nowe_p[i,2], labels=colnames(y[i]), col="navy") arrows(0, 0, nowe_p[i,1], nowe_p[i,2], col="red", length=0.1) } #==========ANALIZA CONJOINT============================================================================= library(conjoint) #======Planowanie eksperymentu conjoint===== experiment<-expand.grid(cena<-c("wysoka","srednia","niska"), typ<-c("mleczna","nadziewana","bakaliowa", "gorzka"), opakowanie<-c("miekkie","twarde"), waga<-c("mala","srednia", "duza"), kalorie<-c("malo","duzo")) design<-caFactorialDesign(data=experiment,type="aca") design<-caFactorialDesign(data=experiment,type="full") design<-caFactorialDesign(data=experiment,type="ca") design<-caFactorialDesign(data=experiment,type="fractional") print(design) data<-data(czekolada) czprof czpref czlevn # wektor preferencji czpref #macierz preferencji 16 profili x 87 respondentów czprefm # Profile produktów na rynku czsimp # Parametry modelu conjoint #=====Analiza conjoint============== x<-as.data.frame(czprof) y1<-as.data.frame(czpref[1:nrow(x),1]) model<-caModel(y1, x) print(model) # Wartosci uzytecznosci cech dla respondentów uslall<-caPartUtilities(czpref,czprof,czlevn) print(uslall) # Wartości uzyteczności profili dla respondentów Usi<-caTotalUtilities(czpref,czprof) print(Usi) # Graficzna prezentacja uzytecznosci ul<-caUtilities(czpref,czprof,czlevn) print(ul) Conjoint(czpref,czprof,czlevn) # Ważność predyktorów imp<-caImportance(czpref,czprof) print("Waznosc predyktorow: ", quote=FALSE) print(imp) print(paste("Sum: ", sum(imp)), quote=FALSE) #Symulacja BTL simutil<-caBTL(czsimp,czpref,czprof) print("Percentage participation of profiles:", quote=FALSE) print(simutil) # Symulacja logit simutil<-caLogit(czsimp,czpref,czprof) print("Percentage participation of profiles:", quote=FALSE) print(simutil) # Symulacja max simutil<-caMaxUtility(czsimp,czpref,czprof) print("Percentage participation of profiles:", quote=FALSE) print(simutil) #=============MODEL SEM============================================================== library(plspm) library(lavaan) library(semPlot) data(satisfaction) sat<- ' EXPE = ~ expe1+expe2+expe3+expe4+expe5 IMAG = ~ imag1+imag2+imag3+imag4 QUAL = ~ qual1+qual2+qual3+qual4+qual5 VAL= ~ val1+val2+val3+val4 SAT= ~ sat1+sat2+sat3+sat4 LOY= ~ loy1+loy2+loy3+loy4 LOY ~ b*SAT+c*IMAG SAT ~ a*IMAG+EXPE+QUAL+VAL VAL ~ EXPE + QUAL QUAL ~ EXPE * IMAG EXPE ~ IMAG # pośredni efekt (a*b) ab := a*b # całkowity efekt total := c + (a*b)' fit <- sem(sat, data=satisfaction) semCors(fit, vertical = TRUE, titles = TRUE,maximum=0.05) summary(fit, fit.measures=TRUE) # Plot path diagram: semPaths(fit, what = "paths", layout = "tree2") # Plot path diagram: semPaths(fit, what = "paths", layout = "circle") # Plot path diagram: semPaths(fit, what = "paths", layout = "spring") # Plot path diagram: semPaths(fit, whatLabels= "est", layout = "tree2", what = "paths", structural=FALSE, rotation=3, sizeMan=5, color = list( lat = "yellow", man="green")) # Plot path diagram: semPaths(fit, whatLabels= "std", layout = "tree2", what = "paths", structural=TRUE, rotation=2, sizeMan=3, col="green") #====================MODEL PLSPM============================================================================== library(plspm) ## Not run: ## typical example of PLS-PM in customer satisfaction analysis ## model with six LVs and reflective indicators data(satisfaction) IMAG <- c(0,0,0,0,0,0) EXPE <- c(1,0,0,0,0,0) QUAL <- c(0,1,0,0,0,0) VAL <- c(0,1,1,0,0,0) SAT <- c(1,1,1,1,0,0) LOY <- c(1,0,0,0,1,0) sat.inner <- rbind(IMAG, EXPE, QUAL, VAL, SAT, LOY) sat.outer <- list(1:5,6:10,11:15,16:19,20:23,24:27) wart.mod <- c("A","A","A","A","A","A") scaling <- list(c("ORD", "ORD", "ORD", "ORD", "ORD"), c("ORD", "ORD", "ORD", "ORD", "ORD"), c("ORD", "ORD", "ORD", "ORD", "ORD"), c("ORD", "ORD", "ORD", "ORD"), c("ORD", "ORD", "ORD", "ORD"), c("ORD", "ORD", "ORD", "ORD")) # sat.mod <- rep("A",6) ## reflective indicators satpls <- plspm(satisfaction, sat.inner, sat.outer, wart.mod, scaling = scaling, scheme="centroid", scaled=TRUE) summary(satpls) # plot diagram of the inner model innerplot(satpls,colpos = "blue", colneg = "red") # plot loadings outerplot(satpls, what = "loadings", colpos = "blue", colneg = "red") # plot outer weights outerplot(satpls, what = "weights", colpos = "blue", colneg = "red")