Форум «Всё о Паскале» _ Делфи _ функция Todec, вопрос по ней, когда она в программу внедрена
Автор: neZvezda 19.05.2006 0:45
Есть функция ToDec (перевод из любой сист. счисления в 10ричную).
function ToDec(n:string; radix:longint):longint; const digit : string[16] = '0123456789ABCDEF'; var m, i : longint; begin m:=0; while n[1]='0' do delete(n,1,1);
for i:=1 to length(n) do m:=m*radix+pos(n[i],digit)-1; ToDec:=m; end;
По ней есть вопрос, когда она в программу внедрена. Ошибку дает, когда есть одно определенное условие. Думаю, у знающего человека займет не более 10 минут. help
есть вектор А и Б. Состоят из единиц и двоек. Заносятся в матрицу. Для этого идет перевод в двоичную систему, все 2ки из векторов заменяются на 1, 1цы из векторов - на 0. Далее при помощи функции ToDec производится преобразование в десятичное представление. Так вот, если имеется вектор, состоящий из единиц, 11111. Тогда при переводе в двоичное число, будет 00000. А строка программы while n[1]='0' do delete(n,1,1); из строки n удаляет один символ, начиная с первого. Если там все нули, тогда удаляет строку вобще всю! И идет ошибка в программе. перед while надо сделать условие? типа того
for i:= 1 to 5 do begin if n[i]=0 then не удалять
я так понимаю, что если все элементы вектора равны 0, тогда не удалять? или как все это реализовать)) запуталась.
Автор: Malice 19.05.2006 0:57
Тогда вот так:
Код
while (n[1]='0') and (length(n)>1) do delete(n,1,1);
Автор: neZvezda 19.05.2006 1:08
Цитата(Malice @ 18.05.2006 20:57)
Тогда вот так:
Код
while (n[1]='0') and (length(n)>1) do delete(n,1,1);
при этом условии программа ошибка не дает, но незультат ее НЕверен. все же склоняюсь к тому, чтобы перед вайл было условие не удаления строки, если там все 0. Хотя, не знаю...
Автор: volvo 19.05.2006 1:20
Ну, тогда приводи код ПРОГРАММЫ, если нужна помощь... К процедуре перевода ToDec претензий быть больше не может, она будет работать...
Вопрос теперь в том, КАК ты ее вызываешь, и что делаешь ПЕРЕД вызовом...
Цитата
все же склоняюсь к тому, чтобы перед вайл было условие не удаления строки, если там все 0
А это без разницы: что '000' выдаст 0 в результате конвертации, что '0' выдаст тот же 0. А вот согласно логике твоей программы может потребоваться, чтобы '111' и '1111' выдавали разные результаты (если ты делаешь что-то типа хеша, например) - тогда такой подход в корне неверен...
Так что условие и программу - в студию
Автор: neZvezda 19.05.2006 1:36
Цитата(volvo @ 18.05.2006 21:20)
Так что условие и программу - в студию
эм..она достаточно большая, из модулей состоит.
два сюда кину, которые взаимодействую, но они большие..звиняйте
TfMainTestTask = class(TForm) Label1: TLabel; mQuestion: TMemo; rgAnswers: TRadioGroup; btnNext: TButton; Image1: TImage; procedure btnExitClick(Sender: TObject); procedure btnNextClick(Sender: TObject); procedure FormShow(Sender: TObject); Public Answers : TStringList; // Список ответов для соответствующего вопроса Question : TQuestion; // Текущий вопрос
TaskQuestions : Array[1..9] of TQuestion; // перечень вопросов для теста UserResultsArray : Array[1..9] of Byte; // Вектор результатов PupilResultsArray : Array[1..9] of Byte; TestResultArray : Array[1..8] of Byte;
QuestionCount : Word; // Общее количество вопросов для данного теста BaseQuestion : Integer; // "центральный" вопрос
StepsCounter : Byte; // текущий шаг ResultsCounter : Byte; // текущая позиция в PupilResultsArray
LeftQuestionNo : Byte; // текущий номер "левого" вопроса RightQuestonNo : Byte; // текущий номер "правого" вопроса
Function GetStrPupilArray : String; Function GetStrTestArray : String; Function GetResult(PupilVector, TestVector : String) : Integer;
End;
var fMainTestTask: TfMainTestTask;
implementation
uses uMain;
{$R *.dfm}
Procedure TfMainTestTask.InitTaskValues; Var i, j : Integer; Begin QuestionCount := 9; // Общее количество вопросов для данного теста StepsCounter := 0; ResultsCounter := 0; BaseQuestion := 5; LeftQuestionNo := BaseQuestion - 1; // счётчик для понижения сложности RightQuestonNo := BaseQuestion + 1; // счётчик для повышения сложности.
// Первоначально создаём список вопросов со сложностями от 1 до 9 For i := 1 to 9 do Begin GetTaskQuestion(Question, i); TaskQuestions[i] := Question; End;
// Инициализируем констатнтный вектор For i := 1 to _2_N(nMax) do BaseVector[i] := _2_N(nMax) - i + 1;
// Инициализируем матрицу For i := 1 to _2_N(nMax) do Begin For j := 1 to (_2_N(nMax) div 2) do Begin Matrix[i, j] := BaseVector[GetNumber(i, j, nMax) + 1]; End; End;
End;
Procedure TfMainTestTask.ReDraw; Var i : Word; QuestionPos : Integer; Begin Question.Type_ := 'Задача'; Answers := TStringList.Create; QuestionPos := BaseQuestion; // номер выбираемого вопроса
If BaseQuestion < 0 then // необходимо понизить сложность ? Begin If StepsCounter <> 0 then // если выполняем не первый раз Begin QuestionPos := LeftQuestionNo; // понижаем сложность Dec(LeftQuestionNo); PupilResultsArray[ResultsCounter] := 2; End; End Else Begin If StepsCounter <> 0 then Begin QuestionPos := RightQuestonNo; // повышаем сложность PupilResultsArray[ResultsCounter] := 1; Inc(RightQuestonNo); End; End;
If StepsCounter <> 0 then Inc(ResultsCounter); //если выполняем не первый раз
Inc(StepsCounter); End;
Procedure TfMainTestTask.FormShow(Sender: TObject); Begin InitTaskValues; ReDraw; End;
procedure TfMainTestTask.btnExitClick(Sender: TObject); begin If Application.MessageBox('Вы уверены, то хотите закончить тестирование?', 'Внимание', MB_ICONEXCLAMATION+MB_YESNO) = idYes then Begin Close; End;
End;
procedure TfMainTestTask.btnNextClick(Sender: TObject); Var TestVector : String; PupilVector : String; Result,Result1 : Integer; Begin
If rgAnswers.ItemIndex = -1 then Application.MessageBox('Ответ не выбран!', 'Внимание', MB_ICONEXCLAMATION+MB_OK) Else Begin If IsAnswerTrue(Question, rgAnswers.Items[rgAnswers.ItemIndex]) = True then Begin PupilResultsArray[ResultsCounter] := 1; If BaseQuestion < 0 then BaseQuestion := Abs(BaseQuestion); End Else Begin PupilResultsArray[ResultsCounter] := 2; BaseQuestion := -Abs(BaseQuestion); End;
Inc(ResultsCounter);
If StepsCounter >= Abs(BaseQuestion) then Begin PupilVector := GetStrPupilArray; TestVector := GetStrTestArray; Result := GetResult(PupilVector, TestVector);
If (Result <= 512) and (Result >= 420) then Begin ShowMessage('Результат: 5 '); Result1:=5; End;
If (Result < 420) and (Result >= 312) then Begin ShowMessage('Результат: 4 '); Result1:=4; End;
If (Result < 312) and (Result >= 212) then Begin ShowMessage('Результат: 3 '); Result1:=3; End;
If (Result < 212) then Begin ShowMessage(' Вы плохо усвоили материал, результаты вашего теста очень плохие.' + ' Поэтому Вы переходите на полную форму обучения!'); fMain.IsFullType := True; Result1:=2; End; //начали заносить информацию в базу данных
With fMain.Query do Begin Close; SQL.Clear; SQL.Add('INSERT INTO Тесты '); SQL.Add('(КодУченика,ТипТеста,Оценка) VALUES('+IntToStr(fMain.KodUchenika)+ ',"Задача",'+ IntToStr(Result1) +');'); ExecSQL; end; //закончили заносить информацию в базу данных fMainTestTask.Close; End Else ReDraw; End; End;
function TfMainTestTask.GetStrTestArray: String; Var i : Word; S : String; begin S := ''; For i := 1 to 8 do Begin TestResultArray[i] := PupilResultsArray[i]; S := S + IntToStr(PupilResultsArray[i]); End;
GetStrTestArray := S; end;
function TfMainTestTask.GetStrPupilArray: String; Var i : Word; S : String; begin S := ''; For i := 1 to 9 do Begin S := S + IntToStr(PupilResultsArray[i]); End;
GetStrPupilArray := S; end;
function TfMainTestTask.GetResult(PupilVector, TestVector: String): Integer; Var X, Y : Word; i : Integer; begin For i := 1 to 9 do Begin If PupilVector[i] = '2' then PupilVector[i] := '1' Else PupilVector[i] := '0'; End;
For i := 1 to 8 do Begin If TestVector[i] = '2' then TestVector[i] := '1' Else TestVector[i] := '1'; End;
X := ToDec(PupilVector, 2); Y := ToDec(TestVector, 2);
GetResult := Matrix[X, Y]; end;
End.
и второй модуль, кусочек
"(Показать/Скрыть)
Unit uSystem;
Interface
Uses SysUtils, Classes, DB, ADODB;
Const nMax = 9;
Type TMatrix = array [ 1..512, 1..256 ] of Integer;
TVektor = array [ 1..512 ] of Integer;
Function GetTaskQuestion(Var Question : TQuestion; Level : Byte) : Boolean;
Function _2_N ( N : Integer ) : Integer; Function Bit( X : Integer; N : Integer ) : Integer; Function Vektor( X, N : Integer ) : String; Function GetNumber ( n1, n2, n : Integer ) : Integer; function ToDec(n:string; radix:longint):longint;
Implementation
uses uMain;
Var i, QuestionNo, QuestionsCount : Word;
Function GetTaskQuestion(Var Question : TQuestion; Level : Byte) : Boolean; Var i, QuestionNo, QuestionsCount : Word; Begin // Получаем список всех вопросов главы Question.Chapters With fMain.Query do Begin Close; SQL.Clear; SQL.Add(' SELECT * '); SQL.Add(' FROM Вопросы '); SQL.Add(' WHERE КодГлавы = ' + IntToStr(Question.Chapter.Key) + ' '); SQL.Add(' AND Тип = "Задача" '); SQL.Add(' AND Сложность = "' + IntToStr(Level) + '" '); SQL.Add(' ORDER BY Вопрос ');
Open;
If IsEmpty then Begin GetTaskQuestion := False; Exit; End;
// Получаем количество вопросов для данной главы QuestionsCount := 0; First; While Not EOF do Begin Inc(QuestionsCount); Next; End;
// Случайным образом выбираем вопрос Randomize; QuestionNo := Random(QuestionsCount) + 1;
// Переходим на запись QuestionNo First; For i := 1 to QuestionNo do Next;
Function _2_N ( N : Integer ) : Integer; Begin _2_N := 1 shl n; End;
Function Bit( X : Integer; N : Integer ) : Integer; Var B : Integer; Begin B := 1 shl (n-1); Bit := 0;
If (X and B) <> 0 then Bit:=1; End;
Function Vektor( X, N : Integer ) : String; Var I : Integer; S : String; Begin S := '( ';
For i := 1 to n do Begin If Bit(X, N - i + 1 ) = 0 then S := S + '1, ' Else S := S + '2, '; End;
S[ Length(S) - 1 ] := ' '; S[ Length(S) ] := ')';
Vektor := S; End;
Function GetNumber ( n1, n2, n : Integer ) : Integer; var i, k, rez : integer; Begin k := Bit(n1,n); Rez:=k shl (n-1);
For i := n - 1 downto 1 do Begin If (i and 1) = 0 then Begin k := Bit(n2 shl k,i); Rez := Rez or (k shl (i-1)); End Else Begin k := Bit(n1 shl k,i+1); Rez := rez or (k shl (i-1)); End; End; GetNumber := Rez; End;
function ToDec(n:string; radix:longint):longint; // перевод двоичного в десятичное const digit : string[16] = '0123456789ABCDEF'; var m, i : longint; begin m:=0; while n[1]='0' do delete(n,1,1); for i:=1 to length(n) do m:=m*radix+pos(n[i],digit)-1; ToDec:=m; end;
End.
Автор: volvo 19.05.2006 3:46
Первое, что бросилось в глаза -
For i := 1 to 8 do Begin If TestVector[i] = '2' then TestVector[i] := '1' Else TestVector[i] := '1'; // Уверена, что не TestVector[i] := '0' ? End;
А в остальном - присоедини архив с программой (только без EXE ), так сложно что-то говорить. Надо видеть всю программу, а не ее куски.