このディレクトリの索引

http://pc12.2ch.net/test/read.cgi/tech/1250204272/381
#  [1] 授業単元: 情報工学:数理I 
#  [2] 問題文(含コード&リンク): ガウス行列を既約ガウス行列に変形する関数を定義せよ 

% *** user: '既約ガウス行列に変形' / 5 ***
'既約ガウス行列に変形'(N,0,_,_行列,_行列) :- !.
'既約ガウス行列に変形'(N,M,A,_行列1,_行列) :-
        list_nth(M,_行列1,_行1),
        list_nth(N,_行1,0),
        M2 is M - 1,
        '既約ガウス行列に変形'(N,M2,A,_行列1,_行列).
'既約ガウス行列に変形'(N,M,A,_行列1,_行列) :-
        list_nth(M,_行列1,_行1),
        list_nth(N,_行1,B),
        \+(B = 0),
/*
        '行基本変形3の適用'(A,B,M,N,_行列1,_行列2),
*/
        '最小公倍数'(N2 * A,N1 * B,_),
        '行基本変形'(N1 # M - N2 # N,_行列1,_行列2),

        M2 is M - 1,
        '既約ガウス行列に変形'(N,M2,A,_行列2,_行列).

% *** user: '既約ガウス行列に変形' / 3 ***
'既約ガウス行列に変形'(1,_既約ガウス行列,_既約ガウス行列) :- !.
'既約ガウス行列に変形'(N,_ガウス行列,_既約ガウス行列) :-
        list_nth(N,_ガウス行列,L0),
        '最初に現れる0ではない要素・位置'(1,L0,_列,Y),
        M is N - 1,
        list_nth(M,_ガウス行列,L),
        '既約ガウス行列に変形'(_列,M,Y,_ガウス行列,G1),
        N2 is N - 1,
        '既約ガウス行列に変形'(N2,G1,_既約ガウス行列),!.

% *** user: '既約ガウス行列に変形' / 2 ***
'既約ガウス行列に変形'(_ガウス行列,_既約ガウス行列) :-
        length(_ガウス行列,Len),
        '既約ガウス行列に変形'(Len,_ガウス行列,G1),
        '既約ガウス行列に変形の二'(1,Len,G1,_既約ガウス行列).

既約ガウス行列に変形の二(N,Len,_既約ガウス行列,_既約ガウス行列) :- N > Len,!.
既約ガウス行列に変形の二(N,Len,G,_既約ガウス行列) :-
        list_nth(N,G,_行),
        list_nth(N,_行,A),
        行基本変形(1 / A # N,G,G1),
        N2 is N + 1,
        既約ガウス行列に変形の二(N2,Len,G1,_既約ガウス行列).

% *** user: 行基本変形3の適用 / 7 ***
行基本変形3の適用(A,B,M,N,_行列1,_行列2,N2) :-
        B >= 0,
        A2 is abs(A),
        B2 is abs(B),
        最小公倍数(N1 * A2,N2 * B2,_),
        行基本変形(N2#M-N1#N,_行列1,_行列2),!.
行基本変形3の適用(A,B,M,N,_行列1,_行列2,N2) :-
        B < 0,
        A2 is abs(A),
        B2 is abs(B),
        最小公倍数(N1 * A2,N2 * B2,_),
        行基本変形(N2#M+N1#N,_行列1,_行列2),!.

% *** user: 行基本変形3の適用 / 6 ***
行基本変形3の適用(A,B,M,N,_行列1,_行列2) :-
        B >= 0,
        A2 is abs(A),
        B2 is abs(B),
        最小公倍数(N1 * A2,N2 * B2,_),
        行基本変形(N2#M-N1#N,_行列1,_行列2),!.
行基本変形3の適用(A,B,M,N,_行列1,_行列2) :-
        B < 0,
        A2 is abs(A),
        B2 is abs(B),
        最小公倍数(N1 * A2,N2 * B2,_),
        行基本変形(N2#M+N1#N,_行列1,_行列2),!.

% *** user: '行基本変形' / 5 ***
'行基本変形'(*,_乗数,_行目,_行列,X) :-
        '行基本変形'(*,_乗数,1,_行目,_行列,X) .

% *** user: '行基本変形' / 3 ***
'行基本変形'(_行列式,_行列,X) :-
        atom(_行列式),
        \+(_行列式 = []),
        & '行列式変換' # [2|pro],
        '行列式述語変換'(_行列式,P),
        '行基本変形'(P,_行列,X),!.
'行基本変形'([],_行列,[]) :-!.
'行基本変形'([N|R1],_行列,[L|R2]) :-
        !,
        list_nth(N,_行列,L),
        '行基本変形'(R1,_行列,R2),!.
'行基本変形'(# _行目1 # _行目2,_行列,X) :-
        list_nth(_行目1,_行列,_行1),
        list_nth(_行目2,_行列,_行2),
        'ならびの位置指定置換'(_行目2,_行1,_行列,_行列1),
        'ならびの位置指定置換'(_行目1,_行2,_行列1,X),!.
'行基本変形'(_乗数1 # _行目1 - _乗数2 # _行目2,_行列,X) :-
        _乗数2 >= 0,
        _乗数1 >= 0,
        !,
        _乗数3 is -1 * _乗数2,
        '行基本変形'(_乗数1 # _行目1 + _乗数3 # _行目2,_行列,X),!.
'行基本変形'(_乗数1 # _行目1 - _乗数2 # _行目2,_行列,X) :-
        _乗数2 >= 0,
        _乗数1 < 0,
        _乗数3 is _乗数1 * (-1),
        !,
        '行基本変形'(_乗数3 # _行目1 + _乗数2 # _行目2,_行列,X),!.
'行基本変形'(_乗数1 # _行目1 - _乗数2 # _行目2,_行列,X) :-
        _乗数2 < 0,
        _乗数1 >= 0,
        _乗数3 is _乗数1 * (-1),
        !,
        '行基本変形'(_乗数3 # _行目1 + _乗数2 # _行目2,_行列,X),!.
'行基本変形'(_乗数1 # _行目1 - _乗数2 # _行目2,_行列,X) :-
        _乗数2 < 0,
        _乗数1 < 0,
        !,
        _乗数3 is -1 * _乗数2,
        '行基本変形'(_乗数1 # _行目1 + _乗数3 # _行目2,_行列,X),!.
'行基本変形'(_乗数1 # _行目1 + _乗数2 # _行目2,_行列,X) :-
        !,
        list_nth(_行目2,_行列,_行2),
        list_nth(_行目1,_行列,_行1),
        findall(U,(member(A,_行1) , U is A * _乗数1),_乗算された行1),
        findall(W,(member(B,_行2) , W is B * _乗数2),_乗算された行2),
        '型推論加算'([_乗算された行1,_乗算された行2],_加算された行),
        replace_nth(1,_行目1,_加算された行,_行列,X),!.
'行基本変形'(# _行目1 + _乗数 # _行目2,_行列,X) :-
        !,
        list_nth(_行目2,_行列,_行2),
        list_nth(_行目1,_行列,_行1),
        findall(U,(member(A,_行2) , U is A * _乗数),_乗算された行),
        '型推論加算'([_乗算された行,_行1],_加算された行),
        replace_nth(1,_行目1,_加算された行,_行列,X),!.
'行基本変形'(# _行目1 - _乗数 # _行目2,_行列,X) :-
        !,
        _乗数2 is -1 * _乗数,
        '行基本変形'(# _行目1 + _乗数2 * _行目2,_行列,X),!.
'行基本変形'(# _行目1 + _乗数 / _除数 * _行目2,_行列,X) :-
        integer(_除数),
        !,
        list_nth(_行目2,_行列,_行2),
        list_nth(_行目1,_行列,_行1),
        findall(U,(member(A,_行2) , U is A * _乗数 // _除数),_除算された行),
        '型推論加算'([_行1,_除算された行],_加算された行),
        replace_nth(1,_行目1,_加算された行,_行列,X),!.
'行基本変形'(# _行目1 + _乗数 / _除数 # _行目2,_行列,X) :-
        \+(integer(_除数)),
        !,
        list_nth(_行目2,_行列,_行2),
        list_nth(_行目1,_行列,_行1),
        findall(U,(member(A,_行2) , U is A * _乗数 / _除数),_除算された行),
        '型推論加算'([_行1,_除算された行],_加算された行),
        replace_nth(1,_行目1,_加算された行,_行列,X),!.
'行基本変形'(# _行目1 - _乗数 / _除数 # _行目2,_行列,X) :-
        !,
        _除数2 is -1 * _除数,
        '行基本変形'(# _行目1 + _乗数 / _除数2 * _行目2,_行列,X),!.
'行基本変形'(_乗数 / _除数 # _行目,_行列,X) :-
        integer(_除数),
        !,
        list_nth(_行目,_行列,_行1),
        findall(X,(member(A,_行1) , X is A * _乗数 // _除数),_行2),
        replace_nth(1,_行目,_行2,_行列,X),!.
'行基本変形'(_乗数 / _除数 # _行目,_行列,X) :-
        \+(integer(_除数)),
        !,
        list_nth(_行目,_行列,_行1),
        findall(X,(member(A,_行1) , X is A * _乗数 / _除数),_行2),
        replace_nth(1,_行目,_行2,_行列,X),!.
'行基本変形'(_乗数 # _行目,_行列,X) :-
        !,
        list_nth(_行目,_行列,_行1),
        findall(X,(member(A,_行1) , X is A * _乗数),_行2),
        replace_nth(1,_行目,_行2,_行列,X),!.

% *** user: 行基本変形 / 5 ***
行基本変形(*,_乗数,_行目,_行列,X) :-
        行基本変形(*,_乗数,1,_行目,_行列,X).

% *** user: 行基本変形 / 6 ***
行基本変形(*,_乗数,_行目,_行目,[_行1|R1],[_行2|R1]) :-
        findall(X,(member(A,_行1) , X is A * _乗数),_行2) .
行基本変形(*,_乗数,M,_行目,[_行|R1],[_行|R2]) :-
        M2 is M + 1,
        行基本変形(*,_乗数,M2,_行目,R1,R2).

% *** user: 正方行列の行列式の値 / 2 ***
正方行列の行列式の値(_正方行列,_行列式の値) :-
        ガウス行列に変形(_正方行列,X,Y),
        '行列式|C|の値'(X,Z1),
        ならびの積(Y,Z2),
        _行列式の値 is Z1 // Z2.

% *** user: ならびの積 / 2 ***
ならびの積([A],A) :- !.
ならびの積([A|R],X) :-
        ならびの積(R,Y),
        X is A * Y.

% *** user: '行列式|C|の値' / 2 ***
'行列式|C|の値'(_行列,_値) :-
        length(_行列,Len),
        findall(U,(for(1,N,Len) , list_nth(N,_行列,_行) , list_nth(N,_行,U)),L),
        ならびの積(L,_値).

要素がゼロ以外に出会うまで([A|R],[],[A|R]) :-
         \+((A = 0;A=0.0)),!.
要素がゼロ以外に出会うまで([0|R],[0|R1],R2) :-
        要素がゼロ以外に出会うまで(R,R1,R2).
要素がゼロ以外に出会うまで([0.0|R],[0.0|R1],R2) :-
        要素がゼロ以外に出会うまで(R,R1,R2).

最初に現れる0ではない要素・位置(Nth,[X|_],Nth,X) :- \+((X = 0;X=0.0)),!.
最初に現れる0ではない要素・位置(Mth,[0|R],Nth,X) :-
        Mth_2 is Mth + 1,
        最初に現れる0ではない要素・位置(Mth_2,R,Nth,X) .
最初に現れる0ではない要素・位置(Mth,[0.0|R],Nth,X) :-
        Mth_2 is Mth + 1,
        最初に現れる0ではない要素・位置(Mth_2,R,Nth,X) .

% *** user: ならびの位置指定置換 / 4 ***
ならびの位置指定置換(1,A,[_|R],[A|R]) :-
        !.
ならびの位置指定置換(N,A,[B|R1],[B|R2]) :-
        N1 is N - 1,
        ならびの位置指定置換(N1,A,R1,R2) .

最小公倍数(N1 * A,B,C) :-
        integer(B),
        最小公倍数(A,B,C),
        N1 is C // A,!.
最小公倍数(A,N2 * B,C) :-
        integer(A),
        最小公倍数(A,B,C),
        N2 is C // B,!.
最小公倍数(N1 * A,N2 * B,C) :-
        最小公倍数(A,B,C),
        N1 is C // A,
        N2 is C // B,!.
最小公倍数(A,B,X) :-
        integer(A),
        integer(B),
        最大公約数をユークリッドの互除法で求める(A,B,C),
        X is A * B // C.

最小公倍数([N1 * A|R],X) :-
         findall(U,member(_ * U,[N1 * A|R]),L1),
         最小公倍数(L1,X),
         最小公倍数_2([N1 * A|R],X),!.
最小公倍数([A,B],X) :-
        最小公倍数(A,B,X),!.
最小公倍数([A|R],X) :-
        最小公倍数(R,B),
        最小公倍数(A,B,X),!.

最小公倍数_2([],_) :- !.
最小公倍数_2([N * A|R],Y) :-
        N is Y // A,
        最小公倍数_2(R,Y),!.
最小公倍数_2([A|R],Y) :-
        integer(A),
        最小公倍数_2(R,Y),!.

最大公約数をユークリッドの互除法で求める(M,N,N) :-
        0 is M mod N,!.
最大公約数をユークリッドの互除法で求める(M,N,X) :-
        Mod is M mod N,
        最大公約数をユークリッドの互除法で求める(N,Mod,X).