void L2Sphere::EucHvToHv(Variable *x, Vector *etax, Vector *exix, Vector* xix, const Problem *prob) const
{
//exix->CopyTo(xix);//---
//return; //---
const double *xptr = x->ObtainReadData();
Variable *xcubed = x->ConstructEmpty();
SharedSpace *Sharedxcubed = new SharedSpace(xcubed);
double *xcubedptr = xcubed->ObtainWriteEntireData();
for (integer i = 0; i < n; i++)
{
xcubedptr[i] = xptr[i] * xptr[i] * xptr[i];
}
double a1 = Metric(x, xcubed, xcubed);
const SharedSpace *Sharedegf = x->ObtainReadTempData("EGrad");
Vector *egfVec = Sharedegf->GetSharedElement();
double a2 = Metric(x, egfVec, xcubed);
Vector *x2etax = etax->ConstructEmpty();
double *x2etaxptr = x2etax->ObtainWriteEntireData();
const double *etaxptr = etax->ObtainReadData();
for (integer i = 0; i < n; i++)
{
x2etaxptr[i] = xptr[i] * xptr[i] * etaxptr[i];
}
scalarVectorAddVector(x, -3.0 * a2 / a1, x2etax, exix, xix);
delete x2etax;
ExtrProjection(x, xix, xix);
};
void Stiefel::Projection(Variable *x, Vector *v, Vector *result) const
{
if (IsIntrApproach)
IntrProjection(x, v, result);
else
ExtrProjection(x, v, result);
};
void Stiefel::EucHvToHv(Variable *x, Vector *etax, Vector *exix, Vector *xix, const Problem *prob) const
{
if (metric == EUCLIDEAN)
{
char *transn = const_cast<char *> ("n"), *transt = const_cast<char *> ("t");
double one = 1, zero = 0;
integer inc = 1, N = n, P = p, Length = N * P;
double *symxtegfptr;
SharedSpace *symxtegf;
if (x->TempDataExist("symxtegf"))
{
symxtegf = const_cast<SharedSpace *> (x->ObtainReadTempData("symxtegf"));
symxtegfptr = const_cast<double *> (symxtegf->ObtainReadData());
}
else
{
const double *xxM = x->ObtainReadData();
const SharedSpace *Sharedegf = x->ObtainReadTempData("EGrad");
Vector *egfVec = Sharedegf->GetSharedElement();
const double *egf = egfVec->ObtainReadData();
symxtegf = new SharedSpace(2, p, p);
symxtegfptr = symxtegf->ObtainWriteEntireData();
dgemm_(transt, transn, &P, &P, &N, &one, const_cast<double *> (xxM), &N, const_cast<double *> (egf), &N, &zero, symxtegfptr, &P);
for (integer i = 0; i < p; i++)
{
for (integer j = i + 1; j < p; j++)
{
symxtegfptr[i + j * p] += symxtegfptr[j + i * p];
symxtegfptr[i + j * p] /= 2.0;
symxtegfptr[j + i * p] = symxtegfptr[i + j * p];
}
}
}
exix->CopyTo(xix);
double *resultTV = xix->ObtainWritePartialData();
const double *etaxTV = etax->ObtainReadData();
double negone = -1;
dgemm_(transn, transn, &N, &P, &P, &negone, const_cast<double *> (etaxTV), &N, symxtegfptr, &P, &one, resultTV, &N);
ExtrProjection(x, xix, xix);
if (!x->TempDataExist("symxtegf"))
{
x->AddToTempData("symxtegf", symxtegf);
}
return;
}
Rcpp::Rcout << "Warning:The function converting action of Eucidean Hessian to action of Riemannian Hessian has not been done!" << std::endl;
};
void L2Sphere::EucGradToGrad(Variable *x, Vector *egf, Vector *gf, const Problem *prob) const
{
//egf->CopyTo(gf);//--
//return;//--
if (prob->GetUseHess())
{
Vector *segf = egf->ConstructEmpty();
segf->NewMemoryOnWrite(); // I don't remember the reason. It seems to be required.
egf->CopyTo(segf);
SharedSpace *Sharedegf = new SharedSpace(segf);
x->AddToTempData("EGrad", Sharedegf);
}
ExtrProjection(x, egf, gf);
};
void Stiefel::EucGradToGrad(Variable *x, Vector *egf, Vector *gf, const Problem *prob) const
{
if (metric == EUCLIDEAN)
{
if (prob->GetUseHess())
{
Vector *segf = egf->ConstructEmpty();
segf->NewMemoryOnWrite(); // I don't remember the reason. It seems to be required.
egf->CopyTo(segf);
SharedSpace *Sharedegf = new SharedSpace(segf);
x->AddToTempData("EGrad", Sharedegf);
}
ExtrProjection(x, egf, gf);
return;
}
Rcpp::Rcout << "Warning:The function converting Eucidean Gradient to Riemannian Gradient has not been done!" << std::endl;
};
void Stiefel::qfcoTangentVector(Variable *x, Vector *etax, Variable *y, Vector *xiy, Vector *result) const
{
const double *yM = y->ObtainReadData();
Vector *exresult = EMPTYEXTR->ConstructEmpty();
double *exresultTV = exresult->ObtainWriteEntireData();
Vector *extempy = nullptr;
const double *extempyTV;
if (IsIntrApproach)
{
extempy = EMPTYEXTR->ConstructEmpty();
ObtainExtr(y, xiy, extempy);
extempyTV = extempy->ObtainReadData();
}
else
{
extempyTV = xiy->ObtainReadData();
}
double *ytxiy = new double[p * p];
char *transt = const_cast<char *> ("t"), *transn = const_cast<char *> ("n");
integer N = n, P = p, inc = 1;
double one = 1, zero = 0;
dgemm_(transt, transn, &P, &P, &N, &one, const_cast<double *> (yM), &N, const_cast<double *> (extempyTV), &N, &zero, ytxiy, &P);
for (integer i = 0; i < p; i++)
{
for (integer j = i; j < p; j++)
{
ytxiy[i + j * p] = -ytxiy[i + j * p];
}
}
dgemm_(transn, transn, &N, &P, &P, &one, const_cast<double *> (yM), &N, ytxiy, &P, &zero, exresultTV, &N);
integer Length = N * P;
daxpy_(&Length, &one, const_cast<double *> (extempyTV), &inc, exresultTV, &inc);
const SharedSpace *HHR = y->ObtainReadTempData("HHR");
const double *ptrHHR = HHR->ObtainReadData();
double sign;
for (integer i = 0; i < P; i++)
{
sign = (ptrHHR[i + i * N] >= 0) ? 1 : -1;
dscal_(&N, &sign, exresultTV + i * N, &inc);
}
char *left = const_cast<char *> ("r"), *up = const_cast<char *> ("u"), *nonunit = const_cast<char *> ("n");
dtrsm_(left, up, transt, nonunit, &N, &P, &one, const_cast<double *> (ptrHHR), &N, exresultTV, &N);
ExtrProjection(x, exresult, exresult);
if (IsIntrApproach)
{
ObtainIntr(x, exresult, result);
}
else
{
exresult->CopyTo(result);
}
delete[] ytxiy;
delete exresult;
if (extempy != nullptr)
delete extempy;
};
