#======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)


 #======Model symulacyjny=====

 fitbasssim <- diffusion(tsCarstock[, 2], w=c(0.08, 0.5, 1581000), type = "bass")

 plot(fitbasssim)
 fit2 <- predict(fitbasssim,50)
 plot(fit2)


 fitbasssim <- diffusion(x,w=c(0.01, 0.09, 1581000), type = "bass")


 #=======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)
 
 
 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) 
} 
 
#===Mapa łączna preferencji====
 ,
 library(segmented)
 library(SensoMineR)

 ## Analiza coctaili

 data(cocktail)

 senso.cocktail # - ocena 16 koktaili ze względu na 13 sensorycznych cech przez 12 sędziów

 hedo.cocktail # - ocena 16 koktaili przez 100 konsumentów na skali 0-10

 res.cpa = cpa(cbind(senso.cocktail), hedo.cocktail)


#==========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)

 
 czpref
 czlevn
 # wektor preferencji
 czpref
 #macierz preferencji 16 profili x 87 respondentów

  czprefm
 macierz preferencji rynkowych produktów
 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=3, 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)

quantiplot(satpls, lv = 6, mv = 27, pch = 16,
 col = "darkblue")


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")

#========Model REBUS============

# Hierarchiczna analiza skupień 

sim_clus  =  res.clus(satpls)

# Model REBUS z 2 skupieniami

rebus_sim  =  it.reb(satpls,  sim_clus,  nk=2, stop.crit=0.005,  iter.max=100)

rebus_sim

# Model REBUS z 3 skupieniami


rebus_sim3  =  it.reb(satpls,  sim_clus,  nk=3, stop.crit=0.005,  iter.max=100)

rebus_sim3

# Modele lokalne 

local_rebus  =  local.models(satpls,  rebus_sim)

local_rebus$glob.model

summary(local_rebus$loc.model.1)

summary(local_rebus$loc.model.2)

# Diagram modelu wewnętrznego dla 1 segmentu

innerplot(local_rebus$loc.model.1, colpos = "blue",
colneg = "red")


# Diagram modelu wewnętrznego dla 2 segmentu

innerplot(local_rebus$loc.model.2, colpos = "blue",
colneg = "red")