# SPDX-License-Identifier: GPL-2.0-or-later
# LocalizeRingForHomalg: A Package for Localization of Polynomial Rings
#
# Implementations
#
## Implementations for localized rings.
####################################
#
# global variables:
#
####################################
#possibility to use the underlying global ringtable?
InstallValue( CommonHomalgTableForLocalizedRingsTools,
rec(
IsZero := a -> IsZero( Numerator( a ) ),
IsOne := a -> IsZero( Numerator( a ) - Denominator( a ) ),
Minus :=
function( a, b )
local c;
c := Cancel( Denominator( a ), Denominator( b ) );
return HomalgLocalRingElement(
Numerator( a ) * c[2]
-Numerator( b ) * c[1],
Denominator( a ) * c[2],
HomalgRing( a ) );
end,
#HomalgLocalRingElement will cancel here
DivideByUnit :=
function( a, u )
return HomalgLocalRingElement(
Numerator( a ) * Denominator( u ),
Denominator( a ) * Numerator( u ),
HomalgRing( a ) );
end,
IsUnit :=
function( R, u )
local globalR;
globalR := AssociatedComputationRing( R );
return not IsZero( DecideZeroRows( HomalgMatrix ( [ Numerator( u ) ], 1, 1, globalR ), GeneratorsOfMaximalLeftIdeal( R ) ) );
end,
Sum :=
function( a, b )
local c;
c := Cancel( Denominator( a ), Denominator( b ) );
return HomalgLocalRingElement(
Numerator( a ) * c[2]
+Numerator( b ) * c[1],
Denominator( a ) * c[2],
HomalgRing( a ) );
end,
#HomalgLocalRingElement will cancel here
Product :=
function( a, b )
return HomalgLocalRingElement(
Numerator( a ) * Numerator( b ),
Denominator( a ) * Denominator( b ),
HomalgRing( a ) );
end,
ShallowCopy := C -> List( Eval( C ), ShallowCopy ),
InitialMatrix :=
function( C )
local R;
R := AssociatedComputationRing( C );
return [
HomalgInitialMatrix( NumberRows( C ), NumberColumns( C ), R ),
One( R )
];
end,
InitialIdentityMatrix :=
function( C )
local R;
R := AssociatedComputationRing( C );
return [
HomalgInitialIdentityMatrix( NumberRows( C ), R ),
One( R )
];
end,
ZeroMatrix :=
function( C )
local R;
R := AssociatedComputationRing( C );
return [
HomalgZeroMatrix( NumberRows( C ), NumberColumns( C ), R ),
One( R )
];
end,
IdentityMatrix :=
function( C )
local R;
R := AssociatedComputationRing( C );
return [
HomalgIdentityMatrix( NumberRows( C ), R ),
One( R )
];
end,
AreEqualMatrices :=
function( A, B )
local a, b;
a := Eval( A );
b := Eval( B );
return IsZero( b[2] * a[1] - a[2] * b[1] );
end,
Involution :=
function( M )
local m;
m := Eval( M );
return [
Involution( m[1] ),
m[2]
];
end,
CertainRows :=
function( M, plist )
local m;
m := Eval( M );
return [
CertainRows( m[1], plist ),
m[2]
];
end,
CertainColumns :=
function( M, plist )
local m;
m := Eval( M );
return [
CertainColumns( m[1], plist ),
m[2]
];
end,
UnionOfRowsPair :=
function( A, B )
local a, b, c;
a := Eval( A );
b := Eval( B );
c := Cancel( a[2], b[2] );
return [
UnionOfRows( c[2] * a[1], c[1] * b[1] ),
c[1] * b[2]
];
end,
UnionOfColumnsPair :=
function( A, B )
local a, b, c;
a := Eval( A );
b := Eval( B );
c := Cancel( a[2], b[2] );
return [
UnionOfColumns( c[2] * a[1], c[1] * b[1] ),
c[1] * b[2]
];
end,
DiagMat :=
function( e )
local R, u, NumerList, A, a, c;
R := HomalgRing( e[1] );
u := One( AssociatedComputationRing ( R ) );
NumerList := [ ];
for A in e do
a := Eval( A );
#u/a[2]=c[1]/c[2] <=> u*c[2]=a[2]*c[1]
#NumerList/u and a[1]/a[2]
# --->
#(c[2]*NumerList)/(c[2]*u) and
#(c[1]*a[1])/(c[1]*a[2]) = (c[1]*a[1])/(c[2]*u)
c := Cancel( u, a[2] );
u := u * c[2];
NumerList := c[2] * NumerList;
Add( NumerList , c[1] * a[1] );
od;
return [ DiagMat( NumerList ), u ];
end,
KroneckerMat :=
function( A, B )
local a, b;
a := Eval( A );
b := Eval( B );
return [
KroneckerMat( a[1], b[1] ),
a[2] * b[2]
];
end,
DualKroneckerMat :=
function( A, B )
local a, b;
a := Eval( A );
b := Eval( B );
return [
DualKroneckerMat( a[1], b[1] ),
a[2] * b[2]
];
end,
MulMat :=
function( a, A )
local e, c;
e := Eval( A );
c := Cancel( Numerator( a ), Denominator( a ) * e[2] );
return [
c[1] * e[1],
c[2]
];
end,
MulMatRight :=
function( A, a )
local e, c;
e := Eval( A );
c := Cancel( Numerator( a ), e[2] * Denominator( a ) );
return [
e[1] * c[1],
c[2]
];
end,
AddMat :=
function( A, B )
local a, b, c;
a := Eval( A );
b := Eval( B );
c := Cancel( a[2], b[2] );
return [
c[2] * a[1] + c[1] * b[1],
c[1] * b[2]
];
end,
SubMat :=
function( A, B )
local a, b, c;
a := Eval( A );
b := Eval( B );
c := Cancel( a[2], b[2] );
return [
c[2] * a[1] - c[1] * b[1],
c[1] * b[2]
];
end,
Compose :=
function( A, B )
local a, b;
a := Eval( A );
b := Eval( B );
return [
a[1] * b[1],
a[2] * b[2]
];
end,
NumberRows := C -> NumberRows( Numerator( C ) ),
NumberColumns := C -> NumberColumns( Numerator( C ) ),
IsZeroMatrix := M -> IsZero( Numerator( M ) ),
# -> fallback
# IsIdentityMatrix :=
# function( M )
#
# end,
IsDiagonalMatrix := M -> IsDiagonalMatrix( Numerator( M ) ),
ZeroRows := C -> ZeroRows( Numerator( C ) ),
ZeroColumns := C -> ZeroColumns( Numerator( C ) ),
# GetColumnIndependentUnitPositions :=
# function( M, pos_list )
# local pos, f;
# f := function( a )
# if IsList(a) then
# return [a[2],a[1]];
# else
# return a;
# fi;
# end;
# pos:=GetRowIndependentUnitPositions( Involution( M ), List( pos_list, f ) );
# if pos <> [ ] then
# SetIsZero( M, false );
# fi;
# return pos;
# end,
#
# GetRowIndependentUnitPositions :=
# function( M, pos_list )
# local rest, pos, j, l, k;
# rest := [ 1 .. NumberRows( M ) ];
# pos := [ ];
# for j in [ 1 .. NumberColumns( M ) ] do
# l := GetUnitPosition( CertainColumns( M, [ j ] ), List( Filtered( [ 1 .. NumberRows( M ) ], a->not( a in rest )), b->[b,1] ) );
# if l <> fail then
# k := l[1];
# Add( pos, [ j, k ] );
# rest := Filtered( rest, a -> IsZero( M[ a, j ] ) );
# fi;
#
# od;
#
# if pos <> [ ] then
# SetIsZero( M, false );
# fi;
# return pos;
# end,
GetColumnIndependentUnitPositions :=
function( M, pos_list )
local pos, f;
f := function( a )
if IsList(a) then
return [a[2],a[1]];
else
return a;
fi;
end;
pos:=GetRowIndependentUnitPositions( Involution( M ), List( pos_list, f ) );
if pos <> [ ] then
SetIsZero( M, false );
fi;
return pos;
end,
GetRowIndependentUnitPositions :=
function( M, pos_list )
local rest, pos, j, l, k;
rest := [ 1 .. NumberRows( M ) ];
pos := [ ];
for j in [ 1 .. NumberColumns( M ) ] do
l := GetUnitPosition( CertainColumns( M, [ j ] ), List( Filtered( [ 1 .. NumberRows( M ) ], a->not( a in rest )), b->[b,1] ) );
if l <> fail then
k := l[1];
Add( pos, [ j, k ] );
rest := Filtered( rest, a -> IsZero( M[ a, j ] ) );
fi;
od;
if pos <> [ ] then
SetIsZero( M, false );
fi;
return pos;
end,
GetUnitPosition :=
function( M, pos_list )
local R, A, i, N, l;
R:= AssociatedComputationRing( M );
Assert( 6, IsIdenticalObj( R, AssociatedGlobalRing( M ) ) );#should not be called by mora
#our stuff
A := R * GeneratorsOfMaximalLeftIdeal( HomalgRing( M ) );
for i in [ 1 .. NumberColumns( M ) ] do
if not i in pos_list then
N := CertainColumns( Numerator( M ) , [ i ] );
N := DecideZero( N, A );
l := GetUnitPosition( N );
if l <> fail then
return [l[1],i];
fi;
fi;
od;
return fail;
end,
#
# DivideEntryByUnit :=
# function( M, i, j, u )
#
#
# end,
# CopyRowToIdentityMatrix :=
# function( M, i, L, j )
#
#
# end,
# CopyColumnToIdentityMatrix :=
# function( M, j, L, i )
#
#
# end,
# SetColumnToZero :=
# function( M, i, j )
#
#
# end,
# GetCleanRowsPositions :=
# function( M, clean_columns )
#
#
# end,
)
);
# ##
# InstallMethod( Diff,
# "for homalg matrices",
# [ IsHomalgLocalMatrixRep, IsHomalgLocalMatrixRep ],
# function( D, N )
# local R, T, RP, diff;
# R := HomalgRing( D );
# if not IsIdenticalObj( R, HomalgRing( N ) ) then
# Error( "the two matrices must be defined over identically the same ring\n" );
# fi;
# RP := homalgTable( R );
# if IsBound(RP!.Diff) then
# diff := RP!.Diff( D, N );
# if IshomalgExternalObjectRep( diff ) then
# diff := HomalgMatrix( diff, NumberRows( D ) * NumberRows( N ), NumberColumns( D ) * NumberColumns( N ), R );
# fi;
# return diff;
# fi;
# if not IsHomalgInternalRingRep( R ) then
# Error( "could not find a procedure called Diff ",
# "in the homalgTable of the non-internal ring\n" );
# fi;
# TryNextMethod( );
# end );
# ##
# InstallMethod( ModuleOfKaehlerDifferentials,
# "for homalg rings",
# [ IsHomalgRing and HasRingRelations ],
# function( R )
# local A, var, I, jac;
# A := AmbientRing( R );
# # if not ( HasIsFreePolynomialRing( A ) and IsFreePolynomialRing( A ) ) then
# # TryNextMethod( );
# # fi;
# var := Indeterminates( A );
# var := HomalgMatrix( var, 1, Length( var ), A );
# I := MatrixOfRelations( R );
# jac := R * Diff( var, I );
# return LeftPresentation( jac );
# end );
¤ Dauer der Verarbeitung: 0.6 Sekunden
¤
*© Formatika GbR, Deutschland
|
|
